{-# LANGUAGE OverloadedStrings #-} module Main (main) where import Data.ByteString.UTF8 (fromString, toString) import Database.SQLite.Simple import System.Hclip import qualified Data.Text as T import qualified Data.Map as Map import qualified UserInterface as Ui import qualified Database as Db import qualified Crypto as Cr import qualified Utils as Ut main :: IO () main = do conn <- Db.init_connection Ut.clear_screen putStrLn "Welcome to Hassword Manager!!!" setup_application conn mpass <- open_hassword_book conn application_loop conn mpass Db.close_connection conn setup_application :: Connection -> IO () setup_application conn = do first <- Db.is_it_first_app_usage conn if first then do Ut.set_green putStrLn "It seems like you are using this application for the first time." Ut.reset_color create_mpass conn else return () create_mpass :: Connection -> IO () create_mpass conn = do res <- input_new_valid_mpass case res of Ut.Valid mpass -> do Db.insert_new_mpass conn (Cr.hash' $ fromString mpass) Ut.DoNotMatch -> do Ut.set_red putStrLn "Passwords do not match!!!\n" Ut.reset_color create_mpass conn Ut.TooShort -> do Ut.set_red putStrLn "Password is too short!!!\n" Ut.reset_color create_mpass conn Ut.Empty -> do Ut.set_red putStrLn "Password cannot be empty!!!\n" Ut.reset_color create_mpass conn input_new_valid_mpass :: IO (Ut.MasterPasswordValidationCases) input_new_valid_mpass = do (password1:password2:_) <- sequence [putStrLn "Please Enter new MASTER PASSWORD:" >> Ut.get_password, putStrLn "Confirm password:" >> Ut.get_password] return $ Ut.validate_password password1 password2 open_hassword_book :: Connection -> IO (String) open_hassword_book conn = do putStrLn "Please Enter your MASTER PASSWORD:" mpass <- Ut.get_password mpass_valid <- Db.check_if_mpass_valid conn (Cr.hash' $ fromString mpass) if mpass_valid then return mpass else do Ut.set_red putStrLn "Invalid MASTER PASSWORD!!!\n" Ut.reset_color open_hassword_book conn get_action_choice :: IO (Ut.ActionChoice) get_action_choice = do putStrLn "\nWhat would you like to do?" putStrLn "1. List all entries" putStrLn "2. Copy entry password" putStrLn "3. Add a new entry" putStrLn "4. Delete an entry" putStrLn "5. Update an entry" putStrLn "6. Change Master Password" putStrLn "7. Close the application" choice <- getLine case choice of "1" -> return Ut.ListAllEntries "2" -> return Ut.CopyEntryPassword "3" -> return Ut.AddNewEntry "4" -> return Ut.DeleteEntry "5" -> return Ut.UpdateEntry "6" -> return Ut.ChangeMasterPassword "7" -> return Ut.Exit _ -> return Ut.InvalidAction application_loop :: Connection -> String -> IO () application_loop conn mpass = do choice <- get_action_choice case choice of Ut.ListAllEntries -> do list_all_entries conn application_loop conn mpass Ut.CopyEntryPassword -> do copy_entry_pass conn mpass application_loop conn mpass Ut.AddNewEntry -> do add_entry conn mpass application_loop conn mpass Ut.DeleteEntry -> do delete_entry conn application_loop conn mpass Ut.UpdateEntry -> do update_entry conn mpass application_loop conn mpass Ut.ChangeMasterPassword -> do return () application_loop conn mpass Ut.InvalidAction -> do putStrLn "Invalid choice!!!" application_loop conn mpass Ut.Exit -> do return () list_all_entries :: Connection -> IO (Map.Map Int (String, String)) list_all_entries conn = do Ut.clear_screen entries <- Db.get_all_entries conn Ui.print_entries entries let entries_map = Ut.map_entries entries return entries_map copy_entry_pass :: Connection -> String -> IO () copy_entry_pass conn mpass = do entries <- list_all_entries conn chosen_entry <- Ui.choose_entry "Please choose the entry ID to copy password:" let result = Map.lookup chosen_entry entries case result of Just (service, login) -> do entry <- Db.get_entry conn (T.pack service) (T.pack login) setClipboard (Cr.decrypt' mpass (T.unpack $ Db.entryPassword entry)) Ut.set_green putStrLn "Password copied to clipboard!!!" Ut.reset_color Nothing -> do Ut.set_red putStrLn "Invalid entry ID!!!" Ut.reset_color return () add_entry :: Connection -> String -> IO () add_entry conn mpass = do putStrLn "Please Enter the service name:" service <- getLine putStrLn "Please Enter the login:" login <- getLine entry_exists <- Db.entry_already_exists conn (T.pack service) (T.pack login) if entry_exists then do Ut.set_red putStrLn "Entry already exists!!!" Ut.reset_color return () else do putStrLn "Please Enter the password:" password <- Ut.get_password Db.add_entry conn (T.pack service) (T.pack login) (T.pack (Cr.encrypt' mpass password)) update_entry :: Connection -> String -> IO () update_entry conn mpass = do Ut.clear_screen entries <- list_all_entries conn chosen_entry <- Ui.choose_entry "Please choose the entry ID to update:" let result = Map.lookup chosen_entry entries case result of Just (service, login) -> do putStrLn "Please Enter the new password:" password <- Ut.get_password Db.update_entry conn (T.pack service) (T.pack login) (T.pack (Cr.encrypt' mpass password)) Nothing -> do Ut.set_red putStrLn "Invalid entry ID!!!" Ut.reset_color return () delete_entry :: Connection -> IO () delete_entry conn = do entries <- list_all_entries conn chosen_entry <- Ui.choose_entry "Please choose the entry ID to delete:" let result = Map.lookup chosen_entry entries case result of Just (service, login) -> do Db.delete_entry conn (T.pack service) (T.pack login) Nothing -> do Ut.set_red putStrLn "Invalid entry ID!!!" Ut.reset_color return ()