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.

4 files changed, 19 insertions, 19 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 14548bf..f6d1c02 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -10,6 +10,8 @@ keysafe (0.20161023) UNRELEASED; urgency=medium
     delay between 1 and 2 hours and try again.
   * Better suggestion when user is having difficulty thinking of a strong
     enough password.
+  * 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.
 
  -- Joey Hess <id@joeyh.name>  Sun, 23 Oct 2016 15:30:02 -0400
 
diff --git a/Gpg.hs b/Gpg.hs
index 91b53cd..192ab1c 100644
--- a/Gpg.hs
+++ b/Gpg.hs
@@ -21,19 +21,17 @@ import qualified Data.Text as T
 --
 -- If there is only one gpg secret key,
 -- the choice is obvious. Otherwise prompt the user with a list.
-getKeyToBackup :: UI -> IO (SecretKeySource, SecretKey)
+getKeyToBackup :: UI -> IO SecretKeySource
 getKeyToBackup ui = go =<< listSecretKeys
   where
 	go [] = do
 		showError ui "You have no gpg secret keys to back up."
 		error "Aborting on no gpg secret keys."
-	go [(_, kid)] = mkret kid
-	go l = maybe (error "Canceled") mkret
+	go [(_, kid)] = selected kid
+	go l = maybe (error "Canceled") selected
 		=<< promptKeyId ui "Pick gpg secret key"
 			"Pick gpg secret key to back up:" l
-	mkret kid = do
-		sk <- getSecretKey kid
-		return (GpgKey kid, sk)
+	selected = return . GpgKey
 
 listSecretKeys :: IO [(Name, KeyId)]
 listSecretKeys = map mk . parse . lines <$> readProcess "gpg"
diff --git a/SecretKey.hs b/SecretKey.hs
index 8dc2ada..15256d0 100644
--- a/SecretKey.hs
+++ b/SecretKey.hs
@@ -12,12 +12,9 @@ import qualified Data.ByteString as B
 import System.IO
 import System.Posix.IO
 
-getSecretKey :: SecretKeySource -> IO (SecretKeySource, SecretKey)
-getSecretKey sks = do
-	sk <- case sks of
-		GpgKey kid -> Gpg.getSecretKey kid
-		KeyFile f -> SecretKey <$> B.readFile f
-	return (sks, sk)
+getSecretKey :: SecretKeySource -> IO SecretKey
+getSecretKey (GpgKey kid) = Gpg.getSecretKey kid
+getSecretKey (KeyFile f) = SecretKey <$> B.readFile f
 
 -- | Can throw exception if the secret key already exists.
 writeSecretKey :: Distinguisher -> SecretKey -> IO ()
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))