summaryrefslogtreecommitdiff
path: root/lib/Transforms.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-07-11 23:43:16 -0400
committerJoe Crayne <joe@jerkface.net>2019-07-11 23:43:16 -0400
commit352b340868f52d4749180c1ceb63e599170abada (patch)
tree34127970fff880afee59e55254433faf811e02ed /lib/Transforms.hs
parent365bdcd8d9f4a08aaae35fc27722d268f4af9041 (diff)
Promote KeyDB to a type.
Diffstat (limited to 'lib/Transforms.hs')
-rw-r--r--lib/Transforms.hs16
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
65type KeyDB = Map.Map KeyKey KeyData
66 65
66data KeyDB = KeyDB
67 { byKeyKey :: Map.Map KeyKey KeyData
68 } deriving Show
69
70emptyKeyDB :: KeyDB
71emptyKeyDB = KeyDB { byKeyKey = Map.empty }
67 72
68 73
69data KeyRingRuntime = KeyRingRuntime 74data 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.
781candidateSignerKeys :: KeyDB -> Packet -> [Packet] 786candidateSignerKeys :: KeyDB -> Packet -> [Packet]
782candidateSignerKeys db sig = map keyPacket $ Map.elems db 787candidateSignerKeys db sig = map keyPacket $ Map.elems (byKeyKey db)
783 788
784performManipulations :: 789performManipulations ::
785 (PacketDecrypter) 790 (PacketDecrypter)
@@ -790,9 +795,10 @@ performManipulations ::
790performManipulations doDecrypt rt wk manip = do 795performManipulations 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