From ea924c53e6ecb2148747353ce34ae7b0ea416d8c Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 6 Jul 2019 16:15:04 -0400 Subject: Minor refactor --- lib/KeyRing.hs | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) (limited to 'lib') diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 14a3a0c..5cdb30c 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs @@ -177,10 +177,9 @@ isMutable stream | KF_None <- fill stream = False isMutable _ = True -filesToLock :: - KeyRingOperation -> InputFileContext -> [FilePath] -filesToLock k ctx = do - (f,stream) <- Map.toList (opFiles k) +filesToLock :: (Map.Map InputFile StreamInfo) -> InputFileContext -> [FilePath] +filesToLock opfiles ctx = do + (f,stream) <- Map.toList opfiles case fill stream of KF_None -> [] _ -> resolveInputFile ctx f @@ -1146,12 +1145,21 @@ try' v body = -- | Load and update key files according to the specified 'KeyRingOperation'. runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) -runKeyRing operation = do +runKeyRing operation = + withLockedKeyring (opHome operation) + (opFiles operation) + $ realRunKeyRing operation + +withLockedKeyring :: Maybe FilePath + -> Map.Map InputFile StreamInfo + -> (InputFileContext -> Maybe String -> IO (KikiResult a)) + -> IO (KikiResult a) +withLockedKeyring homespec opfiles go = do -- get homedir and keyring files + fingerprint for working key - homedir <- getHomeDir (opHome operation) + homedir <- getHomeDir homespec try' homedir $ \(_homedir, secring, pubring, grip0) -> do let ctx = InputFileContext secring pubring - tolocks = filesToLock operation ctx + tolocks = filesToLock opfiles ctx secring <- return Nothing pubring <- return Nothing (locks :: [(Maybe DotLock, FilePath)]) <- @@ -1167,13 +1175,13 @@ runKeyRing operation = do ret <- if not $ null failed_locks then return $ KikiResult (FailedToLock failed_locks) [] - else realRunKeyRing ctx grip0 operation + else go ctx grip0 forM_ lked $ \(Just lk, fname) -> dotlock_release lk return ret -realRunKeyRing :: InputFileContext -> Maybe String -> KeyRingOperation -> IO (KikiResult KeyRingRuntime) -realRunKeyRing ctx grip0 operation = do +realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe String -> IO (KikiResult KeyRingRuntime) +realRunKeyRing operation ctx grip0 = do bresult <- buildKeyDB ctx grip0 operation try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do -- cgit v1.2.3