reorganized cross_merge to use runKeyring

1 files changed, 25 insertions, 37 deletions

diff --git a/kiki.hs b/kiki.hs
index e4c0dc4..ab3faf5 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1269,7 +1269,7 @@ sortByHint fname f = sortBy (comparing gethint)
 keyMappedPacket (KeyData k _ _ _) = k
 keyPacket (KeyData k _ _ _) = packet k
 
-writeOutKeyrings :: Map.Map FilePath DotLock -> KeyDB -> IO ()
+writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO ()
 writeOutKeyrings lkmap db = do
     let ks = Map.elems db
         fs = Map.keys (foldr unionfiles Map.empty ks)
@@ -1307,44 +1307,34 @@ writeOutKeyrings lkmap db = do
         L.writeFile f (encode m)
 
 cross_merge doDecrypt homespec keyrings wallets f = do
+
+        let it = KeyRingData
+                    { filesToLock = HomeSec:HomePub:map ArgFile keyrings
+                    , homeSpec = homespec
+                    , keyringFiles = keyrings
+                    , walletFiles = wallets
+                    , kaction = go
+                    }
+        runKeyRing it
+ where
+    go rt = do
         let readp n = fmap (n,) (readPacketsFromFile n)
             readw wk n = fmap (n,) (readPacketsFromWallet wk n)
 
-        let relock keyrings = do
-                (fsns,failed_locks) <- lockFiles keyrings
-                (wsns,failed_wlocks) <- lockFiles wallets
-                forM_ (failed_locks++failed_wlocks) $ \f -> warn $ "Failed to lock: " ++ f
-                return (fsns,wsns,failed_locks,failed_wlocks)
-            sec_n:_ = keyrings
-
-        (homedir,secring,pubring,grip0) <- getHomeDir homespec
-
-        (fsns0,wsns0,failed_locks0,failed_wlocks0) <- relock [secring,pubring]
-        db00 <- do
-            ms0 <- mapM readp (map snd fsns0++failed_locks0)
-            return $ foldl' (uncurry . merge) Map.empty ms0
-
-        (fsns,wsns,failed_locks,failed_wlocks) <- relock keyrings
-        wsns <- return $ wsns0 ++ wsns
-        failed_locks <- return $ failed_locks0 ++ failed_locks
-        failed_wlocks <- return $ failed_wlocks0 ++ failed_wlocks
-
-        -- let (lks,fs) = unzip fsns
-        -- forM_ fs $ \f -> warn $ "locked: " ++ f
-        let pass n (fsns,failed_locks) = do
-                ms <- mapM readp (map snd fsns++failed_locks)
-                let db0 = foldl' (uncurry . merge) db00 ms
+        let pass n  = do
+                ms <- mapM readp (rtRings rt)
+                let db0 = foldl' (uncurry . merge) Map.empty ms
                     fstkey = listToMaybe $ mapMaybe isSecringKey ms 
                               where isSecringKey (fn,Message ps)
-                                        | fn==sec_n = listToMaybe ps
+                                        | fn== rtSecring rt = listToMaybe ps
                                     isSecringKey _  = Nothing
-                    grip = grip0 `mplus` (fingerprint <$> fstkey)
+                    grip = rtGrip rt `mplus` (fingerprint <$> fstkey)
                     wk = listToMaybe $ do
                             fp <- maybeToList grip
                             elm <- Map.toList db0
                             guard $ matchSpec (KeyGrip fp) elm
                             return $ keyPacket (snd elm)
-                wms <- mapM (readw wk) (map snd wsns++failed_wlocks)
+                wms <- mapM (readw wk) (rtWallets rt)
                 let -- db1= foldl' (uncurry . merge_) db0 wms
                     ts = do
                         maybeToList wk
@@ -1373,7 +1363,7 @@ cross_merge doDecrypt homespec keyrings wallets f = do
                         return (tag,mp)
 
                 -- export wallet keys
-                forM_ wsns $ \(_,n) -> do
+                forM_ (rtWallets rt) $ \n -> do
                     let cs' = do
                         (nw,mp) <- cs
                         -- let fns = Map.keys (locations mp)
@@ -1389,19 +1379,17 @@ cross_merge doDecrypt homespec keyrings wallets f = do
 
                 -- unlockFiles fsns ----------- Originally, I did this to enable altering the gpg keyrings
                 ------------------------------- from external tools. 
-                (db',_) <- f (sec_n,grip) db pubring
+                (db',_) <- f (rtSecring rt,grip) db (rtPubring rt)
                 -- lk <- relock --------------- The design is not quite safe, so it is disabled for now.
-                let lk = (fsns,failed_locks) -- 
+                let lk = (rtRings rt,[])
                 -------------------------------
-                maybe (if n==0 then pass 1 lk else return (lk,db))
+                maybe (if n==0 then pass 1 else return (lk,db))
                       (return . (lk,))
                       db'
-        ((fsns,failed_locks),db) <- pass 0 (fsns,failed_locks)
-        let lkmap = Map.fromList $ map swap fsns
+        ((fsns,failed_locks),db) <- pass 0
+
+        let lkmap = Map.fromList $ map (,()) fsns
         writeOutKeyrings lkmap db
-        unlockFiles fsns
-        unlockFiles wsns
-        return ()
 
 
 {-