summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs23
1 files changed, 13 insertions, 10 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index ff23bfb..1d21ff5 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -649,11 +649,13 @@ errorString e = uncamel . show $ fmap (const ()) e
649data KikiResult a = KikiResult 649data KikiResult a = KikiResult
650 { kikiCondition :: KikiCondition a 650 { kikiCondition :: KikiCondition a
651 -- ^ The result or a fatal error condition. 651 -- ^ The result or a fatal error condition.
652 , kikiReport :: [ (FilePath, KikiReportAction) ] 652 , kikiReport :: KikiReport
653 -- ^ A list of non-fatal warnings and informational messages 653 -- ^ A list of non-fatal warnings and informational messages
654 -- along with the files that triggered them. 654 -- along with the files that triggered them.
655 } 655 }
656 656
657type KikiReport = [ (FilePath, KikiReportAction) ]
658
657keyPacket :: KeyData -> Packet 659keyPacket :: KeyData -> Packet
658keyPacket (KeyData k _ _ _) = packet k 660keyPacket (KeyData k _ _ _) = packet k
659 661
@@ -2083,17 +2085,17 @@ performManipulations ::
2083 -> KeyRingRuntime 2085 -> KeyRingRuntime
2084 -> Maybe MappedPacket 2086 -> Maybe MappedPacket
2085 -> (KeyRingRuntime -> KeyData -> [PacketUpdate]) 2087 -> (KeyRingRuntime -> KeyData -> [PacketUpdate])
2086 -> IO (KikiCondition (KeyRingRuntime,[(FilePath,KikiReportAction)])) 2088 -> IO (KikiCondition (KeyRingRuntime,KikiReport))
2087performManipulations doDecrypt rt wk manip = do 2089performManipulations doDecrypt rt wk manip = do
2088 let db = rtKeyDB rt 2090 let db = rtKeyDB rt
2089 performAll kd = foldM perform (KikiSuccess kd) $ manip rt kd 2091 performAll kd = foldM perform (KikiSuccess (kd,[])) $ manip rt kd
2090 r <- Traversable.mapM performAll db 2092 r <- Traversable.mapM performAll db
2091 try (sequenceA r) $ \db -> do 2093 try (sequenceA r) $ \db -> do
2092 return $ KikiSuccess (rt { rtKeyDB = db },[]) 2094 return $ KikiSuccess (rt { rtKeyDB = fmap fst db }, concatMap snd $ Map.elems db)
2093 where 2095 where
2094 perform :: KikiCondition KeyData -> PacketUpdate -> IO (KikiCondition KeyData) 2096 perform :: KikiCondition (KeyData,KikiReport) -> PacketUpdate -> IO (KikiCondition (KeyData,KikiReport))
2095 perform kd (InducerSignature uid subpaks) = do 2097 perform kd (InducerSignature uid subpaks) = do
2096 try kd $ \kd -> do 2098 try kd $ \(kd,report) -> do
2097 flip (maybe $ return NoWorkingKey) wk $ \wk' -> do 2099 flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
2098 wkun' <- doDecrypt wk' 2100 wkun' <- doDecrypt wk'
2099 try wkun' $ \wkun -> do 2101 try wkun' $ \wkun -> do
@@ -2131,16 +2133,17 @@ performManipulations doDecrypt rt wk manip = do
2131 let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) 2133 let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap)
2132 f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x 2134 f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x
2133 , om `Map.union` snd x ) 2135 , om `Map.union` snd x )
2134 return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) } 2136 -- XXX: Shouldn't this signature generation show up in the KikiReport ?
2137 return $ KikiSuccess $ ( kd { keyUids = Map.adjust f uid (keyUids kd) }, report )
2135 2138
2136 perform kd (SubKeyDeletion topk subk) = do 2139 perform kd (SubKeyDeletion topk subk) = do
2137 try kd $ \kd -> do 2140 try kd $ \(kd,report) -> do
2138 -- TODO: delete key from key database
2139 let kk = keykey $ packet $ keyMappedPacket kd 2141 let kk = keykey $ packet $ keyMappedPacket kd
2140 kd' | kk /= topk = kd 2142 kd' | kk /= topk = kd
2141 | otherwise = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd } 2143 | otherwise = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd }
2142 pred k _ = k == subk 2144 pred k _ = k == subk
2143 return $ KikiSuccess kd' 2145 -- TODO: update report with DeletedPacket entries
2146 return $ KikiSuccess (kd' , report)
2144 2147
2145initializeMissingPEMFiles :: 2148initializeMissingPEMFiles ::
2146 KeyRingOperation 2149 KeyRingOperation