From 1717f4c29891e4b0d65369b445a80878faf09f73 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 28 Feb 2020 01:23:44 -0500 Subject: [PATCH] fixed pedantic warnings and hlint stuff --- app/Main.hs | 2 -- app/UI.hs | 24 +++++++++++------------- app/Util.hs | 11 +++-------- package.yaml | 3 +++ src/Password.hs | 28 ++++++++++++++-------------- stack.yaml.lock | 19 +++++++++++++++++++ test/Spec.hs | 2 ++ test/Spec/JSON.hs | 12 +++++++++++- test/Spec/NewPWData.hs | 6 +++++- test/Spec/NewPWDatabase.hs | 1 + test/Spec/NewPWPolicy.hs | 2 ++ test/Spec/NewPWSalt.hs | 8 ++++++-- test/Spec/PWGenerate.hs | 13 ++++++++++++- test/Spec/PWGetService.hs | 13 ++++++++++++- test/Spec/PWHasService.hs | 17 +++++++++++++---- test/Spec/PWRemoveService.hs | 14 +++++++++++++- test/Spec/PWSearch.hs | 11 ++++++++++- test/Spec/PWSetService.hs | 19 ++++++++++++++++++- test/Spec/ValidatePWData.hs | 10 ++++++++-- test/Spec/ValidatePWDatabase.hs | 10 +++++++++- test/Spec/ValidatePWPolicy.hs | 7 +++++++ 21 files changed, 179 insertions(+), 53 deletions(-) create mode 100644 stack.yaml.lock diff --git a/app/Main.hs b/app/Main.hs index e77e3df..dc3b322 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -29,8 +29,6 @@ import System.Console.HCL (Request, reqFail, reqIO, runRequest) import System.Environment (lookupEnv) import System.Random (getStdGen) -import Password - import Types import UI import Util diff --git a/app/UI.hs b/app/UI.hs index d38b463..f1fbeae 100644 --- a/app/UI.hs +++ b/app/UI.hs @@ -22,12 +22,10 @@ License along with this program. If not, see 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 @@ -39,7 +37,6 @@ import System.Console.HCL , reqPassword , reqResp , required - , runRequest ) import Password @@ -215,19 +212,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 +235,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 diff --git a/app/Util.hs b/app/Util.hs index a1daa1e..3121abd 100644 --- a/app/Util.hs +++ b/app/Util.hs @@ -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 diff --git a/package.yaml b/package.yaml index d2952b4..89dbceb 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,9 @@ dependencies: - lens - random +ghc-options: +- -Wall + library: source-dirs: src dependencies: diff --git a/src/Password.hs b/src/Password.hs index a8b4fbc..4ac61e4 100644 --- a/src/Password.hs +++ b/src/Password.hs @@ -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 @@ -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 -> +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,8 +336,8 @@ 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 . toUTF8 . show . sha256 @@ -365,7 +365,7 @@ 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 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..4fc2837 --- /dev/null +++ b/stack.yaml.lock @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs index 0f2ab3b..79b2052 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 diff --git a/test/Spec/JSON.hs b/test/Spec/JSON.hs index e8e436c..5e82c49 100644 --- a/test/Spec/JSON.hs +++ b/test/Spec/JSON.hs @@ -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 diff --git a/test/Spec/NewPWData.hs b/test/Spec/NewPWData.hs index b531fcf..15af626 100644 --- a/test/Spec/NewPWData.hs +++ b/test/Spec/NewPWData.hs @@ -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 diff --git a/test/Spec/NewPWDatabase.hs b/test/Spec/NewPWDatabase.hs index c5b94f9..796f305 100644 --- a/test/Spec/NewPWDatabase.hs +++ b/test/Spec/NewPWDatabase.hs @@ -26,6 +26,7 @@ import Test.HUnit (Test (..), (~?=)) import Password +tests :: Test tests = TestLabel "newPWDatabase" $ length newPWDatabase ~?= 0 diff --git a/test/Spec/NewPWPolicy.hs b/test/Spec/NewPWPolicy.hs index f5c2e57..e41862f 100644 --- a/test/Spec/NewPWPolicy.hs +++ b/test/Spec/NewPWPolicy.hs @@ -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 diff --git a/test/Spec/NewPWSalt.hs b/test/Spec/NewPWSalt.hs index 40f8776..4064302 100644 --- a/test/Spec/NewPWSalt.hs +++ b/test/Spec/NewPWSalt.hs @@ -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 diff --git a/test/Spec/PWGenerate.hs b/test/Spec/PWGenerate.hs index 0a899da..11ff8c6 100644 --- a/test/Spec/PWGenerate.hs +++ b/test/Spec/PWGenerate.hs @@ -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 diff --git a/test/Spec/PWGetService.hs b/test/Spec/PWGetService.hs index ecb08c3..d80f94a 100644 --- a/test/Spec/PWGetService.hs +++ b/test/Spec/PWGetService.hs @@ -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 diff --git a/test/Spec/PWHasService.hs b/test/Spec/PWHasService.hs index 609a30c..a31a514 100644 --- a/test/Spec/PWHasService.hs +++ b/test/Spec/PWHasService.hs @@ -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 diff --git a/test/Spec/PWRemoveService.hs b/test/Spec/PWRemoveService.hs index bc9ac29..b779671 100644 --- a/test/Spec/PWRemoveService.hs +++ b/test/Spec/PWRemoveService.hs @@ -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 diff --git a/test/Spec/PWSearch.hs b/test/Spec/PWSearch.hs index 3578d85..444646e 100644 --- a/test/Spec/PWSearch.hs +++ b/test/Spec/PWSearch.hs @@ -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 diff --git a/test/Spec/PWSetService.hs b/test/Spec/PWSetService.hs index c1237b6..e36b75b 100644 --- a/test/Spec/PWSetService.hs +++ b/test/Spec/PWSetService.hs @@ -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 diff --git a/test/Spec/ValidatePWData.hs b/test/Spec/ValidatePWData.hs index 078750b..c2cc300 100644 --- a/test/Spec/ValidatePWData.hs +++ b/test/Spec/ValidatePWData.hs @@ -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 diff --git a/test/Spec/ValidatePWDatabase.hs b/test/Spec/ValidatePWDatabase.hs index 36878ed..fa57132 100644 --- a/test/Spec/ValidatePWDatabase.hs +++ b/test/Spec/ValidatePWDatabase.hs @@ -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 diff --git a/test/Spec/ValidatePWPolicy.hs b/test/Spec/ValidatePWPolicy.hs index 398e65b..0f93682 100644 --- a/test/Spec/ValidatePWPolicy.hs +++ b/test/Spec/ValidatePWPolicy.hs @@ -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 .