record already-existing backup in log after restoring a secret key

This will prevent --autostart from prompting to get the newly restored key
backed up again.

This commit was sponsored by Remy van Elst on Patreon.

1 files changed, 30 insertions, 16 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 7fe27cf..a6db8ca 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -19,6 +19,7 @@ import Cost
 import SecretKey
 import Share
 import Storage
+import Types.Server
 import BackupLog
 import AutoStart
 import HTTP.Server
@@ -28,6 +29,7 @@ import Data.Maybe
 import Data.Time.Clock
 import Data.Time.Calendar
 import Data.Monoid
+import Data.List
 import Control.DeepSeq
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as BU8
@@ -135,9 +137,7 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do
 		password <- fromMaybe (error "Aborting on no password") 
 			<$> promptPassword ui True "Enter password" passworddesc
 		kek <- genKeyEncryptionKey tunables name password
-		username <- userName
-		let badwords = concatMap namewords [name, username]
-		let passwordentropy = calcPasswordEntropy password badwords
+		passwordentropy <- getPasswordEntropy password name
 		let crackcost = estimateAttackCost spotAWS $
 			estimateBruteforceOf kek passwordentropy
 		let mincost = Dollars 100000
@@ -154,7 +154,6 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do
 				if ok
 					then return (kek, passwordentropy)
 					else promptpassword name
-	namewords (Name nb) = words (BU8.toString nb)
 	keydesc = case secretkeysource of
 		GpgKey _ -> "gpg secret key"
 		KeyFile _ -> "secret key"
@@ -229,7 +228,7 @@ restore cmdline storagelocations ui possibletunables secretkeydest = do
 	r <- downloadInitialShares storagelocations ui mksis possibletunables
 	case r of
 		Nothing -> showError ui "No shares could be downloaded. Perhaps you entered the wrong name?"
-		Just (tunables, shares, sis) -> do
+		Just (tunables, shares, sis, usedservers) -> do
 			let candidatekeys = candidateKeyEncryptionKeys tunables name password
 			let cost = getCreationCost candidatekeys 
 				<> castCost (getDecryptionCost candidatekeys)
@@ -238,26 +237,33 @@ restore cmdline storagelocations ui possibletunables secretkeydest = do
 				Right esk -> do
 					final <- withProgress ui "Decrypting"
 						(decryptdesc cost cores) $ \setpercent ->
-							go tunables [shares] sis setpercent $
+							go tunables [shares] usedservers sis setpercent $
 								tryDecrypt candidatekeys esk
-					final
+					final =<< getPasswordEntropy password name
   where
-	go tunables firstshares sis setpercent r = case r of
-		DecryptFailed -> return $
+	go tunables firstshares firstusedservers sis setpercent r = case r of
+		DecryptFailed -> return $ \_ ->
 			showError ui "Decryption failed! Probably you entered the wrong password."
 		DecryptSuccess secretkey -> do
 			_ <- setpercent 100
 			writeSecretKey secretkeydest secretkey
-			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
 		DecryptIncomplete kek -> do
 			-- Download shares for another chunk.
-			(nextshares, sis') <- retrieveShares storagelocations sis (return ())
+			(nextshares, sis', nextusedservers) 
+				<- retrieveShares storagelocations sis (return ())
 			let shares = firstshares ++ [nextshares]
+			let usedservers = nub (firstusedservers ++ nextusedservers)
 			case combineShares tunables shares of
-				Left e -> return $ showError ui e
+				Left e -> return $ \_ -> showError ui e
 				Right esk -> 
-					go tunables shares sis' setpercent $
+					go tunables shares usedservers sis' setpercent $
 						decrypt kek esk
 	namedesc = unlines
 		[ "When you backed up your secret key, you entered some information."
@@ -291,7 +297,7 @@ downloadInitialShares
 	-> UI
 	-> (Tunables -> ShareIdents)
 	-> [Tunables]
-	-> IO (Maybe (Tunables, S.Set Share, ShareIdents))
+	-> IO (Maybe (Tunables, S.Set Share, ShareIdents, [Server]))
 downloadInitialShares storagelocations ui mksis possibletunables = do
 	cores <- fromMaybe 1 <$> getNumCores
 	withProgressIncremental ui "Downloading encrypted data" (message cores) $ \addpercent -> do
@@ -305,10 +311,10 @@ downloadInitialShares storagelocations ui mksis possibletunables = do
 		addpercent 50
 		let m = totalObjects (shareParams tunables)
 		let step = 50 `div` m
-		(shares, sis') <- retrieveShares storagelocations sis (addpercent step)
+		(shares, sis', usedservers) <- retrieveShares storagelocations sis (addpercent step)
 		if S.null shares
 			then go othertunables addpercent
-			else return $ Just (tunables, shares, sis')
+			else return $ Just (tunables, shares, sis', usedservers)
 
 	possiblesis = map mksis possibletunables
 	message cores = unlines
@@ -331,6 +337,14 @@ userName = do
 	u <- getUserEntryForID =<< getEffectiveUserID
 	return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)
 
+getPasswordEntropy :: Password -> Name -> IO (Entropy UnknownPassword)
+getPasswordEntropy password name = do
+	username <- userName
+	let badwords = concatMap namewords [name, username]
+	return $ calcPasswordEntropy password badwords
+  where
+	namewords (Name nb) = words (BU8.toString nb)
+
 uploadQueued :: UI -> Maybe LocalStorageDirectory -> IO ()
 uploadQueued ui d = do
 	problems <- tryUploadQueued d