Compare commits
58 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 41278e81a9 | |||
| 8bddf35a1a | |||
| b0487d4d03 | |||
| 233a559aaf | |||
| 86278db578 | |||
| a872fcfd6c | |||
| d049c40b7a | |||
| ffce0d6a1c | |||
| 2b427789d2 | |||
| a3f405d9c5 | |||
| 76d2600fcf | |||
| 11870423ed | |||
| 4b057272d3 | |||
| 3e661e3b24 | |||
| f65a478fb5 | |||
| 85920c26a0 | |||
| 8be90e9822 | |||
| bb85081380 | |||
| f423d202ce | |||
| 82f2c6c5fb | |||
| d7da4b2924 | |||
| 0267ce8792 | |||
| d0d80223f7 | |||
| 180af04891 | |||
| a048e0ad8b | |||
| d3a54f19b9 | |||
| b9d52070f1 | |||
| 6585d63385 | |||
| 258ebf29fe | |||
| 1d6fbb5f40 | |||
| 08d2827613 | |||
| 4ac3d37913 | |||
| 4be38eb87a | |||
| 807e09a5ae | |||
| c5cdde8f73 | |||
| d87ccc4346 | |||
| 2d70a9e284 | |||
| 97a5ff4c92 | |||
| df5f0a4334 | |||
|
|
ae9a43519e | ||
|
|
a615538d96 | ||
|
|
927ce27865 | ||
|
|
c8412a6d3b | ||
|
|
ef663b39b0 | ||
|
|
645142aa8f | ||
|
|
1717f4c298 | ||
|
|
b3e2121597 | ||
|
|
412c8312b0 | ||
|
|
012486c045 | ||
|
|
cdff8c8917 | ||
|
|
f305822ae1 | ||
|
|
7cf0b34078 | ||
|
|
191be38fbe | ||
|
|
f2ae7bca76 | ||
|
|
3d8b41c5b6 | ||
|
|
60f40262f7 | ||
|
|
32c9241a2e | ||
|
|
29ca8a64bf |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -1,3 +1,2 @@
|
|||||||
.stack-work/
|
.stack-work/
|
||||||
passman.cabal
|
|
||||||
*~
|
*~
|
||||||
46
ChangeLog.md
46
ChangeLog.md
@@ -1,3 +1,47 @@
|
|||||||
# Changelog for passman
|
# Changelog for passman
|
||||||
|
|
||||||
## Unreleased changes
|
## current
|
||||||
|
|
||||||
|
- minor UI tweak
|
||||||
|
- minor refactoring
|
||||||
|
|
||||||
|
## 0.3.1.1
|
||||||
|
|
||||||
|
- updated documentation to on longer mention GitHub
|
||||||
|
- updated resolver to LTS 20.19
|
||||||
|
|
||||||
|
## 0.3.1
|
||||||
|
|
||||||
|
- set maximum version of transformers package
|
||||||
|
- allow user to specifiy a temporary master password to retrieve a password
|
||||||
|
|
||||||
|
## 0.3.0.2
|
||||||
|
|
||||||
|
- more dependency versions
|
||||||
|
|
||||||
|
## 0.3.0.1
|
||||||
|
|
||||||
|
- updated to latest stackage LTS
|
||||||
|
- specified versions for dependencies
|
||||||
|
|
||||||
|
## 0.3.0
|
||||||
|
|
||||||
|
- updated to more recent LTS snapshot
|
||||||
|
- use microlens instead of lens
|
||||||
|
|
||||||
|
## 0.2.1
|
||||||
|
|
||||||
|
- refactoring
|
||||||
|
- store the database where Windows can find it
|
||||||
|
- confirm master password before creating new service
|
||||||
|
|
||||||
|
## 0.2
|
||||||
|
|
||||||
|
- implemented manual saving
|
||||||
|
- added a warning when changing master password
|
||||||
|
- some code cleanup as suggested by [Stephen Paul Weber](https://github.com/singpolyma)
|
||||||
|
|
||||||
|
## 0.1.1
|
||||||
|
|
||||||
|
- corrected a bug that was causing the pwGenerate function to hang occasionally.
|
||||||
|
- this may cause some passwords to be generated differently
|
||||||
|
|||||||
19
README.md
19
README.md
@@ -1,7 +1,7 @@
|
|||||||
# passman
|
# passman
|
||||||
|
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) 2018-2024 Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -38,19 +38,14 @@ This package uses [Haskell Stack](https://haskellstack.org). Please
|
|||||||
refer to [their
|
refer to [their
|
||||||
website](https://docs.haskellstack.org/en/stable/README/#how-to-install)
|
website](https://docs.haskellstack.org/en/stable/README/#how-to-install)
|
||||||
for instructions on installing Haskell Stack. Once you have done
|
for instructions on installing Haskell Stack. Once you have done
|
||||||
this, you can simply enterg the command `stack install passman` in the
|
this, you can simply enter the command `stack install` in the terminal
|
||||||
terminal to install passman.
|
from this directory to install passman.
|
||||||
|
|
||||||
## GitHub
|
## Codeberg
|
||||||
|
|
||||||
The most recent version of passman can be found on GitHub at
|
The most recent version of passman can be found on Codeberg at
|
||||||
<https://github.com/jlamothe/passman>.
|
<https://codeberg.org/jlamothe/passman>.
|
||||||
|
|
||||||
## Pull Requests
|
## Pull Requests
|
||||||
|
|
||||||
Pull requests are welcome, but should be made to the `dev` branch.
|
Pull requests are welcome, but should be made to the `dev` branch.
|
||||||
|
|
||||||
## Donations
|
|
||||||
|
|
||||||
Bitcoin donations are accepted (but not required) at:
|
|
||||||
18hqEsXCinyauDp6smPUEVuscjDdasTKvr
|
|
||||||
|
|||||||
52
app/Main.hs
52
app/Main.hs
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -20,51 +20,15 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Main where
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Monad (mapM_)
|
import Brick (defaultMain)
|
||||||
import Control.Monad.Trans.State as S
|
import Control.Monad (void)
|
||||||
import Data.Maybe (maybe)
|
|
||||||
import System.Console.HCL (Request, reqFail, reqIO, runRequest)
|
|
||||||
import System.Environment (lookupEnv)
|
|
||||||
import System.Random (getStdGen)
|
|
||||||
|
|
||||||
import Password
|
import Password.App
|
||||||
|
import Password.App.Types
|
||||||
import Types
|
|
||||||
import UI
|
|
||||||
import Util
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = runRequest setup >>= mapM_ (S.evalStateT mainMenu)
|
main = void $ mkInitialState >>= defaultMain passmanApp
|
||||||
|
|
||||||
setup :: Request Status
|
|
||||||
setup = do
|
|
||||||
g <- reqIO getStdGen
|
|
||||||
p <- getDBPath
|
|
||||||
db <- loadFrom p
|
|
||||||
pw <- getMasterPass
|
|
||||||
return $ Status g pw p db
|
|
||||||
|
|
||||||
getDBPath :: Request FilePath
|
|
||||||
getDBPath = reqIO (lookupEnv "HOME") >>= maybe
|
|
||||||
(do
|
|
||||||
reqIO $ putStrLn "ERROR: can't find home directory"
|
|
||||||
reqFail)
|
|
||||||
(\home -> case pathDelim home of
|
|
||||||
Nothing -> do
|
|
||||||
reqIO $ putStrLn "ERROR: unsupported home path"
|
|
||||||
reqFail
|
|
||||||
Just delim -> return $ home ++
|
|
||||||
(if last home == delim then "" else [delim]) ++
|
|
||||||
".passman.json")
|
|
||||||
|
|
||||||
pathDelim :: FilePath -> Maybe Char
|
|
||||||
pathDelim = foldr
|
|
||||||
(\x a -> case x of
|
|
||||||
'/' -> Just '/'
|
|
||||||
'\\' -> Just '\\'
|
|
||||||
_ -> a)
|
|
||||||
Nothing
|
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
52
app/Types.hs
52
app/Types.hs
@@ -1,52 +0,0 @@
|
|||||||
{-
|
|
||||||
|
|
||||||
passman
|
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
|
||||||
<jlamothe1980@gmail.com>
|
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU Lesser General Public License as
|
|
||||||
published by the Free Software Foundation, either version 3 of the
|
|
||||||
License, or (at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful, but
|
|
||||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
||||||
Lesser General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU Lesser General Public
|
|
||||||
License along with this program. If not, see
|
|
||||||
<https://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
module Types (Status (Status), gen, dbPath, masterPass, database) where
|
|
||||||
|
|
||||||
import Control.Lens (makeLenses, set, (^.))
|
|
||||||
import System.Random (RandomGen (next, split), StdGen)
|
|
||||||
|
|
||||||
import Password
|
|
||||||
|
|
||||||
data Status = Status
|
|
||||||
{ _gen :: StdGen
|
|
||||||
, _masterPass :: String
|
|
||||||
, _dbPath :: FilePath
|
|
||||||
, _database :: PWDatabase
|
|
||||||
}
|
|
||||||
|
|
||||||
makeLenses ''Status
|
|
||||||
|
|
||||||
instance RandomGen Status where
|
|
||||||
next s = (x, s') where
|
|
||||||
(x, g') = next g
|
|
||||||
s' = set gen g' s
|
|
||||||
g = s^.gen
|
|
||||||
split s = (s1, s2) where
|
|
||||||
s1 = set gen g1 s
|
|
||||||
s2 = set gen g2 s
|
|
||||||
(g1, g2) = split g
|
|
||||||
g = s^.gen
|
|
||||||
|
|
||||||
--jl
|
|
||||||
251
app/UI.hs
251
app/UI.hs
@@ -1,251 +0,0 @@
|
|||||||
{-
|
|
||||||
|
|
||||||
passman
|
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
|
||||||
<jlamothe1980@gmail.com>
|
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU Lesser General Public License as
|
|
||||||
published by the Free Software Foundation, either version 3 of the
|
|
||||||
License, or (at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful, but
|
|
||||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
||||||
Lesser General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU Lesser General Public
|
|
||||||
License along with this program. If not, see
|
|
||||||
<https://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
module UI (getMasterPass, mainMenu) where
|
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
|
||||||
import Control.Lens (over, set, view, (^.))
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
|
||||||
import qualified Control.Monad.Trans.State as S
|
|
||||||
import Data.Maybe (maybe)
|
|
||||||
import System.Console.HCL
|
|
||||||
( Request
|
|
||||||
, prompt
|
|
||||||
, reqDefault
|
|
||||||
, reqFail
|
|
||||||
, reqIf
|
|
||||||
, reqInt
|
|
||||||
, reqIO
|
|
||||||
, reqPassword
|
|
||||||
, reqResp
|
|
||||||
, required
|
|
||||||
, runRequest
|
|
||||||
)
|
|
||||||
|
|
||||||
import Password
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Util
|
|
||||||
|
|
||||||
getMasterPass :: Request String
|
|
||||||
getMasterPass = do
|
|
||||||
p1 <- required $ prompt "master password: " reqPassword
|
|
||||||
p2 <- required $ prompt "confirm master password: " reqPassword
|
|
||||||
if p1 /= p2
|
|
||||||
then do
|
|
||||||
reqIO $ putStrLn "The passwords you entered do not match."
|
|
||||||
reqFail
|
|
||||||
else return p1
|
|
||||||
|
|
||||||
mainMenu :: S.StateT Status IO ()
|
|
||||||
mainMenu =
|
|
||||||
menu "Main Menu"
|
|
||||||
[ ( "add a password", addPassword )
|
|
||||||
, ( "view/edit a password", viewEditMenu )
|
|
||||||
, ( "change master password", changeMasterPass )
|
|
||||||
, ( "lock session", lockSession )
|
|
||||||
, ( "quit", quit )
|
|
||||||
]
|
|
||||||
|
|
||||||
addPassword :: S.StateT Status IO ()
|
|
||||||
addPassword = do
|
|
||||||
svc <- req $ prompt "service name: " reqResp
|
|
||||||
ifServExists svc
|
|
||||||
(do
|
|
||||||
edit <- req (confirm $
|
|
||||||
"The service already exists in the database.\n" ++
|
|
||||||
"Would you like to edit it?")
|
|
||||||
if edit
|
|
||||||
then servMenu svc
|
|
||||||
else mainMenu)
|
|
||||||
(do
|
|
||||||
d <- buildData
|
|
||||||
setService svc d
|
|
||||||
showPass svc
|
|
||||||
servMenu svc)
|
|
||||||
|
|
||||||
viewEditMenu :: S.StateT Status IO ()
|
|
||||||
viewEditMenu = menu "View/Edit Password"
|
|
||||||
[ ( "search services", searchServ )
|
|
||||||
, ( "list services", listServ )
|
|
||||||
, ( "cancel", mainMenu )
|
|
||||||
]
|
|
||||||
|
|
||||||
changeMasterPass :: S.StateT Status IO ()
|
|
||||||
changeMasterPass = do
|
|
||||||
oldP <- S.gets $ view masterPass
|
|
||||||
newP <- req $ reqDefault getMasterPass oldP
|
|
||||||
S.modify $ set masterPass newP
|
|
||||||
mainMenu
|
|
||||||
|
|
||||||
lockSession :: S.StateT Status IO ()
|
|
||||||
lockSession = do
|
|
||||||
lift $ putStrLn "\nThe session is locked."
|
|
||||||
pass <- S.gets $ view masterPass
|
|
||||||
x <- req $ prompt "master password: " reqPassword
|
|
||||||
if x == pass
|
|
||||||
then mainMenu
|
|
||||||
else lockSession
|
|
||||||
|
|
||||||
quit :: S.StateT Status IO ()
|
|
||||||
quit = save
|
|
||||||
|
|
||||||
buildData :: S.StateT Status IO PWData
|
|
||||||
buildData = do
|
|
||||||
d <- run newPWData
|
|
||||||
req $ reqIf (confirm "Would you like to change the password policy?")
|
|
||||||
(do
|
|
||||||
let p = d^.pwPolicy
|
|
||||||
p' <- reqDefault (editPolicy p) p
|
|
||||||
return $ set pwPolicy p' d)
|
|
||||||
(return d)
|
|
||||||
|
|
||||||
searchServ :: S.StateT Status IO ()
|
|
||||||
searchServ = do
|
|
||||||
svc <- req $ prompt "service name: " reqResp
|
|
||||||
db <- S.gets $ view database
|
|
||||||
case pwSearch svc db of
|
|
||||||
[] -> do
|
|
||||||
lift $ putStrLn "\nThe service could not be found in the database."
|
|
||||||
mainMenu
|
|
||||||
[x] -> servMenu x
|
|
||||||
xs -> selectServ xs
|
|
||||||
|
|
||||||
listServ :: S.StateT Status IO ()
|
|
||||||
listServ = S.gets (view database) >>= selectServ . pwSearch ""
|
|
||||||
|
|
||||||
selectServ :: [String] -> S.StateT Status IO ()
|
|
||||||
selectServ xs = menu "Select Service" $
|
|
||||||
map (\x -> (x, servMenu x)) xs ++
|
|
||||||
[("(cancel)", mainMenu)]
|
|
||||||
|
|
||||||
servMenu :: String -> S.StateT Status IO ()
|
|
||||||
servMenu x = menu x
|
|
||||||
[ ( "show password", showPass x >> servMenu x )
|
|
||||||
, ( "edit password", editPassMenu x )
|
|
||||||
, ( "remove service", removeServ x )
|
|
||||||
, ( "rename service", renameServ x )
|
|
||||||
, ( "back", mainMenu )
|
|
||||||
]
|
|
||||||
|
|
||||||
editPassMenu :: String -> S.StateT Status IO ()
|
|
||||||
editPassMenu x = menu (x ++ " : Edit Password")
|
|
||||||
[ ( "generate new password", changeSalt x )
|
|
||||||
, ( "edit password policy", doEditPolicy x )
|
|
||||||
, ( "back", servMenu x )
|
|
||||||
]
|
|
||||||
|
|
||||||
removeServ :: String -> S.StateT Status IO ()
|
|
||||||
removeServ x = do
|
|
||||||
go <- req $ confirm $
|
|
||||||
"Are you sure you want to delete the password for " ++ x ++ "?"
|
|
||||||
if go
|
|
||||||
then do
|
|
||||||
removeServ' x
|
|
||||||
mainMenu
|
|
||||||
else servMenu x
|
|
||||||
|
|
||||||
removeServ' :: String -> S.StateT Status IO ()
|
|
||||||
removeServ' = S.modify . over database . pwRemoveService
|
|
||||||
|
|
||||||
renameServ :: String -> S.StateT Status IO ()
|
|
||||||
renameServ x = do
|
|
||||||
y <- req $ prompt "new service name: " reqResp
|
|
||||||
if x == y
|
|
||||||
then servMenu x
|
|
||||||
else ifServExists y
|
|
||||||
(do
|
|
||||||
overwrite <- req $ confirm $
|
|
||||||
y ++ " already exists.\n" ++
|
|
||||||
"Would you like to overwrite it?"
|
|
||||||
if overwrite
|
|
||||||
then renameServ' x y
|
|
||||||
else servMenu x)
|
|
||||||
(renameServ' x y)
|
|
||||||
|
|
||||||
renameServ' :: String -> String -> S.StateT Status IO ()
|
|
||||||
renameServ' x y = withService x mainMenu $ \d -> do
|
|
||||||
removeServ' x
|
|
||||||
setService y d
|
|
||||||
servMenu y
|
|
||||||
|
|
||||||
changeSalt :: String -> S.StateT Status IO ()
|
|
||||||
changeSalt x = withService x mainMenu $ \d -> do
|
|
||||||
salt <- run newPWSalt
|
|
||||||
setService x $ set pwSalt salt d
|
|
||||||
showPass x
|
|
||||||
editPassMenu x
|
|
||||||
|
|
||||||
doEditPolicy :: String -> S.StateT Status IO ()
|
|
||||||
doEditPolicy x = withService x mainMenu $ \d -> do
|
|
||||||
let p = d^.pwPolicy
|
|
||||||
p' <- req $ reqDefault (editPolicy p) p
|
|
||||||
setService x $ set pwPolicy p' d
|
|
||||||
showPass x
|
|
||||||
editPassMenu x
|
|
||||||
|
|
||||||
showPass :: String -> S.StateT Status IO ()
|
|
||||||
showPass x = do
|
|
||||||
lift $ putStrLn ""
|
|
||||||
withService x
|
|
||||||
(lift $ putStrLn "The service could not be found in the database.") $
|
|
||||||
\d -> do
|
|
||||||
pw <- S.gets $ view masterPass
|
|
||||||
lift $ putStrLn $ case pwGenerate pw d of
|
|
||||||
Nothing -> "The password data were not valid."
|
|
||||||
Just pw -> "password for " ++ x ++ ": " ++ pw
|
|
||||||
|
|
||||||
-- TODO: refactor this monstrosity
|
|
||||||
editPolicy :: PWPolicy -> Request PWPolicy
|
|
||||||
editPolicy p = do
|
|
||||||
p <- edit "length" (p^.pwLength) pwLength p
|
|
||||||
p <- edit "min upper case" (p^.pwUpper) pwUpper p
|
|
||||||
p <- edit "min lower case" (p^.pwLower) pwLower p
|
|
||||||
p <- edit "min digits" (p^.pwDigits) pwDigits p
|
|
||||||
p <- special p
|
|
||||||
if validatePWPolicy p
|
|
||||||
then return p
|
|
||||||
else do
|
|
||||||
reqIO $ putStrLn $
|
|
||||||
"\nThe password policy you entered is invalid\n." ++
|
|
||||||
"It will not be changed."
|
|
||||||
reqFail
|
|
||||||
where
|
|
||||||
edit l v t p = do
|
|
||||||
v <- reqDefault
|
|
||||||
(prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v
|
|
||||||
return $ set t v p
|
|
||||||
special p = do
|
|
||||||
reqIO $ putStrLn $ "Special characters are currently " ++
|
|
||||||
(case p^.pwSpecial of
|
|
||||||
Nothing -> "not "
|
|
||||||
Just _ -> "") ++ "allowed."
|
|
||||||
reqIf (confirm "Would you like to allow special characters?")
|
|
||||||
(case p^.pwSpecial of
|
|
||||||
Nothing -> do
|
|
||||||
x <- required $ prompt "min special chars: " reqInt
|
|
||||||
return $ set pwSpecial (Just x) p
|
|
||||||
Just x -> edit "min special chars" x (pwSpecial.traverse) p)
|
|
||||||
(return $ set pwSpecial Nothing p)
|
|
||||||
|
|
||||||
--jl
|
|
||||||
122
app/Util.hs
122
app/Util.hs
@@ -1,122 +0,0 @@
|
|||||||
{-
|
|
||||||
|
|
||||||
passman
|
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
|
||||||
<jlamothe1980@gmail.com>
|
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU Lesser General Public License as
|
|
||||||
published by the Free Software Foundation, either version 3 of the
|
|
||||||
License, or (at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful, but
|
|
||||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
||||||
Lesser General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU Lesser General Public
|
|
||||||
License along with this program. If not, see
|
|
||||||
<https://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
module Util
|
|
||||||
( menu
|
|
||||||
, run
|
|
||||||
, withService
|
|
||||||
, ifServExists
|
|
||||||
, setService
|
|
||||||
, req
|
|
||||||
, tryReq
|
|
||||||
, confirm
|
|
||||||
, loadFrom
|
|
||||||
, save
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Lens (over, view)
|
|
||||||
import Control.Monad (join)
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
|
||||||
import qualified Control.Monad.Trans.State as S
|
|
||||||
import Data.Aeson (decodeFileStrict, encodeFile)
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import System.Console.HCL
|
|
||||||
( Request
|
|
||||||
, prompt
|
|
||||||
, reqAgree
|
|
||||||
, reqChar
|
|
||||||
, reqDefault
|
|
||||||
, reqIf
|
|
||||||
, reqIO
|
|
||||||
, reqMenu
|
|
||||||
, required
|
|
||||||
, runRequest
|
|
||||||
)
|
|
||||||
|
|
||||||
import Password
|
|
||||||
|
|
||||||
import Types
|
|
||||||
|
|
||||||
menu
|
|
||||||
:: String
|
|
||||||
-> [(String, S.StateT Status IO a)]
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
menu title = reqState . prompt ("\n*** " ++ title ++ " ***") .
|
|
||||||
reqMenu . map menuItem
|
|
||||||
|
|
||||||
menuItem :: (String, a) -> (String, Request a)
|
|
||||||
menuItem (str, x) = (str, return x)
|
|
||||||
|
|
||||||
reqState :: Request (S.StateT s IO a) -> S.StateT s IO a
|
|
||||||
reqState = join . req
|
|
||||||
|
|
||||||
run :: Monad m => (s -> (a, s)) -> S.StateT s m a
|
|
||||||
run f = S.StateT $ return . f
|
|
||||||
|
|
||||||
withService
|
|
||||||
:: String
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
-> (PWData -> S.StateT Status IO a)
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
withService srv fb act = do
|
|
||||||
db <- S.gets $ view database
|
|
||||||
case pwGetService srv db of
|
|
||||||
Nothing -> fb
|
|
||||||
Just x -> act x
|
|
||||||
|
|
||||||
ifServExists
|
|
||||||
:: String
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
-> S.StateT Status IO a
|
|
||||||
ifServExists s x y = do
|
|
||||||
db <- S.gets $ view database
|
|
||||||
if pwHasService s db
|
|
||||||
then x
|
|
||||||
else y
|
|
||||||
|
|
||||||
setService :: String -> PWData -> S.StateT Status IO ()
|
|
||||||
setService k = S.modify . over database . pwSetService k
|
|
||||||
|
|
||||||
req :: Request a -> S.StateT s IO a
|
|
||||||
req = lift . fmap fromJust . runRequest . required
|
|
||||||
|
|
||||||
tryReq :: Request a -> S.StateT s IO (Maybe a)
|
|
||||||
tryReq = lift . runRequest
|
|
||||||
|
|
||||||
confirm :: String -> Request Bool
|
|
||||||
confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar
|
|
||||||
|
|
||||||
loadFrom :: FilePath -> Request PWDatabase
|
|
||||||
loadFrom path = reqDefault
|
|
||||||
(reqIO (decodeFileStrict path))
|
|
||||||
(Just newPWDatabase) >>= maybe
|
|
||||||
(return newPWDatabase)
|
|
||||||
return
|
|
||||||
|
|
||||||
save :: S.StateT Status IO ()
|
|
||||||
save = do
|
|
||||||
path <- S.gets $ view dbPath
|
|
||||||
db <- S.gets $ view database
|
|
||||||
lift $ encodeFile path db
|
|
||||||
|
|
||||||
--jl
|
|
||||||
41
package.yaml
41
package.yaml
@@ -1,10 +1,11 @@
|
|||||||
name: passman
|
name: passman
|
||||||
version: 0.1
|
version: 0.3.1.1
|
||||||
github: "jlamothe/passman"
|
license: LGPL-3.0-or-later
|
||||||
license: LGPL-3
|
|
||||||
author: "Jonathan Lamothe"
|
author: "Jonathan Lamothe"
|
||||||
maintainer: "jlamothe1980@gmail.com"
|
maintainer: "jonathan@jlamothe.net"
|
||||||
copyright: "(C) 2018 Jonathan Lamothe"
|
copyright: "(C) 2018-2024 Jonathan Lamothe"
|
||||||
|
homepage: https://codeberg.org/jlamothe/passman
|
||||||
|
bug-reports: https://codeberg.org/jlamothe/passman/issues
|
||||||
|
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
- README.md
|
- README.md
|
||||||
@@ -17,22 +18,32 @@ category: Security
|
|||||||
# To avoid duplicated efforts in documentation and dealing with the
|
# To avoid duplicated efforts in documentation and dealing with the
|
||||||
# complications of embedding Haddock markup inside cabal files, it is
|
# complications of embedding Haddock markup inside cabal files, it is
|
||||||
# common to point users to the README.md file.
|
# common to point users to the README.md file.
|
||||||
description: Please see the README on GitHub at <https://github.com/jlamothe/passman#readme>
|
description: a simple password manager - see README.md for details
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- aeson
|
- aeson >= 2.1.2.1 && < 2.2
|
||||||
- bytestring
|
- bytestring >= 0.11.4.0 && < 0.12
|
||||||
- containers
|
- containers >= 0.6.2.1 && < 0.7
|
||||||
- lens
|
- microlens >= 0.4.11.2 && < 0.5
|
||||||
- random
|
- microlens-th >= 0.4.3.6 && < 0.5
|
||||||
|
- microlens-mtl >= 0.2.0.3 && < 0.3
|
||||||
|
- random >=1.2.1.1 && < 1.3
|
||||||
|
- brick >= 2.1.1 && < 2.2
|
||||||
|
- vty >= 6.1 && < 6.2
|
||||||
|
- mtl >= 2.3.1 && < 2.4
|
||||||
|
- easy-file >= 0.2.5 && < 0.3
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
dependencies:
|
dependencies:
|
||||||
- base64-bytestring
|
- base16-bytestring >= 1.0.2.0 && < 1.1
|
||||||
- SHA
|
- base64-bytestring >= 1.2.1.0 && < 1.3
|
||||||
- text
|
- SHA >= 1.6.4.4 && < 1.7
|
||||||
|
- text >= 2.0.2 && < 2.1
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
passman:
|
passman:
|
||||||
@@ -44,8 +55,6 @@ executables:
|
|||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
dependencies:
|
dependencies:
|
||||||
- passman
|
- passman
|
||||||
- HCL >= 1.7.1 && < 2
|
|
||||||
- transformers
|
|
||||||
|
|
||||||
tests:
|
tests:
|
||||||
passman-test:
|
passman-test:
|
||||||
|
|||||||
123
passman.cabal
Normal file
123
passman.cabal
Normal file
@@ -0,0 +1,123 @@
|
|||||||
|
cabal-version: 2.2
|
||||||
|
|
||||||
|
-- This file has been generated from package.yaml by hpack version 0.37.0.
|
||||||
|
--
|
||||||
|
-- see: https://github.com/sol/hpack
|
||||||
|
--
|
||||||
|
-- hash: d18a8e1efd32ff2d20b0b1f5ac8186be5242411bd72a6a017fd9f97d401a9836
|
||||||
|
|
||||||
|
name: passman
|
||||||
|
version: 0.3.1.1
|
||||||
|
synopsis: a simple password manager
|
||||||
|
description: a simple password manager - see README.md for details
|
||||||
|
category: Security
|
||||||
|
homepage: https://codeberg.org/jlamothe/passman
|
||||||
|
bug-reports: https://codeberg.org/jlamothe/passman/issues
|
||||||
|
author: Jonathan Lamothe
|
||||||
|
maintainer: jonathan@jlamothe.net
|
||||||
|
copyright: (C) 2018-2024 Jonathan Lamothe
|
||||||
|
license: LGPL-3.0-or-later
|
||||||
|
license-file: LICENSE
|
||||||
|
build-type: Simple
|
||||||
|
extra-source-files:
|
||||||
|
README.md
|
||||||
|
ChangeLog.md
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Password
|
||||||
|
Password.App
|
||||||
|
Password.App.Draw
|
||||||
|
Password.App.Event
|
||||||
|
Password.App.Types
|
||||||
|
other-modules:
|
||||||
|
Paths_passman
|
||||||
|
autogen-modules:
|
||||||
|
Paths_passman
|
||||||
|
hs-source-dirs:
|
||||||
|
src
|
||||||
|
ghc-options: -Wall
|
||||||
|
build-depends:
|
||||||
|
SHA >=1.6.4.4 && <1.7
|
||||||
|
, aeson >=2.1.2.1 && <2.2
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, base16-bytestring >=1.0.2.0 && <1.1
|
||||||
|
, base64-bytestring >=1.2.1.0 && <1.3
|
||||||
|
, brick >=2.1.1 && <2.2
|
||||||
|
, bytestring >=0.11.4.0 && <0.12
|
||||||
|
, containers >=0.6.2.1 && <0.7
|
||||||
|
, easy-file >=0.2.5 && <0.3
|
||||||
|
, microlens >=0.4.11.2 && <0.5
|
||||||
|
, microlens-mtl >=0.2.0.3 && <0.3
|
||||||
|
, microlens-th >=0.4.3.6 && <0.5
|
||||||
|
, mtl >=2.3.1 && <2.4
|
||||||
|
, random >=1.2.1.1 && <1.3
|
||||||
|
, text >=2.0.2 && <2.1
|
||||||
|
, vty ==6.1.*
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable passman
|
||||||
|
main-is: Main.hs
|
||||||
|
other-modules:
|
||||||
|
Paths_passman
|
||||||
|
autogen-modules:
|
||||||
|
Paths_passman
|
||||||
|
hs-source-dirs:
|
||||||
|
app
|
||||||
|
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
aeson >=2.1.2.1 && <2.2
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, brick >=2.1.1 && <2.2
|
||||||
|
, bytestring >=0.11.4.0 && <0.12
|
||||||
|
, containers >=0.6.2.1 && <0.7
|
||||||
|
, easy-file >=0.2.5 && <0.3
|
||||||
|
, microlens >=0.4.11.2 && <0.5
|
||||||
|
, microlens-mtl >=0.2.0.3 && <0.3
|
||||||
|
, microlens-th >=0.4.3.6 && <0.5
|
||||||
|
, mtl >=2.3.1 && <2.4
|
||||||
|
, passman
|
||||||
|
, random >=1.2.1.1 && <1.3
|
||||||
|
, vty ==6.1.*
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite passman-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Spec.hs
|
||||||
|
other-modules:
|
||||||
|
Spec.JSON
|
||||||
|
Spec.NewPWData
|
||||||
|
Spec.NewPWDatabase
|
||||||
|
Spec.NewPWPolicy
|
||||||
|
Spec.NewPWSalt
|
||||||
|
Spec.PWGenerate
|
||||||
|
Spec.PWGetService
|
||||||
|
Spec.PWHasService
|
||||||
|
Spec.PWRemoveService
|
||||||
|
Spec.PWSearch
|
||||||
|
Spec.PWSetService
|
||||||
|
Spec.ValidatePWData
|
||||||
|
Spec.ValidatePWDatabase
|
||||||
|
Spec.ValidatePWPolicy
|
||||||
|
Paths_passman
|
||||||
|
autogen-modules:
|
||||||
|
Paths_passman
|
||||||
|
hs-source-dirs:
|
||||||
|
test
|
||||||
|
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
HUnit
|
||||||
|
, aeson >=2.1.2.1 && <2.2
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, brick >=2.1.1 && <2.2
|
||||||
|
, bytestring >=0.11.4.0 && <0.12
|
||||||
|
, containers >=0.6.2.1 && <0.7
|
||||||
|
, easy-file >=0.2.5 && <0.3
|
||||||
|
, microlens >=0.4.11.2 && <0.5
|
||||||
|
, microlens-mtl >=0.2.0.3 && <0.3
|
||||||
|
, microlens-th >=0.4.3.6 && <0.5
|
||||||
|
, mtl >=2.3.1 && <2.4
|
||||||
|
, passman
|
||||||
|
, random >=1.2.1.1 && <1.3
|
||||||
|
, vty ==6.1.*
|
||||||
|
default-language: Haskell2010
|
||||||
@@ -2,9 +2,9 @@
|
|||||||
|
|
||||||
Module: Password
|
Module: Password
|
||||||
Description: a simple password manager
|
Description: a simple password manager
|
||||||
Copyright: (C) 2018 Jonathan Lamothe
|
Copyright: (C) Jonathan Lamothe
|
||||||
License: LGPLv3 (or later)
|
License: LGPLv3 (or later)
|
||||||
Maintainer: jlamothe1980@gmail.com
|
Maintainer: jonathan@jlamothe.net
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,11 +23,11 @@ License along with this program. If not, see
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Password (
|
module Password (
|
||||||
-- * Data Types
|
-- * Data Types
|
||||||
PWDatabase, PWData(..), PWPolicy (..), PWSalt,
|
PWDatabase, PWData(..), PWPolicy (..), PWSalt (..),
|
||||||
-- ** Lenses
|
-- ** Lenses
|
||||||
-- $lenses
|
-- $lenses
|
||||||
-- *** PWData
|
-- *** PWData
|
||||||
@@ -47,11 +47,9 @@ module Password (
|
|||||||
pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch
|
pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens (makeLenses, over, set, (^.))
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
( FromJSON (parseJSON)
|
( FromJSON (parseJSON)
|
||||||
, ToJSON (toJSON)
|
, ToJSON (toJSON)
|
||||||
, Value (String)
|
|
||||||
, object
|
, object
|
||||||
, withObject
|
, withObject
|
||||||
, withText
|
, withText
|
||||||
@@ -59,14 +57,18 @@ import Data.Aeson
|
|||||||
, (.=)
|
, (.=)
|
||||||
)
|
)
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as B8
|
||||||
|
import Data.ByteString.Builder (toLazyByteString, stringUtf8)
|
||||||
|
import qualified Data.ByteString.Base16.Lazy as B16
|
||||||
import qualified Data.ByteString.Base64.Lazy as B64
|
import qualified Data.ByteString.Base64.Lazy as B64
|
||||||
import Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
|
import Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
|
import Data.Either (fromRight)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import qualified Data.Text as T'
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as T
|
import Lens.Micro (over, set, to, (^.))
|
||||||
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import System.Random (RandomGen, randoms, split)
|
import System.Random (RandomGen, randoms, split)
|
||||||
|
|
||||||
-- | a mapping of service names to password data
|
-- | a mapping of service names to password data
|
||||||
@@ -96,7 +98,8 @@ data PWPolicy = PWPolicy
|
|||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
-- | the "salt" used to generate a password
|
-- | the "salt" used to generate a password
|
||||||
type PWSalt = B.ByteString
|
newtype PWSalt = PWSalt { runPWSalt :: B.ByteString }
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- $lenses The following functions are automatically generated by
|
-- $lenses The following functions are automatically generated by
|
||||||
-- @makeLenses@. See the
|
-- @makeLenses@. See the
|
||||||
@@ -119,11 +122,11 @@ instance FromJSON PWPolicy where
|
|||||||
<*> v .: "min_digits"
|
<*> v .: "min_digits"
|
||||||
<*> v .: "min_special"
|
<*> v .: "min_special"
|
||||||
|
|
||||||
instance FromJSON B.ByteString where
|
instance FromJSON PWSalt where
|
||||||
parseJSON = withText "ByteString" $ \v ->
|
parseJSON = withText "PWSalt" $ \v ->
|
||||||
case B64.decode $ encodeUtf8 $ T.pack $ T'.unpack v of
|
case B64.decode $ toUTF8 $ T.unpack v of
|
||||||
Left x -> fail x
|
Left x -> fail x
|
||||||
Right x -> return x
|
Right x -> return $ PWSalt x
|
||||||
|
|
||||||
instance ToJSON PWData where
|
instance ToJSON PWData where
|
||||||
toJSON d = object
|
toJSON d = object
|
||||||
@@ -140,8 +143,8 @@ instance ToJSON PWPolicy where
|
|||||||
, "min_special" .= (p^.pwSpecial)
|
, "min_special" .= (p^.pwSpecial)
|
||||||
]
|
]
|
||||||
|
|
||||||
instance ToJSON B.ByteString where
|
instance ToJSON PWSalt where
|
||||||
toJSON = toJSON . toB64
|
toJSON = toJSON . toB64 . runPWSalt
|
||||||
|
|
||||||
-- | default (empty) password database
|
-- | default (empty) password database
|
||||||
newPWDatabase :: PWDatabase
|
newPWDatabase :: PWDatabase
|
||||||
@@ -170,7 +173,7 @@ newPWSalt
|
|||||||
-> (PWSalt, g)
|
-> (PWSalt, g)
|
||||||
-- ^ the result and new random generator
|
-- ^ the result and new random generator
|
||||||
newPWSalt g = (result, g2) where
|
newPWSalt g = (result, g2) where
|
||||||
result = B.pack $ take 32 $ randoms g1
|
result = PWSalt $ B.pack $ take 32 $ randoms g1
|
||||||
(g1, g2) = split g
|
(g1, g2) = split g
|
||||||
|
|
||||||
-- | validates a password database
|
-- | validates a password database
|
||||||
@@ -189,7 +192,7 @@ validatePWData
|
|||||||
-- ^ @"True"@ if valid; @"False"@ otherwise
|
-- ^ @"True"@ if valid; @"False"@ otherwise
|
||||||
validatePWData x =
|
validatePWData x =
|
||||||
validatePWPolicy (x^.pwPolicy) &&
|
validatePWPolicy (x^.pwPolicy) &&
|
||||||
B.length (x^.pwSalt) > 0
|
B.length (x^.pwSalt.to runPWSalt) > 0
|
||||||
|
|
||||||
-- | validates a password policy
|
-- | validates a password policy
|
||||||
validatePWPolicy
|
validatePWPolicy
|
||||||
@@ -322,26 +325,24 @@ isSpecial :: Char -> Bool
|
|||||||
isSpecial = not . isAlphaNum
|
isSpecial = not . isAlphaNum
|
||||||
|
|
||||||
mkPass :: String -> PWPolicy -> String
|
mkPass :: String -> PWPolicy -> String
|
||||||
mkPass (x:xs) p = let p' = nextPolicy x p in
|
mkPass [] _ = "" -- this should never happen
|
||||||
if p^.pwLength <= 0
|
mkPass (x:xs) p = if p^.pwLength <= 0
|
||||||
then ""
|
then ""
|
||||||
else if validatePWPolicy p'
|
else let p' = nextPolicy x p in
|
||||||
then x : mkPass xs p'
|
if validatePWPolicy p'
|
||||||
else mkPass xs p
|
then x : mkPass xs p'
|
||||||
|
else mkPass xs p
|
||||||
|
|
||||||
mkPool :: B.ByteString -> String
|
mkPool :: B.ByteString -> String
|
||||||
mkPool = toB64 . raw where
|
mkPool = toB64 . raw where
|
||||||
raw x = let x' = mkHash x in
|
raw x = let x' = mkHash x in
|
||||||
x' `B.append` raw x
|
x' `B.append` raw x'
|
||||||
|
|
||||||
mkSeed :: String -> PWData -> B.ByteString
|
mkSeed :: String -> PWData ->B.ByteString
|
||||||
mkSeed pw d = toUTF8 pw `B.append` (d^.pwSalt)
|
mkSeed pw d = toUTF8 pw `B.append` (d^.pwSalt.to runPWSalt)
|
||||||
|
|
||||||
mkHash :: B.ByteString -> B.ByteString
|
mkHash :: B.ByteString -> B.ByteString
|
||||||
mkHash = raw . show . sha256 where
|
mkHash = fromRight "" . B16.decode . toUTF8 . show . sha256
|
||||||
raw (x:y:xs) = read ("0x" ++ [x] ++ [y]) `B.cons` raw xs
|
|
||||||
raw [_] = error "odd number of hex digits in hash"
|
|
||||||
raw "" = B.empty
|
|
||||||
|
|
||||||
nextPolicy :: Char -> PWPolicy -> PWPolicy
|
nextPolicy :: Char -> PWPolicy -> PWPolicy
|
||||||
nextPolicy x p = over pwLength pred $
|
nextPolicy x p = over pwLength pred $
|
||||||
@@ -358,15 +359,15 @@ nextPolicy x p = over pwLength pred $
|
|||||||
dec l = over l (max 0 . pred) p
|
dec l = over l (max 0 . pred) p
|
||||||
|
|
||||||
toUTF8 :: String -> B.ByteString
|
toUTF8 :: String -> B.ByteString
|
||||||
toUTF8 = encodeUtf8 . T.pack
|
toUTF8 = toLazyByteString . stringUtf8
|
||||||
|
|
||||||
toB64 :: B.ByteString -> String
|
toB64 :: B.ByteString -> String
|
||||||
toB64 = T.unpack . decodeUtf8 . B64.encode
|
toB64 = B8.unpack . B64.encode
|
||||||
|
|
||||||
contains :: String -> String -> Bool
|
contains :: String -> String -> Bool
|
||||||
_ `contains` "" = True
|
_ `contains` "" = True
|
||||||
"" `contains` _ = False
|
"" `contains` _ = False
|
||||||
xs@(x:xs') `contains` ys
|
xs@(_:xs') `contains` ys
|
||||||
| xs `startsWith` ys = True
|
| xs `startsWith` ys = True
|
||||||
| otherwise = xs' `contains` ys
|
| otherwise = xs' `contains` ys
|
||||||
|
|
||||||
|
|||||||
48
src/Password/App.hs
Normal file
48
src/Password/App.hs
Normal file
@@ -0,0 +1,48 @@
|
|||||||
|
{-|
|
||||||
|
|
||||||
|
Module: Password.App
|
||||||
|
Description: the application frontend
|
||||||
|
Copyright: (C) Jonathan Lamothe
|
||||||
|
License: LGPLv3 (or later)
|
||||||
|
Maintainer: jonathan@jlamothe.net
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU Lesser General Public License as
|
||||||
|
published by the Free Software Foundation, either version 3 of the
|
||||||
|
License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Lesser General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this program. If not, see
|
||||||
|
<https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Password.App (passmanApp) where
|
||||||
|
|
||||||
|
import Brick
|
||||||
|
( App (..)
|
||||||
|
, attrMap
|
||||||
|
, showFirstCursor
|
||||||
|
, style
|
||||||
|
)
|
||||||
|
|
||||||
|
import Password.App.Draw
|
||||||
|
import Password.App.Event
|
||||||
|
import Password.App.Types
|
||||||
|
|
||||||
|
-- | The main application
|
||||||
|
passmanApp :: App AppState () ResName
|
||||||
|
passmanApp = App
|
||||||
|
{ appDraw = drawFunc
|
||||||
|
, appChooseCursor = showFirstCursor
|
||||||
|
, appHandleEvent = eventHandler
|
||||||
|
, appStartEvent = loadDatabase
|
||||||
|
, appAttrMap = const $ attrMap (style 0) []
|
||||||
|
}
|
||||||
|
|
||||||
|
--jl
|
||||||
54
src/Password/App/Draw.hs
Normal file
54
src/Password/App/Draw.hs
Normal file
@@ -0,0 +1,54 @@
|
|||||||
|
{-|
|
||||||
|
|
||||||
|
Module: Password.App.Draw
|
||||||
|
Description: widget drawing functions
|
||||||
|
Copyright: (C) Jonathan Lamothe
|
||||||
|
License: LGPLv3 (or later)
|
||||||
|
Maintainer: jonathan@jlamothe.net
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU Lesser General Public License as
|
||||||
|
published by the Free Software Foundation, either version 3 of the
|
||||||
|
License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Lesser General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this program. If not, see
|
||||||
|
<https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Password.App.Draw (drawFunc) where
|
||||||
|
|
||||||
|
import Brick (Widget, emptyWidget, txt, vBox)
|
||||||
|
import Brick.Forms (Form, formState, renderForm)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
|
import Password.App.Types
|
||||||
|
|
||||||
|
-- | Renders the application view
|
||||||
|
drawFunc :: AppState -> [Widget ResName]
|
||||||
|
drawFunc s = maybe [emptyWidget] drawPassForm $ s^.passForm
|
||||||
|
|
||||||
|
drawPassForm :: Form (Text, Text) () ResName -> [Widget ResName]
|
||||||
|
drawPassForm f =
|
||||||
|
[ vBox
|
||||||
|
[ renderForm f
|
||||||
|
, txt $ pfText $ formState f
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
pfText :: (Text, Text) -> Text
|
||||||
|
pfText (pass, conf)
|
||||||
|
| pass == "" = "Password cannot be blank."
|
||||||
|
| pass /= conf = "Passwords do not match."
|
||||||
|
| otherwise = ""
|
||||||
|
|
||||||
|
--jl
|
||||||
106
src/Password/App/Event.hs
Normal file
106
src/Password/App/Event.hs
Normal file
@@ -0,0 +1,106 @@
|
|||||||
|
{-|
|
||||||
|
|
||||||
|
Module: Password.App.Event
|
||||||
|
Description: event handling functions
|
||||||
|
Copyright: (C) Jonathan Lamothe
|
||||||
|
License: LGPLv3 (or later)
|
||||||
|
Maintainer: jonathan@jlamothe.net
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU Lesser General Public License as
|
||||||
|
published by the Free Software Foundation, either version 3 of the
|
||||||
|
License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Lesser General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this program. If not, see
|
||||||
|
<https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase, OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Password.App.Event (eventHandler, loadDatabase) where
|
||||||
|
|
||||||
|
import Brick (BrickEvent (VtyEvent), EventM, halt)
|
||||||
|
import Brick.Forms (handleFormEvent)
|
||||||
|
import Brick.Keybindings
|
||||||
|
( Binding
|
||||||
|
, KeyDispatcher
|
||||||
|
, ctrl
|
||||||
|
, handleKey
|
||||||
|
, keyDispatcher
|
||||||
|
, keyEvents
|
||||||
|
, newKeyConfig
|
||||||
|
, onEvent
|
||||||
|
)
|
||||||
|
import Control.Monad (unless)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.State.Class (gets, put)
|
||||||
|
import Data.Aeson (decodeFileStrict)
|
||||||
|
import Graphics.Vty.Input.Events (Event (EvKey))
|
||||||
|
import Lens.Micro (each, (^.))
|
||||||
|
import Lens.Micro.Mtl (zoom)
|
||||||
|
import System.EasyFile
|
||||||
|
( createDirectoryIfMissing
|
||||||
|
, doesFileExist
|
||||||
|
, getAppUserDataDirectory
|
||||||
|
, (</>)
|
||||||
|
)
|
||||||
|
|
||||||
|
import Password.App.Types
|
||||||
|
|
||||||
|
dbFile :: String
|
||||||
|
dbFile = "database.json"
|
||||||
|
|
||||||
|
data KEventID = QuitKE deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
-- | The main event handler
|
||||||
|
eventHandler :: BrickEvent ResName () -> EventM ResName AppState ()
|
||||||
|
eventHandler e@(VtyEvent (EvKey k m)) = do
|
||||||
|
disp <- gets getKeyDispatcher
|
||||||
|
handleKey disp k m >>= flip unless (fallbackHandler e)
|
||||||
|
eventHandler e = fallbackHandler e
|
||||||
|
|
||||||
|
loadDatabase :: EventM ResName AppState ()
|
||||||
|
loadDatabase = zoom database $ liftIO
|
||||||
|
( do
|
||||||
|
dir <- mkAppDir
|
||||||
|
let fn = dir </> dbFile
|
||||||
|
doesFileExist fn >>= \case
|
||||||
|
True -> decodeFileStrict fn
|
||||||
|
False -> return Nothing
|
||||||
|
) >>= mapM_ put
|
||||||
|
|
||||||
|
fallbackHandler :: BrickEvent ResName () -> EventM ResName AppState ()
|
||||||
|
fallbackHandler e = gets (^.passForm) >>= \case
|
||||||
|
Just _ -> zoom (passForm.each) $ handleFormEvent e
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
|
getKeyDispatcher
|
||||||
|
:: AppState
|
||||||
|
-> KeyDispatcher KEventID (EventM ResName AppState)
|
||||||
|
getKeyDispatcher s = either (error "can't build dispatcher") id $
|
||||||
|
keyDispatcher conf handlers
|
||||||
|
where
|
||||||
|
conf = newKeyConfig ke bs []
|
||||||
|
ke = keyEvents []
|
||||||
|
bs = keyBindingsFor s
|
||||||
|
handlers =
|
||||||
|
[ onEvent QuitKE "Quit Application" halt
|
||||||
|
]
|
||||||
|
|
||||||
|
keyBindingsFor :: AppState -> [(KEventID, [Binding])]
|
||||||
|
keyBindingsFor = const [(QuitKE, [ctrl 'c'])]
|
||||||
|
|
||||||
|
mkAppDir :: IO FilePath
|
||||||
|
mkAppDir = do
|
||||||
|
path <- getAppUserDataDirectory "passman"
|
||||||
|
createDirectoryIfMissing True path
|
||||||
|
return path
|
||||||
|
|
||||||
|
--jl
|
||||||
89
src/Password/App/Types.hs
Normal file
89
src/Password/App/Types.hs
Normal file
@@ -0,0 +1,89 @@
|
|||||||
|
{-|
|
||||||
|
|
||||||
|
Module: Password.App.Types
|
||||||
|
Description: data types used by the application
|
||||||
|
Copyright: (C) Jonathan Lamothe
|
||||||
|
License: LGPLv3 (or later)
|
||||||
|
Maintainer: jonathan@jlamothe.net
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU Lesser General Public License as
|
||||||
|
published by the Free Software Foundation, either version 3 of the
|
||||||
|
License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Lesser General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this program. If not, see
|
||||||
|
<https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
|
||||||
|
|
||||||
|
module Password.App.Types (
|
||||||
|
-- * Types
|
||||||
|
AppState (..),
|
||||||
|
ResName (..),
|
||||||
|
-- * Lenses
|
||||||
|
-- ** AppState
|
||||||
|
randGen,
|
||||||
|
database,
|
||||||
|
mainPass,
|
||||||
|
passForm,
|
||||||
|
-- * Constructors
|
||||||
|
mkInitialState,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Brick (txt, (<+>))
|
||||||
|
import Brick.Forms (Form, editPasswordField, newForm, (@@=))
|
||||||
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Lens.Micro (_1, _2)
|
||||||
|
import Lens.Micro.TH (makeLenses)
|
||||||
|
import System.Random (StdGen, initStdGen)
|
||||||
|
|
||||||
|
import Password
|
||||||
|
|
||||||
|
-- | The application state
|
||||||
|
data AppState = AppState
|
||||||
|
{ _randGen :: StdGen
|
||||||
|
-- ^ The random number generator
|
||||||
|
, _database :: PWDatabase
|
||||||
|
-- ^ The password database
|
||||||
|
, _mainPass :: String
|
||||||
|
-- ^ The main password
|
||||||
|
, _passForm :: Maybe PassForm
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | A password form (with confirmation)
|
||||||
|
type PassForm = Form (Text, Text) () ResName
|
||||||
|
|
||||||
|
-- | Resource identifier
|
||||||
|
data ResName
|
||||||
|
= PassField
|
||||||
|
| ConfField
|
||||||
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
makeLenses ''AppState
|
||||||
|
|
||||||
|
-- | Builds an initial state
|
||||||
|
mkInitialState :: MonadIO m => m AppState
|
||||||
|
mkInitialState = AppState
|
||||||
|
<$> initStdGen
|
||||||
|
<*> return newPWDatabase
|
||||||
|
<*> return ""
|
||||||
|
<*> return (Just newPassForm)
|
||||||
|
|
||||||
|
-- | Constructs a blank password form
|
||||||
|
newPassForm :: PassForm
|
||||||
|
newPassForm = newForm
|
||||||
|
[ (txt "Master password: " <+>) @@= editPasswordField _1 PassField
|
||||||
|
, (txt "Confirm password: " <+>) @@= editPasswordField _2 ConfField
|
||||||
|
]
|
||||||
|
("", "")
|
||||||
|
|
||||||
|
--jl
|
||||||
@@ -17,7 +17,7 @@
|
|||||||
#
|
#
|
||||||
# resolver: ./custom-snapshot.yaml
|
# resolver: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver: lts-12.21
|
resolver: lts-22.33
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
# Various formats can be used as shown in the example below.
|
# Various formats can be used as shown in the example below.
|
||||||
@@ -37,8 +37,7 @@ packages:
|
|||||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||||
# using the same syntax as the packages field.
|
# using the same syntax as the packages field.
|
||||||
# (e.g., acme-missiles-0.3)
|
# (e.g., acme-missiles-0.3)
|
||||||
extra-deps:
|
# extra-deps:
|
||||||
- HCL-1.7.1@sha256:7bc617fbc9ba4b1f9c10d9b3e195042c1f031629f86d08253eec87660492d646
|
|
||||||
|
|
||||||
# Override default flag values for local packages and extra-deps
|
# Override default flag values for local packages and extra-deps
|
||||||
# flags: {}
|
# flags: {}
|
||||||
|
|||||||
12
stack.yaml.lock
Normal file
12
stack.yaml.lock
Normal file
@@ -0,0 +1,12 @@
|
|||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
|
packages: []
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
sha256: 098936027eaa1ef14e2b8eb39d9933a973894bb70a68684a1bbf00730249879b
|
||||||
|
size: 720001
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/33.yaml
|
||||||
|
original: lts-22.33
|
||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -41,11 +41,13 @@ import qualified Spec.ValidatePWData as ValidatePWData
|
|||||||
import qualified Spec.ValidatePWDatabase as ValidatePWDatabase
|
import qualified Spec.ValidatePWDatabase as ValidatePWDatabase
|
||||||
import qualified Spec.ValidatePWPolicy as ValidatePWPolicy
|
import qualified Spec.ValidatePWPolicy as ValidatePWPolicy
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
counts <- runTestTT tests
|
counts <- runTestTT tests
|
||||||
when (failures counts > 0 || errors counts > 0)
|
when (failures counts > 0 || errors counts > 0)
|
||||||
exitFailure
|
exitFailure
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestList
|
tests = TestList
|
||||||
[ NewPWDatabase.tests
|
[ NewPWDatabase.tests
|
||||||
, NewPWData.tests
|
, NewPWData.tests
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -25,31 +25,41 @@ module Spec.JSON (tests) where
|
|||||||
import Data.Aeson (eitherDecode, encode, decode)
|
import Data.Aeson (eitherDecode, encode, decode)
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "JSON" $ TestList [success, failure]
|
tests = TestLabel "JSON" $ TestList [success, failure]
|
||||||
|
|
||||||
|
success :: Test
|
||||||
success = TestLabel "succeasful encoding/decoding" $
|
success = TestLabel "succeasful encoding/decoding" $
|
||||||
eitherDecode (encode db) ~?= Right db
|
eitherDecode (encode db) ~?= Right db
|
||||||
|
|
||||||
|
failure :: Test
|
||||||
failure = TestLabel "decoding failure" $
|
failure = TestLabel "decoding failure" $
|
||||||
(decode B.empty :: Maybe PWDatabase) ~?= Nothing
|
(decode B.empty :: Maybe PWDatabase) ~?= Nothing
|
||||||
|
|
||||||
|
db :: M.Map String PWData
|
||||||
db = M.fromList
|
db = M.fromList
|
||||||
[ ( "foo", foo )
|
[ ( "foo", foo )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g' :: StdGen
|
||||||
(foo, g') = newPWData g
|
(foo, g') = newPWData g
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g'' :: StdGen
|
||||||
(bar, g'') = newPWData g'
|
(bar, g'') = newPWData g'
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g''
|
(baz, _) = newPWData g''
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,24 +22,28 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.NewPWData (tests) where
|
module Spec.NewPWData (tests) where
|
||||||
|
|
||||||
import Control.Lens ((^.))
|
import Lens.Micro ((^.))
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "newPData" $ TestList
|
tests = TestLabel "newPData" $ TestList
|
||||||
[ testSalt x
|
[ testSalt x
|
||||||
, testPolicy x
|
, testPolicy x
|
||||||
] where (x, _) = newPWData g
|
] where (x, _) = newPWData g
|
||||||
|
|
||||||
|
testSalt :: PWData -> Test
|
||||||
testSalt x = TestLabel "pwSalt" $
|
testSalt x = TestLabel "pwSalt" $
|
||||||
x^.pwSalt ~?= salt where
|
x^.pwSalt ~?= salt where
|
||||||
(salt, _) = newPWSalt g
|
(salt, _) = newPWSalt g
|
||||||
|
|
||||||
|
testPolicy :: PWData -> Test
|
||||||
testPolicy x = TestLabel "pwPolicy" $
|
testPolicy x = TestLabel "pwPolicy" $
|
||||||
x^.pwPolicy ~?= newPWPolicy
|
x^.pwPolicy ~?= newPWPolicy
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -26,6 +26,7 @@ import Test.HUnit (Test (..), (~?=))
|
|||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "newPWDatabase" $
|
tests = TestLabel "newPWDatabase" $
|
||||||
length newPWDatabase ~?= 0
|
length newPWDatabase ~?= 0
|
||||||
|
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,11 +22,12 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.NewPWPolicy (tests) where
|
module Spec.NewPWPolicy (tests) where
|
||||||
|
|
||||||
import Control.Lens ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Test.HUnit (Test(..), (~?=))
|
import Test.HUnit (Test(..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "PWPolicy" $ TestList $ map test'
|
tests = TestLabel "PWPolicy" $ TestList $ map test'
|
||||||
[ ( "pwLength", newPWPolicy^.pwLength ~?= 16 )
|
[ ( "pwLength", newPWPolicy^.pwLength ~?= 16 )
|
||||||
, ( "pwUpper", newPWPolicy^.pwUpper ~?= 0 )
|
, ( "pwUpper", newPWPolicy^.pwUpper ~?= 0 )
|
||||||
@@ -35,6 +36,7 @@ tests = TestLabel "PWPolicy" $ TestList $ map test'
|
|||||||
, ( "pwSpecial", newPWPolicy^.pwSpecial ~?= Just 0 )
|
, ( "pwSpecial", newPWPolicy^.pwSpecial ~?= Just 0 )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, Test) -> Test
|
||||||
test' (label, x) = TestLabel label x
|
test' (label, x) = TestLabel label x
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -28,6 +28,7 @@ import Test.HUnit (Test(..), assertBool, (~?=))
|
|||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "newPWSalt" $ TestList
|
tests = TestLabel "newPWSalt" $ TestList
|
||||||
[ testLength salt
|
[ testLength salt
|
||||||
, testDiff salt salt'
|
, testDiff salt salt'
|
||||||
@@ -36,9 +37,12 @@ tests = TestLabel "newPWSalt" $ TestList
|
|||||||
(salt', _) = newPWSalt g'
|
(salt', _) = newPWSalt g'
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
testLength x = TestLabel "salt length" $ B.length x ~?= 32
|
testLength :: PWSalt -> Test
|
||||||
|
testLength x = TestLabel "salt length" $
|
||||||
|
B.length (runPWSalt x) ~?= 32
|
||||||
|
|
||||||
testDiff x y = TestLabel "different generators" $ TestCase $
|
testDiff :: PWSalt -> PWSalt -> Test
|
||||||
|
testDiff x y = TestLabel "different salts" $ TestCase $
|
||||||
assertBool "salts match" $ x /= y
|
assertBool "salts match" $ x /= y
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,9 +22,9 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.PWGenerate (tests) where
|
module Spec.PWGenerate (tests) where
|
||||||
|
|
||||||
import Control.Lens (set, (^.))
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import System.Random (mkStdGen)
|
import Lens.Micro (set, (^.))
|
||||||
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
(Test (..)
|
(Test (..)
|
||||||
, assertBool
|
, assertBool
|
||||||
@@ -35,6 +35,7 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwGenerate" $ TestList
|
tests = TestLabel "pwGenerate" $ TestList
|
||||||
[ defaultData
|
[ defaultData
|
||||||
, invalidPolicy
|
, invalidPolicy
|
||||||
@@ -43,15 +44,18 @@ tests = TestLabel "pwGenerate" $ TestList
|
|||||||
, differentMaster
|
, differentMaster
|
||||||
]
|
]
|
||||||
|
|
||||||
|
defaultData :: Test
|
||||||
defaultData = TestLabel "default data" $ TestCase $
|
defaultData = TestLabel "default data" $ TestCase $
|
||||||
case pwGenerate "foo" validData of
|
case pwGenerate "foo" validData of
|
||||||
Nothing -> assertFailure "no password generated"
|
Nothing -> assertFailure "no password generated"
|
||||||
Just x -> assertEqual "incorrect password length"
|
Just x -> assertEqual "incorrect password length"
|
||||||
(validData^.pwPolicy.pwLength) (length x)
|
(validData^.pwPolicy.pwLength) (length x)
|
||||||
|
|
||||||
|
invalidPolicy :: Test
|
||||||
invalidPolicy = TestLabel "invalid policy" $
|
invalidPolicy = TestLabel "invalid policy" $
|
||||||
pwGenerate "foo" invalidPolicy' ~?= Nothing
|
pwGenerate "foo" invalidPolicy' ~?= Nothing
|
||||||
|
|
||||||
|
constraints :: Test
|
||||||
constraints = TestLabel "strict constraints" $ TestCase $
|
constraints = TestLabel "strict constraints" $ TestCase $
|
||||||
case pwGenerate "foo" constraints' of
|
case pwGenerate "foo" constraints' of
|
||||||
Nothing -> assertFailure "no password generated"
|
Nothing -> assertFailure "no password generated"
|
||||||
@@ -67,6 +71,7 @@ constraints = TestLabel "strict constraints" $ TestCase $
|
|||||||
assertEqual "incorrect number of special characters"
|
assertEqual "incorrect number of special characters"
|
||||||
(fromJust $ constraints'^.pwPolicy.pwSpecial) (pwCountSpecial x)
|
(fromJust $ constraints'^.pwPolicy.pwSpecial) (pwCountSpecial x)
|
||||||
|
|
||||||
|
noSpecial :: Test
|
||||||
noSpecial = TestLabel "no special chars" $ TestCase $
|
noSpecial = TestLabel "no special chars" $ TestCase $
|
||||||
case pwGenerate "foo" noSpecial' of
|
case pwGenerate "foo" noSpecial' of
|
||||||
Nothing -> assertFailure "no password generated"
|
Nothing -> assertFailure "no password generated"
|
||||||
@@ -75,25 +80,31 @@ noSpecial = TestLabel "no special chars" $ TestCase $
|
|||||||
(noSpecial'^.pwPolicy.pwLength) (length x)
|
(noSpecial'^.pwPolicy.pwLength) (length x)
|
||||||
assertEqual "special characters found" 0 $ pwCountSpecial x
|
assertEqual "special characters found" 0 $ pwCountSpecial x
|
||||||
|
|
||||||
|
differentMaster :: Test
|
||||||
differentMaster = TestLabel "different master passwords" $ TestCase $
|
differentMaster = TestLabel "different master passwords" $ TestCase $
|
||||||
assertBool "passwords match" $
|
assertBool "passwords match" $
|
||||||
fromJust (pwGenerate "foo" validData) /=
|
fromJust (pwGenerate "foo" validData) /=
|
||||||
fromJust (pwGenerate "bar" validData)
|
fromJust (pwGenerate "bar" validData)
|
||||||
|
|
||||||
|
validData :: PWData
|
||||||
(validData, _) = newPWData g
|
(validData, _) = newPWData g
|
||||||
|
|
||||||
|
invalidPolicy' :: PWData
|
||||||
invalidPolicy' = set (pwPolicy.pwLength) (-1) validData
|
invalidPolicy' = set (pwPolicy.pwLength) (-1) validData
|
||||||
|
|
||||||
|
constraints' :: PWData
|
||||||
constraints' = set (pwPolicy.pwUpper) 4 $
|
constraints' = set (pwPolicy.pwUpper) 4 $
|
||||||
set (pwPolicy.pwLower) 4 $
|
set (pwPolicy.pwLower) 4 $
|
||||||
set (pwPolicy.pwDigits) 4 $
|
set (pwPolicy.pwDigits) 4 $
|
||||||
set (pwPolicy.pwSpecial) (Just 4)
|
set (pwPolicy.pwSpecial) (Just 4)
|
||||||
validData
|
validData
|
||||||
|
|
||||||
|
noSpecial' :: PWData
|
||||||
noSpecial' = set (pwPolicy.pwLength) 256 $
|
noSpecial' = set (pwPolicy.pwLength) 256 $
|
||||||
set (pwPolicy.pwSpecial) Nothing
|
set (pwPolicy.pwSpecial) Nothing
|
||||||
validData
|
validData
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,35 +23,46 @@ License along with this program. If not, see
|
|||||||
module Spec.PWGetService (tests) where
|
module Spec.PWGetService (tests) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwGetService" $ TestList
|
tests = TestLabel "pwGetService" $ TestList
|
||||||
[ empty, found, notFound ]
|
[ empty, found, notFound ]
|
||||||
|
|
||||||
|
empty :: Test
|
||||||
empty = TestLabel "empty database" $
|
empty = TestLabel "empty database" $
|
||||||
pwGetService "foo" newPWDatabase ~?= Nothing
|
pwGetService "foo" newPWDatabase ~?= Nothing
|
||||||
|
|
||||||
|
found :: Test
|
||||||
found = TestLabel "service found" $
|
found = TestLabel "service found" $
|
||||||
pwGetService "foo" db ~?= Just foo
|
pwGetService "foo" db ~?= Just foo
|
||||||
|
|
||||||
|
notFound :: Test
|
||||||
notFound = TestLabel "service not found" $
|
notFound = TestLabel "service not found" $
|
||||||
pwGetService "quux" db ~?= Nothing
|
pwGetService "quux" db ~?= Nothing
|
||||||
|
|
||||||
|
db :: M.Map String PWData
|
||||||
db = M.fromList
|
db = M.fromList
|
||||||
[ ( "foo", foo )
|
[ ( "foo", foo )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g' :: StdGen
|
||||||
(foo, g') = newPWData g
|
(foo, g') = newPWData g
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g'' :: StdGen
|
||||||
(bar, g'') = newPWData g'
|
(bar, g'') = newPWData g'
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g''
|
(baz, _) = newPWData g''
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,32 +23,41 @@ License along with this program. If not, see
|
|||||||
module Spec.PWHasService (tests) where
|
module Spec.PWHasService (tests) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwHasService" $ TestList $ map test'
|
tests = TestLabel "pwHasService" $ TestList $ map test'
|
||||||
[ ( "empty database", "foo", newPWDatabase, False )
|
[ ( "empty database", "foo", newPWDatabase, False )
|
||||||
, ( "in database", "foo", db, True )
|
, ( "in database", "foo", database, True )
|
||||||
, ( "not found", "quux", db, False )
|
, ( "not found", "quux", database, False )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, String, PWDatabase, Bool) -> Test
|
||||||
test' (label, x, db, expect) = TestLabel label $
|
test' (label, x, db, expect) = TestLabel label $
|
||||||
pwHasService x db ~?= expect
|
pwHasService x db ~?= expect
|
||||||
|
|
||||||
db = M.fromList
|
database :: M.Map String PWData
|
||||||
|
database = M.fromList
|
||||||
[ ( "foo", foo )
|
[ ( "foo", foo )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g' :: StdGen
|
||||||
(foo, g') = newPWData g
|
(foo, g') = newPWData g
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g'' :: StdGen
|
||||||
(bar, g'') = newPWData g'
|
(bar, g'') = newPWData g'
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g''
|
(baz, _) = newPWData g''
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,26 +23,31 @@ License along with this program. If not, see
|
|||||||
module Spec.PWRemoveService (tests) where
|
module Spec.PWRemoveService (tests) where
|
||||||
|
|
||||||
import qualified Data.Map.Lazy as M
|
import qualified Data.Map.Lazy as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), assertBool, (~?=))
|
import Test.HUnit (Test (..), assertBool, (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwRemoveService" $ TestList
|
tests = TestLabel "pwRemoveService" $ TestList
|
||||||
[ emptyDB
|
[ emptyDB
|
||||||
, existingService
|
, existingService
|
||||||
, missingService
|
, missingService
|
||||||
]
|
]
|
||||||
|
|
||||||
|
emptyDB :: Test
|
||||||
emptyDB = TestLabel "empty database" $
|
emptyDB = TestLabel "empty database" $
|
||||||
pwRemoveService "foo" newPWDatabase ~?= newPWDatabase
|
pwRemoveService "foo" newPWDatabase ~?= newPWDatabase
|
||||||
|
|
||||||
|
existingService :: Test
|
||||||
existingService = TestLabel "existing service" $
|
existingService = TestLabel "existing service" $
|
||||||
test' "foo" ["bar", "baz"]
|
test' "foo" ["bar", "baz"]
|
||||||
|
|
||||||
|
missingService :: Test
|
||||||
missingService = TestLabel "missing service" $
|
missingService = TestLabel "missing service" $
|
||||||
test' "quux" ["foo", "bar", "baz"]
|
test' "quux" ["foo", "bar", "baz"]
|
||||||
|
|
||||||
|
test' :: String -> [String] -> Test
|
||||||
test' serv keys = let db' = pwRemoveService serv db in
|
test' serv keys = let db' = pwRemoveService serv db in
|
||||||
TestList $
|
TestList $
|
||||||
TestLabel "key count" (length keys ~?= length (M.keys db')) :
|
TestLabel "key count" (length keys ~?= length (M.keys db')) :
|
||||||
@@ -50,18 +55,25 @@ test' serv keys = let db' = pwRemoveService serv db in
|
|||||||
(\x -> TestLabel x $ TestCase $ assertBool "service missing" $ pwHasService x db')
|
(\x -> TestLabel x $ TestCase $ assertBool "service missing" $ pwHasService x db')
|
||||||
keys
|
keys
|
||||||
|
|
||||||
|
db :: M.Map String PWData
|
||||||
db = M.fromList
|
db = M.fromList
|
||||||
[ ( "foo", foo )
|
[ ( "foo", foo )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g' ::StdGen
|
||||||
(foo, g') = newPWData g
|
(foo, g') = newPWData g
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g'' :: StdGen
|
||||||
(bar, g'') = newPWData g'
|
(bar, g'') = newPWData g'
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g''
|
(baz, _) = newPWData g''
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,35 +23,44 @@ License along with this program. If not, see
|
|||||||
module Spec.PWSearch (tests) where
|
module Spec.PWSearch (tests) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), assertBool, (~?=))
|
import Test.HUnit (Test (..), assertBool, (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwSearch" $ TestList $ map test'
|
tests = TestLabel "pwSearch" $ TestList $ map test'
|
||||||
[ ( "no results", "quux", [] )
|
[ ( "no results", "quux", [] )
|
||||||
, ( "some results", "A", ["bar", "baz"] )
|
, ( "some results", "A", ["bar", "baz"] )
|
||||||
, ( "all results", "", ["foo", "bar", "baz"] )
|
, ( "all results", "", ["foo", "bar", "baz"] )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, String, [String]) -> Test
|
||||||
test' (label, str, expect) = TestLabel label $ TestList $
|
test' (label, str, expect) = TestLabel label $ TestList $
|
||||||
TestLabel "length" (length result ~?= length expect) :
|
TestLabel "length" (length result ~?= length expect) :
|
||||||
map (\x -> TestLabel ("has " ++ x) $ TestCase $
|
map (\x -> TestLabel ("has " ++ x) $ TestCase $
|
||||||
assertBool "not found" $ elem x expect) result
|
assertBool "not found" $ elem x expect) result
|
||||||
where result = pwSearch str db
|
where result = pwSearch str db
|
||||||
|
|
||||||
|
db :: M.Map String PWData
|
||||||
db = M.fromList
|
db = M.fromList
|
||||||
[ ( "foo", foo )
|
[ ( "foo", foo )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g' :: StdGen
|
||||||
(foo, g') = newPWData g
|
(foo, g') = newPWData g
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g'' :: StdGen
|
||||||
(bar, g'') = newPWData g'
|
(bar, g'') = newPWData g'
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g''
|
(baz, _) = newPWData g''
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -23,51 +23,68 @@ License along with this program. If not, see
|
|||||||
module Spec.PWSetService (tests) where
|
module Spec.PWSetService (tests) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "pwSetService" $ TestList
|
tests = TestLabel "pwSetService" $ TestList
|
||||||
[ addToEmpty, addToNonEmpty, addToExisting ]
|
[ addToEmpty, addToNonEmpty, addToExisting ]
|
||||||
|
|
||||||
|
addToEmpty :: Test
|
||||||
addToEmpty = tests' "empty database" newPWDatabase 1
|
addToEmpty = tests' "empty database" newPWDatabase 1
|
||||||
|
|
||||||
|
addToNonEmpty :: Test
|
||||||
addToNonEmpty = tests' "non-empty database" nonEmpty 3
|
addToNonEmpty = tests' "non-empty database" nonEmpty 3
|
||||||
|
|
||||||
|
addToExisting :: Test
|
||||||
addToExisting = tests' "existing database" existing 3
|
addToExisting = tests' "existing database" existing 3
|
||||||
|
|
||||||
|
tests' :: String -> PWDatabase -> Int -> Test
|
||||||
tests' label db size = TestLabel label $ TestList
|
tests' label db size = TestLabel label $ TestList
|
||||||
[ dbSize result size
|
[ dbSize result size
|
||||||
, find result
|
, find result
|
||||||
] where
|
] where
|
||||||
result = pwSetService "foo" foo db
|
result = pwSetService "foo" foo db
|
||||||
|
|
||||||
|
dbSize :: M.Map String PWData -> Int -> Test
|
||||||
dbSize db expect = TestLabel "database size" $
|
dbSize db expect = TestLabel "database size" $
|
||||||
length db ~?= expect
|
length db ~?= expect
|
||||||
|
|
||||||
|
find :: M.Map String PWData -> Test
|
||||||
find db = TestLabel "record" $
|
find db = TestLabel "record" $
|
||||||
M.lookup "foo" db ~?= Just foo
|
M.lookup "foo" db ~?= Just foo
|
||||||
|
|
||||||
|
nonEmpty :: M.Map String PWData
|
||||||
nonEmpty = M.fromList
|
nonEmpty = M.fromList
|
||||||
[ ( "bar", bar )
|
[ ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
existing :: M.Map String PWData
|
||||||
existing = M.fromList
|
existing = M.fromList
|
||||||
[ ( "foo", foo' )
|
[ ( "foo", foo' )
|
||||||
, ( "bar", bar )
|
, ( "bar", bar )
|
||||||
, ( "baz", baz )
|
, ( "baz", baz )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
foo :: PWData
|
||||||
|
g1 :: StdGen
|
||||||
(foo, g1) = newPWData g
|
(foo, g1) = newPWData g
|
||||||
|
|
||||||
|
foo' :: PWData
|
||||||
|
g2 :: StdGen
|
||||||
(foo', g2) = newPWData g1
|
(foo', g2) = newPWData g1
|
||||||
|
|
||||||
|
bar :: PWData
|
||||||
|
g3 :: StdGen
|
||||||
(bar, g3) = newPWData g2
|
(bar, g3) = newPWData g2
|
||||||
|
|
||||||
|
baz :: PWData
|
||||||
(baz, _) = newPWData g3
|
(baz, _) = newPWData g3
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,28 +22,34 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.ValidatePWData (tests) where
|
module Spec.ValidatePWData (tests) where
|
||||||
|
|
||||||
import Control.Lens (set)
|
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
import System.Random (mkStdGen)
|
import Lens.Micro (set)
|
||||||
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "validatePWData" $ TestList $ map test'
|
tests = TestLabel "validatePWData" $ TestList $ map test'
|
||||||
[ ( "valid", new, True )
|
[ ( "valid", new, True )
|
||||||
, ( "invalid policy", invalidPolicy, False )
|
, ( "invalid policy", invalidPolicy, False )
|
||||||
, ( "invalid salt", invalidSalt, False )
|
, ( "invalid salt", invalidSalt, False )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, PWData, Bool) -> Test
|
||||||
test' (label, x, expect) = TestLabel label $
|
test' (label, x, expect) = TestLabel label $
|
||||||
validatePWData x ~?= expect
|
validatePWData x ~?= expect
|
||||||
|
|
||||||
|
new :: PWData
|
||||||
(new, _) = newPWData g
|
(new, _) = newPWData g
|
||||||
|
|
||||||
|
invalidPolicy :: PWData
|
||||||
invalidPolicy = set (pwPolicy.pwLength) (-1) new
|
invalidPolicy = set (pwPolicy.pwLength) (-1) new
|
||||||
|
|
||||||
invalidSalt = set pwSalt B.empty new
|
invalidSalt :: PWData
|
||||||
|
invalidSalt = set pwSalt (PWSalt B.empty) new
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,13 +22,14 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.ValidatePWDatabase (tests) where
|
module Spec.ValidatePWDatabase (tests) where
|
||||||
|
|
||||||
import Control.Lens (set)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Random (mkStdGen)
|
import Lens.Micro (set)
|
||||||
|
import System.Random (mkStdGen, StdGen)
|
||||||
import Test.HUnit (Test (..), (~?=))
|
import Test.HUnit (Test (..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "validatePWDatabase" $ TestList $ map test'
|
tests = TestLabel "validatePWDatabase" $ TestList $ map test'
|
||||||
[ ( "empty", newPWDatabase, True )
|
[ ( "empty", newPWDatabase, True )
|
||||||
, ( "valid", validDB, True )
|
, ( "valid", validDB, True )
|
||||||
@@ -36,19 +37,26 @@ tests = TestLabel "validatePWDatabase" $ TestList $ map test'
|
|||||||
, ( "bar invalid", barInvalid, False )
|
, ( "bar invalid", barInvalid, False )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, PWDatabase, Bool) -> Test
|
||||||
test' (label, x, expect) = TestLabel label $
|
test' (label, x, expect) = TestLabel label $
|
||||||
validatePWDatabase x ~?= expect
|
validatePWDatabase x ~?= expect
|
||||||
|
|
||||||
|
validDB :: M.Map String PWData
|
||||||
validDB = M.fromList [("foo", validData), ("bar", validData)]
|
validDB = M.fromList [("foo", validData), ("bar", validData)]
|
||||||
|
|
||||||
|
fooInvalid :: M.Map String PWData
|
||||||
fooInvalid = M.insert "foo" invalidData validDB
|
fooInvalid = M.insert "foo" invalidData validDB
|
||||||
|
|
||||||
|
barInvalid :: M.Map String PWData
|
||||||
barInvalid = M.insert "bar" invalidData validDB
|
barInvalid = M.insert "bar" invalidData validDB
|
||||||
|
|
||||||
|
validData :: PWData
|
||||||
(validData, _) = newPWData g
|
(validData, _) = newPWData g
|
||||||
|
|
||||||
|
invalidData :: PWData
|
||||||
invalidData = set (pwPolicy.pwLength) (-1) validData
|
invalidData = set (pwPolicy.pwLength) (-1) validData
|
||||||
|
|
||||||
|
g :: StdGen
|
||||||
g = mkStdGen 1
|
g = mkStdGen 1
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018 Jonathan Lamothe
|
Copyright (C) Jonathan Lamothe
|
||||||
<jlamothe1980@gmail.com>
|
<jonathan@jlamothe.net>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU Lesser General Public License as
|
it under the terms of the GNU Lesser General Public License as
|
||||||
@@ -22,11 +22,12 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
module Spec.ValidatePWPolicy (tests) where
|
module Spec.ValidatePWPolicy (tests) where
|
||||||
|
|
||||||
import Control.Lens (set)
|
import Lens.Micro (set)
|
||||||
import Test.HUnit (Test(..), (~?=))
|
import Test.HUnit (Test(..), (~?=))
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|
||||||
|
tests :: Test
|
||||||
tests = TestLabel "validatePWPolicy" $ TestList $ map test'
|
tests = TestLabel "validatePWPolicy" $ TestList $ map test'
|
||||||
[ ( "default", id, True )
|
[ ( "default", id, True )
|
||||||
, ( "no special chars", set pwSpecial Nothing, True )
|
, ( "no special chars", set pwSpecial Nothing, True )
|
||||||
@@ -45,18 +46,24 @@ tests = TestLabel "validatePWPolicy" $ TestList $ map test'
|
|||||||
, ( "negative special", set pwSpecial (Just (-1)), False )
|
, ( "negative special", set pwSpecial (Just (-1)), False )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
test' :: (String, PWPolicy -> PWPolicy, Bool) -> Test
|
||||||
test' (label, f, expect) = TestLabel label $
|
test' (label, f, expect) = TestLabel label $
|
||||||
validatePWPolicy x ~?= expect where
|
validatePWPolicy x ~?= expect where
|
||||||
x = f newPWPolicy
|
x = f newPWPolicy
|
||||||
|
|
||||||
|
validMins :: PWPolicy -> PWPolicy
|
||||||
validMins = setAll 1
|
validMins = setAll 1
|
||||||
|
|
||||||
|
excessive :: PWPolicy -> PWPolicy
|
||||||
excessive = setAll 5
|
excessive = setAll 5
|
||||||
|
|
||||||
|
shortValid :: PWPolicy -> PWPolicy
|
||||||
shortValid = set pwLength 8 . setAll 2
|
shortValid = set pwLength 8 . setAll 2
|
||||||
|
|
||||||
|
shortInvalid :: PWPolicy -> PWPolicy
|
||||||
shortInvalid = set pwLength 8 . set pwUpper 9
|
shortInvalid = set pwLength 8 . set pwUpper 9
|
||||||
|
|
||||||
|
setAll :: Int -> PWPolicy -> PWPolicy
|
||||||
setAll x = set pwUpper x .
|
setAll x = set pwUpper x .
|
||||||
set pwLower x .
|
set pwLower x .
|
||||||
set pwDigits x .
|
set pwDigits x .
|
||||||
|
|||||||
Reference in New Issue
Block a user