big setup
This commit is contained in:
parent
0ca86bc203
commit
d34a957780
2
.gitignore
vendored
2
.gitignore
vendored
@ -22,4 +22,4 @@ cabal.project.local
|
|||||||
cabal.project.local~
|
cabal.project.local~
|
||||||
.HTF/
|
.HTF/
|
||||||
.ghc.environment.*
|
.ghc.environment.*
|
||||||
|
*.db
|
||||||
|
@ -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
|
||||||
|
80
app/Main.hs
80
app/Main.hs
@ -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
|
||||||
|
@ -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
15
src/Crypto.hs
Normal 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
64
src/Database.hs
Normal 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
|
@ -1,4 +1,4 @@
|
|||||||
module Lib
|
module UserInterface
|
||||||
( someFunc
|
( someFunc
|
||||||
) where
|
) where
|
||||||
|
|
39
src/Utils.hs
Normal file
39
src/Utils.hs
Normal 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
|
@ -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: {}
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user