39 Commits
0.1 ... 0.3.1.1

Author SHA1 Message Date
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
Jonathan Lamothe
412c8312b0 version 0.2 2019-01-01 23:03:09 -05:00
Jonathan Lamothe
012486c045 handle empty input string in mkPass 2019-01-01 22:50:16 -05:00
Jonathan Lamothe
cdff8c8917 refactored mkHash 2019-01-01 22:45:03 -05:00
Jonathan Lamothe
f305822ae1 whitespace fix 2019-01-01 22:25:25 -05:00
Jonathan Lamothe
7cf0b34078 warn when changing master password 2019-01-01 21:15:09 -05:00
Jonathan Lamothe
191be38fbe implemented manual saving 2019-01-01 21:02:52 -05:00
Jonathan Lamothe
f2ae7bca76 fixed changelog 2019-01-01 04:57:24 -05:00
Jonathan Lamothe
3d8b41c5b6 version 0.1.1 2019-01-01 04:51:52 -05:00
Jonathan Lamothe
60f40262f7 fixed pwGenerate hanging 2019-01-01 04:48:36 -05:00
Jonathan Lamothe
32c9241a2e updated copyright 2019-01-01 04:47:42 -05:00
Jonathan Lamothe
29ca8a64bf typo 2019-01-01 04:30:12 -05:00
27 changed files with 487 additions and 191 deletions

1
.gitignore vendored
View File

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

View File

@@ -1,3 +1,42 @@
# Changelog for passman # Changelog for passman
## Unreleased changes ## 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

View File

@@ -1,7 +1,7 @@
# passman # passman
Copyright (C) 2018 Jonathan Lamothe Copyright (C) 2018-2023 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 passman` in the
terminal to install passman. terminal 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 Jonathan Lamothe Copyright (C) 2018-2021 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,15 +22,15 @@ License along with this program. If not, see
module Main where module Main where
import Control.Monad (mapM_)
import Control.Monad.Trans.State as S import Control.Monad.Trans.State as S
import Data.Maybe (maybe) import System.Console.HCL (Request, reqIO, runRequest)
import System.Console.HCL (Request, reqFail, reqIO, runRequest) import System.EasyFile
import System.Environment (lookupEnv) ( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import System.Random (getStdGen) import System.Random (getStdGen)
import Password
import Types import Types
import UI import UI
import Util import Util
@@ -47,24 +47,9 @@ setup = do
return $ Status g pw p db return $ Status g pw p db
getDBPath :: Request FilePath getDBPath :: Request FilePath
getDBPath = reqIO (lookupEnv "HOME") >>= maybe getDBPath = reqIO $ do
(do path <- getAppUserDataDirectory "passman"
reqIO $ putStrLn "ERROR: can't find home directory" createDirectoryIfMissing True path
reqFail) return $ path </> "database.json"
(\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,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018 Jonathan Lamothe Copyright (C) 2018-2021 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
@@ -24,8 +24,9 @@ License along with this program. If not, see
module Types (Status (Status), gen, dbPath, masterPass, database) where module Types (Status (Status), gen, dbPath, masterPass, database) where
import Control.Lens (makeLenses, set, (^.)) import Lens.Micro (set, (^.))
import System.Random (RandomGen (next, split), StdGen) import Lens.Micro.TH (makeLenses)
import System.Random (RandomGen (genWord64, split), StdGen)
import Password import Password
@@ -39,8 +40,8 @@ data Status = Status
makeLenses ''Status makeLenses ''Status
instance RandomGen Status where instance RandomGen Status where
next s = (x, s') where genWord64 s = (x, s') where
(x, g') = next g (x, g') = genWord64 g
s' = set gen g' s s' = set gen g' s
g = s^.gen g = s^.gen
split s = (s1, s2) where split s = (s1, s2) where

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018 Jonathan Lamothe Copyright (C) 2018-2021 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,14 +20,15 @@ License along with this program. If not, see
-} -}
{-# LANGUAGE LambdaCase #-}
module UI (getMasterPass, mainMenu) where module UI (getMasterPass, mainMenu) where
import Control.Applicative ((<|>))
import Control.Lens (over, set, view, (^.))
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.State as S
import Data.Maybe (maybe) import Lens.Micro (over, set, (^.), (.~))
import Lens.Micro.Extras (view)
import System.Console.HCL import System.Console.HCL
( Request ( Request
, prompt , prompt
@@ -60,15 +61,30 @@ getMasterPass = do
mainMenu :: S.StateT Status IO () mainMenu :: S.StateT Status IO ()
mainMenu = mainMenu =
menu "Main Menu" menu "Main Menu"
[ ( "add a password", addPassword ) [ ( "view/edit a password", viewEditMenu )
, ( "view/edit a password", viewEditMenu ) , ( "add a password", addPassword )
, ( "change master password", changeMasterPass ) , ( "change master password", changeMasterPass )
, ( "save manually", save >> mainMenu )
, ( "lock session", lockSession ) , ( "lock session", lockSession )
, ( "quit", quit ) , ( "quit", quit )
] ]
addPassword :: S.StateT Status IO () addPassword :: S.StateT Status IO ()
addPassword = do addPassword = do
pass <- S.gets (^.masterPass)
lift (runRequest $ prompt "confirm master password: " reqPassword)
>>= \case
Nothing -> mainMenu
Just chkPass
| pass == chkPass -> addPassword'
| otherwise -> do
lift $ putStrLn "Incorrect master password."
mainMenu
addPassword' :: S.StateT Status IO ()
addPassword' = do
svc <- req $ prompt "service name: " reqResp svc <- req $ prompt "service name: " reqResp
ifServExists svc ifServExists svc
(do (do
@@ -93,9 +109,13 @@ viewEditMenu = menu "View/Edit Password"
changeMasterPass :: S.StateT Status IO () changeMasterPass :: S.StateT Status IO ()
changeMasterPass = do changeMasterPass = do
oldP <- S.gets $ view masterPass req (confirm $
newP <- req $ reqDefault getMasterPass oldP "\nWARNING: Changing your master password will change all of your saved passwords.\n" ++
S.modify $ set masterPass newP "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 mainMenu
lockSession :: S.StateT Status IO () lockSession :: S.StateT Status IO ()
@@ -141,11 +161,12 @@ selectServ xs = menu "Select Service" $
servMenu :: String -> S.StateT Status IO () servMenu :: String -> S.StateT Status IO ()
servMenu x = menu x servMenu x = menu x
[ ( "show password", showPass x >> servMenu x ) [ ( "show password", showPass x >> servMenu x )
, ( "edit password", editPassMenu x ) , ( "show alternate password", showAltPass x )
, ( "remove service", removeServ x ) , ( "edit password", editPassMenu x )
, ( "rename service", renameServ x ) , ( "remove service", removeServ x )
, ( "back", mainMenu ) , ( "rename service", renameServ x )
, ( "back", mainMenu )
] ]
editPassMenu :: String -> S.StateT Status IO () editPassMenu :: String -> S.StateT Status IO ()
@@ -205,24 +226,34 @@ doEditPolicy x = withService x mainMenu $ \d -> do
editPassMenu x editPassMenu x
showPass :: String -> S.StateT Status IO () showPass :: String -> S.StateT Status IO ()
showPass x = do showPass x = withService x
(lift $ putStrLn "The service could not be found in the database.") $
\d -> do
lift $ putStrLn ""
mp <- S.gets $ view masterPass
lift $ putStrLn $ case pwGenerate mp d of
Nothing -> "The password data were not valid."
Just pw -> "password for " ++ x ++ ": " ++ pw
showAltPass :: String -> S.StateT Status IO ()
showAltPass srv = do
lift $ putStrLn "" lift $ putStrLn ""
withService x old <- S.gets $ view masterPass
(lift $ putStrLn "The service could not be found in the database.") $ Just new <- lift $ runRequest $ required $ prompt "alternate master password: " reqPassword
\d -> do S.modify $ masterPass .~ new
pw <- S.gets $ view masterPass showPass srv
lift $ putStrLn $ case pwGenerate pw d of S.modify $ masterPass .~ old
Nothing -> "The password data were not valid." servMenu srv
Just pw -> "password for " ++ x ++ ": " ++ pw
-- TODO: refactor this monstrosity -- TODO: refactor this monstrosity
editPolicy :: PWPolicy -> Request PWPolicy editPolicy :: PWPolicy -> Request PWPolicy
editPolicy p = do editPolicy policy = do
p <- edit "length" (p^.pwLength) pwLength p p <-
p <- edit "min upper case" (p^.pwUpper) pwUpper p edit "length" (policy^.pwLength) pwLength policy >>=
p <- edit "min lower case" (p^.pwLower) pwLower p edit "min upper case" (policy^.pwUpper) pwUpper >>=
p <- edit "min digits" (p^.pwDigits) pwDigits p edit "min lower case" (policy^.pwLower) pwLower >>=
p <- special p edit "min digits" (policy^.pwDigits) pwDigits >>=
special
if validatePWPolicy p if validatePWPolicy p
then return p then return p
else do else do
@@ -232,9 +263,9 @@ editPolicy p = do
reqFail reqFail
where where
edit l v t p = do edit l v t p = do
v <- reqDefault v' <- reqDefault
(prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v (prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v
return $ set t v p return $ set t v' p
special p = do special p = do
reqIO $ putStrLn $ "Special characters are currently " ++ reqIO $ putStrLn $ "Special characters are currently " ++
(case p^.pwSpecial of (case p^.pwSpecial of

View File

@@ -1,8 +1,8 @@
{- {-
passman passman
Copyright (C) 2018 Jonathan Lamothe Copyright (C) 2018-2021 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
@@ -33,19 +33,19 @@ module Util
, save , save
) where ) where
import Control.Lens (over, view)
import Control.Monad (join) import Control.Monad (join)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.State as S
import Data.Aeson (decodeFileStrict, encodeFile) import Data.Aeson (decodeFileStrict, encodeFile)
import Data.Maybe (fromJust) import Data.Maybe (fromJust, fromMaybe)
import Lens.Micro (over)
import Lens.Micro.Extras (view)
import System.Console.HCL import System.Console.HCL
( Request ( Request
, prompt , prompt
, reqAgree , reqAgree
, reqChar , reqChar
, reqDefault , reqDefault
, reqIf
, reqIO , reqIO
, reqMenu , reqMenu
, required , required
@@ -79,9 +79,7 @@ withService
-> S.StateT Status IO a -> S.StateT Status IO a
withService srv fb act = do withService srv fb act = do
db <- S.gets $ view database db <- S.gets $ view database
case pwGetService srv db of maybe fb act $ pwGetService srv db
Nothing -> fb
Just x -> act x
ifServExists ifServExists
:: String :: String
@@ -109,9 +107,7 @@ confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar
loadFrom :: FilePath -> Request PWDatabase loadFrom :: FilePath -> Request PWDatabase
loadFrom path = reqDefault loadFrom path = reqDefault
(reqIO (decodeFileStrict path)) (reqIO (decodeFileStrict path))
(Just newPWDatabase) >>= maybe (Just newPWDatabase) >>= (return . fromMaybe newPWDatabase)
(return newPWDatabase)
return
save :: S.StateT Status IO () save :: S.StateT Status IO ()
save = do save = do

View File

@@ -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-2023 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,27 @@ 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.0.3.0 && < 2.1
- 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
- random >=1.2.1.1 && < 1.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 >= 1.2.4.1 && < 1.3
executables: executables:
passman: passman:
@@ -44,8 +50,9 @@ executables:
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- passman - passman
- HCL >= 1.7.1 && < 2 - easy-file >= 0.2.2 && < 0.3
- transformers - HCL >= 1.8 && < 1.9
- transformers >= 0.5.6.2 && < 0.6
tests: tests:
passman-test: passman-test:

110
passman.cabal Normal file
View File

@@ -0,0 +1,110 @@
cabal-version: 2.2
-- This file has been generated from package.yaml by hpack version 0.35.1.
--
-- see: https://github.com/sol/hpack
--
-- hash: da6c3020622e5c4c06814752b3f3334e52925005f8b3be9516efb9fd1976af9c
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-2023 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
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.0.3.0 && <2.1
, base >=4.7 && <5
, base16-bytestring >=1.0.2.0 && <1.1
, base64-bytestring >=1.2.1.0 && <1.3
, bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7
, microlens >=0.4.11.2 && <0.5
, microlens-th >=0.4.3.6 && <0.5
, random >=1.2.1.1 && <1.3
, text >=1.2.4.1 && <1.3
default-language: Haskell2010
executable passman
main-is: Main.hs
other-modules:
Types
UI
Util
Paths_passman
autogen-modules:
Paths_passman
hs-source-dirs:
app
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends:
HCL ==1.8.*
, aeson >=2.0.3.0 && <2.1
, base >=4.7 && <5
, bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7
, easy-file >=0.2.2 && <0.3
, microlens >=0.4.11.2 && <0.5
, microlens-th >=0.4.3.6 && <0.5
, passman
, random >=1.2.1.1 && <1.3
, transformers >=0.5.6.2 && <0.6
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.0.3.0 && <2.1
, base >=4.7 && <5
, bytestring >=0.11.4.0 && <0.12
, containers >=0.6.2.1 && <0.7
, microlens >=0.4.11.2 && <0.5
, microlens-th >=0.4.3.6 && <0.5
, passman
, random >=1.2.1.1 && <1.3
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 Jonathan Lamothe Copyright: (C) 2018-2021 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

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-20.19
# 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.
@@ -38,7 +38,7 @@ packages:
# 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 - HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}

19
stack.yaml.lock Normal file
View File

@@ -0,0 +1,19 @@
# 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:
- completed:
hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
pantry-tree:
sha256: 5c93c5184dc378de5ecf235aa1a60dc24163ab7e0efad19c8f3bbc94354cf2b8
size: 1223
original:
hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
snapshots:
- completed:
sha256: 42f77c84b34f68c30c2cd0bf8c349f617a0f428264362426290847a6a2019b64
size: 649618
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
original: lts-20.19

View File

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