8 Commits
0.2 ... 0.2.1

Author SHA1 Message Date
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
22 changed files with 222 additions and 84 deletions

View File

@@ -1,5 +1,11 @@
# Changelog for passman
## 0.2.1
- refactoring
- store the database where Windows can find it
- confirm master password before creating new service
## 0.2
- implemented manual saving

View File

@@ -24,13 +24,14 @@ module Main where
import Control.Monad (mapM_)
import Control.Monad.Trans.State as S
import Data.Maybe (maybe)
import System.Console.HCL (Request, reqFail, reqIO, runRequest)
import System.Environment (lookupEnv)
import System.Console.HCL (Request, reqIO, runRequest)
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import System.Random (getStdGen)
import Password
import Types
import UI
import Util
@@ -47,24 +48,9 @@ setup = do
return $ Status g pw p db
getDBPath :: Request FilePath
getDBPath = reqIO (lookupEnv "HOME") >>= maybe
(do
reqIO $ putStrLn "ERROR: can't find home directory"
reqFail)
(\home -> case pathDelim home of
Nothing -> do
reqIO $ putStrLn "ERROR: unsupported home path"
reqFail
Just delim -> return $ home ++
(if last home == delim then "" else [delim]) ++
".passman.json")
pathDelim :: FilePath -> Maybe Char
pathDelim = foldr
(\x a -> case x of
'/' -> Just '/'
'\\' -> Just '\\'
_ -> a)
Nothing
getDBPath = reqIO $ do
path <- getAppUserDataDirectory "passman"
createDirectoryIfMissing True path
return $ path </> "database.json"
--jl

View File

@@ -20,14 +20,14 @@ License along with this program. If not, see
-}
{-# LANGUAGE LambdaCase #-}
module UI (getMasterPass, mainMenu) where
import Control.Applicative ((<|>))
import Control.Lens (over, set, view, (^.))
import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S
import Data.Maybe (maybe)
import System.Console.HCL
( Request
, prompt
@@ -60,8 +60,8 @@ getMasterPass = do
mainMenu :: S.StateT Status IO ()
mainMenu =
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 )
, ( "save manually", save >> mainMenu )
, ( "lock session", lockSession )
@@ -70,6 +70,20 @@ mainMenu =
addPassword :: S.StateT Status IO ()
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
ifServExists svc
(do
@@ -215,19 +229,20 @@ showPass x = do
withService x
(lift $ putStrLn "The service could not be found in the database.") $
\d -> do
pw <- S.gets $ view masterPass
lift $ putStrLn $ case pwGenerate pw d of
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
-- TODO: refactor this monstrosity
editPolicy :: PWPolicy -> Request PWPolicy
editPolicy p = do
p <- edit "length" (p^.pwLength) pwLength p
p <- edit "min upper case" (p^.pwUpper) pwUpper p
p <- edit "min lower case" (p^.pwLower) pwLower p
p <- edit "min digits" (p^.pwDigits) pwDigits p
p <- special p
editPolicy policy = do
p <-
edit "length" (policy^.pwLength) pwLength policy >>=
edit "min upper case" (policy^.pwUpper) pwUpper >>=
edit "min lower case" (policy^.pwLower) pwLower >>=
edit "min digits" (policy^.pwDigits) pwDigits >>=
special
if validatePWPolicy p
then return p
else do
@@ -237,9 +252,9 @@ editPolicy p = do
reqFail
where
edit l v t p = do
v <- reqDefault
v' <- reqDefault
(prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v
return $ set t v p
return $ set t v' p
special p = do
reqIO $ putStrLn $ "Special characters are currently " ++
(case p^.pwSpecial of

View File

@@ -38,14 +38,13 @@ import Control.Monad (join)
import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S
import Data.Aeson (decodeFileStrict, encodeFile)
import Data.Maybe (fromJust)
import Data.Maybe (fromJust, fromMaybe)
import System.Console.HCL
( Request
, prompt
, reqAgree
, reqChar
, reqDefault
, reqIf
, reqIO
, reqMenu
, required
@@ -79,9 +78,7 @@ withService
-> S.StateT Status IO a
withService srv fb act = do
db <- S.gets $ view database
case pwGetService srv db of
Nothing -> fb
Just x -> act x
maybe fb act $ pwGetService srv db
ifServExists
:: String
@@ -109,9 +106,7 @@ confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar
loadFrom :: FilePath -> Request PWDatabase
loadFrom path = reqDefault
(reqIO (decodeFileStrict path))
(Just newPWDatabase) >>= maybe
(return newPWDatabase)
return
(Just newPWDatabase) >>= (return . fromMaybe newPWDatabase)
save :: S.StateT Status IO ()
save = do

View File

@@ -1,5 +1,5 @@
name: passman
version: 0.2
version: 0.2.1
github: "jlamothe/passman"
license: LGPL-3
author: "Jonathan Lamothe"
@@ -27,6 +27,9 @@ dependencies:
- lens
- random
ghc-options:
- -Wall
library:
source-dirs: src
dependencies:
@@ -45,6 +48,7 @@ executables:
- -with-rtsopts=-N
dependencies:
- passman
- easy-file >= 0.2.2 && < 0.3
- HCL >= 1.7.1 && < 2
- transformers

View File

@@ -27,7 +27,7 @@ License along with this program. If not, see
module Password (
-- * Data Types
PWDatabase, PWData(..), PWPolicy (..), PWSalt,
PWDatabase, PWData(..), PWPolicy (..), PWSalt (..),
-- ** Lenses
-- $lenses
-- *** PWData
@@ -47,11 +47,10 @@ module Password (
pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch
) where
import Control.Lens (makeLenses, over, set, (^.))
import Control.Lens (makeLenses, over, set, to, (^.))
import Data.Aeson
( FromJSON (parseJSON)
, ToJSON (toJSON)
, Value (String)
, object
, withObject
, withText
@@ -59,15 +58,15 @@ import Data.Aeson
, (.=)
)
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 Data.Char (isUpper, isLower, isDigit, isAlphaNum, toLower)
import Data.Digest.Pure.SHA
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T'
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text as T
import System.Random (RandomGen, randoms, split)
-- | a mapping of service names to password data
@@ -97,7 +96,8 @@ data PWPolicy = PWPolicy
} deriving (Eq, Show)
-- | 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
-- @makeLenses@. See the
@@ -120,11 +120,11 @@ instance FromJSON PWPolicy where
<*> v .: "min_digits"
<*> v .: "min_special"
instance FromJSON B.ByteString where
parseJSON = withText "ByteString" $ \v ->
case B64.decode $ encodeUtf8 $ T.pack $ T'.unpack v of
instance FromJSON PWSalt where
parseJSON = withText "PWSalt" $ \v ->
case B64.decode $ toUTF8 $ T.unpack v of
Left x -> fail x
Right x -> return x
Right x -> return $ PWSalt x
instance ToJSON PWData where
toJSON d = object
@@ -141,8 +141,8 @@ instance ToJSON PWPolicy where
, "min_special" .= (p^.pwSpecial)
]
instance ToJSON B.ByteString where
toJSON = toJSON . toB64
instance ToJSON PWSalt where
toJSON = toJSON . toB64 . runPWSalt
-- | default (empty) password database
newPWDatabase :: PWDatabase
@@ -171,7 +171,7 @@ newPWSalt
-> (PWSalt, g)
-- ^ the result and new random generator
newPWSalt g = (result, g2) where
result = B.pack $ take 32 $ randoms g1
result = PWSalt $ B.pack $ take 32 $ randoms g1
(g1, g2) = split g
-- | validates a password database
@@ -190,7 +190,7 @@ validatePWData
-- ^ @"True"@ if valid; @"False"@ otherwise
validatePWData x =
validatePWPolicy (x^.pwPolicy) &&
B.length (x^.pwSalt) > 0
B.length (x^.pwSalt.to runPWSalt) > 0
-- | validates a password policy
validatePWPolicy
@@ -336,11 +336,11 @@ mkPool = toB64 . raw where
raw x = let x' = mkHash x in
x' `B.append` raw x'
mkSeed :: String -> PWData -> B.ByteString
mkSeed pw d = toUTF8 pw `B.append` (d^.pwSalt)
mkSeed :: String -> PWData ->B.ByteString
mkSeed pw d = toUTF8 pw `B.append` (d^.pwSalt.to runPWSalt)
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 x p = over pwLength pred $
@@ -357,15 +357,15 @@ nextPolicy x p = over pwLength pred $
dec l = over l (max 0 . pred) p
toUTF8 :: String -> B.ByteString
toUTF8 = encodeUtf8 . T.pack
toUTF8 = toLazyByteString . stringUtf8
toB64 :: B.ByteString -> String
toB64 = T.unpack . decodeUtf8 . B64.encode
toB64 = B8.unpack . B64.encode
contains :: String -> String -> Bool
_ `contains` "" = True
"" `contains` _ = False
xs@(x:xs') `contains` ys
xs@(_:xs') `contains` ys
| xs `startsWith` ys = True
| otherwise = xs' `contains` ys

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.7.1@sha256:7bc617fbc9ba4b1f9c10d9b3e195042c1f031629f86d08253eec87660492d646,1627
pantry-tree:
size: 1223
sha256: 5dd9d6b52e85caae6e47d8686be92873e00de14791c4e2c2753492ff288454fe
original:
hackage: HCL-1.7.1@sha256:7bc617fbc9ba4b1f9c10d9b3e195042c1f031629f86d08253eec87660492d646
snapshots:
- completed:
size: 508406
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/21.yaml
sha256: 609dd00c32f59e11bb333b9113d9d2e54269627de1268cbb3cc576af8c7b6237
original: lts-12.21

View File

@@ -41,11 +41,13 @@ import qualified Spec.ValidatePWData as ValidatePWData
import qualified Spec.ValidatePWDatabase as ValidatePWDatabase
import qualified Spec.ValidatePWPolicy as ValidatePWPolicy
main :: IO ()
main = do
counts <- runTestTT tests
when (failures counts > 0 || errors counts > 0)
exitFailure
tests :: Test
tests = TestList
[ NewPWDatabase.tests
, NewPWData.tests

View File

@@ -25,31 +25,41 @@ module Spec.JSON (tests) where
import Data.Aeson (eitherDecode, encode, decode)
import qualified Data.ByteString.Lazy as B
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "JSON" $ TestList [success, failure]
success :: Test
success = TestLabel "succeasful encoding/decoding" $
eitherDecode (encode db) ~?= Right db
failure :: Test
failure = TestLabel "decoding failure" $
(decode B.empty :: Maybe PWDatabase) ~?= Nothing
db :: M.Map String PWData
db = M.fromList
[ ( "foo", foo )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g' :: StdGen
(foo, g') = newPWData g
bar :: PWData
g'' :: StdGen
(bar, g'') = newPWData g'
baz :: PWData
(baz, _) = newPWData g''
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,23 +23,27 @@ License along with this program. If not, see
module Spec.NewPWData (tests) where
import Control.Lens ((^.))
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "newPData" $ TestList
[ testSalt x
, testPolicy x
] where (x, _) = newPWData g
testSalt :: PWData -> Test
testSalt x = TestLabel "pwSalt" $
x^.pwSalt ~?= salt where
(salt, _) = newPWSalt g
testPolicy :: PWData -> Test
testPolicy x = TestLabel "pwPolicy" $
x^.pwPolicy ~?= newPWPolicy
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -26,6 +26,7 @@ import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "newPWDatabase" $
length newPWDatabase ~?= 0

View File

@@ -27,6 +27,7 @@ import Test.HUnit (Test(..), (~?=))
import Password
tests :: Test
tests = TestLabel "PWPolicy" $ TestList $ map test'
[ ( "pwLength", newPWPolicy^.pwLength ~?= 16 )
, ( "pwUpper", newPWPolicy^.pwUpper ~?= 0 )
@@ -35,6 +36,7 @@ tests = TestLabel "PWPolicy" $ TestList $ map test'
, ( "pwSpecial", newPWPolicy^.pwSpecial ~?= Just 0 )
]
test' :: (String, Test) -> Test
test' (label, x) = TestLabel label x
--jl

View File

@@ -28,6 +28,7 @@ import Test.HUnit (Test(..), assertBool, (~?=))
import Password
tests :: Test
tests = TestLabel "newPWSalt" $ TestList
[ testLength salt
, testDiff salt salt'
@@ -36,9 +37,12 @@ tests = TestLabel "newPWSalt" $ TestList
(salt', _) = newPWSalt g'
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
--jl

View File

@@ -24,7 +24,7 @@ module Spec.PWGenerate (tests) where
import Control.Lens (set, (^.))
import Data.Maybe (fromJust)
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit
(Test (..)
, assertBool
@@ -35,6 +35,7 @@ import Test.HUnit
import Password
tests :: Test
tests = TestLabel "pwGenerate" $ TestList
[ defaultData
, invalidPolicy
@@ -43,15 +44,18 @@ tests = TestLabel "pwGenerate" $ TestList
, differentMaster
]
defaultData :: Test
defaultData = TestLabel "default data" $ TestCase $
case pwGenerate "foo" validData of
Nothing -> assertFailure "no password generated"
Just x -> assertEqual "incorrect password length"
(validData^.pwPolicy.pwLength) (length x)
invalidPolicy :: Test
invalidPolicy = TestLabel "invalid policy" $
pwGenerate "foo" invalidPolicy' ~?= Nothing
constraints :: Test
constraints = TestLabel "strict constraints" $ TestCase $
case pwGenerate "foo" constraints' of
Nothing -> assertFailure "no password generated"
@@ -67,6 +71,7 @@ constraints = TestLabel "strict constraints" $ TestCase $
assertEqual "incorrect number of special characters"
(fromJust $ constraints'^.pwPolicy.pwSpecial) (pwCountSpecial x)
noSpecial :: Test
noSpecial = TestLabel "no special chars" $ TestCase $
case pwGenerate "foo" noSpecial' of
Nothing -> assertFailure "no password generated"
@@ -75,25 +80,31 @@ noSpecial = TestLabel "no special chars" $ TestCase $
(noSpecial'^.pwPolicy.pwLength) (length x)
assertEqual "special characters found" 0 $ pwCountSpecial x
differentMaster :: Test
differentMaster = TestLabel "different master passwords" $ TestCase $
assertBool "passwords match" $
fromJust (pwGenerate "foo" validData) /=
fromJust (pwGenerate "bar" validData)
validData :: PWData
(validData, _) = newPWData g
invalidPolicy' :: PWData
invalidPolicy' = set (pwPolicy.pwLength) (-1) validData
constraints' :: PWData
constraints' = set (pwPolicy.pwUpper) 4 $
set (pwPolicy.pwLower) 4 $
set (pwPolicy.pwDigits) 4 $
set (pwPolicy.pwSpecial) (Just 4)
validData
noSpecial' :: PWData
noSpecial' = set (pwPolicy.pwLength) 256 $
set (pwPolicy.pwSpecial) Nothing
validData
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,35 +23,46 @@ License along with this program. If not, see
module Spec.PWGetService (tests) where
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "pwGetService" $ TestList
[ empty, found, notFound ]
empty :: Test
empty = TestLabel "empty database" $
pwGetService "foo" newPWDatabase ~?= Nothing
found :: Test
found = TestLabel "service found" $
pwGetService "foo" db ~?= Just foo
notFound :: Test
notFound = TestLabel "service not found" $
pwGetService "quux" db ~?= Nothing
db :: M.Map String PWData
db = M.fromList
[ ( "foo", foo )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g' :: StdGen
(foo, g') = newPWData g
bar :: PWData
g'' :: StdGen
(bar, g'') = newPWData g'
baz :: PWData
(baz, _) = newPWData g''
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,32 +23,41 @@ License along with this program. If not, see
module Spec.PWHasService (tests) where
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "pwHasService" $ TestList $ map test'
[ ( "empty database", "foo", newPWDatabase, False )
, ( "in database", "foo", db, True )
, ( "not found", "quux", db, False )
, ( "in database", "foo", database, True )
, ( "not found", "quux", database, False )
]
test' :: (String, String, PWDatabase, Bool) -> Test
test' (label, x, db, expect) = TestLabel label $
pwHasService x db ~?= expect
db = M.fromList
database :: M.Map String PWData
database = M.fromList
[ ( "foo", foo )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g' :: StdGen
(foo, g') = newPWData g
bar :: PWData
g'' :: StdGen
(bar, g'') = newPWData g'
baz :: PWData
(baz, _) = newPWData g''
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,26 +23,31 @@ License along with this program. If not, see
module Spec.PWRemoveService (tests) where
import qualified Data.Map.Lazy as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), assertBool, (~?=))
import Password
tests :: Test
tests = TestLabel "pwRemoveService" $ TestList
[ emptyDB
, existingService
, missingService
]
emptyDB :: Test
emptyDB = TestLabel "empty database" $
pwRemoveService "foo" newPWDatabase ~?= newPWDatabase
existingService :: Test
existingService = TestLabel "existing service" $
test' "foo" ["bar", "baz"]
missingService :: Test
missingService = TestLabel "missing service" $
test' "quux" ["foo", "bar", "baz"]
test' :: String -> [String] -> Test
test' serv keys = let db' = pwRemoveService serv db in
TestList $
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')
keys
db :: M.Map String PWData
db = M.fromList
[ ( "foo", foo )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g' ::StdGen
(foo, g') = newPWData g
bar :: PWData
g'' :: StdGen
(bar, g'') = newPWData g'
baz :: PWData
(baz, _) = newPWData g''
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,35 +23,44 @@ License along with this program. If not, see
module Spec.PWSearch (tests) where
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), assertBool, (~?=))
import Password
tests :: Test
tests = TestLabel "pwSearch" $ TestList $ map test'
[ ( "no results", "quux", [] )
, ( "some results", "A", ["bar", "baz"] )
, ( "all results", "", ["foo", "bar", "baz"] )
]
test' :: (String, String, [String]) -> Test
test' (label, str, expect) = TestLabel label $ TestList $
TestLabel "length" (length result ~?= length expect) :
map (\x -> TestLabel ("has " ++ x) $ TestCase $
assertBool "not found" $ elem x expect) result
where result = pwSearch str db
db :: M.Map String PWData
db = M.fromList
[ ( "foo", foo )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g' :: StdGen
(foo, g') = newPWData g
bar :: PWData
g'' :: StdGen
(bar, g'') = newPWData g'
baz :: PWData
(baz, _) = newPWData g''
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -23,51 +23,68 @@ License along with this program. If not, see
module Spec.PWSetService (tests) where
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "pwSetService" $ TestList
[ addToEmpty, addToNonEmpty, addToExisting ]
addToEmpty :: Test
addToEmpty = tests' "empty database" newPWDatabase 1
addToNonEmpty :: Test
addToNonEmpty = tests' "non-empty database" nonEmpty 3
addToExisting :: Test
addToExisting = tests' "existing database" existing 3
tests' :: String -> PWDatabase -> Int -> Test
tests' label db size = TestLabel label $ TestList
[ dbSize result size
, find result
] where
result = pwSetService "foo" foo db
dbSize :: M.Map String PWData -> Int -> Test
dbSize db expect = TestLabel "database size" $
length db ~?= expect
find :: M.Map String PWData -> Test
find db = TestLabel "record" $
M.lookup "foo" db ~?= Just foo
nonEmpty :: M.Map String PWData
nonEmpty = M.fromList
[ ( "bar", bar )
, ( "baz", baz )
]
existing :: M.Map String PWData
existing = M.fromList
[ ( "foo", foo' )
, ( "bar", bar )
, ( "baz", baz )
]
foo :: PWData
g1 :: StdGen
(foo, g1) = newPWData g
foo' :: PWData
g2 :: StdGen
(foo', g2) = newPWData g1
bar :: PWData
g3 :: StdGen
(bar, g3) = newPWData g2
baz :: PWData
(baz, _) = newPWData g3
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -24,26 +24,32 @@ module Spec.ValidatePWData (tests) where
import Control.Lens (set)
import qualified Data.ByteString.Lazy as B
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "validatePWData" $ TestList $ map test'
[ ( "valid", new, True )
, ( "invalid policy", invalidPolicy, False )
, ( "invalid salt", invalidSalt, False )
]
test' :: (String, PWData, Bool) -> Test
test' (label, x, expect) = TestLabel label $
validatePWData x ~?= expect
new :: PWData
(new, _) = newPWData g
invalidPolicy :: PWData
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
--jl

View File

@@ -24,11 +24,12 @@ module Spec.ValidatePWDatabase (tests) where
import Control.Lens (set)
import qualified Data.Map as M
import System.Random (mkStdGen)
import System.Random (mkStdGen, StdGen)
import Test.HUnit (Test (..), (~?=))
import Password
tests :: Test
tests = TestLabel "validatePWDatabase" $ TestList $ map test'
[ ( "empty", newPWDatabase, True )
, ( "valid", validDB, True )
@@ -36,19 +37,26 @@ tests = TestLabel "validatePWDatabase" $ TestList $ map test'
, ( "bar invalid", barInvalid, False )
]
test' :: (String, PWDatabase, Bool) -> Test
test' (label, x, expect) = TestLabel label $
validatePWDatabase x ~?= expect
validDB :: M.Map String PWData
validDB = M.fromList [("foo", validData), ("bar", validData)]
fooInvalid :: M.Map String PWData
fooInvalid = M.insert "foo" invalidData validDB
barInvalid :: M.Map String PWData
barInvalid = M.insert "bar" invalidData validDB
validData :: PWData
(validData, _) = newPWData g
invalidData :: PWData
invalidData = set (pwPolicy.pwLength) (-1) validData
g :: StdGen
g = mkStdGen 1
--jl

View File

@@ -27,6 +27,7 @@ import Test.HUnit (Test(..), (~?=))
import Password
tests :: Test
tests = TestLabel "validatePWPolicy" $ TestList $ map test'
[ ( "default", id, 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 )
]
test' :: (String, PWPolicy -> PWPolicy, Bool) -> Test
test' (label, f, expect) = TestLabel label $
validatePWPolicy x ~?= expect where
x = f newPWPolicy
validMins :: PWPolicy -> PWPolicy
validMins = setAll 1
excessive :: PWPolicy -> PWPolicy
excessive = setAll 5
shortValid :: PWPolicy -> PWPolicy
shortValid = set pwLength 8 . setAll 2
shortInvalid :: PWPolicy -> PWPolicy
shortInvalid = set pwLength 8 . set pwUpper 9
setAll :: Int -> PWPolicy -> PWPolicy
setAll x = set pwUpper x .
set pwLower x .
set pwDigits x .