diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 23 |
1 files changed, 13 insertions, 10 deletions
@@ -649,11 +649,13 @@ errorString e = uncamel . show $ fmap (const ()) e | |||
649 | data KikiResult a = KikiResult | 649 | data 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 | ||
657 | type KikiReport = [ (FilePath, KikiReportAction) ] | ||
658 | |||
657 | keyPacket :: KeyData -> Packet | 659 | keyPacket :: KeyData -> Packet |
658 | keyPacket (KeyData k _ _ _) = packet k | 660 | keyPacket (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)) |
2087 | performManipulations doDecrypt rt wk manip = do | 2089 | performManipulations 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 | ||
2145 | initializeMissingPEMFiles :: | 2148 | initializeMissingPEMFiles :: |
2146 | KeyRingOperation | 2149 | KeyRingOperation |