abstracted initializeMissingPEMFiles

1 files changed, 59 insertions, 44 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 8571482..b0e24de 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1267,45 +1267,17 @@ performManipulations doDecrypt operation rt wk = do
     return $ KikiSuccess (db,[])
 
 
-{-
-interpretManip :: KeyData -> KeyRingAddress PacketUpdate -> IO KeyData
-interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo"
-interpretManip kd manip = return kd
--}
-
-runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
-runKeyRing operation = do
-    homedir <- getHomeDir (homeSpec operation)
-    let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
-        -- FIXME: try' should probably accept a list of KikiReportActions.
-        --  This would be useful for reporting on disk writes that have already
-        --  succeded prior to this termination.
-        try' v body =
-            case functorToEither v of
-                   Left e -> return $ KikiResult e []
-                   Right wkun -> body wkun
-    try' homedir $ \(homedir,secring,pubring,grip0) -> do
-    let tolocks = filesToLock operation secring pubring
-    lks <- forM tolocks $ \f -> do
-        lk <- dotlock_create f 0
-        v <- flip (maybe $ return Nothing) lk $ \lk -> do
-                e <- dotlock_take lk (-1)
-                if e==0 then return $ Just lk
-                        else dotlock_destroy lk >> return Nothing
-        return (v,f)
-    let (lked, map snd -> failed_locks) = partition (isJust . fst) lks
-    ret <-
-      if not $ null failed_locks
-       then return $ KikiResult (FailedToLock failed_locks) []
-       else do
-
-        -- memoizing decrypter
-        decrypt <- makeMemoizingDecrypter operation secring pubring
-
-        -- merge all keyrings, PEM files, and wallets
-        bresult <- buildKeyDB decrypt secring pubring grip0 operation
-        try' bresult $ \((db,grip,wk),report_imports) -> do
-
+initializeMissingPEMFiles ::
+    KeyRingOperation
+      -> FilePath -> FilePath -> Maybe String
+      -> (MappedPacket -> IO (KikiCondition Packet))
+      -> KeyDB
+      -> IO (KikiCondition ( (KeyDB,[( FilePath
+                                     , Maybe String
+                                     , [MappedPacket]
+                                     , Maybe Initializer)])
+                           , [(FilePath,KikiReportAction)]))
+initializeMissingPEMFiles operation secring pubring grip decrypt db = do
         nonexistents <- 
            filterM (fmap not . doesFileExist . fst)
                $ do (f,t) <- Map.toList (kFiles operation)
@@ -1329,9 +1301,8 @@ runKeyRing operation = do
                                              notmissing
             exports = map (\(f,subspec,ns,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0
 
-
             ambiguity (f,topspec,subspec,_) = do
-               return $ KikiResult (AmbiguousKeySpec f) []
+               return $ AmbiguousKeySpec f
 
             ifnotnull (x:xs) f g = f x
             ifnotnull _      f g = g
@@ -1339,7 +1310,7 @@ runKeyRing operation = do
         ifnotnull ambiguous ambiguity $ do
 
         -- create nonexistent files via external commands
-        externals_ret <- do
+        do
            let cmds = mapMaybe getcmd missing
                  where
                    getcmd (fname,subspec,ms,mcmd) = do
@@ -1362,8 +1333,51 @@ runKeyRing operation = do
                     return (f,subspec,map fst ms,cmd)
 
            try v $ \(db,import_rs) -> do
-           return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs
+           return $ KikiSuccess ((db,exports), map (\((f,_,_,_),r)->(f,r)) rs
                                      ++ import_rs)
+{-
+interpretManip :: KeyData -> KeyRingAddress PacketUpdate -> IO KeyData
+interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo"
+interpretManip kd manip = return kd
+-}
+
+runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
+runKeyRing operation = do
+    homedir <- getHomeDir (homeSpec operation)
+    let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
+        -- FIXME: try' should probably accept a list of KikiReportActions.
+        --  This would be useful for reporting on disk writes that have already
+        --  succeded prior to this termination.
+        try' v body =
+            case functorToEither v of
+                   Left e -> return $ KikiResult e []
+                   Right wkun -> body wkun
+    try' homedir $ \(homedir,secring,pubring,grip0) -> do
+    let tolocks = filesToLock operation secring pubring
+    lks <- forM tolocks $ \f -> do
+        lk <- dotlock_create f 0
+        v <- flip (maybe $ return Nothing) lk $ \lk -> do
+                e <- dotlock_take lk (-1)
+                if e==0 then return $ Just lk
+                        else dotlock_destroy lk >> return Nothing
+        return (v,f)
+    let (lked, map snd -> failed_locks) = partition (isJust . fst) lks
+    ret <-
+      if not $ null failed_locks
+       then return $ KikiResult (FailedToLock failed_locks) []
+       else do
+
+        -- memoizing decrypter
+        decrypt <- makeMemoizingDecrypter operation secring pubring
+
+        -- merge all keyrings, PEM files, and wallets
+        bresult <- buildKeyDB decrypt secring pubring grip0 operation
+        try' bresult $ \((db,grip,wk),report_imports) -> do
+
+        externals_ret <- initializeMissingPEMFiles operation
+                                                   secring pubring grip
+                                                   decrypt
+                                                   db
 
         let rt = KeyRingRuntime
                        { rtPubring = pubring
@@ -1373,7 +1387,8 @@ runKeyRing operation = do
                        , rtKeyDB = db
                        }
 
-        try' externals_ret $ \(db,report_externals) -> do
+        try' externals_ret $ \((db,exports),report_externals) -> do
+
 
 
         r <- performManipulations decrypt