47 Commits

Author SHA1 Message Date
41278e81a9 simplified application state 2024-09-12 20:57:51 -04:00
8bddf35a1a generate passord form error message 2024-09-12 20:09:13 -04:00
b0487d4d03 created post-initialization state 2024-09-12 19:47:33 -04:00
233a559aaf Don't crash if the database doesn't exist 2024-09-10 20:12:46 -04:00
86278db578 load database on start 2024-09-10 20:00:24 -04:00
a872fcfd6c added password database to AppState 2024-09-10 19:03:19 -04:00
d049c40b7a handle events for password entry form 2024-09-07 20:41:43 -04:00
ffce0d6a1c render the master password form 2024-09-07 18:30:25 -04:00
2b427789d2 defined data structure for master password form 2024-09-07 16:57:20 -04:00
a3f405d9c5 make lenses for AppState 2024-09-07 15:40:46 -04:00
76d2600fcf initialize random number generator 2024-09-07 15:40:46 -04:00
11870423ed use brick 2024-09-07 15:00:17 -04:00
4b057272d3 updated copyright to reflect current year 2024-09-07 14:43:22 -04:00
3e661e3b24 use LTS 22.33 2024-09-07 14:36:48 -04:00
f65a478fb5 stripped out frontend 2024-09-07 14:26:15 -04:00
85920c26a0 minor refactor to app/Util.hs to make hlint happy 2023-05-04 14:47:20 -04:00
8be90e9822 add blank line before prompting for service name to search for 2023-05-04 14:24:55 -04:00
bb85081380 removed copyright years from individual source files
it remains intact in the README.md and package.yml files
2023-05-02 19:40:22 -04:00
f423d202ce fixed installation instructions 2023-05-02 17:45:48 -04:00
82f2c6c5fb version 0.3.1.1 2023-05-02 17:29:31 -04:00
d7da4b2924 use LTS 20.19 resolver 2023-05-02 17:27:58 -04:00
0267ce8792 removed GitHub references 2023-05-02 16:48:44 -04:00
d0d80223f7 added bug reports link 2021-11-14 03:47:53 -05:00
180af04891 updated description
The old one still pointed to GitHub.
2021-11-13 23:54:06 -05:00
a048e0ad8b moved priject to codeberg 2021-11-13 23:50:08 -05:00
d3a54f19b9 updated cabal file 2021-10-25 15:51:19 -04:00
b9d52070f1 version 0.3.1 2021-05-14 13:55:01 -04:00
6585d63385 allow user to specify temporary alternate master password 2021-05-14 13:46:52 -04:00
258ebf29fe max version for transformers package
...because I'm an idiot.
2021-05-09 14:41:20 -04:00
1d6fbb5f40 version 0.3.0.2
more dependency versions
2021-05-09 13:36:27 -04:00
08d2827613 version 0.3.0.1
- updated to latest lts
- specified dependency versions
2021-05-09 12:57:38 -04:00
4ac3d37913 version 0.3.0 2021-01-05 21:26:12 -05:00
4be38eb87a updated ChangeLog 2021-01-05 21:25:29 -05:00
807e09a5ae switched from lens package to microlens 2021-01-05 21:22:41 -05:00
c5cdde8f73 removed unnecessary import 2021-01-05 21:22:05 -05:00
d87ccc4346 updated copyright
modified in 2021
2021-01-05 21:08:41 -05:00
2d70a9e284 updated to more recent snapshot 2021-01-05 10:28:18 -05:00
97a5ff4c92 updated email address 2020-12-14 22:41:24 -05:00
df5f0a4334 updated copyright 2020-12-14 22:10:14 -05:00
Jonathan Lamothe
ae9a43519e version 0.2.1 2020-03-20 20:29:37 -04:00
Jonathan Lamothe
a615538d96 confirm master password before creating new service 2020-03-20 20:20:59 -04:00
Jonathan Lamothe
927ce27865 swap items 1 & 2 in main menu 2020-03-20 17:36:04 -04:00
Jonathan Lamothe
c8412a6d3b updated change log 2020-03-20 17:29:09 -04:00
Jonathan Lamothe
ef663b39b0 don't store database file in home directory
Instead of being stored in ~/.passman.json, it will be stored in
~/.passman/database.json on *NIX and as database.json in the app data
directory on Windows
2020-03-20 17:24:14 -04:00
Jonathan Lamothe
645142aa8f import easy-package 2020-02-28 01:55:23 -05:00
Jonathan Lamothe
1717f4c298 fixed pedantic warnings and hlint stuff 2020-02-28 01:23:44 -05:00
Jonathan Lamothe
b3e2121597 refactoring 2019-01-02 13:38:29 -05:00
31 changed files with 699 additions and 582 deletions

1
.gitignore vendored
View File

@@ -1,3 +1,2 @@
.stack-work/ .stack-work/
passman.cabal
*~ *~

View File

@@ -1,5 +1,40 @@
# Changelog for passman # Changelog for passman
## 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 ## 0.2
- implemented manual saving - implemented manual saving

View File

@@ -1,7 +1,7 @@
# passman # passman
Copyright (C) 2018, 2019 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 enter 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,52 +0,0 @@
{-
passman
Copyright (C) 2018, 2019 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

256
app/UI.hs
View File

@@ -1,256 +0,0 @@
{-
passman
Copyright (C) 2018, 2019 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 )
, ( "save manually", save >> mainMenu )
, ( "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
req (confirm $
"\nWARNING: Changing your master password will change all of your saved passwords.\n" ++
"Are you sure you would like to proceed?") >>= flip when
(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

View File

@@ -1,122 +0,0 @@
{-
passman
Copyright (C) 2018, 2019 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

View File

@@ -1,10 +1,11 @@
name: passman name: passman
version: 0.2 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, 2019 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,23 +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:
- base16-bytestring - base16-bytestring >= 1.0.2.0 && < 1.1
- base64-bytestring - base64-bytestring >= 1.2.1.0 && < 1.3
- SHA - SHA >= 1.6.4.4 && < 1.7
- text - text >= 2.0.2 && < 2.1
executables: executables:
passman: passman:
@@ -45,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
View 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

View File

@@ -2,9 +2,9 @@
Module: Password Module: Password
Description: a simple password manager Description: a simple password manager
Copyright: (C) 2018, 2019 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
@@ -27,7 +27,7 @@ License along with this program. If not, see
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,15 +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.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
@@ -97,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
@@ -120,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
@@ -141,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
@@ -171,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
@@ -190,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
@@ -336,11 +338,11 @@ 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 = fst . B16.decode . encodeUtf8 . T.pack . show . sha256 mkHash = fromRight "" . B16.decode . toUTF8 . show . sha256
nextPolicy :: Char -> PWPolicy -> PWPolicy nextPolicy :: Char -> PWPolicy -> PWPolicy
nextPolicy x p = over pwLength pred $ nextPolicy x p = over pwLength pred $
@@ -357,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
View 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
View 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
View 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
View 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

View File

@@ -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
View 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018, 2019 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 .