fixed pedantic warnings and hlint stuff
This commit is contained in:
Jonathan Lamothe
parent
b3e2121597
commit
1717f4c298
|
|
@ -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
|
||||
|
|
|
|||
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
|
||||
|
||||
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
|
||||
|
|
|
|||
11
app/Util.hs
11
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
|
||||
|
|
|
|||
|
|
@ -27,6 +27,9 @@ dependencies:
|
|||
- lens
|
||||
- random
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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.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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@ import Test.HUnit (Test (..), (~?=))
|
|||
|
||||
import Password
|
||||
|
||||
tests :: Test
|
||||
tests = TestLabel "newPWDatabase" $
|
||||
length newPWDatabase ~?= 0
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 .
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user