HasswordManager/app/Main.hs
2024-05-26 13:35:02 +02:00

205 lines
6.0 KiB
Haskell

{-# 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 ()