From d1dce393d77121509c7ac6d729a09f9f94bc7ab7 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sun, 14 Jul 2019 00:10:42 -0400 Subject: newtype UidString --- kiki.hs | 2 +- lib/KeyDB.hs | 11 +++++++---- lib/KeyRing.hs | 2 +- lib/KeyRing/BuildKeyDB.hs | 14 ++++++-------- lib/Transforms.hs | 16 ++++++++-------- 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)] -- cgit v1.2.3