more command line interface improvements

1 files changed, 61 insertions, 35 deletions

diff --git a/keysafe.hs b/keysafe.hs
index 7f89004..056003a 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -18,7 +18,9 @@ import Cost
 import Shard
 import Storage
 import Storage.LocalFiles
+import qualified Gpg
 import Data.Maybe
+import Control.Monad
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as BU8
 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
@@ -27,49 +29,64 @@ main :: IO ()
 main = do
 	cmdline <- CmdLine.get
 	ui <- selectUI (CmdLine.gui cmdline)
-	-- TODO determine gpg key id by examining secret key,
-	-- or retrieving public key from keyserver and examining it.
 	let tunables = if CmdLine.testMode cmdline
 		then testModeTunables
 		else defaultTunables
-	case (CmdLine.mode cmdline, CmdLine.secretkeysource cmdline) of
-		(CmdLine.Backup, Just secretkeysource) ->
-			backup ui tunables =<< normalize secretkeysource
-		(CmdLine.Backup, Nothing) -> do
-			backup ui tunables =<< normalize =<< pickGpgKey CmdLine.Backup ui
-		(CmdLine.Restore, Just secretkeydest) ->
-			restore ui =<< normalize secretkeydest
-		(CmdLine.Restore, Nothing) -> do
-			restore ui =<< normalize =<< pickGpgKey CmdLine.Backup ui
-		(CmdLine.Benchmark, _) -> benchmarkTunables tunables
+	mode <- CmdLine.selectMode cmdline
+	go mode (CmdLine.secretkeysource cmdline) tunables ui
+  where
+	go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) tunables ui = do
+		ok <- Gpg.knownByKeyServer kid
+		unless ok $
+			error "Your gpg public key has to be stored on the keyservers before you can back it up by keyid. Either use gpg --send-key to store the public key on the keyservers, or omit the --gpgkeyid option"
+		backup ui tunables secretkeysource
+			=<< getSecretKey secretkeysource
+	go CmdLine.Backup (Just secretkeysource) tunables ui =
+		backup ui tunables secretkeysource
+			=<< getSecretKey secretkeysource
+	go CmdLine.Backup Nothing tunables ui =
+		backup ui tunables anyGpgKey =<< pickGpgKeyToBackup ui
+	go CmdLine.Restore (Just secretkeydest) _ ui =
+		restore ui secretkeydest
+	go CmdLine.Restore Nothing _ ui =
+		restore ui anyGpgKey
+	go CmdLine.Benchmark _ tunables _ =
+		benchmarkTunables tunables
 
--- | Normalize gpg keyids, by querying the gpg keyserver for the key.
--- If the keyserver knows of the key, the long keyid is used.
--- But, if the keyserver does not know of the key, a null keyid is used.
-normalize :: SecretKeySource -> IO SecretKeySource
-normalize = return -- TODO
+getSecretKey :: SecretKeySource -> IO SecretKey
+getSecretKey (GpgKey kid) = Gpg.getSecretKey kid
+getSecretKey (KeyFile f) = SecretKey <$> B.readFile f
 
--- | Pick gpg secret key to back up or restore.
---
--- When backing up, if there is only one secret
--- key, the choice is obvious. Otherwise prompt the user with a list.
+-- | Pick gpg secret key to back up.
 --
--- When restoring, prompt the user for the name of the key,
--- query the keyserver, and let the user pick from a list.
--- The "other" option uses a null keyid, to handle the case where a key is
--- not stored in the keyserver.
-pickGpgKey :: CmdLine.Mode -> UI -> IO SecretKeySource
-pickGpgKey CmdLine.Backup ui = error "TODO"
-pickGpgKey CmdLine.Restore ui = error "TODO"
-pickGpgKey _ ui = error "internal error in pickGpgKey"
+-- If there is only one gpg secret key,
+-- the choice is obvious. Otherwise prompt the user with a list.
+pickGpgKeyToBackup :: UI -> IO SecretKey
+pickGpgKeyToBackup ui = go =<< Gpg.listSecretKeys
+  where
+	go [] = do
+		showError ui "You have no gpg secret keys to back up."
+		error "Aborting on no gpg secret keys."
+	go [(_, kid)] = Gpg.getSecretKey kid
+	go l = maybe (error "Canceled") Gpg.getSecretKey
+		=<< promptKeyId ui "Pick gpg secret key"
+			"Pick gpg secret key to back up:" l
 
-backup :: UI -> Tunables -> SecretKeySource -> IO ()
-backup ui tunables secretkeysource = do
+-- | Use when the gpg keyid will not be known at restore time.
+anyGpgKey :: SecretKeySource
+anyGpgKey = GpgKey (KeyId "")
+
+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"
 			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 [])
@@ -79,17 +96,23 @@ backup ui tunables secretkeysource = do
 	print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards)
 	print =<< obscureShards localFiles
   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."
+		[ "To back up your secret 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."
+		, "spelling and capitalization in order to restore your secret key."
 		, ""
 		, "(Your own full name is a pretty good choice for the name to enter here.)"
 		]
+	passworddesc = unlines
+		[ "Pick a password that will be used to protect your secret key."
+		, ""
+		, "It's very important that this password be hard to guess."
+		, ""
+		, "And, it needs to be one that you will be able to remember years from now"
+		, "in order to restore your secret key."
+		]
 
 restore :: UI -> SecretKeySource -> IO ()
 restore ui secretkeydest = do
@@ -126,6 +149,9 @@ 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