prompt for name

1 files changed, 43 insertions, 7 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 94a7b09..6306511 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -16,25 +16,32 @@ import Cost
 import Shard
 import Storage
 import Storage.LocalFiles
+import Data.Maybe
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as BU8
+import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
 
 main :: IO ()
 main = do
 	cmdline <- CmdLine.get
 	ui <- selectUI (CmdLine.gui cmdline)
-	let name = CmdLine.name cmdline
 	let keytype = CmdLine.keytype cmdline
 	-- TODO determine gpg key id by examining secret key,
 	-- or retrieving public key from keyserver and examining it.
 	let keyid = KeyId keytype "dummy key id"
 	case CmdLine.mode cmdline of
-		CmdLine.Backup -> storedemo name keyid $
+		CmdLine.Backup -> storedemo ui keyid $
 			if CmdLine.testMode cmdline
 				then testModeTunables
 				else defaultTunables
-		CmdLine.Restore -> retrievedemo name keyid
+		CmdLine.Restore -> retrievedemo ui keyid
 
-storedemo :: Name -> KeyId -> Tunables -> IO ()
-storedemo name keyid tunables = do
+storedemo :: UI -> KeyId -> Tunables -> IO ()
+storedemo ui keyid tunables = do
+	username <- userName
+	name <- fromMaybe (error "Aborting on no name") 
+		<$> promptName ui "Enter a name"
+			namedesc username validateName
 	kek <- genKeyEncryptionKey tunables name password
 	putStrLn "Very rough estimate of cost to brute-force the password:"
 	print $ estimateAttack spotAWS $ estimateBruteforceOf kek
@@ -47,9 +54,22 @@ storedemo name keyid tunables = do
   where
 	password = Password "correct horse battery staple"
 	secretkey = SecretKey "this is a gpg private key"
+	namedesc = unlines
+		[ "To back up your key, you will need to enter a name and a password."
+		, ""
+		, "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 the key."
+		, ""
+		, "(Your own full name is a pretty good choice for the name to enter here.)"
+		]
 
-retrievedemo :: Name -> KeyId -> IO ()
-retrievedemo name keyid = do
+retrievedemo :: UI -> KeyId -> IO ()
+retrievedemo ui keyid = do
+	username <- userName
+	name <- fromMaybe (error "Aborting on no name") 
+		<$> promptName ui "Enter the name of the key to restore"
+			namedesc username validateName
 	let sis = shardIdents tunables name keyid
 	-- we drop 1 to simulate not getting all shards from the servers
 	let l = drop 1 $ zip [1..] (getIdents sis)
@@ -68,3 +88,19 @@ retrievedemo name keyid = do
 	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."
+		, "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.)"
+		]
+
+validateName :: Name -> Maybe Problem
+validateName (Name n)
+	| B.length n < 6 = Just "The name should be at least 6 letters long."
+	| otherwise = Nothing
+
+userName :: IO Name
+userName = do
+	u <- getUserEntryForID =<< getEffectiveUserID
+	return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)