From 77ffbd3140c6d5a14d55aea122d13f1d6d18f8cb Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 11 Dec 2020 22:18:20 -0500
Subject: [PATCH] ENH make veracrypt look up passwords in the bitwarden vault

---
 app/rofi-dev.hs           | 22 +++++++++++++++++++---
 lib/Bitwarden/Internal.hs | 14 +++++++-------
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/app/rofi-dev.hs b/app/rofi-dev.hs
index 8b85069..811000a 100644
--- a/app/rofi-dev.hs
+++ b/app/rofi-dev.hs
@@ -11,6 +11,8 @@
 
 module Main (main) where
 
+import           Bitwarden.Internal
+
 import           Control.Monad
 import           Control.Monad.Reader
 
@@ -47,7 +49,6 @@ parse args = case getOpt Permute options args of
   where
     h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]"
 
--- TODO add option to look up password in bitwarden vault
 options :: [OptDescr (MountConf -> MountConf)]
 options =
   [ Option ['s'] ["secret"]
@@ -55,6 +56,11 @@ options =
     $ wrap "Use libsecret to retrieve password for DIR using ATTR/VAL pairs. \
            \The pairs will be supplied to a 'secret-tool lookup' call. \
            \ Argument is formatted like 'DIR:ATTR1=VAL1,ATTR2=VAL2...'"
+  , Option ['b'] ["bitwarden"]
+    (ReqArg (\s m -> m { passwords = addBitwarden (passwords m) s } ) "BW")
+    $ wrap "Use the Bitwarden CLI to retrieve a password for DIR. \
+           \The argument is formatted like 'DIR:NAME' where NAME is the \
+           \name of the Bitwarden entry to find."
   , Option ['d'] ["directory"]
     (ReqArg (\s m -> m { mountDir = s } ) "DIR")
     $ wrap "The DIR in which new mountpoints will be created. This is assumed \
@@ -110,17 +116,27 @@ addSecret :: MountpointPasswords -> String -> MountpointPasswords
 addSecret pwds c = case splitPrefix c of
   (dir, ":", r) -> M.insert dir (runSecret $ fromCommaSepString' r) pwds
   _             -> pwds
-  where
-    splitPrefix s = s =~ (":" :: String) :: (String, String, String)
 
 runSecret :: [(String, String)] -> Password
 runSecret kvs = readCmdSuccess "secret-tool" ("lookup":kvs') ""
   where
     kvs' = concatMap (\(k, v) -> [k, v]) kvs
 
+addBitwarden :: MountpointPasswords -> String -> MountpointPasswords
+addBitwarden pwds c = case splitPrefix c of
+  (dir, ":", name) -> M.insert dir (runBitwarden name) pwds
+  _                -> pwds
+
+runBitwarden :: String -> Password
+runBitwarden pname = ((password . login) <=< find (\i -> name i == pname))
+  <$> getItems
+
 addPwdPrompt :: MountpointPasswords -> String -> MountpointPasswords
 addPwdPrompt pwds dir = M.insert dir readPassword pwds
 
+splitPrefix :: String -> (String, String, String)
+splitPrefix s = s =~ (":" :: String)
+
 --------------------------------------------------------------------------------
 -- | Main prompt
 --
diff --git a/lib/Bitwarden/Internal.hs b/lib/Bitwarden/Internal.hs
index 7cd2632..f09e327 100644
--- a/lib/Bitwarden/Internal.hs
+++ b/lib/Bitwarden/Internal.hs
@@ -78,7 +78,7 @@ getSession' BWServerConf { timeout = t } ses = do
     Nothing -> getNewSession
   where
     getNewSession = do
-      pwd <- readPassword
+      pwd <- readPassword' "Bitwarden Password"
       newHash <- join <$> mapM readSession pwd
       (, newHash) <$> mapM newSession newHash
     newSession h = do
@@ -134,13 +134,13 @@ runClient a = do
           ]
 
 browseLogins :: RofiConf c => RofiIO c ()
-browseLogins = do
-  session <- io callGetSession
-  forM_ session $ (io . getItems) >=> selectItem
+browseLogins = io getItems >>= selectItem
 
--- TODO use this in rofi-dev to mount thing using BW passwords
-getItems :: String -> IO [Item]
-getItems session = do
+getItems :: IO [Item]
+getItems = maybe (return []) getItems' =<< callGetSession
+
+getItems' :: String -> IO [Item]
+getItems' session = do
   items <- io $ readProcess "bw" ["list", "items", "--session", session] ""
   return $ filter notEmpty $ fromMaybe [] $ decode $ fromString items
   where