From 352b340868f52d4749180c1ceb63e599170abada Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Thu, 11 Jul 2019 23:43:16 -0400
Subject: Promote KeyDB to a type.

---
 lib/Transforms.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'lib/Transforms.hs')

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
     , keyUids         :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids
     , keySubKeys      :: (Map.Map KeyKey SubKey)                    -- subkeys
     } deriving Show
-type KeyDB = Map.Map KeyKey KeyData
 
+data KeyDB = KeyDB
+    { byKeyKey :: Map.Map KeyKey KeyData
+    } deriving Show
+
+emptyKeyDB :: KeyDB
+emptyKeyDB = KeyDB { byKeyKey = Map.empty }
 
 
 data KeyRingRuntime = KeyRingRuntime
@@ -779,7 +784,7 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do
 
 -- TODO: Use fingerprint to narrow candidates.
 candidateSignerKeys :: KeyDB -> Packet -> [Packet]
-candidateSignerKeys db sig = map keyPacket $ Map.elems db
+candidateSignerKeys db sig = map keyPacket $ Map.elems (byKeyKey db)
 
 performManipulations ::
                 (PacketDecrypter)
@@ -790,9 +795,10 @@ performManipulations ::
 performManipulations doDecrypt rt wk manip = do
     let db = rtKeyDB rt
         performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd
-    r <- Traversable.mapM performAll db
+    r <- Traversable.mapM performAll (byKeyKey db)
     try (sequenceA r) $ \db -> do
-    return $ KikiSuccess (rt { rtKeyDB =  fmap fst db }, concatMap snd $ Map.elems db)
+    return $ KikiSuccess ( rt { rtKeyDB = (rtKeyDB rt) { byKeyKey = fmap fst db } }
+                         , concatMap snd $ Map.elems db)
  where
     perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
     perform kd (InducerSignature uid subpaks) = do
@@ -812,7 +818,7 @@ performManipulations doDecrypt rt wk manip = do
             selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard
                                    . (== keykey whosign)
                                    . keykey)) vs
-            keys = map keyPacket $ Map.elems (rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig
+            keys = map keyPacket $ Map.elems (byKeyKey $ rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig
             overs sig = signatures $ Message (keys ++ [keyPacket kd,UserIDPacket uid,sig])
             vs :: [ ( Packet -- signature
                    , Maybe SignatureOver -- Nothing means non-verified
-- 
cgit v1.2.3