key selection working

1 files changed, 27 insertions, 15 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 056003a..7068e22 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -80,22 +80,30 @@ backup :: UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
 backup ui tunables secretkeysource secretkey = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
-		<$> promptName ui "Enter a name"
+		<$> promptName ui "Enter name"
 			namedesc username validateName
-	password <- fromMaybe (error "Aborting on no password") 
-		<$> promptPassword ui "Enter a password"
-			passworddesc validatePassword
-	kek <- genKeyEncryptionKey tunables name password
-	-- TODO: show password strength estimate, and verify password.
-	putStrLn "Very rough estimate of cost to brute-force the password:"
-	print $ estimateAttack spotAWS $ estimateBruteforceOf kek
-		(passwordEntropy password [])
+	kek <- getkek name
 	let esk = encrypt tunables kek secretkey
 	let sis = shardIdents tunables name secretkeysource
 	shards <- genShards esk tunables
 	print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards)
 	print =<< obscureShards localFiles
   where
+	getkek name = 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 crackcost = estimateAttack spotAWS $
+			estimateBruteforceOf kek $
+				passwordEntropy password badwords
+		ok <- promptQuestion ui "Password strength estimate" $
+			show crackcost
+		if ok
+			then return kek
+			else getkek name
+	namewords (Name nb) = words (BU8.toString nb)
 	namedesc = unlines
 		[ "To back up your secret key, you will need to enter a name and a password."
 		, ""
@@ -118,14 +126,19 @@ restore :: UI -> SecretKeySource -> IO ()
 restore ui secretkeydest = do
 	username <- userName
 	name <- fromMaybe (error "Aborting on no name") 
-		<$> promptName ui "Enter the name of the key to restore"
+		<$> promptName ui "Enter name"
 			namedesc username validateName
+	password <- fromMaybe (error "Aborting on no password") 
+		<$> promptPassword ui True "Enter password" passworddesc
+	
 	let sis = shardIdents tunables name secretkeydest
 	-- we drop 1 to simulate not getting all shards from the servers
 	let l = drop 1 $ zip [1..] (getIdents sis)
+
 	shards <- map (\(RetrieveSuccess s) -> s)
 		<$> mapM (uncurry (retrieveShard localFiles)) l
 	_ <- obscureShards localFiles
+
 	let esk = combineShards tunables shards
 	go esk (candidateKeyEncryptionKeys tunables name password)
   where
@@ -134,24 +147,23 @@ restore ui secretkeydest = do
 		Just (SecretKey sk) -> print sk
 		Nothing -> go esk rest
 
-	password = Password "correct horse battery staple"
 	-- TODO: derive by probing to find objects
 	tunables = testModeTunables -- defaultTunables
 	namedesc = unlines
-		[ "When you backed up the key, you entered a name and a password."
+		[ "When you backed up your secret key, you entered a name and a password."
 		, "Now it's time to remember what you entered back then."
 		, ""
 		, "(If you can't remember the name you used, your own full name is the best guess.)"
 		]
+	passworddesc = unlines
+		[ "Enter the password to unlock your secret key."
+		]
 
 validateName :: Name -> Maybe Problem
 validateName (Name n)
 	| B.length n < 6 = Just "The name should be at least 6 letters long."
 	| otherwise = Nothing
 
-validatePassword :: Password -> Maybe Problem
-validatePassword _ = Nothing
-
 userName :: IO Name
 userName = do
 	u <- getUserEntryForID =<< getEffectiveUserID