Make ready for ascii-armor (write) support.

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
 import Control.Monad
 import Control.Exception ( catch )
 import System.IO.Error ( isDoesNotExistError )
+import Data.Bool
 import Data.Maybe
 import Data.Either
 import Data.Char
@@ -803,22 +804,23 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do
             isdeleted (f',DeletedPacket _) = f'==f
             isdeleted _                    = False
         guard (not (null new_packets) || any isdeleted report_manips)
-        return ((f0,isMutable stream),(new_packets,x))
-    let (towrites,report) = (\f -> foldl f ([],[]) s) $
-         \(ws,report) ((f,mutable),(new_packets,x)) ->
-            if mutable
-                then
-                     let rs = flip map new_packets
-                                $ \c -> (concat $ resolveInputFile ctx f, NewPacket $ showPacket (packet c))
-                     in (ws++[(f,x)],report++rs)
-                else
-                     let rs = flip map new_packets
-                                $ \c -> (concat $ resolveInputFile ctx f,MissingPacket (showPacket (packet c)))
-                     in (ws,report++rs)
-    forM_ towrites $ \(f,x) -> do
-        let m = Message $ map packet x
-        -- warn $ "writing "++f
-        writeInputFileL ctx f (encode m)
+        return ((f0,stream),(new_packets,x))
+    let (towrites,report) = foldl' go ([],[]) s
+          where
+            go (ws,report) ((f,stream),(new_packets,x)) = (ws++writes, report++(items <$> new_packets))
+              where
+                mutable = isMutable stream
+                encoding = case typ stream of PGPPackets e -> e
+                                              _            -> BinaryPackets
+                writes | mutable   = [(encoding,f,x)]
+                       | otherwise = []
+                items c = ( concat $ resolveInputFile ctx f
+                          , bool MissingPacket NewPacket mutable $ showPacket (packet c)
+                          )
+    forM_ towrites $ \(encoding,f,xs) -> case encoding of
+        BinaryPackets -> writeInputFileL ctx f $ encode $ Message $ map packet xs
+        AsciiArmor    -> hPutStrLn stderr $ "Not writing " ++ show (resolveInputFile ctx f)
+                                            ++ " because ascii-armor is not implemented. (TODO)"
     return $ KikiSuccess report