obscure name

6 files changed, 61 insertions, 24 deletions

diff --git a/TODO b/TODO
index cb45e6a..46dd080 100644
--- a/TODO
+++ b/TODO
@@ -1,5 +1,4 @@
 * splitting large secret keys
-* prompt for name that is less obviously connected to user
 * tune hashes on more powerful hardware than thermal throttling laptop
 * store to servers
 * improve restore progress bar points (10m, 5m, 50m)
diff --git a/Types.hs b/Types.hs
index 5ba208f..459dcd1 100644
--- a/Types.hs
+++ b/Types.hs
@@ -47,7 +47,7 @@ newtype Password = Password B.ByteString
 
 -- | A name associated with a key stored in keysafe.
 newtype Name = Name B.ByteString
-	deriving (Show)
+	deriving (Show, Monoid)
 
 -- | Source of the secret key stored in keysafe.
 data SecretKeySource = GpgKey KeyId | KeyFile FilePath
diff --git a/Types/UI.hs b/Types/UI.hs
index 77a3095..553c323 100644
--- a/Types/UI.hs
+++ b/Types/UI.hs
@@ -14,7 +14,7 @@ data UI = UI
 	, showError :: Desc -> IO ()
 	, showInfo :: Title -> Desc -> IO ()
 	, promptQuestion :: Title -> Desc -> Question -> IO Bool
-	, promptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+	, promptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
 	, promptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)
 	, promptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)
 	, withProgress :: forall a. Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a
diff --git a/UI/Readline.hs b/UI/Readline.hs
index c75bd19..668c023 100644
--- a/UI/Readline.hs
+++ b/UI/Readline.hs
@@ -61,8 +61,8 @@ myPromptQuestion title desc question = bracket_ setup cleanup go
 				putStrLn "Please enter 'y' or 'n'"
 				go
 
-myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-myPromptName title desc (Name suggested) checkproblem =
+myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+myPromptName title desc suggested checkproblem =
 	bracket_ setup cleanup go
   where
 	setup = do
@@ -70,7 +70,9 @@ myPromptName title desc (Name suggested) checkproblem =
 		putStrLn desc
 	cleanup = putStrLn ""
 	go = do
-		addHistory (BU8.toString suggested)
+		case suggested of
+			Nothing -> return ()
+			Just (Name b) -> addHistory (BU8.toString b)
 		mname <- readline "Name> "
 		case mname of
 			Just s -> do
diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index a419b62..943be14 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -65,15 +65,17 @@ myPromptQuestion title desc question = do
 	(_, ok) <- waitZenity h
 	return ok
 
-myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-myPromptName title desc (Name suggested) checkproblem = go ""
+myPromptName :: Title -> Desc -> Maybe Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+myPromptName title desc suggested checkproblem = go ""
   where
 	go extradesc = do
 		h <- runZenity
 			[ "--entry"
 			, "--title", title
 			, "--text", desc ++ "\n" ++ extradesc
-			, "--entry-text", BU8.toString suggested
+			, "--entry-text", case suggested of
+				Nothing -> ""
+				Just (Name b) -> BU8.toString b
 			]
 		(ret, ok) <- waitZenity h
 		if ok
diff --git a/keysafe.hs b/keysafe.hs
index bb6d766..2ac765f 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -66,9 +66,13 @@ dispatch cmdline ui tunables possibletunables = do
 backup :: Storage -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
 backup storage ui tunables secretkeysource secretkey = do
 	username <- userName
-	name <- fromMaybe (error "Aborting on no name") 
-		<$> promptName ui "Enter name"
-			namedesc username validateName
+	Name theirname <- fromMaybe (error "Aborting on no username") 
+		<$> promptName ui "Enter your name"
+			usernamedesc (Just username) validateName
+	Name othername <- fromMaybe (error "aborting on no othername")
+		<$> promptName ui "Enter other name"
+			othernamedesc Nothing validateName
+	let name = Name (theirname <> " " <> othername)
 	kek <- promptkek name
 	let sis = shardIdents tunables name secretkeysource
 	let cost = getCreationCost kek <> getCreationCost sis
@@ -115,14 +119,26 @@ backup storage ui tunables secretkeysource secretkey = do
 					then return kek
 					else promptkek 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."
+	keydesc = case secretkeysource of
+		GpgKey _ -> "gpg secret key"
+		KeyFile _ -> "secret key"
+	usernamedesc = unlines
+		[ "Keysafe is going to backup your " ++ keydesc ++ " securely."
+		, ""
+		, "You will be prompted for some information. To restore your " ++ keydesc
+		, "at a later date, you will need to remember and enter the same information."
+		, ""
+		, "To get started, what is your name?"
+		]
+	othernamedesc = unlines
+		[ "Now think of another name, which not many people know."
+		, "This will be used to make it hard for anyone else to find"
+		, "the backup of your " ++ keydesc ++ "."
 		, ""
-		, "Make sure to pick a name you will remember at some point in the future,"
-		, "perhaps years from now, when you will need to enter it with the same"
-		, "spelling and capitalization in order to restore your secret key."
+		, "Some suggestions:"
+		, otherNameSuggestions
 		, ""
-		, "(Your own full name is a pretty good choice for the name to enter here.)"
+		, "Make sure to pick a name you will remember later."
 		]
 	passworddesc = unlines
 		[ "Pick a password that will be used to protect your secret key."
@@ -144,12 +160,24 @@ backup storage ui tunables secretkeysource secretkey = do
 		, "Please wait..."
 		]
 
+otherNameSuggestions :: String
+otherNameSuggestions = unlines $ map ("  * " ++)
+	[ "Your high-school sweetheart."
+	, "Your first pet."
+	, "Your favorite teacher."
+	, "Your college roomate."
+	]
+
 restore :: Storage -> UI -> [Tunables] -> SecretKeySource -> IO ()
 restore storage ui possibletunables secretkeydest = do
 	username <- userName
-	name <- fromMaybe (error "Aborting on no name") 
-		<$> promptName ui "Enter name"
-			namedesc username validateName
+	Name theirname <- fromMaybe (error "Aborting on no username") 
+		<$> promptName ui "Enter your name"
+			namedesc (Just username) validateName
+	Name othername <- fromMaybe (error "aborting on no othername")
+		<$> promptName ui "Enter other name"
+			othernamedesc Nothing validateName
+	let name = Name (theirname <> " " <> othername)
 	password <- fromMaybe (error "Aborting on no password") 
 		<$> promptPassword ui True "Enter password" passworddesc
 	
@@ -171,10 +199,16 @@ restore storage ui possibletunables secretkeydest = do
 						showInfo ui "Success" "Your secret key successfully restored!"
   where
 	namedesc = unlines
-		[ "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."
+		[ "When you backed up your secret key, you entered some information."
+		, "To restore it, you'll need to remember what you entered back then."
+		, ""
+		, "To get started, what is your name?"
+		]
+	othernamedesc = unlines
+		[ "What other name did you enter when you backed up your secret key?"
 		, ""
-		, "(If you can't remember the name you used, your own full name is the best guess.)"
+		, "Back then, you were given some suggestions, like these:"
+		, otherNameSuggestions
 		]
 	passworddesc = unlines
 		[ "Enter the password to unlock your secret key."