diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 34 |
1 files changed, 18 insertions, 16 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index c41439a..3a4bdc6 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -30,6 +30,7 @@ import System.Environment | |||
30 | import Control.Monad | 30 | import Control.Monad |
31 | import Control.Exception ( catch ) | 31 | import Control.Exception ( catch ) |
32 | import System.IO.Error ( isDoesNotExistError ) | 32 | import System.IO.Error ( isDoesNotExistError ) |
33 | import Data.Bool | ||
33 | import Data.Maybe | 34 | import Data.Maybe |
34 | import Data.Either | 35 | import Data.Either |
35 | import Data.Char | 36 | import Data.Char |
@@ -803,22 +804,23 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do | |||
803 | isdeleted (f',DeletedPacket _) = f'==f | 804 | isdeleted (f',DeletedPacket _) = f'==f |
804 | isdeleted _ = False | 805 | isdeleted _ = False |
805 | guard (not (null new_packets) || any isdeleted report_manips) | 806 | guard (not (null new_packets) || any isdeleted report_manips) |
806 | return ((f0,isMutable stream),(new_packets,x)) | 807 | return ((f0,stream),(new_packets,x)) |
807 | let (towrites,report) = (\f -> foldl f ([],[]) s) $ | 808 | let (towrites,report) = foldl' go ([],[]) s |
808 | \(ws,report) ((f,mutable),(new_packets,x)) -> | 809 | where |
809 | if mutable | 810 | go (ws,report) ((f,stream),(new_packets,x)) = (ws++writes, report++(items <$> new_packets)) |
810 | then | 811 | where |
811 | let rs = flip map new_packets | 812 | mutable = isMutable stream |
812 | $ \c -> (concat $ resolveInputFile ctx f, NewPacket $ showPacket (packet c)) | 813 | encoding = case typ stream of PGPPackets e -> e |
813 | in (ws++[(f,x)],report++rs) | 814 | _ -> BinaryPackets |
814 | else | 815 | writes | mutable = [(encoding,f,x)] |
815 | let rs = flip map new_packets | 816 | | otherwise = [] |
816 | $ \c -> (concat $ resolveInputFile ctx f,MissingPacket (showPacket (packet c))) | 817 | items c = ( concat $ resolveInputFile ctx f |
817 | in (ws,report++rs) | 818 | , bool MissingPacket NewPacket mutable $ showPacket (packet c) |
818 | forM_ towrites $ \(f,x) -> do | 819 | ) |
819 | let m = Message $ map packet x | 820 | forM_ towrites $ \(encoding,f,xs) -> case encoding of |
820 | -- warn $ "writing "++f | 821 | BinaryPackets -> writeInputFileL ctx f $ encode $ Message $ map packet xs |
821 | writeInputFileL ctx f (encode m) | 822 | AsciiArmor -> hPutStrLn stderr $ "Not writing " ++ show (resolveInputFile ctx f) |
823 | ++ " because ascii-armor is not implemented. (TODO)" | ||
822 | return $ KikiSuccess report | 824 | return $ KikiSuccess report |
823 | 825 | ||
824 | 826 | ||