Defer requesting secret key from gpg until just before backup

So the user knows why gpg is asking for this secret key to be backed up.
Before, this was done as soon as keysafe started, which didn't give the
user any indication what was going on, unless they had multiple keys and so
picked the key to back up from a list.

This commit was sponsored by Thomas Hochstein on Patreon.

1 files changed, 10 insertions, 7 deletions

diff --git a/keysafe.hs b/keysafe.hs
index cbbbb86..d6c2a5e 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -65,7 +65,7 @@ dispatch cmdline ui tunables possibletunables = do
   where
 	go CmdLine.Backup (Just secretkeysource) =
 		backup cmdline ui tunables (Distinguisher secretkeysource)
-			=<< getSecretKey secretkeysource
+			secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
 		restore cmdline ui possibletunables (Distinguisher secretkeydest)
 	go CmdLine.Backup Nothing =
@@ -97,8 +97,8 @@ dispatch cmdline ui tunables possibletunables = do
 	go CmdLine.Test _ =
 		runTests
 
-backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO ()
-backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
+backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> SecretKeySource -> IO ()
+backup cmdline ui tunables distinguisher secretkeysource = do
 	installAutoStartFile
 
 	let m = totalObjects (shareParams tunables)
@@ -122,9 +122,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 		Nothing -> fromMaybe (error "Aborting on no username") 
 			<$> promptName ui "Enter your name"
 				usernamedesc (Just username) validateName
-	go theirname locs
+	go theirname locs Nothing
   where
-	go theirname locs = do
+	go theirname locs msecretkey = do
 		cores <- fromMaybe 1 <$> getNumCores
 		Name othername <- case CmdLine.name cmdline of
 			Just n -> pure n
@@ -135,6 +135,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 		(kek, passwordentropy) <- promptpassword name
 		let sis = shareIdents tunables name distinguisher
 		let cost = getCreationCost kek <> getCreationCost sis
+		secretkey <- case msecretkey of
+			Just sk -> pure sk
+			Nothing -> getSecretKey secretkeysource
 		(r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data"
 			(encryptdesc cost cores) $ \addpercent -> do
 				let esk = encrypt tunables kek secretkey
@@ -159,7 +162,7 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 					[ "Another secret key is already being stored under the name you entered."
 					, "Please try again with a different name."
 					]
-				go theirname locs
+				go theirname locs (Just secretkey)
 	promptpassword name = do
 		password <- fromMaybe (error "Aborting on no password") 
 			<$> promptPassword ui True "Enter password" passworddesc
@@ -427,7 +430,7 @@ autoStart cmdline tunables ui = do
 				"Do you want to back up the gpg secret key now?"
 			if ans
 				then backup cmdline ui tunables AnyGpgKey
-					=<< getSecretKey (GpgKey kid)
+					(GpgKey kid)
 				else storeBackupLog
 					=<< mkBackupLog (BackupSkipped (GpgKey kid))