Gpg keyid bugs

Fix bugs with entry of gpg keyid in the keysafe.log. Gpg.anyKey was being
used in writing the log, which made the log contain gpg keys with an empty
keyid.

Fix bug in --autostart that caused the full gpg keyid to be
used in the name, so restores would only work when --gpgkeyid was
specifid.

Added a Distinguisher data type rather than the Gpg.anyKey hack.

This commit was sponsored by Thom May on Patreon.

1 files changed, 24 insertions, 16 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 4c93251..ae99879 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -61,15 +61,15 @@ dispatch cmdline ui tunables possibletunables = do
 	go mode (CmdLine.secretkeysource cmdline)
   where
 	go CmdLine.Backup (Just secretkeysource) =
-		backup cmdline ui tunables secretkeysource
+		backup cmdline ui tunables (Distinguisher secretkeysource)
 			=<< getSecretKey secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
-		restore cmdline ui possibletunables secretkeydest
+		restore cmdline ui possibletunables (Distinguisher secretkeydest)
 	go CmdLine.Backup Nothing =
-		backup cmdline ui tunables Gpg.anyKey
+		backup cmdline ui tunables AnyGpgKey
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
-		restore cmdline ui possibletunables Gpg.anyKey
+		restore cmdline ui possibletunables AnyGpgKey
 	go CmdLine.UploadQueued _ =
 		uploadQueued ui (CmdLine.localstoragedirectory cmdline)
 	go CmdLine.AutoStart _ =
@@ -91,8 +91,8 @@ dispatch cmdline ui tunables possibletunables = do
 	go CmdLine.Test _ =
 		runTests
 
-backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
-backup cmdline ui tunables secretkeysource secretkey = do
+backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO ()
+backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 	installAutoStartFile
 
 	let m = totalObjects (shareParams tunables)
@@ -127,7 +127,7 @@ backup cmdline ui tunables secretkeysource secretkey = do
 					othernamedesc Nothing validateName
 		let name = Name (theirname <> " " <> othername)
 		(kek, passwordentropy) <- promptpassword name
-		let sis = shareIdents tunables name secretkeysource
+		let sis = shareIdents tunables name distinguisher
 		let cost = getCreationCost kek <> getCreationCost sis
 		(r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data"
 			(encryptdesc cost cores) $ \addpercent -> do
@@ -227,8 +227,8 @@ otherNameSuggestions = unlines $ map ("  * " ++)
 	, "A place you like to visit."
 	]
 
-restore :: CmdLine.CmdLine -> UI -> [Tunables] -> SecretKeySource -> IO ()
-restore cmdline ui possibletunables secretkeydest = do
+restore :: CmdLine.CmdLine -> UI -> [Tunables] -> Distinguisher -> IO ()
+restore cmdline ui possibletunables distinguisher = do
 	cores <- fromMaybe 1 <$> getNumCores
 	username <- userName
 	Name theirname <- case CmdLine.name cmdline of
@@ -245,7 +245,7 @@ restore cmdline ui possibletunables secretkeydest = do
 	password <- fromMaybe (error "Aborting on no password") 
 		<$> promptPassword ui True "Enter password" passworddesc
 	
-	let mksis tunables = shareIdents tunables name secretkeydest
+	let mksis tunables = shareIdents tunables name distinguisher
 	locs <- cmdLineStorageLocations cmdline
 	r <- downloadInitialShares locs ui mksis possibletunables
 	case r of
@@ -268,14 +268,22 @@ restore cmdline ui possibletunables secretkeydest = do
 			showError ui "Decryption failed! Probably you entered the wrong password."
 		DecryptSuccess secretkey -> do
 			_ <- setpercent 100
-			writeSecretKey secretkeydest secretkey
+			oldgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return []
+			writeSecretKey distinguisher secretkey
+			newgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return []
 			return $ \passwordentropy -> do
 				showInfo ui "Success" "Your secret key was successfully restored!"
 				-- Since the key was restored, we know it's
 				-- backed up; log that.
-				backuplog <- mkBackupLog $ 
-					backupMade firstusedservers secretkeydest passwordentropy
-				storeBackupLog backuplog
+				let updatelog restored = do
+					backuplog <- mkBackupLog $ 
+						backupMade firstusedservers restored passwordentropy
+					storeBackupLog backuplog
+				case distinguisher of
+					AnyGpgKey -> case filter (`notElem` oldgpgkeys) newgpgkeys of
+						[(_n, k)] -> updatelog (GpgKey k)
+						_ -> return ()
+					Distinguisher sks -> updatelog sks
 		DecryptIncomplete kek -> do
 			-- Download shares for another chunk.
 			(nextshares, sis', nextusedservers) 
@@ -405,8 +413,8 @@ autoStart cmdline tunables ui = do
 				("Your " ++ kdesc ++ " has not been backed up by keysafe yet.\n\nKeysafe can securely back up the secret key to the cloud, protected with a password.\n")
 				"Do you want to back up the gpg secret key now?"
 			if ans
-				then backup cmdline ui tunables (GpgKey kid)
-					=<< Gpg.getSecretKey kid
+				then backup cmdline ui tunables AnyGpgKey
+					=<< getSecretKey (GpgKey kid)
 				else storeBackupLog
 					=<< mkBackupLog (BackupSkipped (GpgKey kid))