ADD sync session functionality
This commit is contained in:
parent
bfdb50d6a5
commit
e21b581e6c
|
@ -97,25 +97,43 @@ runDaemon t = do
|
||||||
lockSession :: Session -> IO ()
|
lockSession :: Session -> IO ()
|
||||||
lockSession ses = void $ swapMVar ses Nothing
|
lockSession ses = void $ swapMVar ses Nothing
|
||||||
|
|
||||||
getSession :: BWServerConf -> Session -> IO String
|
syncSession :: BWServerConf -> Session -> IO ()
|
||||||
getSession BWServerConf { timeout = t } ses = do
|
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 String)
|
||||||
|
getSession' BWServerConf { timeout = t } ses = do
|
||||||
ut <- getUnixTime
|
ut <- getUnixTime
|
||||||
modifyMVar ses $ \s -> case s of
|
modifyMVar ses $ \s -> case s of
|
||||||
Just CurrentSession { timestamp = ts, hash = h } ->
|
Just CurrentSession { timestamp = ts, hash = h } ->
|
||||||
if diffUnixTime ut ts > t then getNewSession else return (s, h)
|
if diffUnixTime ut ts > t then getNewSession else return (s, Just h)
|
||||||
Nothing -> getNewSession
|
Nothing -> getNewSession
|
||||||
where
|
where
|
||||||
getNewSession = do
|
getNewSession = do
|
||||||
pwd <- readPassword
|
pwd <- readPassword
|
||||||
newHash <- join <$> mapM readSession pwd
|
newHash <- join <$> mapM readSession pwd
|
||||||
(, fromMaybe "" newHash) <$> mapM newSession newHash
|
(, newHash) <$> mapM newSession newHash
|
||||||
newSession h = do
|
newSession h = do
|
||||||
ut <- getUnixTime
|
ut <- getUnixTime
|
||||||
return CurrentSession { timestamp = ut, hash = h }
|
return CurrentSession { timestamp = ut, hash = h }
|
||||||
|
|
||||||
|
getSession :: BWServerConf -> Session -> IO String
|
||||||
|
getSession conf ses = fromMaybe "" <$> getSession' conf ses
|
||||||
|
|
||||||
readSession :: String -> IO (Maybe String)
|
readSession :: String -> IO (Maybe String)
|
||||||
readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] ""
|
readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] ""
|
||||||
|
|
||||||
|
notifyStatus :: Bool -> String -> IO ()
|
||||||
|
notifyStatus succeeded msg =
|
||||||
|
void $ spawnProcess "notify-send" ["-i", i, msg]
|
||||||
|
where
|
||||||
|
i = if succeeded
|
||||||
|
then "dialog-information-symbolic"
|
||||||
|
else "dialog-error-symbolic"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Client
|
-- | Client
|
||||||
--
|
--
|
||||||
|
@ -146,6 +164,7 @@ runClient a = do
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
ras = [ ("Browse Logins", browseLogins)
|
ras = [ ("Browse Logins", browseLogins)
|
||||||
|
, ("Sync Session", io callSyncSession)
|
||||||
, ("Lock Session", io callLockSession)
|
, ("Lock Session", io callLockSession)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -246,6 +265,9 @@ memGetSession = "GetSession"
|
||||||
memLockSession :: MemberName
|
memLockSession :: MemberName
|
||||||
memLockSession = "LockSession"
|
memLockSession = "LockSession"
|
||||||
|
|
||||||
|
memSyncSession :: MemberName
|
||||||
|
memSyncSession = "SyncSession"
|
||||||
|
|
||||||
startService :: BWServerConf -> Session -> IO ()
|
startService :: BWServerConf -> Session -> IO ()
|
||||||
startService c ses = do
|
startService c ses = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
|
@ -257,27 +279,30 @@ startService c ses = do
|
||||||
, interfaceMethods =
|
, interfaceMethods =
|
||||||
[ autoMethod memGetSession $ getSession c ses
|
[ autoMethod memGetSession $ getSession c ses
|
||||||
, autoMethod memLockSession $ lockSession ses
|
, autoMethod memLockSession $ lockSession ses
|
||||||
|
, autoMethod memSyncSession $ syncSession c ses
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
callLockSession :: IO ()
|
callMember :: MemberName -> IO [Variant]
|
||||||
callLockSession = do
|
callMember m = do
|
||||||
reply <- callMethod $ methodCall path interface memLockSession
|
reply <- callMethod $ methodCall path interface m
|
||||||
case reply of
|
case reply of
|
||||||
Left err -> putStrLn $ methodErrorMessage err
|
Left err -> putStrLn (methodErrorMessage err) >> return []
|
||||||
Right _ -> return ()
|
Right body -> return body
|
||||||
|
|
||||||
|
callLockSession :: IO ()
|
||||||
|
callLockSession = void $ callMember memLockSession
|
||||||
|
|
||||||
|
callSyncSession :: IO ()
|
||||||
|
callSyncSession = void $ callMember memSyncSession
|
||||||
|
|
||||||
callGetSession :: IO (Maybe String)
|
callGetSession :: IO (Maybe String)
|
||||||
callGetSession = do
|
callGetSession = getBodySession <$> callMember memGetSession
|
||||||
reply <- callMethod $ methodCall path interface memGetSession
|
|
||||||
case reply of
|
|
||||||
Left err -> putStrLn (methodErrorMessage err) >> return Nothing
|
|
||||||
Right body -> return $ getBodySession body
|
|
||||||
|
|
||||||
getBodySession :: [Variant] -> Maybe String
|
getBodySession :: [Variant] -> Maybe String
|
||||||
getBodySession [b] = case ses of { Just "" -> Nothing; _ -> ses }
|
getBodySession [b] = case fromVariant b :: Maybe String of
|
||||||
where
|
Just "" -> Nothing
|
||||||
ses = fromVariant b :: Maybe String
|
s -> s
|
||||||
getBodySession _ = Nothing
|
getBodySession _ = Nothing
|
||||||
|
|
||||||
callMethod :: MethodCall -> IO (Either MethodError [Variant])
|
callMethod :: MethodCall -> IO (Either MethodError [Variant])
|
||||||
|
|
Loading…
Reference in New Issue