306 lines
8.8 KiB
Haskell
306 lines
8.8 KiB
Haskell
module Bitwarden.Internal
|
|
( Item (..)
|
|
, Login (..)
|
|
, Session
|
|
, runDaemon
|
|
, runClient
|
|
, getItems
|
|
, callGetSession
|
|
)
|
|
where
|
|
|
|
import DBus
|
|
import DBus.Client
|
|
import Data.Aeson
|
|
import qualified Data.Text.IO as TI
|
|
import Data.UnixTime
|
|
import GHC.Generics
|
|
import RIO hiding (timeout)
|
|
import qualified RIO.Text as T
|
|
import Rofi.Command
|
|
import System.Clipboard
|
|
import System.Process
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Daemon
|
|
--
|
|
-- Daemon will export an interface on DBus with two methods:
|
|
-- * get current session id - if no session is active, launch Rofi to prompt
|
|
-- for a password; return session id or null if password is invalid
|
|
-- * lock session - destroy the current session id if active
|
|
--
|
|
-- The session ID will be valid only as long as TIMEOUT
|
|
newtype BWServerConf = BWServerConf
|
|
{ timeout :: UnixDiffTime
|
|
}
|
|
|
|
-- TODO add a cache so the browse list will load faster
|
|
data CurrentSession = CurrentSession
|
|
{ timestamp :: UnixTime
|
|
, hash :: T.Text
|
|
}
|
|
|
|
type Session = MVar (Maybe CurrentSession)
|
|
|
|
runDaemon :: Int -> IO ()
|
|
runDaemon t = do
|
|
ses <- newMVar Nothing
|
|
let c = BWServerConf {timeout = UnixDiffTime (fromIntegral t) 0}
|
|
startService c ses
|
|
forever $ threadDelay 1000000
|
|
|
|
lockSession :: Session -> IO ()
|
|
lockSession ses = void $ swapMVar ses Nothing
|
|
|
|
syncSession :: BWServerConf -> Session -> IO ()
|
|
syncSession conf ses = notify =<< fmap join . mapM cmd =<< getSession' conf ses
|
|
where
|
|
cmd h = readCmdSuccess "bw" ["sync", "--session", h] ""
|
|
notify res =
|
|
let j = isJust res
|
|
in notifyStatus j $ if j then "sync succeeded" else "sync failed"
|
|
|
|
getSession' :: BWServerConf -> Session -> IO (Maybe T.Text)
|
|
getSession' BWServerConf {timeout = t} ses = do
|
|
ut <- getUnixTime
|
|
modifyMVar ses $ \s -> case s of
|
|
Just CurrentSession {timestamp = ts, hash = h} ->
|
|
if diffUnixTime ut ts > t then getNewSession else return (s, Just h)
|
|
Nothing -> getNewSession
|
|
where
|
|
getNewSession = do
|
|
pwd <- readPassword' "Bitwarden Password"
|
|
newHash <- join <$> mapM readSession pwd
|
|
(,newHash) <$> mapM newSession newHash
|
|
newSession h = do
|
|
ut <- getUnixTime
|
|
return CurrentSession {timestamp = ut, hash = h}
|
|
|
|
getSession :: BWServerConf -> Session -> IO T.Text
|
|
getSession conf ses = fromMaybe "" <$> getSession' conf ses
|
|
|
|
readSession :: T.Text -> IO (Maybe T.Text)
|
|
readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] ""
|
|
|
|
notifyStatus :: Bool -> T.Text -> IO ()
|
|
notifyStatus succeeded msg =
|
|
void $ spawnProcess "notify-send" ["-i", i, T.unpack msg]
|
|
where
|
|
i =
|
|
if succeeded
|
|
then "dialog-information-symbolic"
|
|
else "dialog-error-symbolic"
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Client
|
|
--
|
|
-- The client will get the current session from the daemon (if it can) and then
|
|
-- go through a decision-tree like selection process to retrieve information as
|
|
-- needed. This will be in the form of the following menus:
|
|
--
|
|
-- Main menus
|
|
-- - Lock Session -> lock the session
|
|
-- - Browse logins -> show new menu of all logins
|
|
-- - select an entry -> show new menu with entry contents
|
|
-- - All -> copy all to clipboard
|
|
-- - username (if applicable) -> copy to clipboard
|
|
-- - password (if applicable) -> copy to clipboard
|
|
-- - anything else (notes and such) -> copy to clipboard
|
|
newtype BWClientConf = BWClientConf [T.Text]
|
|
|
|
instance HasRofiConf BWClientConf where
|
|
defArgs (BWClientConf a) = a
|
|
|
|
runClient :: [T.Text] -> IO ()
|
|
runClient a = do
|
|
let c = BWClientConf a
|
|
runRofi c $
|
|
emptyMenu
|
|
{ groups = [untitledGroup $ toRofiActions ras]
|
|
, prompt = Just "Action"
|
|
}
|
|
where
|
|
ras =
|
|
[ ("Browse Logins", browseLogins)
|
|
, ("Sync Session", io callSyncSession)
|
|
, ("Lock Session", io callLockSession)
|
|
]
|
|
|
|
browseLogins :: HasRofiConf c => RIO c ()
|
|
browseLogins = io getItems >>= selectItem
|
|
|
|
getItems :: IO [Item]
|
|
getItems = maybe (return []) getItems' =<< callGetSession
|
|
|
|
getItems' :: T.Text -> IO [Item]
|
|
getItems' session = do
|
|
items <- io $ readProcess "bw" ["list", "items", "--session", T.unpack session] ""
|
|
return $ filter notEmpty $ fromMaybe [] $ decode $ fromString items
|
|
where
|
|
notEmpty Item {login = Login {username = Nothing, password = Nothing}} =
|
|
False
|
|
notEmpty _ = True
|
|
|
|
data Item = Item
|
|
{ name :: T.Text
|
|
, login :: Login
|
|
}
|
|
deriving (Show)
|
|
|
|
instance FromJSON Item where
|
|
parseJSON (Object o) =
|
|
Item
|
|
<$> o .: "name"
|
|
<*> o .:? "login" .!= Login {username = Nothing, password = Nothing}
|
|
parseJSON _ = mzero
|
|
|
|
data Login = Login
|
|
{ username :: Maybe T.Text
|
|
, password :: Maybe T.Text
|
|
}
|
|
deriving (Show, Generic)
|
|
|
|
instance FromJSON Login
|
|
|
|
-- TODO make menu buttons here to go back and to copy without leaving
|
|
-- the current menu
|
|
selectItem :: HasRofiConf c => [Item] -> RIO c ()
|
|
selectItem items =
|
|
selectAction $
|
|
emptyMenu
|
|
{ groups = [untitledGroup $ itemsToRofiActions items]
|
|
, prompt = Just "Login"
|
|
}
|
|
|
|
itemsToRofiActions :: HasRofiConf c => [Item] -> RofiActions c
|
|
itemsToRofiActions = toRofiActions . fmap (\i -> (name i, selectCopy $ login i))
|
|
|
|
selectCopy :: HasRofiConf c => Login -> RIO c ()
|
|
selectCopy l =
|
|
selectAction $
|
|
emptyMenu
|
|
{ groups = [untitledGroup $ loginToRofiActions l copy]
|
|
, prompt = Just "Copy"
|
|
, hotkeys = [copyHotkey, backHotkey]
|
|
}
|
|
where
|
|
copy = io . setClipboardString . T.unpack
|
|
copyRepeat s = copy s >> selectCopy l
|
|
copyHotkey =
|
|
Hotkey
|
|
{ keyCombo = "Alt+c"
|
|
, keyIndex = 1
|
|
, keyDescription = "Copy One"
|
|
, keyActions = loginToRofiActions l copyRepeat
|
|
}
|
|
backHotkey =
|
|
Hotkey
|
|
{ keyCombo = "Alt+q"
|
|
, keyIndex = 2
|
|
, keyDescription = "Back"
|
|
, -- TODO this is overly complicated, all entries do the same thing
|
|
-- TODO this is slow, we can cache the logins somehow...
|
|
keyActions = loginToRofiActions l (const browseLogins)
|
|
}
|
|
|
|
loginToRofiActions :: Login -> (T.Text -> RIO c ()) -> RofiActions c
|
|
loginToRofiActions Login {username = u, password = p} a =
|
|
toRofiActions $ catMaybes [user, pwd]
|
|
where
|
|
copyIfJust f = fmap $ liftM2 (,) f a
|
|
fmtUsername s = T.concat ["Username (", s, ")"]
|
|
fmtPassword s = T.concat ["Password (", T.take 32 (T.replicate (T.length s) "*"), ")"]
|
|
user = copyIfJust fmtUsername u
|
|
pwd = copyIfJust fmtPassword p
|
|
|
|
getItemPassword' :: BWServerConf -> Session -> T.Text -> IO (Maybe T.Text)
|
|
getItemPassword' conf session item = mapM getPwd =<< getSession' conf session
|
|
where
|
|
getPwd s =
|
|
T.pack
|
|
<$> readProcess
|
|
"bw"
|
|
["get", "password", T.unpack item, "--session", T.unpack s]
|
|
""
|
|
|
|
getItemPassword :: BWServerConf -> Session -> T.Text -> IO T.Text
|
|
getItemPassword conf session item =
|
|
fromMaybe ""
|
|
<$> getItemPassword' conf session item
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | DBus
|
|
startService :: BWServerConf -> Session -> IO ()
|
|
startService c ses = do
|
|
client <- connectSession
|
|
let flags = [nameAllowReplacement, nameReplaceExisting]
|
|
_ <- requestName client busname flags
|
|
TI.putStrLn "Started rofi bitwarden dbus client"
|
|
export
|
|
client
|
|
path
|
|
defaultInterface
|
|
{ interfaceName = interface
|
|
, interfaceMethods =
|
|
[ autoMethod memGetSession $ getSession c ses
|
|
, autoMethod memLockSession $ lockSession ses
|
|
, autoMethod memSyncSession $ syncSession c ses
|
|
, autoMethod memGetPassword $ getItemPassword c ses
|
|
]
|
|
}
|
|
|
|
busname :: BusName
|
|
busname = "org.rofi.bitwarden"
|
|
|
|
path :: ObjectPath
|
|
path = "/bitwarden"
|
|
|
|
interface :: InterfaceName
|
|
interface = "org.rofi.bitwarden.session"
|
|
|
|
memGetSession :: MemberName
|
|
memGetSession = "GetSession"
|
|
|
|
memLockSession :: MemberName
|
|
memLockSession = "LockSession"
|
|
|
|
memSyncSession :: MemberName
|
|
memSyncSession = "SyncSession"
|
|
|
|
memGetPassword :: MemberName
|
|
memGetPassword = "GetPassword"
|
|
|
|
callMember :: MemberName -> IO [Variant]
|
|
callMember m = do
|
|
reply <- callMethod $ methodCall path interface m
|
|
case reply of
|
|
Left err -> TI.putStrLn (T.pack (methodErrorMessage err)) >> return []
|
|
Right body -> return body
|
|
|
|
callLockSession :: IO ()
|
|
callLockSession = void $ callMember memLockSession
|
|
|
|
callSyncSession :: IO ()
|
|
callSyncSession = void $ callMember memSyncSession
|
|
|
|
callGetSession :: IO (Maybe T.Text)
|
|
callGetSession = getBodyString <$> callMember memGetSession
|
|
|
|
-- TODO maybe will need to add a caller for getItemPassword
|
|
|
|
getBodyString :: [Variant] -> Maybe T.Text
|
|
getBodyString [b] = case fromVariant b :: Maybe T.Text of
|
|
Just "" -> Nothing
|
|
s -> s
|
|
getBodyString _ = Nothing
|
|
|
|
callMethod :: MethodCall -> IO (Either MethodError [Variant])
|
|
callMethod mc = do
|
|
client <- connectSession
|
|
reply <- call client mc {methodCallDestination = Just busname}
|
|
disconnect client
|
|
return $ methodReturnBody <$> reply
|