diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-06 16:15:04 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-06 16:15:04 -0400 |
commit | ea924c53e6ecb2148747353ce34ae7b0ea416d8c (patch) | |
tree | b1d9ba1f824537856dfef4204fc6227ea686941b /lib | |
parent | 88f69b2f64ca5af925bd2bcfa25c0a054e09f63c (diff) |
Minor refactor
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 28 |
1 files changed, 18 insertions, 10 deletions
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 | |||
177 | isMutable _ = True | 177 | isMutable _ = True |
178 | 178 | ||
179 | 179 | ||
180 | filesToLock :: | 180 | filesToLock :: (Map.Map InputFile StreamInfo) -> InputFileContext -> [FilePath] |
181 | KeyRingOperation -> InputFileContext -> [FilePath] | 181 | filesToLock opfiles ctx = do |
182 | filesToLock k ctx = do | 182 | (f,stream) <- Map.toList opfiles |
183 | (f,stream) <- Map.toList (opFiles k) | ||
184 | case fill stream of | 183 | case fill stream of |
185 | KF_None -> [] | 184 | KF_None -> [] |
186 | _ -> resolveInputFile ctx f | 185 | _ -> resolveInputFile ctx f |
@@ -1146,12 +1145,21 @@ try' v body = | |||
1146 | 1145 | ||
1147 | -- | Load and update key files according to the specified 'KeyRingOperation'. | 1146 | -- | Load and update key files according to the specified 'KeyRingOperation'. |
1148 | runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) | 1147 | runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) |
1149 | runKeyRing operation = do | 1148 | runKeyRing operation = |
1149 | withLockedKeyring (opHome operation) | ||
1150 | (opFiles operation) | ||
1151 | $ realRunKeyRing operation | ||
1152 | |||
1153 | withLockedKeyring :: Maybe FilePath | ||
1154 | -> Map.Map InputFile StreamInfo | ||
1155 | -> (InputFileContext -> Maybe String -> IO (KikiResult a)) | ||
1156 | -> IO (KikiResult a) | ||
1157 | withLockedKeyring homespec opfiles go = do | ||
1150 | -- get homedir and keyring files + fingerprint for working key | 1158 | -- get homedir and keyring files + fingerprint for working key |
1151 | homedir <- getHomeDir (opHome operation) | 1159 | homedir <- getHomeDir homespec |
1152 | try' homedir $ \(_homedir, secring, pubring, grip0) -> do | 1160 | try' homedir $ \(_homedir, secring, pubring, grip0) -> do |
1153 | let ctx = InputFileContext secring pubring | 1161 | let ctx = InputFileContext secring pubring |
1154 | tolocks = filesToLock operation ctx | 1162 | tolocks = filesToLock opfiles ctx |
1155 | secring <- return Nothing | 1163 | secring <- return Nothing |
1156 | pubring <- return Nothing | 1164 | pubring <- return Nothing |
1157 | (locks :: [(Maybe DotLock, FilePath)]) <- | 1165 | (locks :: [(Maybe DotLock, FilePath)]) <- |
@@ -1167,13 +1175,13 @@ runKeyRing operation = do | |||
1167 | ret <- | 1175 | ret <- |
1168 | if not $ null failed_locks | 1176 | if not $ null failed_locks |
1169 | then return $ KikiResult (FailedToLock failed_locks) [] | 1177 | then return $ KikiResult (FailedToLock failed_locks) [] |
1170 | else realRunKeyRing ctx grip0 operation | 1178 | else go ctx grip0 |
1171 | forM_ lked $ \(Just lk, fname) -> dotlock_release lk | 1179 | forM_ lked $ \(Just lk, fname) -> dotlock_release lk |
1172 | return ret | 1180 | return ret |
1173 | 1181 | ||
1174 | 1182 | ||
1175 | realRunKeyRing :: InputFileContext -> Maybe String -> KeyRingOperation -> IO (KikiResult KeyRingRuntime) | 1183 | realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe String -> IO (KikiResult KeyRingRuntime) |
1176 | realRunKeyRing ctx grip0 operation = do | 1184 | realRunKeyRing operation ctx grip0 = do |
1177 | bresult <- buildKeyDB ctx grip0 operation | 1185 | bresult <- buildKeyDB ctx grip0 operation |
1178 | try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do | 1186 | try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do |
1179 | 1187 | ||