fixed pedantic warnings and hlint stuff
This commit is contained in:
parent
b3e2121597
commit
1717f4c298
@ -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
|
||||||
|
24
app/UI.hs
24
app/UI.hs
@ -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
|
||||||
|
11
app/Util.hs
11
app/Util.hs
@ -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
|
||||||
|
@ -27,6 +27,9 @@ dependencies:
|
|||||||
- lens
|
- lens
|
||||||
- random
|
- random
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
dependencies:
|
dependencies:
|
||||||
|
@ -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
19
stack.yaml.lock
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- completed:
|
||||||
|
hackage: HCL-1.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
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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 .
|
||||||
|
Loading…
x
Reference in New Issue
Block a user