big setup

This commit is contained in:
s473615 2024-05-25 14:38:26 +02:00
parent 0ca86bc203
commit d34a957780
10 changed files with 241 additions and 7 deletions

2
.gitignore vendored
View File

@ -22,4 +22,4 @@ cabal.project.local
cabal.project.local~ cabal.project.local~
.HTF/ .HTF/
.ghc.environment.* .ghc.environment.*
*.db

View File

@ -25,7 +25,10 @@ source-repository head
library library
exposed-modules: exposed-modules:
Lib Crypto
Database
UserInterface
Utils
other-modules: other-modules:
Paths_HasswordManager Paths_HasswordManager
autogen-modules: autogen-modules:
@ -34,7 +37,14 @@ library
src src
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 Hclip
, ansi-terminal
, base >=4.7 && <5
, bytestring
, hashable
, sqlite-simple
, text
, utf8-string
default-language: Haskell2010 default-language: Haskell2010
executable HasswordManager-exe executable HasswordManager-exe
@ -48,7 +58,14 @@ executable HasswordManager-exe
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
HasswordManager HasswordManager
, Hclip
, ansi-terminal
, base >=4.7 && <5 , base >=4.7 && <5
, bytestring
, hashable
, sqlite-simple
, text
, utf8-string
default-language: Haskell2010 default-language: Haskell2010
test-suite HasswordManager-test test-suite HasswordManager-test
@ -63,5 +80,12 @@ test-suite HasswordManager-test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
HasswordManager HasswordManager
, Hclip
, ansi-terminal
, base >=4.7 && <5 , base >=4.7 && <5
, bytestring
, hashable
, sqlite-simple
, text
, utf8-string
default-language: Haskell2010 default-language: Haskell2010

View File

@ -1,6 +1,82 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where module Main (main) where
import Lib import Data.ByteString.UTF8 (fromString)
import Database.SQLite.Simple
import System.Hclip
import qualified UserInterface as Ui
import qualified Database as Db
import qualified Crypto as Cr
import qualified Utils as Ut
main :: IO () main :: IO ()
main = someFunc main = do
conn <- Db.init_connection
Ut.clear_screen
putStrLn "Welcome to Hassword Manager!!!"
welcome_screen conn
mpass <- open_hassword_book conn
putStrLn mpass
setClipboard mpass
-- application_loop conn
Db.close_connection conn
welcome_screen :: Connection -> IO ()
welcome_screen 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
res <- Db.check_if_mpass_valid conn (Cr.hash' $ fromString mpass)
if res
then
return mpass
else do
Ut.set_red
putStrLn "Invalid MASTER PASSWORD!!!\n"
Ut.reset_color
open_hassword_book conn
application_loop :: Connection -> IO ()
application_loop conn = do
putStrLn "What would you like to do?"
application_loop conn

View File

@ -20,6 +20,13 @@ extra-source-files:
description: Please see the README on GitHub at <https://github.com/githubuser/HasswordManager#readme> description: Please see the README on GitHub at <https://github.com/githubuser/HasswordManager#readme>
dependencies: dependencies:
- text
- sqlite-simple
- hashable
- bytestring
- utf8-string
- ansi-terminal
- Hclip
- base >= 4.7 && < 5 - base >= 4.7 && < 5
ghc-options: ghc-options:

15
src/Crypto.hs Normal file
View File

@ -0,0 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module Crypto (
-- encode,
-- decode,
hash'
) where
import Data.ByteString (ByteString)
import Data.Hashable
pepper :: ByteString
pepper = "pepper"
hash' :: ByteString -> Int
hash' = hashWithSalt 0 . mappend pepper

64
src/Database.hs Normal file
View File

@ -0,0 +1,64 @@
{-# LANGUAGE OverloadedStrings #-}
module Database (
Entry(..),
init_connection,
close_connection,
check_if_mpass_valid,
insert_new_mpass,
is_it_first_app_usage
) where
import Control.Applicative
import qualified Data.Text as T
import Database.SQLite.Simple
data Entry = Entry { entryId :: Int, entryLogin :: T.Text, entryPassword :: T.Text } deriving (Show)
data Mpass = Mpass { mpassId :: Int, hash :: Int } deriving (Show)
instance FromRow Entry where
fromRow = Entry <$> field <*> field <*> field
instance FromRow Mpass where
fromRow = Mpass <$> field <*> field
instance ToRow Entry where
toRow (Entry id_ login password) = toRow (id_, login, password)
instance ToRow Mpass where
toRow (Mpass id_ hash) = toRow (id_, hash)
init_connection :: IO Connection
init_connection = do
conn <- open "hassword.db"
create_db conn
return conn
close_connection :: Connection -> IO ()
close_connection conn = close conn
create_db :: Connection -> IO ()
create_db conn = do
execute_ conn "CREATE TABLE IF NOT EXISTS hasswords (entryId INTEGER PRIMARY KEY, entryLogin TEXT, entryPassword TEXT)"
execute_ conn "CREATE TABLE IF NOT EXISTS mpass (mpassId INTEGER PRIMARY KEY, hash INTEGER)"
-- execute conn "INSERT INTO hassword (entryId, entryLogin, entryPassword) VALUES (?,?,?)" (Entry 1 "admin" "admin")
-- rowId <- lastInsertRowId conn
-- r <- query_ conn "SELECT * from hassword" :: IO [Entry]
-- mapM_ print r
is_it_first_app_usage :: Connection -> IO Bool
is_it_first_app_usage conn = do
r <- query_ conn "SELECT * from mpass" :: IO [Mpass]
return $ length r == 0
insert_new_mpass :: Connection -> Int -> IO ()
insert_new_mpass conn hash = do
execute_ conn "DELETE FROM mpass"
execute conn "INSERT INTO mpass (mpassId, hash) VALUES (?,?)" (Mpass 1 hash)
check_if_mpass_valid :: Connection -> Int -> IO Bool
check_if_mpass_valid conn hash = do
r <- query conn "SELECT * from mpass WHERE hash = ?" (Only hash) :: IO [Mpass]
return $ length r == 1

View File

@ -1,4 +1,4 @@
module Lib module UserInterface
( someFunc ( someFunc
) where ) where

39
src/Utils.hs Normal file
View File

@ -0,0 +1,39 @@
module Utils where
import System.Console.ANSI
import System.IO
import Control.Exception
data MasterPasswordValidationCases = Empty | TooShort | DoNotMatch | NotValid | Valid String deriving (Show)
validate_password :: String -> String -> MasterPasswordValidationCases
validate_password p1 p2
| p1 /= p2 = DoNotMatch
| null p1 = Empty
| length p1 < 8 = TooShort
| otherwise = Valid p1
clear_screen :: IO ()
clear_screen = clearScreen
set_red :: IO ()
set_red = setSGR [SetColor Foreground Vivid Red]
set_green :: IO ()
set_green = setSGR [SetColor Foreground Vivid Green]
reset_color :: IO ()
reset_color = setSGR [Reset]
set_title :: String -> IO ()
set_title title = setTitle title
hide_pass :: IO a -> IO a
hide_pass action = do
old <- hGetEcho stdin
bracket_ (hSetEcho stdin False) (hSetEcho stdin old) action
get_password :: IO String
get_password = do
pass <- hide_pass getLine
return pass

View File

@ -41,6 +41,8 @@ packages:
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# #
# extra-deps: [] # extra-deps: []
extra-deps:
- Hclip-3.0.0.4@sha256:df341c936594465df25c3b9f93f6ebe3110a36d64a51dbbd1dbd557394bbdba4,1648
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}

View File

@ -3,7 +3,14 @@
# For more information, please see the documentation at: # For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files # https://docs.haskellstack.org/en/stable/lock_files
packages: [] packages:
- completed:
hackage: Hclip-3.0.0.4@sha256:df341c936594465df25c3b9f93f6ebe3110a36d64a51dbbd1dbd557394bbdba4,1648
pantry-tree:
sha256: bc09b0acdf0ffce64e16a53ffc18d76dc05d4282433cae723402d1b8ecc01301
size: 205
original:
hackage: Hclip-3.0.0.4@sha256:df341c936594465df25c3b9f93f6ebe3110a36d64a51dbbd1dbd557394bbdba4,1648
snapshots: snapshots:
- completed: - completed:
sha256: 4be1ca5d31689b524a7f0f17a439bbe9136465213edc498e9a395899a670f2aa sha256: 4be1ca5d31689b524a7f0f17a439bbe9136465213edc498e9a395899a670f2aa