factored mergeKeyPacket out of merge routine.

1 files changed, 22 insertions, 27 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index c8a5bf9..a65ebc4 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -167,6 +167,7 @@ data InputFile = HomeSec
                | ArgFile FilePath
                | FileDesc Posix.Fd
                | Pipe Posix.Fd Posix.Fd
+               -- ^ Note: Don't use Pipe for wallet files. (TODO)
  deriving (Eq,Ord)
 
 -- type UsageTag = String
@@ -2358,21 +2359,29 @@ onionName kd = (addr,name)
  where
     (addr,(name:_,_)) = getHostnames kd
 -}
+keyCompare :: String -> Packet -> Packet -> Ordering
+keyCompare what (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
+keyCompare what (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
+keyCompare what a b | keykey a==keykey b = EQ
+keyCompare what a b = error $ unlines ["Unable to merge "++what++":"
+                              , fingerprint a
+                              , PP.ppShow a
+                              , fingerprint b
+                              , PP.ppShow b
+                              ]
+
+mergeKeyPacket :: String -> MappedPacket -> MappedPacket -> MappedPacket
+mergeKeyPacket what key p = 
+    key { packet = minimumBy (keyCompare what) [packet key,packet p]
+        , locations = Map.union (locations key) (locations p)
+        , usage_tag = usage_tag key `mplus` usage_tag p
+        }
+
 
 merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
                 -> KeyDB
 merge_ db filename qs = foldl mergeit db (zip [0..] qs)
  where
-    keycomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
-    keycomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
-    keycomp a b | keykey a==keykey b = EQ
-    keycomp a b = error $ unlines ["Unable to merge keys:"
-                                  , fingerprint a
-                                  , PP.ppShow a
-                                  , fingerprint b
-                                  , PP.ppShow b
-                                  ]
-
     asMapped n p = let m = mappedPacket filename p
                    in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
     asSigAndTrust n (p,tm) = (asMapped n p,tm)
@@ -2389,12 +2398,12 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
         --  This is due to the use of statements like
         --      (Map.insert filename (origin p n) (locations key))
         --
+        update :: Maybe KeyData -> Maybe KeyData
         update v | isKey p && not (is_subkey p)
           = case v of
              Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
              Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
-                     -> Just $ KeyData ( (asMapped n (minimumBy keycomp [packet key,p]))
-                                          { locations = Map.insert filename (origin p n) (locations key) } )
+                     -> Just $ KeyData (mergeKeyPacket "master keys" key $ asMapped n p)
                                        sigs
                                        uids
                                        subkeys
@@ -2424,22 +2433,8 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
     mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
     mergeSubkey n p Nothing                  = Just $ SubKey (asMapped n p) []
     mergeSubkey n p (Just (SubKey key sigs)) = Just $
-        SubKey ((asMapped n (minimumBy subcomp [packet key,p]))
-                 { locations = Map.insert filename (origin p n) (locations key) })
+        SubKey (mergeKeyPacket "subs" key $ asMapped n p)
                sigs
-     where
-        -- Compare master keys, LT is prefered for merging
-        -- Compare subkeys, LT is prefered for merging
-        subcomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
-        subcomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
-        subcomp a b | keykey a==keykey b = EQ
-        subcomp a b = error $ unlines ["Unable to merge subs:"
-                                      , fingerprint a
-                                      , PP.ppShow a
-                                      , fingerprint b
-                                      , PP.ppShow b
-                                      ]
-        -- subcomp_m a b = subcomp (packet a) (packet b)
 
     mergeUid :: Int ->(Packet,a) -> Maybe ([SigAndTrust],OriginMap) -> Maybe ([SigAndTrust],OriginMap)
     mergeUid n (UserIDPacket s,_) Nothing         = Just ([],Map.singleton filename (origin MarkerPacket n))