packages feed

passman 0.2 → 0.2.1

raw patch · 21 files changed

+205/−88 lines, 21 filesdep +easy-file

Dependencies added: easy-file

Files

ChangeLog.md view
@@ -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
app/Main.hs view
@@ -24,13 +24,14 @@  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 @@   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
app/UI.hs view
@@ -20,14 +20,14 @@  -} +{-# 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 @@ 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 @@  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 @@   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 @@       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
app/Util.hs view
@@ -38,14 +38,13 @@ 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 @@   -> 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 @@ 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
passman.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: c5c331a76842a12b6c072d80df3fe0d51970f056f11188205518ee6926790491+-- hash: 51d5ea38547ab5dc4561e0faea0947ff40e4942817ad364ff3f645b1494095ff  name:           passman-version:        0.2+version:        0.2.1 synopsis:       a simple password manager description:    Please see the README on GitHub at <https://github.com/jlamothe/passman#readme> category:       Security@@ -34,6 +34,7 @@       Paths_passman   hs-source-dirs:       src+  ghc-options: -Wall   build-depends:       SHA     , aeson@@ -56,13 +57,14 @@       Paths_passman   hs-source-dirs:       app-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       HCL >=1.7.1 && <2     , aeson     , base >=4.7 && <5     , bytestring     , containers+    , easy-file >=0.2.2 && <0.3     , lens     , passman     , random@@ -90,7 +92,7 @@       Paths_passman   hs-source-dirs:       test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       HUnit     , aeson
src/Password.hs view
@@ -27,7 +27,7 @@  module Password (   -- * Data Types-  PWDatabase, PWData(..), PWPolicy (..), PWSalt,+  PWDatabase, PWData(..), PWPolicy (..), PWSalt (..),   -- ** Lenses   -- $lenses   -- *** PWData@@ -47,11 +47,10 @@   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 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 @@   } 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 @@     <*> 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 @@     , "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 @@   -> (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 @@   -- ^ @"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 @@   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 @@     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
test/Spec.hs view
@@ -41,11 +41,13 @@ 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
test/Spec/JSON.hs view
@@ -25,31 +25,41 @@ 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
test/Spec/NewPWData.hs view
@@ -23,23 +23,27 @@ 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
test/Spec/NewPWDatabase.hs view
@@ -26,6 +26,7 @@  import Password +tests :: Test tests = TestLabel "newPWDatabase" $   length newPWDatabase ~?= 0
test/Spec/NewPWPolicy.hs view
@@ -27,6 +27,7 @@  import Password +tests :: Test tests = TestLabel "PWPolicy" $ TestList $ map test'   [ ( "pwLength",  newPWPolicy^.pwLength  ~?= 16     )   , ( "pwUpper",   newPWPolicy^.pwUpper   ~?= 0      )@@ -35,6 +36,7 @@   , ( "pwSpecial", newPWPolicy^.pwSpecial ~?= Just 0 )   ] +test' :: (String, Test) -> Test test' (label, x) = TestLabel label x  --jl
test/Spec/NewPWSalt.hs view
@@ -28,6 +28,7 @@  import Password +tests :: Test tests = TestLabel "newPWSalt" $ TestList   [ testLength salt   , testDiff salt salt'@@ -36,9 +37,12 @@     (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
test/Spec/PWGenerate.hs view
@@ -24,7 +24,7 @@  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 Password +tests :: Test tests = TestLabel "pwGenerate" $ TestList   [ defaultData   , invalidPolicy@@ -43,15 +44,18 @@   , 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 @@       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'^.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
test/Spec/PWGetService.hs view
@@ -23,35 +23,46 @@ 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
test/Spec/PWHasService.hs view
@@ -23,32 +23,41 @@ 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
test/Spec/PWRemoveService.hs view
@@ -23,26 +23,31 @@ 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 @@   (\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
test/Spec/PWSearch.hs view
@@ -23,35 +23,44 @@ 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
test/Spec/PWSetService.hs view
@@ -23,51 +23,68 @@ 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
test/Spec/ValidatePWData.hs view
@@ -24,26 +24,32 @@  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
test/Spec/ValidatePWDatabase.hs view
@@ -24,11 +24,12 @@  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 @@   , ( "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
test/Spec/ValidatePWPolicy.hs view
@@ -27,6 +27,7 @@  import Password +tests :: Test tests = TestLabel "validatePWPolicy" $ TestList $ map test'   [ ( "default",          id,                        True  )   , ( "no special chars", set pwSpecial Nothing,     True  )@@ -45,18 +46,24 @@   , ( "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 .