Compare commits
18 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 1d6fbb5f40 | |||
| 08d2827613 | |||
| 4ac3d37913 | |||
| 4be38eb87a | |||
| 807e09a5ae | |||
| c5cdde8f73 | |||
| d87ccc4346 | |||
| 2d70a9e284 | |||
| 97a5ff4c92 | |||
| df5f0a4334 | |||
|
|
ae9a43519e | ||
|
|
a615538d96 | ||
|
|
927ce27865 | ||
|
|
c8412a6d3b | ||
|
|
ef663b39b0 | ||
|
|
645142aa8f | ||
|
|
1717f4c298 | ||
|
|
b3e2121597 |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -1,3 +1,2 @@
|
|||||||
.stack-work/
|
.stack-work/
|
||||||
passman.cabal
|
|
||||||
*~
|
*~
|
||||||
20
ChangeLog.md
20
ChangeLog.md
@@ -1,5 +1,25 @@
|
|||||||
# Changelog for passman
|
# Changelog for passman
|
||||||
|
|
||||||
|
## 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
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
# passman
|
# passman
|
||||||
|
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
39
app/Main.hs
39
app/Main.hs
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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,7 +24,8 @@ 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 Lens.Micro.TH (makeLenses)
|
||||||
import System.Random (RandomGen (next, split), StdGen)
|
import System.Random (RandomGen (next, split), StdGen)
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
|
|||||||
50
app/UI.hs
50
app/UI.hs
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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,8 +61,8 @@ 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 )
|
, ( "save manually", save >> mainMenu )
|
||||||
, ( "lock session", lockSession )
|
, ( "lock session", lockSession )
|
||||||
@@ -70,6 +71,20 @@ mainMenu =
|
|||||||
|
|
||||||
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
|
||||||
@@ -215,19 +230,20 @@ showPass x = do
|
|||||||
withService x
|
withService x
|
||||||
(lift $ putStrLn "The service could not be found in the database.") $
|
(lift $ putStrLn "The service could not be found in the database.") $
|
||||||
\d -> do
|
\d -> do
|
||||||
pw <- S.gets $ view masterPass
|
mp <- S.gets $ view masterPass
|
||||||
lift $ putStrLn $ case pwGenerate pw d of
|
lift $ putStrLn $ case pwGenerate mp d of
|
||||||
Nothing -> "The password data were not valid."
|
Nothing -> "The password data were not valid."
|
||||||
Just pw -> "password for " ++ x ++ ": " ++ pw
|
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
|
||||||
@@ -237,9 +253,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
|
||||||
|
|||||||
18
app/Util.hs
18
app/Util.hs
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
33
package.yaml
33
package.yaml
@@ -1,10 +1,10 @@
|
|||||||
name: passman
|
name: passman
|
||||||
version: 0.2
|
version: 0.3.0.2
|
||||||
github: "jlamothe/passman"
|
github: "jlamothe/passman"
|
||||||
license: LGPL-3
|
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-2021 Jonathan Lamothe"
|
||||||
|
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
- README.md
|
- README.md
|
||||||
@@ -21,19 +21,23 @@ description: Please see the README on GitHub at <https://github.com/jlam
|
|||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- aeson
|
- aeson >= 1.5.6.0 && < 1.6
|
||||||
- bytestring
|
- bytestring >= 0.10.12.0 && < 0.11
|
||||||
- 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.1 && < 1.2
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
dependencies:
|
dependencies:
|
||||||
- base16-bytestring
|
- base16-bytestring >= 0.1.1.7 && < 0.2
|
||||||
- base64-bytestring
|
- base64-bytestring >= 1.1.0.0 && < 1.2
|
||||||
- SHA
|
- SHA >= 1.6.4.4 && < 1.7
|
||||||
- text
|
- text >= 1.2.4.1 && < 1.3
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
passman:
|
passman:
|
||||||
@@ -45,8 +49,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
|
||||||
|
|
||||||
tests:
|
tests:
|
||||||
passman-test:
|
passman-test:
|
||||||
|
|||||||
108
passman.cabal
Normal file
108
passman.cabal
Normal file
@@ -0,0 +1,108 @@
|
|||||||
|
cabal-version: 1.12
|
||||||
|
|
||||||
|
-- This file has been generated from package.yaml by hpack version 0.33.0.
|
||||||
|
--
|
||||||
|
-- see: https://github.com/sol/hpack
|
||||||
|
--
|
||||||
|
-- hash: 2f7f0e04b3c25e738c5538d07d22d64c28c2a586ed82d577999d070ceafc41ba
|
||||||
|
|
||||||
|
name: passman
|
||||||
|
version: 0.3.0.2
|
||||||
|
synopsis: a simple password manager
|
||||||
|
description: Please see the README on GitHub at <https://github.com/jlamothe/passman#readme>
|
||||||
|
category: Security
|
||||||
|
homepage: https://github.com/jlamothe/passman#readme
|
||||||
|
bug-reports: https://github.com/jlamothe/passman/issues
|
||||||
|
author: Jonathan Lamothe
|
||||||
|
maintainer: jonathan@jlamothe.net
|
||||||
|
copyright: (C) 2018-2021 Jonathan Lamothe
|
||||||
|
license: LGPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
build-type: Simple
|
||||||
|
extra-source-files:
|
||||||
|
README.md
|
||||||
|
ChangeLog.md
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/jlamothe/passman
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Password
|
||||||
|
other-modules:
|
||||||
|
Paths_passman
|
||||||
|
hs-source-dirs:
|
||||||
|
src
|
||||||
|
ghc-options: -Wall
|
||||||
|
build-depends:
|
||||||
|
SHA >=1.6.4.4 && <1.7
|
||||||
|
, aeson >=1.5.6.0 && <1.6
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, base16-bytestring >=0.1.1.7 && <0.2
|
||||||
|
, base64-bytestring >=1.1.0.0 && <1.2
|
||||||
|
, bytestring >=0.10.12.0 && <0.11
|
||||||
|
, containers >=0.6.2.1 && <0.7
|
||||||
|
, microlens >=0.4.11.2 && <0.5
|
||||||
|
, microlens-th >=0.4.3.6 && <0.5
|
||||||
|
, random >=1.1 && <1.2
|
||||||
|
, text >=1.2.4.1 && <1.3
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable passman
|
||||||
|
main-is: Main.hs
|
||||||
|
other-modules:
|
||||||
|
Types
|
||||||
|
UI
|
||||||
|
Util
|
||||||
|
Paths_passman
|
||||||
|
hs-source-dirs:
|
||||||
|
app
|
||||||
|
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
HCL >=1.8 && <1.9
|
||||||
|
, aeson >=1.5.6.0 && <1.6
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, bytestring >=0.10.12.0 && <0.11
|
||||||
|
, 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.1 && <1.2
|
||||||
|
, transformers >=0.5.6.2
|
||||||
|
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
|
||||||
|
hs-source-dirs:
|
||||||
|
test
|
||||||
|
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
HUnit
|
||||||
|
, aeson >=1.5.6.0 && <1.6
|
||||||
|
, base >=4.7 && <5
|
||||||
|
, bytestring >=0.10.12.0 && <0.11
|
||||||
|
, 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.1 && <1.2
|
||||||
|
default-language: Haskell2010
|
||||||
@@ -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) 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
|
||||||
@@ -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,17 @@ 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 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 +97,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 +121,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 +142,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 +172,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 +191,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 +337,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 = fst . 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 +358,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
|
||||||
|
|
||||||
|
|||||||
@@ -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-17.10
|
||||||
|
|
||||||
# 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
19
stack.yaml.lock
Normal 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:
|
||||||
|
size: 1223
|
||||||
|
sha256: 5c93c5184dc378de5ecf235aa1a60dc24163ab7e0efad19c8f3bbc94354cf2b8
|
||||||
|
original:
|
||||||
|
hackage: HCL-1.8@sha256:39ec0da0cd6157f20c395e1b0df474df45efb0088afdaab20bb9dfb3662baf7c,1726
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
size: 567241
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/10.yaml
|
||||||
|
sha256: 321b3b9f0c7f76994b39e0dabafdc76478274b4ff74cc5e43d410897a335ad3b
|
||||||
|
original: lts-17.10
|
||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
passman
|
passman
|
||||||
Copyright (C) 2018, 2019 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 .
|
||||||
|
|||||||
Reference in New Issue
Block a user