summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs34
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
30import Control.Monad 30import Control.Monad
31import Control.Exception ( catch ) 31import Control.Exception ( catch )
32import System.IO.Error ( isDoesNotExistError ) 32import System.IO.Error ( isDoesNotExistError )
33import Data.Bool
33import Data.Maybe 34import Data.Maybe
34import Data.Either 35import Data.Either
35import Data.Char 36import 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