fixed pedantic warnings and hlint stuff

This commit is contained in:
Jonathan Lamothe 2020-02-28 01:23:44 -05:00
parent b3e2121597
commit 1717f4c298
21 changed files with 179 additions and 53 deletions

View File

@ -29,8 +29,6 @@ import System.Console.HCL (Request, reqFail, reqIO, runRequest)
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import System.Random (getStdGen) import System.Random (getStdGen)
import Password
import Types import Types
import UI import UI
import Util import Util

View File

@ -22,12 +22,10 @@ License along with this program. If not, see
module UI (getMasterPass, mainMenu) where module UI (getMasterPass, mainMenu) where
import Control.Applicative ((<|>))
import Control.Lens (over, set, view, (^.)) 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 System.Console.HCL import System.Console.HCL
( Request ( Request
, prompt , prompt
@ -39,7 +37,6 @@ import System.Console.HCL
, reqPassword , reqPassword
, reqResp , reqResp
, required , required
, runRequest
) )
import Password import Password
@ -215,19 +212,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 +235,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

@ -38,14 +38,13 @@ 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 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 +78,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 +106,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

@ -27,6 +27,9 @@ dependencies:
- lens - lens
- random - random
ghc-options:
- -Wall
library: library:
source-dirs: src source-dirs: src
dependencies: dependencies:

View File

@ -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,10 @@ module Password (
pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch pwHasService, pwSetService, pwGetService, pwRemoveService, pwSearch
) where ) where
import Control.Lens (makeLenses, over, set, (^.)) import Control.Lens (makeLenses, over, set, to, (^.))
import Data.Aeson import Data.Aeson
( FromJSON (parseJSON) ( FromJSON (parseJSON)
, ToJSON (toJSON) , ToJSON (toJSON)
, Value (String)
, object , object
, withObject , withObject
, withText , withText
@ -97,7 +96,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 +120,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 $ toUTF8 $ 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 +141,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 +171,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 +190,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,8 +336,8 @@ 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 . toUTF8 . show . sha256 mkHash = fst . B16.decode . toUTF8 . show . sha256
@ -365,7 +365,7 @@ 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

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.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

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

@ -23,23 +23,27 @@ License along with this program. If not, see
module Spec.NewPWData (tests) where module Spec.NewPWData (tests) where
import Control.Lens ((^.)) import Control.Lens ((^.))
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

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

@ -27,6 +27,7 @@ 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

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

@ -24,7 +24,7 @@ module Spec.PWGenerate (tests) where
import Control.Lens (set, (^.)) import Control.Lens (set, (^.))
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import System.Random (mkStdGen) 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

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

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

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

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

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

@ -24,26 +24,32 @@ module Spec.ValidatePWData (tests) where
import Control.Lens (set) import Control.Lens (set)
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
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 "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

@ -24,11 +24,12 @@ module Spec.ValidatePWDatabase (tests) where
import Control.Lens (set) import Control.Lens (set)
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 "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

@ -27,6 +27,7 @@ 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 .