1 files changed, 11 insertions, 36 deletions

diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index 3e13b1a..0a3a9a6 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -9,12 +9,14 @@ import Control.Applicative
 import Control.Arrow
 import Control.Monad
 import Data.Char
+import Data.Functor
 import Data.List
 import Data.Maybe
 import Data.Ord
 import Data.OpenPGP
 import Data.OpenPGP.Util
 import Data.Word
+import KeyDB
 import KeyRing.Types
 import FunctorToMaybe
 import GnuPGAgent ( key_nbits )
@@ -38,27 +40,6 @@ import qualified Data.Text as T ( Text, unpack, pack,
 import Data.Text.Encoding ( encodeUtf8 )
 import Data.Bits              ((.|.), (.&.), Bits)
 
-type TrustMap = Map.Map FilePath Packet
-type SigAndTrust = ( MappedPacket
-                   , TrustMap     ) -- trust packets
-data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
-
--- | 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
-    , keySubKeys      :: (Map.Map KeyKey SubKey)                    -- subkeys
-    } deriving Show
-
-data KeyDB = KeyDB
-    { byKeyKey :: Map.Map KeyKey KeyData
-    } deriving Show
-
-emptyKeyDB :: KeyDB
-emptyKeyDB = KeyDB { byKeyKey = Map.empty }
-
 
 data KeyRingRuntime = KeyRingRuntime
     { rtPubring :: FilePath -- ^ Path to the file represented by 'HomePub'
@@ -765,7 +746,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 (byKeyKey db)
+candidateSignerKeys db sig = map keyPacket $ keyData db
 
 performManipulations ::
                 (PacketDecrypter)
@@ -775,18 +756,14 @@ performManipulations ::
                 -> IO (KikiCondition (KeyRingRuntime,KikiReport))
 performManipulations doDecrypt rt wk manip = do
     let db = rtKeyDB rt
-        performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd
-    r <- Traversable.mapM performAll (byKeyKey db)
-    try (sequenceA r) $ \db -> do
-    return $ KikiSuccess ( rt { rtKeyDB = (rtKeyDB rt) { byKeyKey = fmap fst db } }
-                         , concatMap snd $ Map.elems db)
+    r <- transmute perform (manip rt) db
+    return $ r <&> \(db,rs) -> (rt { rtKeyDB = db }, rs)
  where
-    perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
-    perform kd (InducerSignature uid subpaks) = do
-        try kd $ \(kd,report) -> do
+    perform :: (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
+    perform (kd,report) (InducerSignature uid subpaks) = do
         flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
         wkun' <- doDecrypt wk'
-        try wkun' $ \wkun -> do    
+        try wkun' $ \wkun -> do
         let flgs = if keykey (keyPacket kd) == keykey wkun
                     then keyFlags0 (keyPacket kd) (map (\(x,_,_)->x) selfsigs)
                     else []
@@ -799,7 +776,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 (byKeyKey $ rtKeyDB rt) -- TODO candidateSignerKeys (rtKeyDB rt) sig
+            keys = map keyPacket $ keyData (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
@@ -825,8 +802,7 @@ performManipulations doDecrypt rt wk manip = do
         -- XXX: Shouldn't this signature generation show up in the KikiReport ?
         return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report )
 
-    perform kd (SubKeyDeletion topk subk) = do
-        try kd $ \(kd,report) -> do
+    perform (kd,report) (SubKeyDeletion topk subk) = do
         let kk = keykey $ packet $ keyMappedPacket kd
             kd' | kk /= topk = kd
                 | otherwise  = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd }
@@ -839,8 +815,7 @@ performManipulations doDecrypt rt wk manip = do
         return $ KikiSuccess (kd' , report ++ [ (f,DeletedPacket $ showPacket p) | f <- rings, p <- ps ])
 
     -- perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
-    perform kd (SubKeyRenaming srctag dsttag) = do
-        try kd $ \(kd,report) -> do
+    perform (kd,report) (SubKeyRenaming srctag dsttag) = do
         flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
         subkeys' <- traverse (freshenOne wk') (keySubKeys kd)
         let _ = subkeys' :: Map.Map KeyKey (KikiCondition (SubKey, KikiReport))