HasswordManager/app/Main.hs

{-# 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 (min 8 symbols)!!!\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 "Enter the password again:" >> 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 an entry password"
  putStrLn "3. Add a new entry"
  putStrLn "4. Delete an entry"
  putStrLn "5. Update an entry password"
  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
      entries <- Db.get_all_entries conn
      if null entries
        then do
          Ut.clear_screen
          Ut.set_red
          putStrLn "No entries to list!!!"
          Ut.reset_color
          application_loop conn mpass
        else do
          list_all_entries conn
          application_loop conn mpass
    Ut.CopyEntryPassword -> do
      entries <- Db.get_all_entries conn
      if null entries
        then do
          Ut.clear_screen
          Ut.set_red
          putStrLn "No entries to copy a password from!!!"
          Ut.reset_color
          application_loop conn mpass
        else do
          copy_entry_pass conn mpass
          application_loop conn mpass
    Ut.AddNewEntry -> do
      add_entry conn mpass
      application_loop conn mpass
    Ut.DeleteEntry -> do
      entries <- Db.get_all_entries conn
      if null entries
        then do
          Ut.clear_screen
          Ut.set_red
          putStrLn "No entries to delete!!!"
          Ut.reset_color
          application_loop conn mpass
        else do
          delete_entry conn
          application_loop conn mpass
    Ut.UpdateEntry -> do
      entries <- Db.get_all_entries conn
      if null entries
        then do
          Ut.clear_screen
          Ut.set_red
          putStrLn "No entries to update!!!"
          Ut.reset_color
          application_loop conn mpass
        else do
          update_entry conn mpass
          application_loop conn mpass
    Ut.ChangeMasterPassword -> do
      mpass <- change_mpass conn mpass
      application_loop conn mpass
    Ut.InvalidAction -> do
      Ut.clear_screen
      Ut.set_red
      putStrLn "Invalid choice!!!"
      Ut.reset_color
      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.clear_screen
      Ut.set_green
      putStrLn "Password copied to clipboard!!!"
      Ut.reset_color
    Nothing -> do
      Ut.clear_screen
      Ut.set_red
      putStrLn "Invalid entry ID!!!"
      Ut.reset_color
      return ()

add_entry :: Connection -> String -> IO ()
add_entry conn mpass = do
  Ut.clear_screen
  putStrLn "Please Enter the service name for the new entry:"
  service <- getLine
  putStrLn "Please Enter the login for the new entry:"
  login <- getLine
  entry_exists <- Db.entry_already_exists conn (T.pack service) (T.pack login)
  if entry_exists
    then do
      Ut.clear_screen
      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))
      Ut.clear_screen
      Ut.set_green
      putStrLn "Entry added successfully!!!"
      Ut.reset_color

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))
      Ut.clear_screen
      Ut.set_green
      putStrLn "Entry updated successfully!!!"
      Ut.reset_color
    Nothing -> do
      Ut.clear_screen
      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)
      Ut.clear_screen
      Ut.set_green
      putStrLn "Entry deleted successfully!!!"
      Ut.reset_color
    Nothing -> do
      Ut.clear_screen
      Ut.set_red
      putStrLn "Invalid entry ID!!!"
      Ut.reset_color
      return ()

change_mpass :: Connection -> String -> IO (String)
change_mpass conn mpass = do
  putStrLn "Please Enter your current MASTER PASSWORD:"
  current_mpass <- Ut.get_password
  mpass_valid <- Db.check_if_mpass_valid conn (Cr.hash' $ fromString current_mpass)
  if mpass_valid
    then do
      res <- input_new_valid_mpass
      case res of
        Ut.Valid new_mpass -> do
          Db.insert_new_mpass conn (Cr.hash' $ fromString new_mpass)
          entries <- Db.get_all_entries conn
          mapM_ (\entry -> Db.update_entry conn (Db.entryService entry) (Db.entryLogin entry) (T.pack (Cr.encrypt' new_mpass (Cr.decrypt' mpass (T.unpack (Db.entryPassword entry)))))) entries
          Ut.clear_screen
          Ut.set_green
          putStrLn "Master Password changed successfully!!!\n"
          Ut.reset_color
          return new_mpass
        Ut.DoNotMatch -> do
          Ut.clear_screen
          Ut.set_red
          putStrLn "Passwords do not match!!!\n"
          Ut.reset_color
          return mpass
        Ut.TooShort -> do
          Ut.clear_screen
          Ut.set_red
          putStrLn "Password is too short (min 8 symbols)!!!\n"
          Ut.reset_color
          return mpass
        Ut.Empty -> do
          Ut.clear_screen
          Ut.set_red
          putStrLn "Password cannot be empty!!!\n"
          Ut.reset_color
          return mpass
    else do
      Ut.clear_screen
      Ut.set_red
      putStrLn "Invalid MASTER PASSWORD!!!\n"
      Ut.reset_color
      return mpass