refactoring (preparing heigenic design of non-spilling keyrings)

1 files changed, 31 insertions, 30 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index c99a2f5..3eba3de 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1089,16 +1089,12 @@ buildKeyDB doDecrypt ctx grip0 keyring = do
             guard (isring $ typ stream)
             resolveInputFile ctx f
 
-        filesAccs isring = do
-            (f,stream) <- Map.toList (kFiles keyring)
-            guard (isring $ typ stream)
-            -- n <- resolveInputFile ctx f
-            return (f, access stream)
+        (ringMap,nonRingMap) = Map.partition (isring . typ) $ kFiles keyring
 
-        readp (f,acc) = fmap readp0 $ readPacketsFromFile ctx f
+        readp f stream = fmap readp0 $ readPacketsFromFile ctx f
          where
-          readp0 ps = ((f,acc'),ps)
-           where acc' = case acc of
+          readp0 ps = (stream { access = acc' }, ps)
+           where acc' = case access stream of
                             AutoAccess ->
                                 case ps of
                                     Message ((PublicKeyPacket {}):_) -> Pub
@@ -1121,22 +1117,25 @@ buildKeyDB doDecrypt ctx grip0 keyring = do
 
     -- KeyRings (todo: KikiCondition reporting?)
     (db_rings,mwk,grip,accs) <- do
-        ms <- mapM readp (filesAccs isring)
+        ringPackets <- Map.traverseWithKey readp ringMap
+        let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
+
         let grip = grip0 `mplus` (fingerprint <$> fstkey)
               where
-                fstkey = listToMaybe $ mapMaybe isSecringKey ms
-                          where isSecringKey ((HomeSec,_),Message ps)
-                                                        = listToMaybe ps
-                                isSecringKey _          = Nothing
-            db_rings = foldl' mergeIt Map.empty ms
-                        where mergeIt db ((f,_),ps) = merge db f ps
+                fstkey = do
+                    (_,Message ps) <- Map.lookup HomeSec ringPackets
+                    listToMaybe ps
+            (spilled,unspilled) = Map.partition (spillable . fst) ringPackets
+            db_rings = Map.foldlWithKey mergeIt Map.empty ringPackets
+                        where mergeIt db f (_,ps) = merge db f ps
             wk = listToMaybe $ do
                     fp <- maybeToList grip
-                    elm <- Map.toList db_rings
-                    guard $ matchSpec (KeyGrip fp) elm
-                    return $ keyMappedPacket (snd elm)
-            accs = map (first (concat . resolveInputFile ctx) . fst) ms
-        return (db_rings,wk,grip,Map.fromList accs)
+                    (kk,kd) <- Map.toList db_rings
+                    guard $ matchSpec (KeyGrip fp) (kk,kd)
+                    return $ keyMappedPacket kd
+            accs = Map.mapKeys (concat . resolveInputFile ctx)
+                        $ fmap (access . fst) ringPackets
+        return (db_rings,wk,grip,accs)
 
     let wk = fmap packet mwk
 
@@ -1740,7 +1739,7 @@ performManipulations doDecrypt operation rt wk = do
                    , Packet ) -- key who signed
                  ]
             vs = do
-                   x <- maybeToList $ Map.lookup uid (rentryUids kd)
+                   x <- maybeToList $ Map.lookup uid (keyUids kd)
                    sig <- map (packet . fst) (fst x)
                    o <- overs sig
                    k <- keys
@@ -1755,7 +1754,7 @@ performManipulations doDecrypt operation rt wk = 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 { rentryUids = Map.adjust f uid (rentryUids kd) }
+        return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) }
 
 initializeMissingPEMFiles ::
     KeyRingOperation
@@ -2297,14 +2296,14 @@ type SigAndTrust = ( MappedPacket
 type KeyKey = [ByteString]
 data SubKey = SubKey MappedPacket [SigAndTrust]
 
--- | This is a roster entry, it's poorly named
+-- | This is a GPG Identity. It's poorly named
 --   but we are keeping the name around until
 --   we're sure we wont be cutting and pasting
---   code with master any more
+--   code with master any more.
 data KeyData = KeyData { keyMappedPacket :: MappedPacket    -- main key
-                       , rentrySigAndTrusts :: [SigAndTrust]  -- sigs on main key
-                       , rentryUids :: (Map.Map String ([SigAndTrust],OriginMap))  -- uids
-                       , rentrySubKeys :: (Map.Map KeyKey SubKey)    -- subkeys
+                       , keySigAndTrusts :: [SigAndTrust]  -- sigs on main key
+                       , keyUids :: (Map.Map String ([SigAndTrust],OriginMap))  -- uids
+                       , keySubKeys :: (Map.Map KeyKey SubKey)    -- subkeys
                        }
 
 type KeyDB = Map.Map KeyKey KeyData
@@ -2324,9 +2323,11 @@ mappedPacket filename p = MappedPacket
 
 keykey :: Packet -> KeyKey
 keykey key =
-    -- Note: The key's timestamp is included in it's fingerprint.
-    --       Therefore, the same key with a different timestamp is
-    --       considered distinct using this keykey implementation.
+    -- Note: The key's timestamp is normally included in it's fingerprint.
+    --       This is undesirable for kiki because it causes the same
+    --       key to be imported multiple times and show as apparently
+    --       distinct keys with different fingerprints.
+    --       Thus, we will remove the timestamp.
     fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
 
 uidkey :: Packet -> String