From a58aea595a780c91bbbe26d2d24a63abcd835994 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 12 Aug 2016 11:36:44 -0400
Subject: add readline UI

---
 INSTALL        |  7 +++--
 UI.hs          | 18 ++++--------
 UI/Readline.hs | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 UI/Zenity.hs   |  4 +--
 keysafe.cabal  |  1 +
 5 files changed, 105 insertions(+), 17 deletions(-)
 create mode 100644 UI/Readline.hs

diff --git a/INSTALL b/INSTALL
index 3f09bc1..81ba7d2 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,7 +1,8 @@
-You should first install ghc, cabal, the argon2 library, and zenity
-For example, on a Debian system:
+You should first install ghc, cabal, the readline and argon2 libraries, 
+and zenity. For example, on a Debian system:
 
-	sudo apt-get install ghc cabal-install libargon2-0-dev zenity
+	sudo apt-get install ghc cabal-install libreadline-dev \
+		libargon2-0-dev zenity
 
 Then to build and install keysafe:
 
diff --git a/UI.hs b/UI.hs
index 7e583cf..0ce87db 100644
--- a/UI.hs
+++ b/UI.hs
@@ -5,16 +5,10 @@
 
 module UI where
 
-import Types
+import Types.UI
+import Control.Monad
+import UI.Zenity
+import UI.Readline
 
-data UI = UI
-	{ isAvailable :: IO Bool
-	, promptName :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
-	, promptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-	, withProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
-	}
-
-type Title = String
-type Desc = String
-type Percent = Int
-type Problem = String
+availableUI :: IO [UI]
+availableUI = filterM isAvailable [zenityUI, readlineUI]
diff --git a/UI/Readline.hs b/UI/Readline.hs
new file mode 100644
index 0000000..bcbe27e
--- /dev/null
+++ b/UI/Readline.hs
@@ -0,0 +1,92 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module UI.Readline (readlineUI) where
+
+import Types.UI
+import Types
+import System.Console.Readline
+import System.Posix.Terminal
+import System.Posix.IO
+import Control.Monad
+import Control.Exception
+import System.IO
+import qualified Data.ByteString.UTF8 as BU8
+
+readlineUI :: UI
+readlineUI = UI
+	{ isAvailable = queryTerminal stdInput
+	, promptName = name
+	, promptPassword = password
+	, withProgress = progress
+	}
+
+name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
+name title desc checkproblem = go ""
+  where
+	go extradesc = do
+		putStrLn title
+		putStrLn ""
+		putStrLn desc
+		unless (null extradesc) $
+			putStrLn extradesc
+		mname <- readline "Name> "
+		case mname of
+			Just s -> do
+				addHistory s
+				let n = Name $ BU8.fromString s
+				case checkproblem n of
+					Nothing -> do
+						putStrLn ""
+						return $ Just n
+					Just problem -> go problem
+			Nothing -> return Nothing
+
+password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
+password title desc checkproblem = bracket setup teardown (const go)
+  where
+	setup = do
+		putStrLn title
+		putStrLn ""
+		putStrLn desc
+		origattr <- getTerminalAttributes stdInput
+		let newattr = origattr `withoutMode` EnableEcho
+		setTerminalAttributes stdInput newattr Immediately
+		return origattr
+	teardown origattr = setTerminalAttributes stdInput origattr Immediately
+	go = do
+		putStr "Enter password> "
+		hFlush stdout
+		p1 <- getLine
+		putStrLn ""
+		putStr "Confirm password> "
+		hFlush stdout
+		p2 <- getLine
+		putStrLn ""
+		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
+
+progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
+progress title desc a = bracket_ setup teardown (a sendpercent)
+  where
+	setup = do
+		putStrLn title
+		putStrLn ""
+		putStrLn desc
+	sendpercent p = do
+		putStr (show p ++ "%  ")
+		hFlush stdout
+	teardown = putStrLn "done"
diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index 2601f68..5eb4bef 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -27,7 +27,7 @@ zenityUI = UI
 	, withProgress = progress
 	}
 
-name :: Title -> Desc -> (Name -> Maybe String) -> IO (Maybe Name)
+name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
 name title desc checkproblem = go ""
   where
 	go extradesc = do
@@ -45,7 +45,7 @@ name title desc checkproblem = go ""
 					Just problem -> go problem
 			else return Nothing
 
-password :: Title -> Desc -> (Password -> Maybe String) -> IO (Maybe Password)
+password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
 password title desc checkproblem = go ""
   where
 	go extradesc = do
diff --git a/keysafe.cabal b/keysafe.cabal
index 724ad70..aa212b1 100644
--- a/keysafe.cabal
+++ b/keysafe.cabal
@@ -33,6 +33,7 @@ Executable keysafe
     , filepath == 1.4.*
     , directory == 1.2.*
     , optparse-applicative == 0.12.*
+    , readline == 1.0.*
 
     -- secret-sharing == 1.0.*
     , dice-entropy-conduit >= 1.0.0.0
-- 
cgit v1.2.3