From c54050cd56d4f1181ce31636b1a176b953604903 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Wed, 3 Jul 2019 15:17:24 -0400
Subject: minor refactor

---
 lib/KeyRing/Types.hs |  3 ++-
 lib/Kiki.hs          | 31 ++++++++++++++++---------------
 2 files changed, 18 insertions(+), 16 deletions(-)

(limited to 'lib')

diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index f5fd879..6b686d5 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveFunctor #-}
 module KeyRing.Types where
 
@@ -28,7 +29,7 @@ data KeyRingOperation = KeyRingOperation
     -- files reside.  Otherwise, the evironment variable $GNUPGHOME is consulted
     -- and if that is not set, it falls back to $HOME/.gnupg.
     }
- deriving (Eq,Show)
+  deriving (Eq,Show,Semigroup,Monoid)
 
 data InputFile = HomeSec
                -- ^ A file named secring.gpg located in the home directory.
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 5201dac..5070389 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -485,21 +485,17 @@ refreshCache rt rootdir = do
 
     let grip = fingerprint wk
         wkkd = rtKeyDB rt Map.! keykey wk
-        getSecret tag = sortOn (Down . timestamp)
-                        $ getSubkeys Unsigned wk (keySubKeys wkkd) tag
-        exportOp = withOutgoing $ minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt)
-                                                              Nothing)
+        getSecret tag = sortOn (Down . timestamp) $ getSubkeys Unsigned wk (keySubKeys wkkd) tag
+        exportOp = passphrases <> pemSecrets <> minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) Nothing)
          where
-          withOutgoing op = op
-            { opFiles = opFiles op `Map.union` Map.fromList outgoing_secrets
-            , opPassphrases = [PassphraseMemoizer (rtPassphrases rt)]
-            }
-          outgoing_secrets =
+          passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] }
+          pemSecrets = mempty { opFiles = Map.fromList
             [ send "ipsec"      (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?"
             , send "ssh-client" (mkpath "root/.ssh/id_rsa")                               "missing ssh-client key?"
             , send "ssh-server" (mkpath "ssh_host_rsa_key")                               "missing ssh host key?"
             , send "tor"        (mkpath "tor/private_key")                                "missing tor key?"
             ]
+          }
           send usage path warning =
             ( ArgFile path, StreamInfo { typ = PEMFile
                                        , fill = KF_Match usage
@@ -509,17 +505,22 @@ refreshCache rt rootdir = do
                                        , transforms = []
                                        })
     KikiResult rt' report <- runKeyRing exportOp
-
     outputReport report
     -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report
-    rt <- case rt' of
-        BadPassphrase ->
-            error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
-        _ -> unconditionally $ return rt'
+    rt'' <- rethrowKikiErrors rt'
+    writePublicKeyFiles rt'' mkpath grip oname wkaddr commit
+
+rethrowKikiErrors :: KikiCondition a -> IO a
+rethrowKikiErrors BadPassphrase =
+  error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
+rethrowKikiErrors rt = unconditionally $ return rt
+
+writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Char8.ByteString -> SockAddr -> IO () -> IO ()
+writePublicKeyFiles rt mkpath grip oname wkaddr commit = do
 
     -- Finally, export public keys if they do not exist.
     either warn (write $ mkpath "root/.ssh/id_rsa.pub")
-            $ show_ssh' "ssh-client" grip (rtKeyDB rt)
+        $ show_ssh' "ssh-client" grip (rtKeyDB rt)
     either warn (write $ mkpath "ssh_host_rsa_key.pub")
         $ show_ssh' "ssh-server" grip (rtKeyDB rt)
     either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem")
-- 
cgit v1.2.3