{-# LANGUAGE CPP                        #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# OPTIONS_GHC -fno-warn-unused-imports#-}

module Data.KeyStore.PasswordManager
    ( PMConfig(..)
    , PW(..)
    , PW_(..)
    , SessionDescriptor(..)
    , CollectConfig(..)
    , defaultCollectConfig
    , Password(..)
    , PasswordName(..)
    , PasswordText(..)
    , SessionName(..)
    , EnvVar(..)
    , passwordManager
    , defaultHashDescription
    , defaultSampleScript
    , hashMasterPassword
    , bindMasterPassword
    , setup
    , login
    , passwordValid
    , passwordValid'
    , isStorePresent
    , amLoggedIn
    , isBound
    , import_
    , load
    , loadPlus
    , psComment
    , collect
    , prime
    , select
    , deletePassword
    , deletePasswordPlus
    , deleteSession
    , status
    , prompt
    , passwords
    , passwordsPlus
    , sessions
    , infoPassword
    , infoPassword_
    , infoPasswordPlus
    , infoPasswordPlus_
    , dump
    , collectShell
    -- password manager CLI internals
    , passwordManager'
    , PMCommand(..)
    , pmCommandParser
    -- debugging
    , getStore
    ) where

import           Data.KeyStore.Types.PasswordStoreModel
import           Data.KeyStore.Types
import           Data.KeyStore.KS.Crypto
import           Data.KeyStore.KS.CPRNG
import           Data.KeyStore.Version
import qualified Data.Aeson                               as A
import qualified Data.ByteString.Char8                    as B
import qualified Data.ByteString.Lazy                     as BL
import qualified Data.ByteString.Base64                   as B64
import qualified Data.Text                                as T
import qualified Data.Map                                 as Map
import           Data.Time
import           Data.Monoid
import           Data.API.Types
import           Data.API.JSON
import           Data.Maybe
import qualified Text.PrettyPrint.ANSI.Leijen             as P
import           Text.Printf
import qualified Control.Lens                             as L
import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           System.Directory
import qualified System.Environment                       as E
import           System.SetEnv
import           System.Exit
import           System.IO
import qualified Options.Applicative                      as O
import           Options.Applicative

#if MIN_VERSION_time(1,5,0)
#else
import           System.Locale (defaultTimeLocale)
#endif

-- | The password manager is used for storing locally the passwords and session
-- tokens of a single user.  The password used to encode the store is stored in
-- an environment variable and the passwords and tokens are stored in a file.
-- The file and and environment cariable are specified in the 'PWConfig' record.
-- (The attributes of each password and session list, including the environment
-- variables that they are communicated through, is statically specified
-- with the PW class below.)

data PMConfig p =
  PMConfig
    { forall p. PMConfig p -> FilePath
_pmc_location       :: FilePath     -- ^ file in which to store the encrypted passords
    , forall p. PMConfig p -> EnvVar
_pmc_env_var        :: EnvVar       -- ^ the environmant variable containing the master password used to secure the store
    , forall p. PMConfig p -> FilePath
_pmc_keystore_msg   :: String       -- ^ error message to be used on failure to locate the keystore
    , forall p. PMConfig p -> FilePath
_pmc_password_msg   :: String       -- ^ error message to be used on failure to locate the master password
    , forall p. PMConfig p -> IO ()
_pmc_shell          :: IO ()        -- ^ for firing up an interactive shell on successful login
    , forall p. PMConfig p -> HashDescription
_pmc_hash_descr     :: HashDescription
                                          -- ^ for generating has descriptions (can use 'defaultHashDescription' here)
    , forall p. PMConfig p -> Bool
_pmc_allow_dumps    :: Bool         -- ^ must be true to enable 'dump' commands
    , forall p. PMConfig p -> FilePath
_pmc_dump_prefix    :: String       -- ^ the prefix string to be used in making up the commands from dump scripts
    , forall p. PMConfig p -> Maybe FilePath
_pmc_sample_script  :: Maybe String -- ^ the sample script
    , forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_plus_env_var   :: PasswordName -> Maybe EnvVar
                                          -- ^ map the dynamic (plus) passwords to their environment variables
    }

-- | The PW class provides all of the information on the bounded enumeration type used to identify the passwords
class (Bounded p,Enum p,Eq p, Ord p,Show p) => PW p where
  -- | the name by which the password is known
  pwName       :: p -> PasswordName
  pwName       = Text -> PasswordName
PasswordName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show
  -- | parse a PasswordName into a p
  parsePwName  :: PasswordName -> Maybe p
  parsePwName  = \PasswordName
pnm -> forall a. [a] -> Maybe a
listToMaybe [ p
p | p
p<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], forall p. PW p => p -> PasswordName
pwName p
p forall a. Eq a => a -> a -> Bool
== PasswordName
pnm ]
  -- | whether the passwords is a session and if so a function for extracting the session name from the secret password text
  isSession    :: p -> Maybe (PasswordText -> Either String SessionDescriptor)
  isSession    = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
  -- | whether the password is a one-shot password, needing to be primed to be used
  isOneShot    :: p -> Bool
  isOneShot    = forall a b. a -> b -> a
const Bool
False
  -- | the environment variable where the password is expected to be found by the client/deployment scripts
  enVar        :: p -> EnvVar
  enVar        = Text -> EnvVar
EnvVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
T.append Text
"KEY_pw_") forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordName -> Text
_PasswordName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. PW p => p -> PasswordName
pwName
  -- | a brief description of the password in a few words
  summarize     :: p -> String
  summarize  p
_  = FilePath
""
  -- | a description of the password
  describe     :: p -> String
  describe  p
p  = (Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> PasswordName
pwName p
p) forall a. [a] -> [a] -> [a]
++ FilePath
": description to follow"

-- | we resort to phantom types when we have no other way of passing PW into a
-- function (see 'defaultSampleScript')
data PW_ p = PW_

cast_pmc :: PMConfig p -> p -> p
cast_pmc :: forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
_ p
p = p
p

cast_pw :: PW_ p -> p -> p
cast_pw :: forall p. PW_ p -> p -> p
cast_pw PW_ p
_ p
p = p
p

-- each session is named and may be a one-shot session
data SessionDescriptor =
  SessionDescriptor
    { SessionDescriptor -> SessionName
_sd_name      :: SessionName
    , SessionDescriptor -> Bool
_sd_isOneShot :: Bool
    }
  deriving (Int -> SessionDescriptor -> ShowS
[SessionDescriptor] -> ShowS
SessionDescriptor -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SessionDescriptor] -> ShowS
$cshowList :: [SessionDescriptor] -> ShowS
show :: SessionDescriptor -> FilePath
$cshow :: SessionDescriptor -> FilePath
showsPrec :: Int -> SessionDescriptor -> ShowS
$cshowsPrec :: Int -> SessionDescriptor -> ShowS
Show)

-- | the client calls 'collect' to bind the passwords into the environment
data CollectConfig p =
  CollectConfig
    { forall p. CollectConfig p -> Bool
_cc_optional :: Bool  -- ^ if True , collect will not report an error if the master password is missing
    , forall p. CollectConfig p -> [p]
_cc_active   :: [p]   -- ^ the list of active passwords for this collection
    }

-- | raise an error if not logged in and collect all of the passwords
defaultCollectConfig :: PW p => CollectConfig p
defaultCollectConfig :: forall p. PW p => CollectConfig p
defaultCollectConfig =
  CollectConfig
    { _cc_optional :: Bool
_cc_optional = Bool
True
    , _cc_active :: [p]
_cc_active   = [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
    }

-- | the password manager CLI: it just needs the config and command line
passwordManager :: PW p => PMConfig p -> [String] -> IO ()
passwordManager :: forall p. PW p => PMConfig p -> [FilePath] -> IO ()
passwordManager PMConfig p
pmc [FilePath]
args = forall p. PW p => PMConfig p -> [FilePath] -> IO (PMCommand p)
parsePMCommand PMConfig p
pmc [FilePath]
args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall p. PW p => PMConfig p -> PMCommand p -> IO ()
passwordManager' PMConfig p
pmc

-- | a sample 'HashDescription' generator to help with setting up 'PMConfig'
defaultHashDescription :: Salt -> HashDescription
defaultHashDescription :: Salt -> HashDescription
defaultHashDescription Salt
st =
    HashDescription
        { _hashd_comment :: Comment
_hashd_comment      = Comment
"PM master password"
        , _hashd_prf :: HashPRF
_hashd_prf          = HashPRF
PRF_sha512
        , _hashd_iterations :: Iterations
_hashd_iterations   = Iterations
5000
        , _hashd_width_octets :: Octets
_hashd_width_octets = Octets
32
        , _hashd_salt_octets :: Octets
_hashd_salt_octets  = Int -> Octets
Octets forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ Salt -> Binary
_Salt Salt
st
        , _hashd_salt :: Salt
_hashd_salt         = Salt
st
        }

-- | sample sample-script generator to help with setting up 'PMConfig'
defaultSampleScript :: PW p => PW_ p -> String -> String
defaultSampleScript :: forall p. PW p => PW_ p -> ShowS
defaultSampleScript PW_ p
pw_ FilePath
pfx = forall p.
PW p =>
FilePath
-> PasswordStoreComment
-> [(p, PasswordText)]
-> [(p, SessionName)]
-> FilePath
format_dump FilePath
pfx PasswordStoreComment
cmt (forall a b. (a -> b) -> [a] -> [b]
map p -> (p, PasswordText)
f [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]) []
  where
    f :: p -> (p, PasswordText)
f p
p = (,) p
p forall a b. (a -> b) -> a -> b
$ Text -> PasswordText
PasswordText forall a b. (a -> b) -> a -> b
$ Text
"secret-" Text -> Text -> Text
`T.append` PasswordName -> Text
_PasswordName (forall p. PW p => p -> PasswordName
pwName forall a b. (a -> b) -> a -> b
$ forall p. PW_ p -> p -> p
cast_pw PW_ p
pw_ p
p)

    cmt :: PasswordStoreComment
cmt = Text -> PasswordStoreComment
PasswordStoreComment forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
"loaded by the sample script"

-- | hashing the master password to create the private key for securing the store
hashMasterPassword :: PW p => PMConfig p -> String -> PasswordText
hashMasterPassword :: forall p. PW p => PMConfig p -> FilePath -> PasswordText
hashMasterPassword PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} FilePath
pw =
    Text -> PasswordText
PasswordText forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B.unpack forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString
B64.encode forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ HashData -> Binary
_HashData forall a b. (a -> b) -> a -> b
$ Hash -> HashData
_hash_hash forall a b. (a -> b) -> a -> b
$
        HashDescription -> ClearText -> Hash
hashKS_ HashDescription
_pmc_hash_descr forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
B.pack FilePath
pw

-- | bind the master password in the environment
bindMasterPassword :: PW p => PMConfig p -> PasswordText -> IO ()
bindMasterPassword :: forall p. PW p => PMConfig p -> PasswordText -> IO ()
bindMasterPassword PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} = EnvVar -> PasswordText -> IO ()
set_env EnvVar
_pmc_env_var

-- | create an empty passowrd store; if the boolean flag is False then
-- an interactive shell is fired up with access to the new store;
-- if no password is specified then one is read from stdin
setup :: PW p
      => PMConfig p
      -> Bool                       -- ^ => don't fire up an interactive shell with access to the new store
      -> Maybe PasswordText         -- ^ the master password
      -> IO ()
setup :: forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
setup PMConfig p
pmc Bool
no_li Maybe PasswordText
mb_pwt = do
    -- check there isn't a store there already
    Bool
ex <- FilePath -> IO Bool
doesFileExist FilePath
_pmc_location
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ex forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"password store already exists in: " forall a. [a] -> [a] -> [a]
++ FilePath
_pmc_location
    -- get a password from stdin if we have not been passed one
    PasswordText
pwt  <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
True PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb_pwt
    PasswordText
pwt' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
True PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb_pwt
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PasswordText
pwtforall a. Eq a => a -> a -> Bool
/=PasswordText
pwt') forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error FilePath
"passwords do not match"
    -- need creation time and comment
    UTCTime
now  <- IO UTCTime
getCurrentTime
    let ps :: PasswordStore
ps =
          PasswordStore
            { _ps_comment :: PasswordStoreComment
_ps_comment = Text -> PasswordStoreComment
PasswordStoreComment forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath
"Created at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show UTCTime
now
            , _ps_map :: PasswordMap
_ps_map     = forall k a. Map k a
Map.empty
            , _ps_setup :: UTCTime
_ps_setup   = UTCTime
now
          }
    -- write out the new store
    forall p. PW p => PMConfig p -> AESKey -> PasswordStore -> IO ()
save_ps PMConfig p
pmc (PasswordText -> AESKey
mk_aek PasswordText
pwt) PasswordStore
ps
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
no_li) forall a b. (a -> b) -> a -> b
$ forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
login PMConfig p
pmc Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just PasswordText
pwt
  where
    PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} = PMConfig p
pmc

-- | launch an interactive shell with access to the password store; if the bool
-- boolean flag is True then it will loop asking for the passwoord until the
-- correct password is typed (or an error ocurrs, possibly from a SIGint);
-- if no 'PasswordText' is specified then one will be read from stdin
login :: PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
login :: forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
login PMConfig p
pmc Bool
y Maybe PasswordText
mb = do
  PasswordText
pwt <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
True PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb
  Bool
ok  <- forall p. PW p => PMConfig p -> PasswordText -> IO Bool
passwordValid PMConfig p
pmc PasswordText
pwt
  case Bool
ok of
    Bool
True  -> forall p. PW p => PMConfig p -> PasswordText -> IO ()
bindMasterPassword PMConfig p
pmc PasswordText
pwt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
good forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall p. PMConfig p -> IO ()
_pmc_shell PMConfig p
pmc
    Bool
False ->                               IO ()
bad  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
login PMConfig p
pmc Bool
y forall a. Maybe a
Nothing
  where
    good :: IO ()
good  = FilePath -> IO ()
putStr FilePath
"*** Login Successful ***\n"
    bad :: IO ()
bad   = FilePath -> IO ()
bad_f  FilePath
"*** Password Invalid ***\n"
    bad_f :: FilePath -> IO ()
bad_f = if Bool
y then FilePath -> IO ()
putStr else forall a. HasCallStack => FilePath -> a
error

-- | is this the correct master password?
passwordValid :: PW p => PMConfig p -> PasswordText -> IO Bool
passwordValid :: forall p. PW p => PMConfig p -> PasswordText -> IO Bool
passwordValid PMConfig p
pmc PasswordText
pwt = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p.
PW p =>
PMConfig p -> FilePath -> PasswordText -> IO (Maybe PasswordStore)
passwordValid' PMConfig p
pmc (forall p. PMConfig p -> FilePath
_pmc_location PMConfig p
pmc) PasswordText
pwt

-- | is this the correct master password for this keystore? Return the decrypted
-- keystore if so.
passwordValid' :: PW p => PMConfig p -> FilePath -> PasswordText -> IO (Maybe PasswordStore)
passwordValid' :: forall p.
PW p =>
PMConfig p -> FilePath -> PasswordText -> IO (Maybe PasswordStore)
passwordValid' PMConfig p
pmc FilePath
fp = forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO (Maybe PasswordStore)
password_valid PMConfig p
pmc FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordText -> AESKey
mk_aek

-- | is the password store there?
isStorePresent :: PW p => PMConfig p -> IO Bool
isStorePresent :: forall p. PW p => PMConfig p -> IO Bool
isStorePresent PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} = FilePath -> IO Bool
doesFileExist FilePath
_pmc_location

-- | are we currently logged in?
amLoggedIn :: PW p => PMConfig p -> IO Bool
amLoggedIn :: forall p. PW p => PMConfig p -> IO Bool
amLoggedIn PMConfig p
pmc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch forall {m :: * -> *}. Monad m => SomeException -> m Bool
hdl forall a b. (a -> b) -> a -> b
$
    forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall p. PW p => PMConfig p -> IO AESKey
get_key PMConfig p
pmc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO (Maybe PasswordStore)
password_valid PMConfig p
pmc (forall p. PMConfig p -> FilePath
_pmc_location PMConfig p
pmc))
  where
    hdl :: SomeException -> m Bool
hdl (SomeException
_::SomeException) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | is the password/session bound to a value in the store?
isBound :: PW p => PMConfig p -> p -> Maybe SessionName -> IO Bool
isBound :: forall p. PW p => PMConfig p -> p -> Maybe SessionName -> IO Bool
isBound PMConfig p
pmc p
p Maybe SessionName
mb = forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall p. PW p => p -> PasswordName
pwName p
p) forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps of
    Maybe Password
Nothing           -> Bool
False
    Just Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
..} -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\SessionName
snm->forall k a. Ord k => k -> Map k a -> Bool
Map.member SessionName
snm forall a b. (a -> b) -> a -> b
$ SessionMap
_pw_sessions) Maybe SessionName
mb

-- | import the contents of another keystore into the current keystore
import_ :: PW p => PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import_ :: forall p.
PW p =>
PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import_ = forall p.
PW p =>
Bool -> PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import__ Bool
False

-- | import the contents of another keystore into the current keystore
import__ :: PW p => Bool -> PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import__ :: forall p.
PW p =>
Bool -> PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import__ Bool
x_pps PMConfig p
pmc FilePath
fp0 Maybe PasswordText
mb = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> do
    FilePath
fp    <- FilePath -> IO FilePath
tilde FilePath
fp0
    Bool
ok    <- FilePath -> IO Bool
doesFileExist FilePath
fp
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
ok) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error FilePath
"*** password store not found ***"
    PasswordText
pwt   <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
True PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb
    Maybe PasswordStore
mb_ps <- forall p.
PW p =>
PMConfig p -> FilePath -> PasswordText -> IO (Maybe PasswordStore)
passwordValid' PMConfig p
pmc FilePath
fp PasswordText
pwt
    case Maybe PasswordStore
mb_ps of
      Maybe PasswordStore
Nothing  -> forall a. HasCallStack => FilePath -> a
error FilePath
"*** Password Invalid ***\n"
      Just PasswordStore
ps' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> PasswordStore -> PasswordStore -> PasswordStore
merge_ps Bool
x_pps PasswordStore
ps PasswordStore
ps'
  where
    tilde :: FilePath -> IO FilePath
tilde (Char
'~':t :: FilePath
t@(Char
'/':FilePath
_)) = do
      Maybe FilePath
mb_hm <- FilePath -> IO (Maybe FilePath)
E.lookupEnv FilePath
"HOME"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. a -> Maybe a -> a
fromMaybe FilePath
"/" Maybe FilePath
mb_hm) forall a. [a] -> [a] -> [a]
++ FilePath
t
    tilde FilePath
fp = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp

-- | loads a password into the store; if this is a session password and the
-- boolean ss is True then the session will be reset to this password also;
-- if no 'PasswordText' is specified then one will be read from stdin
load :: PW p => PMConfig p -> p -> Maybe PasswordText -> IO ()
load :: forall p. PW p => PMConfig p -> p -> Maybe PasswordText -> IO ()
load PMConfig p
pmc p
p Maybe PasswordText
mb = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> do
  PasswordText
pwt <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
False PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb
  UTCTime
now <- IO UTCTime
getCurrentTime
  case forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p of
    Maybe (PasswordText -> Either FilePath SessionDescriptor)
Nothing  -> forall {m :: * -> *}.
Monad m =>
PasswordStore -> Password -> m (Maybe PasswordStore)
load_pwd PasswordStore
ps
      Password
        { _pw_name :: PasswordName
_pw_name      = PasswordName
pnm
        , _pw_text :: PasswordText
_pw_text      = PasswordText
pwt
        , _pw_sessions :: SessionMap
_pw_sessions  = forall k a. Map k a
Map.empty
        , _pw_isOneShot :: Bool
_pw_isOneShot = forall p. PW p => p -> Bool
isOneShot p
p
        , _pw_primed :: Bool
_pw_primed    = Bool
False
        , _pw_setup :: UTCTime
_pw_setup     = UTCTime
now
        }
    Just PasswordText -> Either FilePath SessionDescriptor
ext ->
      case PasswordText -> Either FilePath SessionDescriptor
ext PasswordText
pwt of
        Left  FilePath
err -> forall a. FilePath -> a
ssn_error forall a b. (a -> b) -> a -> b
$ FilePath
"failed to load session: " forall a. [a] -> [a] -> [a]
++ FilePath
err
        Right SessionDescriptor
sd  -> forall {m :: * -> *}.
Monad m =>
UTCTime
-> PasswordStore
-> PasswordText
-> SessionDescriptor
-> m (Maybe PasswordStore)
load_ssn UTCTime
now PasswordStore
ps PasswordText
pwt SessionDescriptor
sd
  where
    load_ssn :: UTCTime
-> PasswordStore
-> PasswordText
-> SessionDescriptor
-> m (Maybe PasswordStore)
load_ssn UTCTime
now PasswordStore
ps PasswordText
pwt SessionDescriptor{Bool
SessionName
_sd_isOneShot :: Bool
_sd_name :: SessionName
_sd_isOneShot :: SessionDescriptor -> Bool
_sd_name :: SessionDescriptor -> SessionName
..} =
        forall {m :: * -> *}.
Monad m =>
PasswordStore -> Password -> m (Maybe PasswordStore)
load_pwd PasswordStore
ps forall a b. (a -> b) -> a -> b
$
          forall s t a b. ASetter s t a b -> b -> s -> t
L.set  Lens' Password PasswordText
pw_text       PasswordText
pwt                        forall a b. (a -> b) -> a -> b
$
          forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Password SessionMap
pw_sessions  (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SessionName
_sd_name Session
ssn)   forall a b. (a -> b) -> a -> b
$
          forall s t a b. ASetter s t a b -> b -> s -> t
L.set  Lens' Password Bool
pw_isOneShot  Bool
ios                        forall a b. (a -> b) -> a -> b
$
            Password
pw
      where
        pw :: Password
pw  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Password
pw0 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PasswordName
pnm forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
        pw0 :: Password
pw0 =
          Password
            { _pw_name :: PasswordName
_pw_name      = PasswordName
pnm
            , _pw_text :: PasswordText
_pw_text      = PasswordText
pwt
            , _pw_sessions :: SessionMap
_pw_sessions  = forall k a. Map k a
Map.empty
            , _pw_isOneShot :: Bool
_pw_isOneShot = Bool
ios
            , _pw_primed :: Bool
_pw_primed    = Bool
False
            , _pw_setup :: UTCTime
_pw_setup     = UTCTime
now
            }

        ssn :: Session
ssn =
          Session
            { _ssn_name :: SessionName
_ssn_name      = SessionName
_sd_name
            , _ssn_password :: PasswordText
_ssn_password  = PasswordText
pwt
            , _ssn_isOneShot :: Bool
_ssn_isOneShot = Bool
ios
            , _ssn_setup :: UTC
_ssn_setup     = UTCTime -> UTC
UTC UTCTime
now
            }

        ios :: Bool
ios         = Bool
_sd_isOneShot

    load_pwd :: PasswordStore -> Password -> m (Maybe PasswordStore)
load_pwd PasswordStore
ps Password
pw  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PasswordName
pnm Password
pw) PasswordStore
ps

    pnm :: PasswordName
pnm             = forall p. PW p => p -> PasswordName
pwName p
p

-- | load a dynamic password into the Password store
loadPlus :: PW p => PMConfig p -> PasswordName -> Maybe PasswordText -> IO ()
loadPlus :: forall p.
PW p =>
PMConfig p -> PasswordName -> Maybe PasswordText -> IO ()
loadPlus PMConfig p
pmc PasswordName
pnm_ Maybe PasswordText
mb = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> do
  PasswordText
pwt <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
False PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PasswordText
mb
  UTCTime
now <- IO UTCTime
getCurrentTime
  forall {m :: * -> *}.
Monad m =>
PasswordStore -> Password -> m (Maybe PasswordStore)
load_pwd PasswordStore
ps
      Password
        { _pw_name :: PasswordName
_pw_name      = PasswordName
pnm
        , _pw_text :: PasswordText
_pw_text      = PasswordText
pwt
        , _pw_sessions :: SessionMap
_pw_sessions  = forall k a. Map k a
Map.empty
        , _pw_isOneShot :: Bool
_pw_isOneShot = Bool
False
        , _pw_primed :: Bool
_pw_primed    = Bool
False
        , _pw_setup :: UTCTime
_pw_setup     = UTCTime
now
        }
  where
    pnm :: PasswordName
pnm             = Text -> PasswordName
PasswordName forall a b. (a -> b) -> a -> b
$ (Char -> Text -> Text
T.cons Char
'+') forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
pnm_
    load_pwd :: PasswordStore -> Password -> m (Maybe PasswordStore)
load_pwd PasswordStore
ps Password
pw  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PasswordName
pnm Password
pw) PasswordStore
ps

-- | set the comment for the password store
psComment :: PW p => PMConfig p -> PasswordStoreComment -> IO ()
psComment :: forall p. PW p => PMConfig p -> PasswordStoreComment -> IO ()
psComment PMConfig p
pmc PasswordStoreComment
cmt = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' PasswordStore PasswordStoreComment
ps_comment PasswordStoreComment
cmt PasswordStore
ps

-- | collect the available passwords listed in 'CollectConfig' from the store
-- and bind them in their designated environmants variables
collect :: PW p => PMConfig p -> CollectConfig p -> IO ()
collect :: forall p. PW p => PMConfig p -> CollectConfig p -> IO ()
collect PMConfig p
pmc CollectConfig{Bool
[p]
_cc_active :: [p]
_cc_optional :: Bool
_cc_active :: forall p. CollectConfig p -> [p]
_cc_optional :: forall p. CollectConfig p -> Bool
..} = PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap_ PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> do
    -- set up the environment -- first the static passwords...
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall p. PW p => PMConfig p -> PasswordStore -> p -> IO ()
clct PMConfig p
pmc PasswordStore
ps) [p]
_cc_active
    -- ... then the dynamic (+) passwords
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ EnvVar -> PasswordText -> IO ()
set_env EnvVar
ev forall a b. (a -> b) -> a -> b
$ Password -> PasswordText
_pw_text Password
pw
        | (PasswordName
pnm_,Password
pw) <- forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
        , Just PasswordName
pnm  <- [PasswordName -> Maybe PasswordName
is_plus PasswordName
pnm_]
        , Just EnvVar
ev   <- [forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_plus_env_var PMConfig p
pmc PasswordName
pnm]
        ]
    -- now clear down all of the primed passwords
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password Bool
pw_primed Bool
False)) PasswordStore
ps
  where
    clct :: PW p => PMConfig p -> PasswordStore -> p -> IO ()
    clct :: forall p. PW p => PMConfig p -> PasswordStore -> p -> IO ()
clct PMConfig p
_ PasswordStore
ps p
p = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall p. PW p => p -> PasswordName
pwName p
p) forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps of
      Just Password
pw | Password -> Bool
is_primed Password
pw -> EnvVar -> PasswordText -> IO ()
set_env (forall p. PW p => p -> EnvVar
enVar p
p) (Password -> PasswordText
_pw_text Password
pw)
      Maybe Password
_                      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    wrap_ :: PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap_ = if Bool
_cc_optional then forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap_def else forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap

-- | prime a one-shot password so that it will be availabe on the next collection (probably for a deployment);
-- if no password is specified then they are all primed
prime :: PW p => PMConfig p -> Bool -> Maybe p -> IO ()
prime :: forall p. PW p => PMConfig p -> Bool -> Maybe p -> IO ()
prime PMConfig p
pmc Bool
u Maybe p
Nothing  = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map    (forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password Bool
pw_primed forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
u)           ) PasswordStore
ps
prime PMConfig p
pmc Bool
u (Just p
p) = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password Bool
pw_primed forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
u) (forall p. PW p => p -> PasswordName
pwName p
p)) PasswordStore
ps

-- | select a different session for use
select :: PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
select :: forall p. PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
select PMConfig p
pmc Maybe p
mb SessionName
snm = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall {p}.
PW p =>
PasswordStore -> (p, Password, Session) -> Maybe PasswordStore
f PasswordStore
ps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p.
PW p =>
Maybe p
-> SessionName -> PasswordStore -> IO (p, Password, Session)
lookup_session Maybe p
mb SessionName
snm PasswordStore
ps
  where
    f :: PasswordStore -> (p, Password, Session) -> Maybe PasswordStore
f PasswordStore
ps (p
p,Password
pw,Session
ssn) =  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall p. PW p => p -> PasswordName
pwName p
p) (Password -> Session -> Password
upd Password
pw Session
ssn)) PasswordStore
ps

    upd :: Password -> Session -> Password
upd Password
pw Session{Bool
UTC
SessionName
PasswordText
_ssn_setup :: UTC
_ssn_isOneShot :: Bool
_ssn_password :: PasswordText
_ssn_name :: SessionName
_ssn_setup :: Session -> UTC
_ssn_isOneShot :: Session -> Bool
_ssn_password :: Session -> PasswordText
_ssn_name :: Session -> SessionName
..} =
      forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password PasswordText
pw_text      PasswordText
_ssn_password  forall a b. (a -> b) -> a -> b
$
      forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password Bool
pw_isOneShot Bool
_ssn_isOneShot forall a b. (a -> b) -> a -> b
$
      forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' Password Bool
pw_primed     Bool
False         forall a b. (a -> b) -> a -> b
$
        Password
pw

-- | delete a password from the store
deletePassword :: PW p => PMConfig p -> p -> IO ()
deletePassword :: forall p. PW p => PMConfig p -> p -> IO ()
deletePassword PMConfig p
pmc p
p = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall p. PW p => p -> PasswordName
pwName p
p)) PasswordStore
ps

-- | delete a password from the store
deletePasswordPlus :: PW p => PMConfig p -> Maybe PasswordName -> IO ()
deletePasswordPlus :: forall p. PW p => PMConfig p -> Maybe PasswordName -> IO ()
deletePasswordPlus PMConfig p
pmc Maybe PasswordName
Nothing    = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Password -> Bool
is_static_pw)   PasswordStore
ps
deletePasswordPlus PMConfig p
pmc (Just PasswordName
pnm) = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (PasswordName -> PasswordName
plussify PasswordName
pnm)) PasswordStore
ps

-- | delete a session from the store
deleteSession :: PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
deleteSession :: forall p. PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
deleteSession PMConfig p
pmc Maybe p
mb SessionName
snm = forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps -> do
  (p, Password, Session)
trp <- forall p.
PW p =>
Maybe p
-> SessionName -> PasswordStore -> IO (p, Password, Session)
lookup_session Maybe p
mb SessionName
snm PasswordStore
ps
  forall {p} {m :: * -> *}.
(PW p, Monad m) =>
(p, Password, Session) -> m ()
chk (p, Password, Session)
trp
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {p} {c}.
PW p =>
PasswordStore -> (p, Password, c) -> Maybe PasswordStore
f PasswordStore
ps (p, Password, Session)
trp
  where
    chk :: (p, Password, Session) -> m ()
chk (p
p,Password
pw,Session
ssn)
      | Just PasswordText -> Either FilePath SessionDescriptor
ext <- forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p
      , Right SessionDescriptor
sd <- PasswordText -> Either FilePath SessionDescriptor
ext forall a b. (a -> b) -> a -> b
$ Password -> PasswordText
_pw_text Password
pw
      , SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sd forall a. Eq a => a -> a -> Bool
/= Session -> SessionName
_ssn_name Session
ssn
                  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = forall a. HasCallStack => FilePath -> a
error FilePath
"cannot delete this session (is it selected?)"

    f :: PasswordStore -> (p, Password, c) -> Maybe PasswordStore
f   PasswordStore
ps (p
p,Password
pw,c
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall p. PW p => p -> PasswordName
pwName p
p) (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Password SessionMap
pw_sessions (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete SessionName
snm) Password
pw)) PasswordStore
ps

-- | print a status line; if @q@ is @True@ then don't output anything and exit
-- with fail code 1 if not logged in
status :: PW p => PMConfig p -> Bool -> IO ()
status :: forall p. PW p => PMConfig p -> Bool -> IO ()
status PMConfig p
pmc Bool
q = (if Bool
q then forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch forall {a}. SomeException -> IO a
hdl else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc PasswordStore -> IO ()
line
  where
    line :: PasswordStore -> IO ()
line PasswordStore
ps = FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
      FilePath
"Logged in ["                         forall a. [a] -> [a] -> [a]
++
          [FilePath] -> FilePath
unwords [FilePath]
sns' forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
pps' forall a. [a] -> [a] -> [a]
++ FilePath
"] ("    forall a. [a] -> [a] -> [a]
++
          (Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordStoreComment -> Text
_PasswordStoreComment forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordStoreComment
_ps_comment PasswordStore
ps) forall a. [a] -> [a] -> [a]
++ FilePath
")"
      where
        sns' :: [FilePath]
sns' = [FilePath]
sns forall a. [a] -> [a] -> [a]
++ [FilePath
"+" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall p. PMConfig p -> [(p, Password, Session)] -> Int
len PMConfig p
pmc (forall p.
PW p =>
Maybe p
-> (SessionName -> Bool)
-> PasswordStore
-> [(p, Password, Session)]
lookup_sessions forall a. Maybe a
Nothing (forall a b. a -> b -> a
const Bool
True) PasswordStore
ps) forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
sns)]
        pps' :: [FilePath]
pps' = [FilePath]
pps forall a. [a] -> [a] -> [a]
++ [FilePath
"+" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall k a. Map k a -> Int
Map.size (PasswordStore -> PasswordMap
_ps_map PasswordStore
ps)                             forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
pps)]

        sns :: [FilePath]
sns =
          [ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ SessionName -> Text
_SessionName forall a b. (a -> b) -> a -> b
$ SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sd
            | Password
pw <- forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
            , let Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} = Password
pw
            , Just  p
p   <- [forall p. PW p => PasswordName -> Maybe p
parsePwName PasswordName
_pw_name]
            , Just  PasswordText -> Either FilePath SessionDescriptor
prs <- [forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p]
            , Right SessionDescriptor
sd  <- [PasswordText -> Either FilePath SessionDescriptor
prs PasswordText
_pw_text]
            , Password -> Bool
is_primed Password
pw
            ]

        pps :: [FilePath]
pps =
          [ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName forall a b. (a -> b) -> a -> b
$ Password -> PasswordName
_pw_name Password
pw
            | Password
pw     <- forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
            , Password -> Bool
_pw_isOneShot Password
pw Bool -> Bool -> Bool
&& Password -> Bool
is_primed Password
pw
            ]

    len :: PMConfig p -> [(p,Password,Session)] -> Int
    len :: forall p. PMConfig p -> [(p, Password, Session)] -> Int
len PMConfig p
_ = forall (t :: * -> *) a. Foldable t => t a -> Int
length

    hdl :: SomeException -> IO a
hdl (SomeException
_::SomeException) = forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

-- | print a status apropriate for a prompt
prompt :: PW p => PMConfig p -> IO ()
prompt :: forall p. PW p => PMConfig p -> IO ()
prompt PMConfig p
pmc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch SomeException -> IO ()
hdl forall a b. (a -> b) -> a -> b
$ do
  Bool
li <- forall p. PW p => PMConfig p -> IO Bool
amLoggedIn PMConfig p
pmc
  case Bool
li of
    Bool
True  -> forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc PasswordStore -> IO ()
line
    Bool
False -> FilePath -> IO ()
putStrLn FilePath
"*"
  where
    line :: PasswordStore -> IO ()
line PasswordStore
ps = FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"[" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
sns forall a. [a] -> [a] -> [a]
++ FilePath
"]"
      where
        sns :: [FilePath]
sns =
          [ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ SessionName -> Text
_SessionName forall a b. (a -> b) -> a -> b
$ SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sd
            | Password
pw <- forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
            , let Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} = Password
pw
            , Just  p
p   <- [forall p. PW p => PasswordName -> Maybe p
parsePwName PasswordName
_pw_name]
            , Just  PasswordText -> Either FilePath SessionDescriptor
prs <- [forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p]
            , Right SessionDescriptor
sd  <- [PasswordText -> Either FilePath SessionDescriptor
prs PasswordText
_pw_text]
            , Password -> Bool
is_primed Password
pw
            ]

    hdl :: SomeException -> IO ()
hdl (SomeException
_::SomeException) = FilePath -> IO ()
putStrLn FilePath
"???"

-- | list the passwords, one per line; if @a@ is set then all passwords will be listed,
-- otherwise just the primed passwords will be listed
passwords :: PW p => PMConfig p -> Bool -> IO ()
passwords :: forall p. PW p => PMConfig p -> Bool -> IO ()
passwords PMConfig p
pmc Bool
br = do
  TimeZone
tz <- IO TimeZone
getCurrentTimeZone
  forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps ->
    FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall p. PW p => TimeZone -> (p, Password) -> FilePath
fmt TimeZone
tz) forall a b. (a -> b) -> a -> b
$ PasswordStore -> [(p, Password)]
pws PasswordStore
ps
  where
    fmt :: PW p => TimeZone -> (p,Password) -> String
    fmt :: forall p. PW p => TimeZone -> (p, Password) -> FilePath
fmt TimeZone
tz (p
p,Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..})
        | Bool
br        = FilePath
nm_s
        | Bool
otherwise = forall r. PrintfType r => FilePath -> r
printf FilePath
"%-12s %c %2s $%-18s %s %s" FilePath
nm_s Char
p_c FilePath
sn_s FilePath
ev_s FilePath
su_s FilePath
cmt
      where
        nm_s :: FilePath
nm_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
_pw_name
        p_c :: Char
p_c  = if Bool
_pw_isOneShot then Bool -> Char
prime_char Bool
_pw_primed else Char
' '
        sn_s :: FilePath
sn_s = case forall k a. Map k a -> Int
Map.size SessionMap
_pw_sessions of
          Int
0 -> FilePath
""
          Int
n -> forall a. Show a => a -> FilePath
show Int
n
        ev_s :: FilePath
ev_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> EnvVar
enVar p
p
        su_s :: FilePath
su_s = TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz UTCTime
_pw_setup
        cmt :: FilePath
cmt  = case forall p. PW p => p -> FilePath
summarize p
p of
          FilePath
"" -> FilePath
""
          FilePath
cs -> FilePath
"# " forall a. [a] -> [a] -> [a]
++ FilePath
cs

    pws :: PasswordStore -> [(p, Password)]
pws PasswordStore
ps =
      [ (forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p,Password
pwd)
        | p
p <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
        , Just Password
pwd <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall p. PW p => p -> PasswordName
pwName p
p) forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps]
        ]

-- | list all of the dynamic (+) passwords
passwordsPlus :: PW p => PMConfig p -> Bool -> IO ()
passwordsPlus :: forall p. PW p => PMConfig p -> Bool -> IO ()
passwordsPlus PMConfig p
pmc Bool
br = do
  TimeZone
tz <- IO TimeZone
getCurrentTimeZone
  forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps ->
    FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TimeZone -> (PasswordName, Password) -> FilePath
fmt TimeZone
tz) forall a b. (a -> b) -> a -> b
$ PasswordStore -> [(PasswordName, Password)]
pws PasswordStore
ps
  where
    fmt :: TimeZone -> (PasswordName, Password) -> FilePath
fmt TimeZone
tz (PasswordName
pnm,Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..})
        | Bool
br        = FilePath
nm_s
        | Bool
otherwise = forall r. PrintfType r => FilePath -> r
printf FilePath
"+%-12s $%-18s %s" FilePath
nm_s FilePath
ev_s FilePath
su_s
      where
        nm_s :: FilePath
nm_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
pnm
        ev_s :: FilePath
ev_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe EnvVar
"?" forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_plus_env_var PMConfig p
pmc PasswordName
pnm
        su_s :: FilePath
su_s = TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz UTCTime
_pw_setup

    pws :: PasswordStore -> [(PasswordName, Password)]
pws PasswordStore
ps =
      [ (PasswordName
pnm,Password
pw)
        | (PasswordName
pnm_,Password
pw) <- forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
        , Just PasswordName
pnm  <- [PasswordName -> Maybe PasswordName
is_plus PasswordName
pnm_]
        ]

-- | list the sessions, one per line; if @p@ is specified then all of the
-- sessions are listed for that password
sessions :: PW p
         => PMConfig p
         -> Bool        -- ^ list active sessions only
         -> Bool        -- ^ list only the session identifiers
         -> Maybe p     -- ^ if specified, then only the sessions on this password
         -> IO ()
sessions :: forall p. PW p => PMConfig p -> Bool -> Bool -> Maybe p -> IO ()
sessions PMConfig p
pmc Bool
a Bool
b Maybe p
mb = do
  TimeZone
tz <- IO TimeZone
getCurrentTimeZone
  forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps ->
    let trps :: [(p, Password, Session)]
trps  = case Bool
a of
          Bool
True  -> [ (p, Password, Session)
trp | trp :: (p, Password, Session)
trp@(p
_,Password
pw,Session
_)<-[(p, Password, Session)]
trps_, forall p. PW p => (p, Password, Session) -> Bool
active_session (p, Password, Session)
trp Bool -> Bool -> Bool
&& Password -> Bool
is_primed Password
pw]
          Bool
False -> [(p, Password, Session)]
trps_
        trps_ :: [(p, Password, Session)]
trps_ = forall p.
PW p =>
Maybe p
-> (SessionName -> Bool)
-> PasswordStore
-> [(p, Password, Session)]
lookup_sessions Maybe p
mb (forall a b. a -> b -> a
const Bool
True) PasswordStore
ps
    in
    FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {t} {a}.
(PrintfType t, PW a) =>
TimeZone -> (a, Password, Session) -> t
fmt TimeZone
tz) [(p, Password, Session)]
trps
  where
    fmt :: TimeZone -> (a, Password, Session) -> t
fmt TimeZone
tz trp :: (a, Password, Session)
trp@(a
_,Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..},Session{Bool
UTC
SessionName
PasswordText
_ssn_setup :: UTC
_ssn_isOneShot :: Bool
_ssn_password :: PasswordText
_ssn_name :: SessionName
_ssn_setup :: Session -> UTC
_ssn_isOneShot :: Session -> Bool
_ssn_password :: Session -> PasswordText
_ssn_name :: Session -> SessionName
..}) =
      case Bool
b of
        Bool
True  -> forall r. PrintfType r => FilePath -> r
printf FilePath
"%s" FilePath
sn_s
        Bool
False ->
          case Bool
sgl of
            Bool
True  -> forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s %c %s %s"            FilePath
sn_s Char
p_c FilePath
su_s FilePath
a_s
            Bool
False -> forall r. PrintfType r => FilePath -> r
printf FilePath
"%-12s %-16s %c %s %s" FilePath
pn_s FilePath
sn_s Char
p_c FilePath
su_s FilePath
a_s
      where
        pn_s :: FilePath
pn_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
_pw_name
        sn_s :: FilePath
sn_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ SessionName -> Text
_SessionName  SessionName
_ssn_name
        p_c :: Char
p_c  = if Bool
_ssn_isOneShot then Bool -> Char
prime_char Bool
False else Char
' '
        su_s :: FilePath
su_s = TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz forall a b. (a -> b) -> a -> b
$ UTC -> UTCTime
_UTC UTC
_ssn_setup
        a_s :: FilePath
a_s  = if forall p. PW p => (p, Password, Session) -> Bool
active_session (a, Password, Session)
trp then FilePath
"[ACTIVE]" else FilePath
"" :: String

    sgl :: Bool
sgl = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ () | p
p<-[forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound], forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p ] forall a. Eq a => a -> a -> Bool
== Int
1

-- | print the info, including the text descriton, for an individual passowrd
infoPassword :: PW p
             => PMConfig p
             -> Bool          -- ^ True => show the password secret text
             -> p             -- ^ the password to show
             -> IO ()
infoPassword :: forall p. PW p => PMConfig p -> Bool -> p -> IO ()
infoPassword PMConfig p
pmc Bool
sh_s p
p = do
  Doc
doc <- forall p. PW p => PMConfig p -> Bool -> p -> IO Doc
infoPassword_ PMConfig p
pmc Bool
sh_s p
p
  FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ SimpleDoc -> ShowS
P.displayS (Float -> Int -> Doc -> SimpleDoc
P.renderPretty Float
0.75 Int
120 Doc
doc) FilePath
""

-- | get the info on a password
infoPassword_ :: PW p => PMConfig p -> Bool -> p -> IO P.Doc
infoPassword_ :: forall p. PW p => PMConfig p -> Bool -> p -> IO Doc
infoPassword_ PMConfig p
pmc Bool
sh_s p
p = do
    TimeZone
tz <- IO TimeZone
getCurrentTimeZone
    forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
P.empty (TimeZone -> Password -> Doc
mk TimeZone
tz) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PasswordName
pnm forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
  where
    mk :: TimeZone -> Password -> Doc
mk TimeZone
tz pw :: Password
pw@Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} =
        Doc
heading           Doc -> Doc -> Doc
P.<$$> Int -> Doc -> Doc
P.indent Int
4 (
            Doc
sssions       forall a. Semigroup a => a -> a -> a
P.<>
            Doc
primed        Doc -> Doc -> Doc
P.<$$>
            Doc
evar          Doc -> Doc -> Doc
P.<$$>
            Doc
secret        forall a. Semigroup a => a -> a -> a
P.<>
            Doc
loaded        Doc -> Doc -> Doc
P.<$$>
            Doc
P.empty       Doc -> Doc -> Doc
P.<$$>
            Doc
descr
          )               Doc -> Doc -> Doc
P.<$$>
          Doc
P.empty
      where
        heading :: Doc
heading  = Doc -> Doc
P.bold forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
P.string forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
pnm
        sssions :: Doc
sssions = case forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p of
          Maybe (PasswordText -> Either FilePath SessionDescriptor)
Nothing -> Doc
P.empty
          Just PasswordText -> Either FilePath SessionDescriptor
xt -> (FilePath -> FilePath -> Doc
line   FilePath
"sessions" forall a b. (a -> b) -> a -> b
$ (PasswordText -> Either FilePath SessionDescriptor) -> FilePath
fmt_sns PasswordText -> Either FilePath SessionDescriptor
xt) Doc -> Doc -> Doc
P.<$$> Doc
P.empty
        primed :: Doc
primed     =  FilePath -> FilePath -> Doc
line   FilePath
"primed"   forall a b. (a -> b) -> a -> b
$ if Password -> Bool
is_primed Password
pw then FilePath
"yes" else FilePath
"no"
        evar :: Doc
evar       =  FilePath -> FilePath -> Doc
line   FilePath
"env var"  forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> EnvVar
enVar p
p
        loaded :: Doc
loaded     =  FilePath -> FilePath -> Doc
line   FilePath
"loaded"   forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz forall a b. (a -> b) -> a -> b
$ UTCTime
_pw_setup
        descr :: Doc
descr      = FilePath -> Doc
P.string forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> FilePath
describe p
p
        secret :: Doc
secret = case Bool
sh_s of
          Bool
True  -> (FilePath -> FilePath -> Doc
line   FilePath
"secret" forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordText -> Text
_PasswordText PasswordText
_pw_text) Doc -> Doc -> Doc
P.<$$> Doc
P.empty
          Bool
False -> Doc
P.empty

        fmt_sns :: (PasswordText -> Either FilePath SessionDescriptor) -> FilePath
fmt_sns PasswordText -> Either FilePath SessionDescriptor
xt = FilePath
sn forall a. [a] -> [a] -> [a]
++ FilePath
" / " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionName -> Text
_SessionName) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter SessionName -> Bool
fl [SessionName]
sns)
          where
            sn :: FilePath
sn = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
s->FilePath
"<<"forall a. [a] -> [a] -> [a]
++FilePath
sforall a. [a] -> [a] -> [a]
++FilePath
">>") (Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionName -> Text
_SessionName forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionDescriptor -> SessionName
_sd_name ) Either FilePath SessionDescriptor
ei
            fl :: SessionName -> Bool
fl = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
_ SessionName
_->Bool
False)       (\SessionDescriptor
sd SessionName
sn'->SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sdforall a. Eq a => a -> a -> Bool
/=SessionName
sn')           Either FilePath SessionDescriptor
ei
            ei :: Either FilePath SessionDescriptor
ei = PasswordText -> Either FilePath SessionDescriptor
xt PasswordText
_pw_text

        sns :: [SessionName]
sns = forall k a. Map k a -> [k]
Map.keys SessionMap
_pw_sessions

        line :: String -> String -> P.Doc
        line :: FilePath -> FilePath -> Doc
line FilePath
nm FilePath
vl = Doc -> Doc
P.bold(FilePath -> Doc
P.string forall a b. (a -> b) -> a -> b
$ Int -> ShowS
ljust Int
8 FilePath
nm) forall a. Semigroup a => a -> a -> a
P.<> FilePath -> Doc
P.string FilePath
" : " forall a. Semigroup a => a -> a -> a
P.<>
                                                        Int -> Doc -> Doc
P.hang Int
8 (FilePath -> Doc
P.string FilePath
vl)

    pnm :: PasswordName
pnm       = forall p. PW p => p -> PasswordName
pwName p
p

    ljust :: Int -> ShowS
ljust Int
n FilePath
s = FilePath
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max Int
0 (Int
nforall a. Num a => a -> a -> a
-forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s)) Char
' '

-- | print the info for a dynamic (+) password
infoPasswordPlus :: PW p => PMConfig p -> Bool -> PasswordName -> IO ()
infoPasswordPlus :: forall p. PW p => PMConfig p -> Bool -> PasswordName -> IO ()
infoPasswordPlus PMConfig p
pmc Bool
sh_s PasswordName
pnm = do
  Doc
doc <- forall p. PW p => PMConfig p -> Bool -> PasswordName -> IO Doc
infoPasswordPlus_ PMConfig p
pmc Bool
sh_s PasswordName
pnm
  FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ SimpleDoc -> ShowS
P.displayS (Float -> Int -> Doc -> SimpleDoc
P.renderPretty Float
0.75 Int
120 Doc
doc) FilePath
""

-- | get the info on a dynamic (+) password
infoPasswordPlus_ :: PW p => PMConfig p -> Bool -> PasswordName -> IO P.Doc
infoPasswordPlus_ :: forall p. PW p => PMConfig p -> Bool -> PasswordName -> IO Doc
infoPasswordPlus_ PMConfig p
pmc Bool
sh_s PasswordName
pnm = do
    TimeZone
tz <- IO TimeZone
getCurrentTimeZone
    forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ \PasswordStore
ps ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
P.empty (TimeZone -> Password -> Doc
mk TimeZone
tz) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PasswordName -> PasswordName
plussify PasswordName
pnm) forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps
  where
    mk :: TimeZone -> Password -> Doc
mk TimeZone
tz Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} =
        Doc
heading           Doc -> Doc -> Doc
P.<$$> Int -> Doc -> Doc
P.indent Int
4 (
          Doc
evar          forall a. Semigroup a => a -> a -> a
P.<>
          Doc
secret        forall a. Semigroup a => a -> a -> a
P.<>
          Doc
loaded
          )             Doc -> Doc -> Doc
P.<$$>
          Doc
P.empty
      where
        heading :: Doc
heading  = Doc -> Doc
P.bold forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
P.string forall a b. (a -> b) -> a -> b
$ FilePath
"+" forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack (PasswordName -> Text
_PasswordName PasswordName
pnm)
        evar :: Doc
evar     = case forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_plus_env_var PMConfig p
pmc PasswordName
pnm of
          Maybe EnvVar
Nothing -> Doc
P.empty
          Just EnvVar
ev -> (FilePath -> FilePath -> Doc
line FilePath
"env var" forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ EnvVar -> Text
_EnvVar forall a b. (a -> b) -> a -> b
$ EnvVar
ev          ) Doc -> Doc -> Doc
P.<$$> Doc
P.empty
        loaded :: Doc
loaded     =  FilePath -> FilePath -> Doc
line FilePath
"loaded"  forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz forall a b. (a -> b) -> a -> b
$ UTCTime
_pw_setup
        secret :: Doc
secret   = case Bool
sh_s of
          Bool
True  ->   (FilePath -> FilePath -> Doc
line FilePath
"secret"  forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordText -> Text
_PasswordText PasswordText
_pw_text) Doc -> Doc -> Doc
P.<$$> Doc
P.empty
          Bool
False -> Doc
P.empty

        line :: String -> String -> P.Doc
        line :: FilePath -> FilePath -> Doc
line FilePath
nm FilePath
vl = Doc -> Doc
P.bold(FilePath -> Doc
P.string forall a b. (a -> b) -> a -> b
$ Int -> ShowS
ljust Int
8 FilePath
nm) forall a. Semigroup a => a -> a -> a
P.<> FilePath -> Doc
P.string FilePath
" : " forall a. Semigroup a => a -> a -> a
P.<>
                                                        Int -> Doc -> Doc
P.hang Int
8 (FilePath -> Doc
P.string FilePath
vl)

    ljust :: Int -> ShowS
ljust Int
n FilePath
s = FilePath
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max Int
0 (Int
nforall a. Num a => a -> a -> a
-forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s)) Char
' '

-- | dump the store in a s script that can be used to reload it
dump :: PW p => PMConfig p -> Bool -> IO ()
dump :: forall p. PW p => PMConfig p -> Bool -> IO ()
dump PMConfig p
pmc Bool
inc_ssns = forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc PasswordStore -> IO ()
dmp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall p. PW p => PMConfig p -> Bool -> Maybe p -> IO ()
prime PMConfig p
pmc Bool
True forall a. Maybe a
Nothing
  where
    dmp :: PasswordStore -> IO ()
dmp ps :: PasswordStore
ps@PasswordStore{UTCTime
PasswordMap
PasswordStoreComment
_ps_setup :: UTCTime
_ps_map :: PasswordMap
_ps_comment :: PasswordStoreComment
_ps_setup :: PasswordStore -> UTCTime
_ps_map :: PasswordStore -> PasswordMap
_ps_comment :: PasswordStore -> PasswordStoreComment
..} = FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall p.
PW p =>
FilePath
-> PasswordStoreComment
-> [(p, PasswordText)]
-> [(p, SessionName)]
-> FilePath
format_dump (forall p. PMConfig p -> FilePath
_pmc_dump_prefix PMConfig p
pmc) PasswordStoreComment
_ps_comment [(p, PasswordText)]
al_l [(p, SessionName)]
al_s
      where
        al_l :: [(p, PasswordText)]
al_l =
            [ (p
p,Password -> PasswordText
_pw_text Password
pw)
              | p
p <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
              , Just Password
pw <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall p. PW p => p -> PasswordName
pwName forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p) PasswordMap
_ps_map]
              , forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p
              , Password -> Bool
is_primed Password
pw
              ] forall a. [a] -> [a] -> [a]
++
            [ (p
p,Session -> PasswordText
_ssn_password Session
ssn)
              | Bool
inc_ssns
              , (p
p,Password
_,Session
ssn) <- forall p.
PW p =>
Maybe p
-> (SessionName -> Bool)
-> PasswordStore
-> [(p, Password, Session)]
lookup_sessions forall a. Maybe a
Nothing (forall a b. a -> b -> a
const Bool
True) PasswordStore
ps
              ]

        al_s :: [(p, SessionName)]
al_s =
            [ (p
p,SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sd)
              | Bool
inc_ssns
              , p
p <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
              , Just  Password
pw <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall p. PW p => p -> PasswordName
pwName forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> p -> p
cast_pmc PMConfig p
pmc p
p) PasswordMap
_ps_map]
              , Just PasswordText -> Either FilePath SessionDescriptor
ext <- [forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p]
              , Right SessionDescriptor
sd <- [PasswordText -> Either FilePath SessionDescriptor
ext forall a b. (a -> b) -> a -> b
$ Password -> PasswordText
_pw_text Password
pw]
              ]

-- | collect the passowrds, bthem into the environmant and launch an interacive shell
collectShell :: PW p => PMConfig p -> IO ()
collectShell :: forall p. PW p => PMConfig p -> IO ()
collectShell PMConfig p
pmc = forall p. PW p => PMConfig p -> CollectConfig p -> IO ()
collect PMConfig p
pmc forall p. PW p => CollectConfig p
defaultCollectConfig forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall p. PMConfig p -> IO ()
_pmc_shell PMConfig p
pmc

-- | check whether a password is primed for use
is_primed :: Password -> Bool
is_primed :: Password -> Bool
is_primed Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} = Bool -> Bool
not Bool
_pw_isOneShot Bool -> Bool -> Bool
|| Bool
_pw_primed

-- | lookup a session in a password store, possibly specifying the password it belogs to; exactly
-- one session must be found, otherwise an error is generated
lookup_session :: PW p => Maybe p -> SessionName -> PasswordStore -> IO (p,Password,Session)
lookup_session :: forall p.
PW p =>
Maybe p
-> SessionName -> PasswordStore -> IO (p, Password, Session)
lookup_session Maybe p
mb SessionName
snm PasswordStore
ps =
  case forall p.
PW p =>
Maybe p
-> (SessionName -> Bool)
-> PasswordStore
-> [(p, Password, Session)]
lookup_sessions Maybe p
mb (forall a. Eq a => a -> a -> Bool
==SessionName
snm) PasswordStore
ps of
    []  -> forall a. FilePath -> a
err FilePath
"session not loaded"
    [(p, Password, Session)
r] -> forall (m :: * -> *) a. Monad m => a -> m a
return (p, Password, Session)
r
    [(p, Password, Session)]
_   -> forall a. FilePath -> a
err FilePath
"matches multiple sessions"
  where
    err :: FilePath -> a
err FilePath
msg = forall a. FilePath -> a
ssn_error forall a b. (a -> b) -> a -> b
$ FilePath
"lookup_session: " forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack(SessionName -> Text
_SessionName SessionName
snm) forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
msg

-- | lookup all of the sessions in a password store
lookup_sessions :: PW p => Maybe p -> (SessionName->Bool) -> PasswordStore -> [(p,Password,Session)]
lookup_sessions :: forall p.
PW p =>
Maybe p
-> (SessionName -> Bool)
-> PasswordStore
-> [(p, Password, Session)]
lookup_sessions Maybe p
mb SessionName -> Bool
f PasswordStore
ps =
  [ (p
p,Password
pw,Session
ssn)
    | p
p <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (p
pforall a. Eq a => a -> a -> Bool
==) Maybe p
mb
    , forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p
    , let pnm :: PasswordName
pnm = forall p. PW p => p -> PasswordName
pwName p
p
    , Just Password
pw  <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PasswordName
pnm forall a b. (a -> b) -> a -> b
$ PasswordStore -> PasswordMap
_ps_map PasswordStore
ps]
    , Session
ssn <- forall a. (a -> Bool) -> [a] -> [a]
filter (SessionName -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> SessionName
_ssn_name) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Password -> SessionMap
_pw_sessions Password
pw
    ]

active_session :: PW p => (p,Password,Session) -> Bool
active_session :: forall p. PW p => (p, Password, Session) -> Bool
active_session (p
p,Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..},Session{Bool
UTC
SessionName
PasswordText
_ssn_setup :: UTC
_ssn_isOneShot :: Bool
_ssn_password :: PasswordText
_ssn_name :: SessionName
_ssn_setup :: Session -> UTC
_ssn_isOneShot :: Session -> Bool
_ssn_password :: Session -> PasswordText
_ssn_name :: Session -> SessionName
..}) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  [ ()
    | Just PasswordText -> Either FilePath SessionDescriptor
ext <- [forall p.
PW p =>
p -> Maybe (PasswordText -> Either FilePath SessionDescriptor)
isSession p
p]
    , Right SessionDescriptor
sd <- [PasswordText -> Either FilePath SessionDescriptor
ext PasswordText
_pw_text]
    , SessionDescriptor -> SessionName
_sd_name SessionDescriptor
sd forall a. Eq a => a -> a -> Bool
== SessionName
_ssn_name
    ]

-- | read a passord from stdin and hash it
get_pw :: PW p => Bool -> PMConfig p -> IO PasswordText
get_pw :: forall p. PW p => Bool -> PMConfig p -> IO PasswordText
get_pw Bool
hp PMConfig p
pmc = do
  Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False
  FilePath -> IO ()
putStr FilePath
"Password: "
  Handle -> IO ()
hFlush Handle
stdout
  FilePath
pw <- IO FilePath
getLine
  Char -> IO ()
putChar Char
'\n'
  Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
True
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall p. PW p => Bool -> PMConfig p -> FilePath -> PasswordText
cond_hash Bool
hp PMConfig p
pmc FilePath
pw

cond_hash :: PW p => Bool -> PMConfig p -> String -> PasswordText
cond_hash :: forall p. PW p => Bool -> PMConfig p -> FilePath -> PasswordText
cond_hash Bool
False PMConfig p
_   = Text -> PasswordText
PasswordText forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
cond_hash Bool
True  PMConfig p
pmc = forall p. PW p => PMConfig p -> FilePath -> PasswordText
hashMasterPassword PMConfig p
pmc

-- | use a '+' to represent a primed one-shot password,'-' otherwise
prime_char :: Bool -> Char
prime_char :: Bool -> Char
prime_char Bool
is_p = if Bool
is_p then Char
'+' else Char
'-'

-- | make up a script for loading a password store
format_dump :: PW p
            => String               -- ^ the prefix for each script command line
            -> PasswordStoreComment -- ^ the store comment
            -> [(p,PasswordText)]   -- ^ the passwords to load
            -> [(p,SessionName)]    -- ^ the sessions to select
            -> String
format_dump :: forall p.
PW p =>
FilePath
-> PasswordStoreComment
-> [(p, PasswordText)]
-> [(p, SessionName)]
-> FilePath
format_dump FilePath
pfx PasswordStoreComment
ps_cmt [(p, PasswordText)]
al_l [(p, SessionName)]
al_s =
  [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
    (forall r. PrintfType r => FilePath -> r
printf FilePath
"%s comment %s ;" FilePath
pfx forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => t Char -> FilePath
esc forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordStoreComment -> Text
_PasswordStoreComment PasswordStoreComment
ps_cmt) forall a. a -> [a] -> [a]
:
    [ forall r. PrintfType r => FilePath -> r
printf FilePath
"%s load %-12s %-20s %-30s ;" FilePath
pfx FilePath
pnm_s FilePath
ptx_s forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> FilePath
cmt_s p
p
      | (p
p,PasswordText
ptx) <- [(p, PasswordText)]
al_l
      , let pnm_s :: FilePath
pnm_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> PasswordName
pwName p
p
      , let ptx_s :: FilePath
ptx_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordText -> Text
_PasswordText   PasswordText
ptx
      ] forall a. [a] -> [a] -> [a]
++
    [ forall r. PrintfType r => FilePath -> r
printf FilePath
"%s select -p %s %s ;" FilePath
pfx FilePath
pnm_s FilePath
snm_s
      | (p
p,SessionName
snm) <- [(p, SessionName)]
al_s
      , let pnm_s :: FilePath
pnm_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName forall a b. (a -> b) -> a -> b
$ forall p. PW p => p -> PasswordName
pwName p
p
      , let snm_s :: FilePath
snm_s = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ SessionName -> Text
_SessionName    SessionName
snm
      ]
  where
    cmt_s :: p -> FilePath
cmt_s  p
p = case forall p. PW p => p -> FilePath
summarize p
p of
      FilePath
"" -> FilePath
""
      FilePath
s  -> FilePath
"# " forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *}. Foldable t => t Char -> FilePath
esc FilePath
s

    esc :: t Char -> FilePath
esc t Char
s = Char
'\'' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
tr FilePath
"\'" t Char
s
      where
        tr :: Char -> ShowS
tr Char
'\'' FilePath
t = Char
'\\' forall a. a -> [a] -> [a]
: Char
'\'' forall a. a -> [a] -> [a]
: FilePath
t
        tr Char
c    FilePath
t = Char
c           forall a. a -> [a] -> [a]
: FilePath
t

wrap_def :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap_def :: forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap_def PMConfig p
pmc PasswordStore -> IO (Maybe PasswordStore)
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall p.
PW p =>
PMConfig p
-> (PasswordStore -> IO (Maybe PasswordStore)) -> AESKey -> IO ()
wrap' PMConfig p
pmc PasswordStore -> IO (Maybe PasswordStore)
f) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall p. PW p => PMConfig p -> IO (Maybe AESKey)
get_key' PMConfig p
pmc

wrap :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap :: forall p.
PW p =>
PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()
wrap PMConfig p
pmc PasswordStore -> IO (Maybe PasswordStore)
f = forall p. PW p => PMConfig p -> IO AESKey
get_key PMConfig p
pmc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall p.
PW p =>
PMConfig p
-> (PasswordStore -> IO (Maybe PasswordStore)) -> AESKey -> IO ()
wrap' PMConfig p
pmc PasswordStore -> IO (Maybe PasswordStore)
f

wrap' :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> AESKey -> IO ()
wrap' :: forall p.
PW p =>
PMConfig p
-> (PasswordStore -> IO (Maybe PasswordStore)) -> AESKey -> IO ()
wrap' PMConfig p
pmc PasswordStore -> IO (Maybe PasswordStore)
f AESKey
aek = do
  PasswordStore
pws <- forall p. PW p => PMConfig p -> AESKey -> IO PasswordStore
load_ps PMConfig p
pmc AESKey
aek
  Maybe PasswordStore
mb  <- PasswordStore -> IO (Maybe PasswordStore)
f PasswordStore
pws
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall p. PW p => PMConfig p -> AESKey -> PasswordStore -> IO ()
save_ps PMConfig p
pmc AESKey
aek) Maybe PasswordStore
mb

getStore :: PW p => PMConfig p -> IO PasswordStore
getStore :: forall p. PW p => PMConfig p -> IO PasswordStore
getStore PMConfig p
pmc = forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc forall (m :: * -> *) a. Monad m => a -> m a
return

enquire :: PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire :: forall p a. PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a
enquire PMConfig p
pmc PasswordStore -> IO a
f = do
  AESKey
aek <- forall p. PW p => PMConfig p -> IO AESKey
get_key PMConfig p
pmc
  forall p. PW p => PMConfig p -> AESKey -> IO PasswordStore
load_ps PMConfig p
pmc AESKey
aek forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PasswordStore -> IO a
f

password_valid :: PW p => PMConfig p -> FilePath -> AESKey -> IO (Maybe PasswordStore)
password_valid :: forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO (Maybe PasswordStore)
password_valid PMConfig p
pmc FilePath
fp AESKey
aek = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO (Maybe PasswordStore)
ld forall {m :: * -> *} {a}. Monad m => SomeException -> m (Maybe a)
hd
  where
    ld :: IO (Maybe PasswordStore)
ld                    = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO PasswordStore
load_ps_ PMConfig p
pmc FilePath
fp AESKey
aek
    hd :: SomeException -> m (Maybe a)
hd (SomeException
_::SomeException) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

load_ps :: PW p => PMConfig p -> AESKey -> IO PasswordStore
load_ps :: forall p. PW p => PMConfig p -> AESKey -> IO PasswordStore
load_ps PMConfig p
pmc = forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO PasswordStore
load_ps_ PMConfig p
pmc (forall p. PMConfig p -> FilePath
_pmc_location PMConfig p
pmc)

load_ps_ :: PW p => PMConfig p -> FilePath -> AESKey -> IO PasswordStore
load_ps_ :: forall p.
PW p =>
PMConfig p -> FilePath -> AESKey -> IO PasswordStore
load_ps_ PMConfig p
pmc FilePath
fp AESKey
aek = do
  AESSecretData
aed <- forall p. PW p => PMConfig p -> FilePath -> IO AESSecretData
load_ps' PMConfig p
pmc FilePath
fp
  case forall a.
FromJSONWithErrs a =>
ByteString -> Either [(JSONError, Position)] a
decodeWithErrs forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks [Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ ClearText -> Binary
_ClearText forall a b. (a -> b) -> a -> b
$ AESKey -> AESSecretData -> ClearText
decryptAES AESKey
aek AESSecretData
aed] of
    Right PasswordStore
pws -> forall (m :: * -> *) a. Monad m => a -> m a
return PasswordStore
pws
    Left  [(JSONError, Position)]
ers -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ [(JSONError, Position)] -> FilePath
prettyJSONErrorPositions [(JSONError, Position)]
ers

save_ps :: PW p => PMConfig p -> AESKey -> PasswordStore -> IO ()
save_ps :: forall p. PW p => PMConfig p -> AESKey -> PasswordStore -> IO ()
save_ps PMConfig p
pmc AESKey
aek PasswordStore
pws = do
  IV
iv <- forall a. Octets -> (Binary -> a) -> IO a
random_bytes Octets
sizeAesIV Binary -> IV
IV
  forall p. PW p => PMConfig p -> AESSecretData -> IO ()
save_ps' PMConfig p
pmc forall a b. (a -> b) -> a -> b
$ AESKey -> IV -> ClearText -> AESSecretData
encryptAES AESKey
aek IV
iv forall a b. (a -> b) -> a -> b
$ Binary -> ClearText
ClearText forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode PasswordStore
pws

load_ps' :: PW p => PMConfig p -> FilePath -> IO AESSecretData
load_ps' :: forall p. PW p => PMConfig p -> FilePath -> IO AESSecretData
load_ps' PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} FilePath
fp = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch forall {a}. SomeException -> a
hdl forall a b. (a -> b) -> a -> b
$ do
  (ByteString
iv,ByteString
ct) <- Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Octets -> Int
_Octets Octets
sizeAesIV) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
fp
  forall (m :: * -> *) a. Monad m => a -> m a
return
    AESSecretData
      { _asd_iv :: IV
_asd_iv          = Binary -> IV
IV         forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
iv
      , _asd_secret_data :: SecretData
_asd_secret_data = Binary -> SecretData
SecretData forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
ct
      }
  where
    hdl :: SomeException -> a
hdl (SomeException
_::SomeException) = forall a. HasCallStack => FilePath -> a
error FilePath
_pmc_keystore_msg

-- | marge in the second password store into the first, all definitions in
-- the second passwords store, except the store's creation time, which is
-- taken from the first store; any sessions are also merged with the
-- sessions in the second store taking precedence
merge_ps :: Bool -> PasswordStore -> PasswordStore -> PasswordStore
merge_ps :: Bool -> PasswordStore -> PasswordStore -> PasswordStore
merge_ps Bool
x_pps PasswordStore
ps PasswordStore
ps0' =
  PasswordStore
    { _ps_comment :: PasswordStoreComment
_ps_comment = PasswordStore -> PasswordStoreComment
_ps_comment PasswordStore
ps'
    , _ps_map :: PasswordMap
_ps_map     =  forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Password -> Password -> Password
f (PasswordStore -> PasswordMap
_ps_map PasswordStore
ps) (PasswordStore -> PasswordMap
_ps_map PasswordStore
ps')
    , _ps_setup :: UTCTime
_ps_setup   = PasswordStore -> UTCTime
_ps_setup PasswordStore
ps
    }
  where
    f :: Password -> Password -> Password
f Password
pw Password
pw' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' Password SessionMap
pw_sessions (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall a b. (a -> b) -> a -> b
$ Password -> SessionMap
_pw_sessions Password
pw) Password
pw'

    ps' :: PasswordStore
ps' = case Bool
x_pps of
      Bool
True  -> forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over Lens' PasswordStore PasswordMap
ps_map (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Password -> Bool
is_static_pw) PasswordStore
ps0'
      Bool
False -> PasswordStore
ps0'

is_static_pw :: Password -> Bool
is_static_pw :: Password -> Bool
is_static_pw Password{Bool
UTCTime
SessionMap
PasswordText
PasswordName
_pw_setup :: UTCTime
_pw_primed :: Bool
_pw_isOneShot :: Bool
_pw_sessions :: SessionMap
_pw_text :: PasswordText
_pw_name :: PasswordName
_pw_setup :: Password -> UTCTime
_pw_primed :: Password -> Bool
_pw_isOneShot :: Password -> Bool
_pw_sessions :: Password -> SessionMap
_pw_text :: Password -> PasswordText
_pw_name :: Password -> PasswordName
..} = case Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
_pw_name of
      Char
'+':FilePath
_ -> Bool
False
      FilePath
_     -> Bool
True

random_bytes :: Octets -> (Binary->a) -> IO a
random_bytes :: forall a. Octets -> (Binary -> a) -> IO a
random_bytes Octets
sz Binary -> a
f = Binary -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => Int -> CPRNG -> (ba, CPRNG)
generateCPRNG (Octets -> Int
_Octets Octets
sz) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CPRNG
newCPRNG

save_ps' :: PW p => PMConfig p -> AESSecretData -> IO ()
save_ps' :: forall p. PW p => PMConfig p -> AESSecretData -> IO ()
save_ps' PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} AESSecretData{SecretData
IV
_asd_secret_data :: SecretData
_asd_iv :: IV
_asd_secret_data :: AESSecretData -> SecretData
_asd_iv :: AESSecretData -> IV
..} = FilePath -> ByteString -> IO ()
B.writeFile FilePath
_pmc_location forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString
iv_bs,ByteString
ct_bs]
  where
    iv_bs :: ByteString
iv_bs = Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ IV -> Binary
_IV         IV
_asd_iv
    ct_bs :: ByteString
ct_bs = Binary -> ByteString
_Binary forall a b. (a -> b) -> a -> b
$ SecretData -> Binary
_SecretData SecretData
_asd_secret_data

get_key :: PW p => PMConfig p -> IO AESKey
get_key :: forall p. PW p => PMConfig p -> IO AESKey
get_key PMConfig p
pmc = forall p. PW p => PMConfig p -> IO (Maybe AESKey)
get_key' PMConfig p
pmc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall p a. PW p => PMConfig p -> IO a
not_logged_in_err PMConfig p
pmc) forall (m :: * -> *) a. Monad m => a -> m a
return

not_logged_in_err :: PW p => PMConfig p -> IO a
not_logged_in_err :: forall p a. PW p => PMConfig p -> IO a
not_logged_in_err pmc :: PMConfig p
pmc@PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} = do
  Bool
ex <- forall p. PW p => PMConfig p -> IO Bool
isStorePresent PMConfig p
pmc
  forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ if Bool
ex then FilePath
_pmc_password_msg else FilePath
_pmc_keystore_msg

get_key' :: PW p => PMConfig p -> IO (Maybe AESKey)
get_key' :: forall p. PW p => PMConfig p -> IO (Maybe AESKey)
get_key' PMConfig{Bool
FilePath
Maybe FilePath
IO ()
EnvVar
HashDescription
PasswordName -> Maybe EnvVar
_pmc_plus_env_var :: PasswordName -> Maybe EnvVar
_pmc_sample_script :: Maybe FilePath
_pmc_dump_prefix :: FilePath
_pmc_allow_dumps :: Bool
_pmc_hash_descr :: HashDescription
_pmc_shell :: IO ()
_pmc_password_msg :: FilePath
_pmc_keystore_msg :: FilePath
_pmc_env_var :: EnvVar
_pmc_location :: FilePath
_pmc_plus_env_var :: forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_sample_script :: forall p. PMConfig p -> Maybe FilePath
_pmc_dump_prefix :: forall p. PMConfig p -> FilePath
_pmc_allow_dumps :: forall p. PMConfig p -> Bool
_pmc_hash_descr :: forall p. PMConfig p -> HashDescription
_pmc_shell :: forall p. PMConfig p -> IO ()
_pmc_password_msg :: forall p. PMConfig p -> FilePath
_pmc_keystore_msg :: forall p. PMConfig p -> FilePath
_pmc_env_var :: forall p. PMConfig p -> EnvVar
_pmc_location :: forall p. PMConfig p -> FilePath
..} = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> AESKey
mk_aek' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
E.lookupEnv FilePath
var
  where
    var :: FilePath
var = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ EnvVar -> Text
_EnvVar EnvVar
_pmc_env_var

mk_aek :: PasswordText -> AESKey
mk_aek :: PasswordText -> AESKey
mk_aek = FilePath -> AESKey
mk_aek' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordText -> Text
_PasswordText

mk_aek' :: String -> AESKey
mk_aek' :: FilePath -> AESKey
mk_aek' = Binary -> AESKey
AESKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. a
err forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath ByteString
B64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
B.pack
  where
    err :: a
err = forall a. HasCallStack => FilePath -> a
error FilePath
"bad format for the master password"

pretty_setup :: TimeZone -> UTCTime -> String
pretty_setup :: TimeZone -> UTCTime -> FilePath
pretty_setup TimeZone
tz = forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%F %H:%M" forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz

set_env :: EnvVar -> PasswordText -> IO ()
set_env :: EnvVar -> PasswordText -> IO ()
set_env (EnvVar Text
ev) (PasswordText Text
pt) = FilePath -> FilePath -> IO ()
setEnv (Text -> FilePath
T.unpack Text
ev) (Text -> FilePath
T.unpack Text
pt)

ssn_error :: String -> a
ssn_error :: forall a. FilePath -> a
ssn_error FilePath
msg = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"session manager error: " forall a. [a] -> [a] -> [a]
++ FilePath
msg


--
-- The Command Line Parser
--

-- | run a password manager command
passwordManager' :: PW p => PMConfig p -> PMCommand p -> IO ()
passwordManager' :: forall p. PW p => PMConfig p -> PMCommand p -> IO ()
passwordManager' PMConfig p
pmc PMCommand p
pmcd =
  case PMCommand p
pmcd of
    PMCommand p
PMCD_version                  -> FilePath -> IO ()
putStrLn FilePath
version
    PMCD_setup          Bool
nl Maybe PasswordText
mb_t   -> forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
setup              PMConfig p
pmc Bool
nl  Maybe PasswordText
mb_t
    PMCD_login        Bool
y    Maybe PasswordText
mb_t   -> forall p. PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()
login              PMConfig p
pmc Bool
y   Maybe PasswordText
mb_t
    PMCD_import Bool
x_pps   FilePath
fp Maybe PasswordText
mb_t   -> forall p.
PW p =>
Bool -> PMConfig p -> FilePath -> Maybe PasswordText -> IO ()
import__     Bool
x_pps PMConfig p
pmc FilePath
fp  Maybe PasswordText
mb_t
    PMCD_load            p
p Maybe PasswordText
mb_t   -> forall p. PW p => PMConfig p -> p -> Maybe PasswordText -> IO ()
load               PMConfig p
pmc p
p   Maybe PasswordText
mb_t
    PMCD_load_plus     PasswordName
pnm Maybe PasswordText
mb_t   -> forall p.
PW p =>
PMConfig p -> PasswordName -> Maybe PasswordText -> IO ()
loadPlus           PMConfig p
pmc PasswordName
pnm Maybe PasswordText
mb_t
    PMCD_comment            PasswordStoreComment
cmt   -> forall p. PW p => PMConfig p -> PasswordStoreComment -> IO ()
psComment          PMConfig p
pmc PasswordStoreComment
cmt
    PMCD_prime        Bool
u  p
p        -> forall p. PW p => PMConfig p -> Bool -> Maybe p -> IO ()
prime              PMConfig p
pmc Bool
u forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just p
p
    PMCD_prime_all    Bool
u           -> forall p. PW p => PMConfig p -> Bool -> Maybe p -> IO ()
prime              PMConfig p
pmc Bool
u forall a. Maybe a
Nothing
    PMCD_select          Maybe p
mb SessionName
snm   -> forall p. PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
select             PMConfig p
pmc Maybe p
mb SessionName
snm
    PMCD_delete_password      p
p   -> forall p. PW p => PMConfig p -> p -> IO ()
deletePassword     PMConfig p
pmc p
p
    PMCD_delete_password_plus Maybe PasswordName
pnm -> forall p. PW p => PMConfig p -> Maybe PasswordName -> IO ()
deletePasswordPlus PMConfig p
pmc Maybe PasswordName
pnm
    PMCD_delete_session    Maybe p
mb SessionName
snm -> forall p. PW p => PMConfig p -> Maybe p -> SessionName -> IO ()
deleteSession      PMConfig p
pmc Maybe p
mb SessionName
snm
    PMCD_status         Bool
q         -> forall p. PW p => PMConfig p -> Bool -> IO ()
status             PMConfig p
pmc Bool
q
    PMCommand p
PMCD_prompt                   -> forall p. PW p => PMConfig p -> IO ()
prompt             PMConfig p
pmc
    PMCD_passwords      Bool
b         -> forall p. PW p => PMConfig p -> Bool -> IO ()
passwords          PMConfig p
pmc Bool
b
    PMCD_passwords_plus Bool
b         -> forall p. PW p => PMConfig p -> Bool -> IO ()
passwordsPlus      PMConfig p
pmc Bool
b
    PMCD_session     Bool
b            -> forall p. PW p => PMConfig p -> Bool -> Bool -> Maybe p -> IO ()
sessions           PMConfig p
pmc Bool
True  Bool
b forall a. Maybe a
Nothing
    PMCD_sessions    Bool
b Maybe p
mb         -> forall p. PW p => PMConfig p -> Bool -> Bool -> Maybe p -> IO ()
sessions           PMConfig p
pmc Bool
False Bool
b Maybe p
mb
    PMCD_info        Bool
s   p
p        -> forall p. PW p => PMConfig p -> Bool -> p -> IO ()
infoPassword       PMConfig p
pmc Bool
s p
p
    PMCD_info_plus   Bool
s   PasswordName
pnm      -> forall p. PW p => PMConfig p -> Bool -> PasswordName -> IO ()
infoPasswordPlus   PMConfig p
pmc Bool
s PasswordName
pnm
    PMCD_dump        Bool
s            -> forall p. PW p => PMConfig p -> Bool -> IO ()
dump               PMConfig p
pmc Bool
s
    PMCommand p
PMCD_collect                  -> forall p. PW p => PMConfig p -> IO ()
collectShell       PMConfig p
pmc
    PMCommand p
PMCD_sample_script            -> FilePath -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> Maybe FilePath
_pmc_sample_script PMConfig p
pmc

-- | the abstract syntax for the passowd manager commands
data PMCommand p
    = PMCD_version
    | PMCD_setup  Bool              (Maybe PasswordText)
    | PMCD_login  Bool              (Maybe PasswordText)
    | PMCD_import Bool     FilePath (Maybe PasswordText)
    | PMCD_load        p            (Maybe PasswordText)
    | PMCD_load_plus   PasswordName (Maybe PasswordText)
    | PMCD_comment     PasswordStoreComment
    | PMCD_prime     Bool p
    | PMCD_prime_all Bool
    | PMCD_select               (Maybe p) SessionName
    | PMCD_delete_password             p
    | PMCD_delete_password_plus (Maybe PasswordName)
    | PMCD_delete_session       (Maybe p) SessionName
    | PMCD_status         Bool
    | PMCD_prompt
    | PMCD_passwords      Bool
    | PMCD_passwords_plus Bool
    | PMCD_session        Bool
    | PMCD_sessions       Bool  (Maybe p)
    | PMCD_info           Bool         p
    | PMCD_info_plus      Bool PasswordName
    | PMCD_dump           Bool
    | PMCD_collect
    | PMCD_sample_script
    deriving (Int -> PMCommand p -> ShowS
forall p. Show p => Int -> PMCommand p -> ShowS
forall p. Show p => [PMCommand p] -> ShowS
forall p. Show p => PMCommand p -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PMCommand p] -> ShowS
$cshowList :: forall p. Show p => [PMCommand p] -> ShowS
show :: PMCommand p -> FilePath
$cshow :: forall p. Show p => PMCommand p -> FilePath
showsPrec :: Int -> PMCommand p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> PMCommand p -> ShowS
Show)

-- | parse a passwword manager command
parsePMCommand :: PW p => PMConfig p -> [String] -> IO (PMCommand p)
parsePMCommand :: forall p. PW p => PMConfig p -> [FilePath] -> IO (PMCommand p)
parsePMCommand PMConfig p
pmc = forall a. ParserInfo a -> [FilePath] -> IO a
run_parse forall a b. (a -> b) -> a -> b
$ forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
command_info PMConfig p
pmc

command_info :: PW p => PMConfig p -> ParserInfo (PMCommand p)
command_info :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
command_info PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => PMConfig p -> Parser (PMCommand p)
pmCommandParser PMConfig p
pmc)
        (   forall a. InfoMod a
fullDesc
         forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> InfoMod a
progDesc FilePath
"a simple password manager"
         forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> InfoMod a
header FilePath
"pm - sub-command for managing the password store"
         forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> InfoMod a
footer FilePath
"'ks COMMAND --help' to get help on each command")

pmCommandParser :: PW p => PMConfig p -> Parser (PMCommand p)
pmCommandParser :: forall p. PW p => PMConfig p -> Parser (PMCommand p)
pmCommandParser PMConfig p
pmc =
    forall a. Mod CommandFields a -> Parser a
subparser forall a b. (a -> b) -> a -> b
$ forall {p}.
Mod CommandFields (PMCommand p) -> Mod CommandFields (PMCommand p)
f forall a b. (a -> b) -> a -> b
$ Mod CommandFields (PMCommand p) -> Mod CommandFields (PMCommand p)
g
     forall a b. (a -> b) -> a -> b
$  forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"version"                   forall p. ParserInfo (PMCommand p)
pi_version
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"setup"                     (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_setup            PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"login"                     (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_login            PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"import"                    (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_import           PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"load"                      (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_load             PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"comment"                   forall p. PW p => ParserInfo (PMCommand p)
pi_comment
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"prime"                     forall p. PW p => ParserInfo (PMCommand p)
pi_prime
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"prime-all"                 forall p. ParserInfo (PMCommand p)
pi_prime_all
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"select"                    forall p. PW p => ParserInfo (PMCommand p)
pi_select
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"delete-password"           (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_delete_password  PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"delete-all-plus-passwords" forall p. ParserInfo (PMCommand p)
pi_delete_all_plus_passwords
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"delete-session"            forall p. PW p => ParserInfo (PMCommand p)
pi_delete_session
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"status"                    forall p. ParserInfo (PMCommand p)
pi_status
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"prompt"                    forall p. ParserInfo (PMCommand p)
pi_prompt
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"passwords"                 forall p. ParserInfo (PMCommand p)
pi_passwords
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"passwords-plus"            forall p. ParserInfo (PMCommand p)
pi_passwords_plus
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"session"                   forall p. PW p => ParserInfo (PMCommand p)
pi_session
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"sessions"                  forall p. PW p => ParserInfo (PMCommand p)
pi_sessions
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"info"                      (forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_info             PMConfig p
pmc)
     forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"collect"                   forall p. PW p => ParserInfo (PMCommand p)
pi_collect
  where
    s :: Mod CommandFields (PMCommand p)
s = forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"sample-load-script"        forall p. ParserInfo (PMCommand p)
pi_sample_script
    d :: Mod CommandFields (PMCommand p)
d = forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"dump"                      forall p. PW p => ParserInfo (PMCommand p)
pi_dump

    f :: Mod CommandFields (PMCommand p) -> Mod CommandFields (PMCommand p)
f = case forall p. PMConfig p -> Maybe FilePath
_pmc_sample_script PMConfig p
pmc of
          Maybe FilePath
Nothing -> forall a. a -> a
id
          Just FilePath
_  -> (forall a. Semigroup a => a -> a -> a
<> forall {p}. Mod CommandFields (PMCommand p)
s)

    g :: Mod CommandFields (PMCommand p) -> Mod CommandFields (PMCommand p)
g = case forall p. PMConfig p -> Bool
_pmc_allow_dumps PMConfig p
pmc of
          Bool
True    -> (forall a. Semigroup a => a -> a -> a
<> Mod CommandFields (PMCommand p)
d)
          Bool
False   -> forall a. a -> a
id

pi_version :: ParserInfo (PMCommand p)
pi_version :: forall p. ParserInfo (PMCommand p)
pi_version =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall p. PMCommand p
PMCD_version)
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"report the version of this package")

pi_setup :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_setup :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_setup PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> Maybe PasswordText -> PMCommand p
PMCD_setup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_no_login_sw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall p. PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text Bool
True PMConfig p
pmc)))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"setup the password store")

pi_login :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_login :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_login PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> Maybe PasswordText -> PMCommand p
PMCD_login forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_loop_sw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall p. PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text Bool
True PMConfig p
pmc)))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"login to the password manager")

pi_import :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_import :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_import PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> FilePath -> Maybe PasswordText -> PMCommand p
PMCD_import forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_x_pps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
p_store_fp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall p. PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text Bool
True PMConfig p
pmc)))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"import the contents of another store")

pi_load :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_load :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_load PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_load_command PMConfig p
pmc)
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"load a password into the store")

pi_comment :: PW p => ParserInfo (PMCommand p)
pi_comment :: forall p. PW p => ParserInfo (PMCommand p)
pi_comment =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. PasswordStoreComment -> PMCommand p
PMCD_comment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PasswordStoreComment
p_ps_comment))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"load a password into the store")

pi_prime :: PW p => ParserInfo (PMCommand p)
pi_prime :: forall p. PW p => ParserInfo (PMCommand p)
pi_prime =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> p -> PMCommand p
PMCD_prime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_unprime_sw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => Parser p
p_pw_id))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"(un) prime a password for use")

pi_prime_all :: ParserInfo (PMCommand p)
pi_prime_all :: forall p. ParserInfo (PMCommand p)
pi_prime_all =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_prime_all forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_unprime_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"(un)prime all of the passwords")

pi_select :: PW p => ParserInfo (PMCommand p)
pi_select :: forall p. PW p => ParserInfo (PMCommand p)
pi_select =
     forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Maybe p -> SessionName -> PMCommand p
PMCD_select forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall p. PW p => Parser p
p_pw_id_opt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SessionName
p_session_name))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"select a client session")

pi_delete_password :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_delete_password :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_delete_password PMConfig p
pmc =
     forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_delete_password PMConfig p
pmc)
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"delete a password from the store")

pi_delete_all_plus_passwords :: ParserInfo (PMCommand p)
pi_delete_all_plus_passwords :: forall p. ParserInfo (PMCommand p)
pi_delete_all_plus_passwords =
     forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall p. Maybe PasswordName -> PMCommand p
PMCD_delete_password_plus forall a. Maybe a
Nothing))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"delete all dynamic (plus) passwords forom the store")

pi_delete_session :: PW p => ParserInfo (PMCommand p)
pi_delete_session :: forall p. PW p => ParserInfo (PMCommand p)
pi_delete_session =
     forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Maybe p -> SessionName -> PMCommand p
PMCD_delete_session forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall p. PW p => Parser p
p_pw_id_opt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SessionName
p_session_name))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"delete a client session")

pi_status :: ParserInfo (PMCommand p)
pi_status :: forall p. ParserInfo (PMCommand p)
pi_status =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_status forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_quiet_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"report the status of the password manager")

pi_prompt :: ParserInfo (PMCommand p)
pi_prompt :: forall p. ParserInfo (PMCommand p)
pi_prompt =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall p. PMCommand p
PMCD_prompt))
        (forall a. FilePath -> InfoMod a
progDesc forall a b. (a -> b) -> a -> b
$ FilePath
"report the condensed status of the password manager"forall a. [a] -> [a] -> [a]
++
                                  FilePath
" (suitable for embedding in a shell prompt")

pi_passwords :: ParserInfo (PMCommand p)
pi_passwords :: forall p. ParserInfo (PMCommand p)
pi_passwords =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_passwords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_brief_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"list the passwords")

pi_passwords_plus :: ParserInfo (PMCommand p)
pi_passwords_plus :: forall p. ParserInfo (PMCommand p)
pi_passwords_plus =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_passwords_plus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_brief_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"list the dynamic ('+'') passwords")

pi_session :: PW p => ParserInfo (PMCommand p)
pi_session :: forall p. PW p => ParserInfo (PMCommand p)
pi_session =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_session forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_brief_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"list the sessions")

pi_sessions :: PW p => ParserInfo (PMCommand p)
pi_sessions :: forall p. PW p => ParserInfo (PMCommand p)
pi_sessions =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> Maybe p -> PMCommand p
PMCD_sessions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_brief_sw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall p. PW p => Parser p
p_pw_id))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"list the sessions")

pi_info :: PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_info :: forall p. PW p => PMConfig p -> ParserInfo (PMCommand p)
pi_info PMConfig p
pmc =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_info PMConfig p
pmc)
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"print out the info on a password, including desriptive text")

pi_dump :: PW p => ParserInfo (PMCommand p)
pi_dump :: forall p. PW p => ParserInfo (PMCommand p)
pi_dump =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall p. Bool -> PMCommand p
PMCD_dump forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_sessions_sw))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"dump the passwords on the output as a load script")

pi_collect :: PW p => ParserInfo (PMCommand p)
pi_collect :: forall p. PW p => ParserInfo (PMCommand p)
pi_collect =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall p. PMCommand p
PMCD_collect))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"collect the passwords and launch an interacive shell")


pi_sample_script :: ParserInfo (PMCommand p)
pi_sample_script :: forall p. ParserInfo (PMCommand p)
pi_sample_script =
    forall a. Parser a -> InfoMod a -> ParserInfo a
h_info
        (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall p. PMCommand p
PMCD_sample_script))
        (forall a. FilePath -> InfoMod a
progDesc FilePath
"print a sample script to define keystore passwords in the environment (PM edition)")

p_load_command, p_delete_password, p_info :: PW p => PMConfig p -> Parser (PMCommand p)

p_load_command :: forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_load_command PMConfig p
pmc = forall {a}.
Either a PasswordName -> Maybe PasswordText -> PMCommand a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. PW p => PMConfig p -> Parser (Either p PasswordName)
p_pw PMConfig p
pmc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall p. PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text Bool
False PMConfig p
pmc) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
p_load_comment
  where
    f :: Either a PasswordName -> Maybe PasswordText -> PMCommand a
f Either a PasswordName
ei Maybe PasswordText
op_p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p. p -> Maybe PasswordText -> PMCommand p
PMCD_load Maybe PasswordText
op_p) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p. PasswordName -> Maybe PasswordText -> PMCommand p
PMCD_load_plus Maybe PasswordText
op_p) Either a PasswordName
ei

p_delete_password :: forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_delete_password PMConfig p
pmc = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall p. p -> PMCommand p
PMCD_delete_password (forall p. Maybe PasswordName -> PMCommand p
PMCD_delete_password_plus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p. PW p => PMConfig p -> Parser (Either p PasswordName)
p_pw PMConfig p
pmc

p_info :: forall p. PW p => PMConfig p -> Parser (PMCommand p)
p_info PMConfig p
pmc = forall {p}. Bool -> Either p PasswordName -> PMCommand p
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
p_secret_sw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p. PW p => PMConfig p -> Parser (Either p PasswordName)
p_pw PMConfig p
pmc
  where
    f :: Bool -> Either p PasswordName -> PMCommand p
f Bool
s_sw (Left  p
p  ) = forall p. Bool -> p -> PMCommand p
PMCD_info      Bool
s_sw p
p
    f Bool
s_sw (Right PasswordName
pnm) = forall p. Bool -> PasswordName -> PMCommand p
PMCD_info_plus Bool
s_sw PasswordName
pnm

-- switches

p_brief_sw :: Parser Bool
p_brief_sw :: Parser Bool
p_brief_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'b'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"brief"        forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"list the identifiers only")

p_loop_sw :: Parser Bool
p_loop_sw :: Parser Bool
p_loop_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short  Char
'l'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"loop"        forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"on failure prompt for a new password and try again")

p_no_login_sw :: Parser Bool
p_no_login_sw :: Parser Bool
p_no_login_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short  Char
'n'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"no-login"    forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"do not launch an interactive shell")

p_quiet_sw :: Parser Bool
p_quiet_sw :: Parser Bool
p_quiet_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short  Char
'q'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"quiet"        forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"don't print anything but report with error codes (0=>logged in)")

p_secret_sw :: Parser Bool
p_secret_sw :: Parser Bool
p_secret_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short  Char
's'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"secret"      forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"show the secret password")

p_sessions_sw :: Parser Bool
p_sessions_sw :: Parser Bool
p_sessions_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"sessions"      forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"include the sessions")

p_unprime_sw :: Parser Bool
p_unprime_sw :: Parser Bool
p_unprime_sw =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short  Char
'u'            forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"unprime"     forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"clear the prime status")

p_x_pps :: Parser Bool
p_x_pps :: Parser Bool
p_x_pps =
    Mod FlagFields Bool -> Parser Bool
switch
        (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'x'                          forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"exclude-plus-passwords"     forall a. Semigroup a => a -> a -> a
<>
         forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"exclude the dynamic (plus) passwords")

-- options

p_pw_id_opt :: PW p => Parser p
p_pw_id_opt :: forall p. PW p => Parser p
p_pw_id_opt =
    forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FilePath
"password-id not recognised") forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. PW p => PasswordName -> Maybe p
parsePwName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordName
PasswordName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack)
        forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"id"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'p'
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PASSWORD-ID"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"a password ID"

-- arguments

p_comment :: Parser String
p_comment :: Parser FilePath
p_comment = [FilePath] -> FilePath
unwords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FilePath
p_word

p_hash :: Parser ()
p_hash :: Parser ()
p_hash = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \FilePath
s->if FilePath
sforall a. Eq a => a -> a -> Bool
==FilePath
"#" then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall a b. a -> Either a b
Left FilePath
"# expected") forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"#"

h_info :: Parser a -> InfoMod a -> ParserInfo a
h_info :: forall a. Parser a -> InfoMod a -> ParserInfo a
h_info Parser a
pr = forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
pr)

p_load_comment :: Parser ()
p_load_comment :: Parser ()
p_load_comment = forall a b. a -> b -> a
const () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
p_hash forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser FilePath
p_comment)

p_password_text :: PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text :: forall p. PW p => Bool -> PMConfig p -> Parser PasswordText
p_password_text Bool
hp PMConfig p
pmc =
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. PW p => Bool -> PMConfig p -> FilePath -> PasswordText
cond_hash Bool
hp PMConfig p
pmc)
        forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PASSWORD-TEXT"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"the text of the password"

p_pw :: PW p => PMConfig p -> Parser (Either p PasswordName)
p_pw :: forall p. PW p => PMConfig p -> Parser (Either p PasswordName)
p_pw PMConfig p
pmc =
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FilePath
"bad password syntax") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. PW a => FilePath -> Maybe (Either a PasswordName)
prs)
      forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PASSWORD"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"a static or dynamic (+) password name"
  where
    prs :: FilePath -> Maybe (Either a PasswordName)
prs FilePath
s =
      forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall p. PW p => PasswordName -> Maybe p
parsePwName forall a b. (a -> b) -> a -> b
$ Text -> PasswordName
PasswordName forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
s)    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall p. PW p => PMConfig p -> FilePath -> Maybe PasswordName
parse_plus_pw PMConfig p
pmc FilePath
s)

p_pw_id :: PW p => Parser p
p_pw_id :: forall p. PW p => Parser p
p_pw_id =
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FilePath
"bad password syntax") forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. PW p => PasswordName -> Maybe p
parsePwName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordName
PasswordName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack)
        forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PASSWORD-ID"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"a password ID"

p_ps_comment :: Parser PasswordStoreComment
p_ps_comment :: Parser PasswordStoreComment
p_ps_comment = Text -> PasswordStoreComment
PasswordStoreComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
p_comment

p_session_name :: Parser SessionName
p_session_name :: Parser SessionName
p_session_name =
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SessionName
SessionName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack)
        forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SESSION"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"a session name"

p_store_fp :: Parser FilePath
p_store_fp :: Parser FilePath
p_store_fp =
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. b -> Either a b
Right)
        forall a b. (a -> b) -> a -> b
$  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STORE"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"file containing the password store to import"

p_word :: Parser String
p_word :: Parser FilePath
p_word = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. b -> Either a b
Right) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"WORD"

-- run_parse

run_parse :: ParserInfo a -> [String] -> IO a
run_parse :: forall a. ParserInfo a -> [FilePath] -> IO a
run_parse ParserInfo a
pinfo [FilePath]
args =
  case forall a.
ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
execParserPure (PrefsMod -> ParserPrefs
prefs forall m. Monoid m => m
idm) ParserInfo a
pinfo [FilePath]
args of
    Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Failure ParserFailure ParserHelp
failure -> do
      FilePath
progn <- IO FilePath
E.getProgName
      let (ParserHelp
msg, ExitCode
exit, Int
_) = forall h. ParserFailure h -> FilePath -> (h, ExitCode, Int)
execFailure ParserFailure ParserHelp
failure FilePath
progn
      case ExitCode
exit of
        ExitCode
ExitSuccess -> FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show ParserHelp
msg
        ExitCode
_           -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show ParserHelp
msg
      forall a. ExitCode -> IO a
exitWith ExitCode
exit
    CompletionInvoked CompletionResult
compl -> do
      FilePath
progn <- IO FilePath
E.getProgName
      FilePath
msg   <- CompletionResult -> FilePath -> IO FilePath
execCompletion CompletionResult
compl FilePath
progn
      FilePath -> IO ()
putStr FilePath
msg
      forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess

-- plus helpers

parse_plus_pw :: PW p => PMConfig p -> String -> Maybe PasswordName
parse_plus_pw :: forall p. PW p => PMConfig p -> FilePath -> Maybe PasswordName
parse_plus_pw PMConfig p
pmc FilePath
s_ = case FilePath
s_ of
  Char
'+':FilePath
s | forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall p. PMConfig p -> PasswordName -> Maybe EnvVar
_pmc_plus_env_var PMConfig p
pmc PasswordName
pnm
    -> forall a. a -> Maybe a
Just PasswordName
pnm
    where
      pnm :: PasswordName
pnm = Text -> PasswordName
PasswordName forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
s
  FilePath
_ -> forall a. Maybe a
Nothing

plussify :: PasswordName -> PasswordName
plussify :: PasswordName -> PasswordName
plussify = Text -> PasswordName
PasswordName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text -> Text
T.cons Char
'+') forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordName -> Text
_PasswordName

is_plus :: PasswordName -> Maybe PasswordName
is_plus :: PasswordName -> Maybe PasswordName
is_plus PasswordName
pnm = case Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ PasswordName -> Text
_PasswordName PasswordName
pnm of
  Char
'+':FilePath
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> PasswordName
PasswordName forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
s
  FilePath
_     -> forall a. Maybe a
Nothing