From 14ca9ca78ff2ec55b5f353fe101562830a8dd9d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 17 Aug 2016 18:56:05 -0400 Subject: obscure name --- TODO | 1 - Types.hs | 2 +- Types/UI.hs | 2 +- UI/Readline.hs | 8 +++++--- UI/Zenity.hs | 8 +++++--- keysafe.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++-------------- 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." -- cgit v1.2.3