newtype UidString

5 files changed, 23 insertions, 22 deletions

diff --git a/kiki.hs b/kiki.hs
index b3cc880..7d825d3 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -259,7 +259,7 @@ show_whose_key input_key db =
     case ks of
         [KeyData k _ uids _] -> do
             putStrLn $ fingerprint (packet k)
-            mapM_ putStrLn $ Map.keys uids
+            mapM_ putStrLn $ unUidString <$> Map.keys uids
         (_:_) -> error "ambiguous"
         [] -> return ()
 
diff --git a/lib/KeyDB.hs b/lib/KeyDB.hs
index 1f0849c..1aef747 100644
--- a/lib/KeyDB.hs
+++ b/lib/KeyDB.hs
@@ -21,6 +21,7 @@ module KeyDB
     , sortByHint
     , flattenKeys
     , flattenFiltered
+    , UidString(..)
     ) where
 
 import Control.Monad
@@ -38,12 +39,14 @@ type SigAndTrust = ( MappedPacket
                    , TrustMap     ) -- trust packets
 data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
 
+data UidString = UidString { unUidString :: String } deriving (Show, Eq, Ord)
+
 -- | This is a GPG Identity which includes a master key and all its UIDs and
 -- subkeys and associated signatures.
 data KeyData = KeyData
     { keyMappedPacket :: MappedPacket                               -- main key
     , keySigAndTrusts :: [SigAndTrust]                              -- sigs on main key
-    , keyUids         :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids
+    , keyUids         :: (Map.Map UidString ([SigAndTrust],OriginMap)) -- uids
     , keySubKeys      :: (Map.Map KeyKey SubKey)                    -- subkeys
     } deriving Show
 
@@ -118,14 +121,14 @@ flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPubl
                                   _)) = True
                   isSecret _          = False
 
-flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket]
-flattenUid fname ispub (str,(sigs,om)) =
+flattenUid :: FilePath -> Bool -> (UidString,([SigAndTrust],OriginMap)) -> [MappedPacket]
+flattenUid fname ispub (UidString str,(sigs,om)) =
     (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
 
 flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
 flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
 
-flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
+flattenAllUids :: FilePath -> Bool -> Map.Map UidString ([SigAndTrust],OriginMap) -> [MappedPacket]
 flattenAllUids fname ispub uids =
     concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
 
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index b946e54..70edb9e 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -667,7 +667,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
           where wk = workingKey (rtGrip rt) (rtKeyDB rt)
                 dont_have (KeyData p _ _ _) = not . Map.member (rtPubring rt)
                                                    $ locations p
-                has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids
+                has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ first unUidString <$> Map.toList uids
                  where
                     goodsig (uidstr,(sigs,_)) = not . null $ do
                         sig0 <- fmap (packet . fst) sigs
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index cd1bae9..0eddc51 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -30,7 +30,6 @@ import qualified Data.ByteString.Lazy       as L (ByteString, concat, empty,
                                                   null, toChunks,
                                                   toStrict, head)
 import           Data.Char
-import           Data.Functor
 import           Data.List
 import qualified Data.Map                   as Map
 import           Data.Maybe
@@ -55,7 +54,6 @@ import qualified System.Posix.Types         as Posix
 import           Data.Hourglass
 import           Foreign.C.Types            (CTime (..))
 import           Data.Traversable           (sequenceA)
-import qualified Data.Traversable           as Traversable
 import           System.IO                  (openFile, IOMode(ReadMode))
 
 import           System.Posix.IO            (fdToHandle)
@@ -678,7 +676,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
     uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
                 let has_torid = do
                      -- TODO: check for omitted real name field
-                     (sigtrusts,om) <- Map.lookup idstr uids
+                     (sigtrusts,om) <- Map.lookup (UidString idstr) uids
                      listToMaybe $ do
                          s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
                          signatures_over $ verify (Message [packet top]) s
@@ -700,7 +698,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
                 let om = Map.singleton fname (origin sig (-1))
                     trust = Map.empty
                 return $ KikiSuccess
-                    ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
+                    ( Map.insert (UidString idstr) ([( (mappedPacket fname sig) {locations=om}
                                          , trust)],om) uids
                     , [] )
 
@@ -801,7 +799,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
 
 matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us
   where
-    us = filter (isInfixOf pat) $ Map.keys uids
+    us = filter (isInfixOf pat) $ unUidString <$> Map.keys uids
 
 doImport
   :: PacketTranscoder
@@ -946,7 +944,7 @@ setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp tops
     isName (NotationDataPacket True "hostname@" _) = True
     isName _                                       = False
     uids0 = fmap zapIfHasName uids
-    fstuid = head $ do
+    fstuid = UidString $ head $ do
         p <- map packet $ flattenAllUids "" True uids
         maybeToList $ isUserID p
     uids1 = Map.adjust addnames fstuid uids0
@@ -1069,14 +1067,14 @@ dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd)
     update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
           = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
     update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p
-          = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) uid uids)
+          = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) (UidString uid) uids)
                                     subkeys
     update (Just (KeyData key sigs uids subkeys))
           = case sub of
              MarkerPacket    -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys
              UserIDPacket uid-> Just $ KeyData key
                                                sigs
-                                               (Map.alter (mergeUidSig n ptt) uid uids)
+                                               (Map.alter (mergeUidSig n ptt) (UidString uid) uids)
                                                subkeys
              _  | isKey sub  -> Just $ KeyData key
                                                sigs
diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index edc18bb..7750ec5 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -664,7 +664,7 @@ performManipulations doDecrypt rt wk manip = do
                    , Packet ) -- key who signed
                  ]
             vs = do
-                   x <- maybeToList $ Map.lookup uid (keyUids kd)
+                   x <- maybeToList $ Map.lookup (UidString uid) (keyUids kd)
                    sig <- map (packet . fst) (fst x)
                    o <- overs sig
                    take 1 $ do -- Stop attempting to verify after the first success.
@@ -681,7 +681,7 @@ performManipulations doDecrypt rt wk manip = do
             f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x
                   , om `Map.union` snd x )
         -- XXX: Shouldn't this signature generation show up in the KikiReport ?
-        return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report )
+        return $ KikiSuccess $ ( kd { keyUids = Map.adjust f (UidString uid) (keyUids kd) }, report )
 
     perform (kd,report) (SubKeyDeletion topk subk) = do
         let kk = keykey $ packet $ keyMappedPacket kd
@@ -755,13 +755,13 @@ parseUID str = UserIDRecord {
 resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate]
 resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
  where
-    ops = map (\u -> InducerSignature u []) us
+    ops = map (\(UidString u) -> InducerSignature u []) us
     us = filter torStyle $ Map.keys umap
-    torStyle str = and [ uid_topdomain parsed == "onion"
-                        , uid_realname parsed `elem` ["","Anonymous"]
-                        , uid_user parsed == "root"
-                        , fmap (match . fst) (lookup (packet k) torbindings)
-                            == Just True ]
+    torStyle (UidString str) = and [ uid_topdomain parsed == "onion"
+                                    , uid_realname parsed `elem` ["","Anonymous"]
+                                    , uid_user parsed == "root"
+                                    , fmap (match . fst) (lookup (packet k) torbindings)
+                                        == Just True ]
       where parsed = parseUID str
             match =  (==subdom) . take (fromIntegral len)
             subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]