From b42e6e3606ce7d99dea71e51e5deda7915521d1e Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 21 Jun 2015 20:04:22 -0400
Subject: Added ability for transforms to log their progress.

---
 KeyRing.hs | 23 +++++++++++++----------
 1 file changed, 13 insertions(+), 10 deletions(-)

diff --git a/KeyRing.hs b/KeyRing.hs
index ff23bfb..1d21ff5 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -649,11 +649,13 @@ errorString e = uncamel . show $ fmap (const ()) e
 data KikiResult a = KikiResult
     { kikiCondition :: KikiCondition a
     -- ^ The result or a fatal error condition.
-    , kikiReport :: [ (FilePath, KikiReportAction) ]
+    , kikiReport :: KikiReport
     -- ^ A list of non-fatal warnings and informational messages
     -- along with the files that triggered them.
     }
 
+type KikiReport = [ (FilePath, KikiReportAction) ]
+
 keyPacket :: KeyData -> Packet
 keyPacket (KeyData k _ _ _) = packet k
 
@@ -2083,17 +2085,17 @@ performManipulations ::
                 -> KeyRingRuntime
                 -> Maybe MappedPacket
                 -> (KeyRingRuntime -> KeyData -> [PacketUpdate])
-                -> IO (KikiCondition (KeyRingRuntime,[(FilePath,KikiReportAction)]))
+                -> IO (KikiCondition (KeyRingRuntime,KikiReport))
 performManipulations doDecrypt rt wk manip = do
     let db = rtKeyDB rt
-        performAll kd = foldM perform (KikiSuccess kd) $ manip rt kd
+        performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd
     r <- Traversable.mapM performAll db
     try (sequenceA r) $ \db -> do
-    return $ KikiSuccess (rt { rtKeyDB = db },[])
+    return $ KikiSuccess (rt { rtKeyDB =  fmap fst db }, concatMap snd $ Map.elems db)
  where
-    perform :: KikiCondition KeyData -> PacketUpdate -> IO (KikiCondition KeyData)
+    perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
     perform kd (InducerSignature uid subpaks) = do
-        try kd $ \kd -> do
+        try kd $ \(kd,report) -> do
         flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
         wkun' <- doDecrypt wk'
         try wkun' $ \wkun -> do    
@@ -2131,16 +2133,17 @@ performManipulations doDecrypt rt wk manip = do
         let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap)
             f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x
                   , om `Map.union` snd x )
-        return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) }
+        -- XXX: Shouldn't this signature generation show up in the KikiReport ?
+        return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report )
 
     perform kd (SubKeyDeletion topk subk) = do
-        try kd $ \kd -> do
-        -- TODO: delete key from key database
+        try kd $ \(kd,report) -> do
         let kk = keykey $ packet $ keyMappedPacket kd
             kd' | kk /= topk = kd
                 | otherwise  = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd }
             pred k _ = k == subk
-        return $ KikiSuccess kd'
+        -- TODO: update report with DeletedPacket entries
+        return $ KikiSuccess (kd' , report)
 
 initializeMissingPEMFiles ::
     KeyRingOperation
-- 
cgit v1.2.3