diff options
Diffstat (limited to 'lib/Transforms.hs')
-rw-r--r-- | lib/Transforms.hs | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/lib/Transforms.hs b/lib/Transforms.hs index 8eaa482..7a676b0 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs | |||
@@ -62,8 +62,13 @@ data KeyData = KeyData | |||
62 | , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids | 62 | , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids |
63 | , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys | 63 | , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys |
64 | } deriving Show | 64 | } deriving Show |
65 | type KeyDB = Map.Map KeyKey KeyData | ||
66 | 65 | ||
66 | data KeyDB = KeyDB | ||
67 | { byKeyKey :: Map.Map KeyKey KeyData | ||
68 | } deriving Show | ||
69 | |||
70 | emptyKeyDB :: KeyDB | ||
71 | emptyKeyDB = KeyDB { byKeyKey = Map.empty } | ||
67 | 72 | ||
68 | 73 | ||
69 | data KeyRingRuntime = KeyRingRuntime | 74 | data KeyRingRuntime = KeyRingRuntime |
@@ -779,7 +784,7 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do | |||
779 | 784 | ||
780 | -- TODO: Use fingerprint to narrow candidates. | 785 | -- TODO: Use fingerprint to narrow candidates. |
781 | candidateSignerKeys :: KeyDB -> Packet -> [Packet] | 786 | candidateSignerKeys :: KeyDB -> Packet -> [Packet] |
782 | candidateSignerKeys db sig = map keyPacket $ Map.elems db | 787 | candidateSignerKeys db sig = map keyPacket $ Map.elems (byKeyKey db) |
783 | 788 | ||
784 | performManipulations :: | 789 | performManipulations :: |
785 | (PacketDecrypter) | 790 | (PacketDecrypter) |
@@ -790,9 +795,10 @@ performManipulations :: | |||
790 | performManipulations doDecrypt rt wk manip = do | 795 | performManipulations doDecrypt rt wk manip = do |
791 | let db = rtKeyDB rt | 796 | let db = rtKeyDB rt |
792 | performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd | 797 | performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd |
793 | r <- Traversable.mapM performAll db | 798 | r <- Traversable.mapM performAll (byKeyKey db) |
794 | try (sequenceA r) $ \db -> do | 799 | try (sequenceA r) $ \db -> do |
795 | return $ KikiSuccess (rt { rtKeyDB = fmap fst db }, concatMap snd $ Map.elems db) | 800 | return $ KikiSuccess ( rt { rtKeyDB = (rtKeyDB rt) { byKeyKey = fmap fst db } } |
801 | , concatMap snd $ Map.elems db) | ||
796 | where | 802 | where |
797 | perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport)) | 803 | perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport)) |
798 | perform kd (InducerSignature uid subpaks) = do | 804 | perform kd (InducerSignature uid subpaks) = do |
@@ -812,7 +818,7 @@ performManipulations doDecrypt rt wk manip = do | |||
812 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard | 818 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard |
813 | . (== keykey whosign) | 819 | . (== keykey whosign) |
814 | . keykey)) vs | 820 | . keykey)) vs |
815 | keys = map keyPacket $ Map.elems (rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig | 821 | keys = map keyPacket $ Map.elems (byKeyKey $ rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig |
816 | overs sig = signatures $ Message (keys ++ [keyPacket kd,UserIDPacket uid,sig]) | 822 | overs sig = signatures $ Message (keys ++ [keyPacket kd,UserIDPacket uid,sig]) |
817 | vs :: [ ( Packet -- signature | 823 | vs :: [ ( Packet -- signature |
818 | , Maybe SignatureOver -- Nothing means non-verified | 824 | , Maybe SignatureOver -- Nothing means non-verified |