From 9473fee1bb0f9f549de41eec9f7b7d141f2ebfd3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 16 Aug 2016 16:08:13 -0400
Subject: key selection working

---
 UI/Readline.hs | 73 +++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 60 insertions(+), 13 deletions(-)

(limited to 'UI/Readline.hs')

diff --git a/UI/Readline.hs b/UI/Readline.hs
index 086da1e..ac962d2 100644
--- a/UI/Readline.hs
+++ b/UI/Readline.hs
@@ -12,14 +12,20 @@ import System.Posix.Terminal
 import System.Posix.IO
 import Control.Exception
 import System.IO
+import Data.List
+import Data.Char
+import Text.Read
+import Control.Monad
 import qualified Data.ByteString.UTF8 as BU8
 
 readlineUI :: UI
 readlineUI = UI
 	{ isAvailable = queryTerminal stdInput
 	, showError = myShowError
+	, promptQuestion = myPromptQuestion
 	, promptName = myPromptName
 	, promptPassword = myPromptPassword
+	, promptKeyId = myPromptKeyId
 	, withProgress = myWithProgress
 	}
 
@@ -27,6 +33,24 @@ myShowError :: Desc -> IO ()
 myShowError desc = do
 	hPutStrLn stderr $ "Error: " ++ desc
 
+myPromptQuestion :: Title -> Desc -> IO Bool
+myPromptQuestion title desc = do
+	showTitle title
+	go
+  where
+	go = do
+		putStrLn desc
+		mresp <- readline "y/n? "
+		case mresp of
+			Just s
+				| "y" `isPrefixOf` (map toLower s) ->
+					return True
+				| "n" `isPrefixOf` (map toLower s) -> 
+					return False
+			_ -> do
+				putStrLn "Please enter 'y' or 'n'"
+				go
+
 myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
 myPromptName title desc (Name suggested) checkproblem = do
 	showTitle title
@@ -49,8 +73,8 @@ myPromptName title desc (Name suggested) checkproblem = do
 						go
 			Nothing -> return Nothing
 
-myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-myPromptPassword title desc checkproblem = bracket setup teardown (const go)
+myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)
+myPromptPassword confirm title desc = bracket setup teardown (const prompt)
   where
 	setup = do
 		showTitle title
@@ -60,11 +84,15 @@ myPromptPassword title desc checkproblem = bracket setup teardown (const go)
 		setTerminalAttributes stdInput newattr Immediately
 		return origattr
 	teardown origattr = setTerminalAttributes stdInput origattr Immediately
-	go = do
+	prompt = do
 		putStr "Enter password> "
 		hFlush stdout
 		p1 <- getLine
 		putStrLn ""
+		if confirm
+			then promptconfirm p1
+			else return $ mkpassword p1
+	promptconfirm p1 = do
 		putStr "Confirm password> "
 		hFlush stdout
 		p2 <- getLine
@@ -72,16 +100,35 @@ myPromptPassword title desc checkproblem = bracket setup teardown (const go)
 		if p1 /= p2
 			then do
 				putStrLn "Passwords didn't match, try again..."
-				go
-			else
-				let p = Password $ BU8.fromString p1
-				in case checkproblem p of
-					Nothing -> do
-						putStrLn ""
-						return $ Just p
-					Just problem -> do
-						putStrLn problem
-						go
+				prompt
+			else do
+				putStrLn ""
+				return $ mkpassword p1
+	mkpassword = Just . Password . BU8.fromString
+
+myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)
+myPromptKeyId _ _ [] = return Nothing
+myPromptKeyId title desc l = do
+	showTitle title
+	putStrLn desc
+	putStrLn ""
+	forM_ nl $ \(n, ((Name name), (KeyId kid))) ->
+		putStrLn $ show n ++ ".\t" ++ BU8.toString name ++ " (keyid " ++ BU8.toString kid ++ ")"
+	prompt
+  where
+	nl = zip [1 :: Integer ..] l
+	prompt = do
+		putStr "Enter number> "
+		hFlush stdout
+		r <- getLine
+		putStrLn ""
+		case readMaybe r of
+			Just n
+				| n > 0 && n < length l ->
+					return $ Just $ snd (l !! n)
+			_ -> do
+				putStrLn $ "Enter a number from 1 to " ++ show (length l)
+				prompt
 
 myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
 myWithProgress title desc a = bracket_ setup teardown (a sendpercent)
-- 
cgit v1.2.3