summaryrefslogtreecommitdiff
path: root/lib/KeyRing
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-14 00:10:42 -0400
committerAndrew Cady <d@jerkface.net>2019-07-14 00:13:12 -0400
commitd1dce393d77121509c7ac6d729a09f9f94bc7ab7 (patch)
tree237b077c353cf5671f7821e12c59f3c11f64e585 /lib/KeyRing
parent3f29bdc88a068ec3eab91a8bac12757e3a106ceb (diff)
newtype UidString
Diffstat (limited to 'lib/KeyRing')
-rw-r--r--lib/KeyRing/BuildKeyDB.hs14
1 files changed, 6 insertions, 8 deletions
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,
30 null, toChunks, 30 null, toChunks,
31 toStrict, head) 31 toStrict, head)
32import Data.Char 32import Data.Char
33import Data.Functor
34import Data.List 33import Data.List
35import qualified Data.Map as Map 34import qualified Data.Map as Map
36import Data.Maybe 35import Data.Maybe
@@ -55,7 +54,6 @@ import qualified System.Posix.Types as Posix
55import Data.Hourglass 54import Data.Hourglass
56import Foreign.C.Types (CTime (..)) 55import Foreign.C.Types (CTime (..))
57import Data.Traversable (sequenceA) 56import Data.Traversable (sequenceA)
58import qualified Data.Traversable as Traversable
59import System.IO (openFile, IOMode(ReadMode)) 57import System.IO (openFile, IOMode(ReadMode))
60 58
61import System.Posix.IO (fdToHandle) 59import System.Posix.IO (fdToHandle)
@@ -678,7 +676,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
678 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do 676 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
679 let has_torid = do 677 let has_torid = do
680 -- TODO: check for omitted real name field 678 -- TODO: check for omitted real name field
681 (sigtrusts,om) <- Map.lookup idstr uids 679 (sigtrusts,om) <- Map.lookup (UidString idstr) uids
682 listToMaybe $ do 680 listToMaybe $ do
683 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts)) 681 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
684 signatures_over $ verify (Message [packet top]) s 682 signatures_over $ verify (Message [packet top]) s
@@ -700,7 +698,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
700 let om = Map.singleton fname (origin sig (-1)) 698 let om = Map.singleton fname (origin sig (-1))
701 trust = Map.empty 699 trust = Map.empty
702 return $ KikiSuccess 700 return $ KikiSuccess
703 ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om} 701 ( Map.insert (UidString idstr) ([( (mappedPacket fname sig) {locations=om}
704 , trust)],om) uids 702 , trust)],om) uids
705 , [] ) 703 , [] )
706 704
@@ -801,7 +799,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
801 799
802matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us 800matchSpec (KeyUidMatch pat) (KeyData _ _ uids _) = not $ null us
803 where 801 where
804 us = filter (isInfixOf pat) $ Map.keys uids 802 us = filter (isInfixOf pat) $ unUidString <$> Map.keys uids
805 803
806doImport 804doImport
807 :: PacketTranscoder 805 :: PacketTranscoder
@@ -946,7 +944,7 @@ setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp tops
946 isName (NotationDataPacket True "hostname@" _) = True 944 isName (NotationDataPacket True "hostname@" _) = True
947 isName _ = False 945 isName _ = False
948 uids0 = fmap zapIfHasName uids 946 uids0 = fmap zapIfHasName uids
949 fstuid = head $ do 947 fstuid = UidString $ head $ do
950 p <- map packet $ flattenAllUids "" True uids 948 p <- map packet $ flattenAllUids "" True uids
951 maybeToList $ isUserID p 949 maybeToList $ isUserID p
952 uids1 = Map.adjust addnames fstuid uids0 950 uids1 = Map.adjust addnames fstuid uids0
@@ -1069,14 +1067,14 @@ dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd)
1069 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p 1067 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
1070 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys) 1068 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
1071 update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p 1069 update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p
1072 = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) uid uids) 1070 = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) (UidString uid) uids)
1073 subkeys 1071 subkeys
1074 update (Just (KeyData key sigs uids subkeys)) 1072 update (Just (KeyData key sigs uids subkeys))
1075 = case sub of 1073 = case sub of
1076 MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys 1074 MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys
1077 UserIDPacket uid-> Just $ KeyData key 1075 UserIDPacket uid-> Just $ KeyData key
1078 sigs 1076 sigs
1079 (Map.alter (mergeUidSig n ptt) uid uids) 1077 (Map.alter (mergeUidSig n ptt) (UidString uid) uids)
1080 subkeys 1078 subkeys
1081 _ | isKey sub -> Just $ KeyData key 1079 _ | isKey sub -> Just $ KeyData key
1082 sigs 1080 sigs