diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,8 +5,8 @@ ## Prerequisites In order to build or install you will need - * GHC (tested on 8.0) - * cabal-install (tested on 1.24) + * GHC (tested on 8.6.5) + * Stack (tested on 2.1.3.1) ## Installing Elocrypt is on [Hackage](https://hackage.haskell.org/package/elocrypt). Installation is as easy as: @@ -15,8 +15,8 @@ ``` Binaries are also available: - * [elocrypt-2.0.0-linux-bin.tar.gz](https://github.com/sgillespie/elocrypt/releases/download/v2.0.0/elocrypt-2.0.0-linux-bin.tar.gz) - * [elocrypt-2.0.0-windows-bin.exe](https://github.com/sgillespie/elocrypt/releases/download/v2.0.0/elocrypt-2.0.0-windows-bin.exe) + * [elocrypt-2.1.0-linux-bin.tar.gz](https://github.com/sgillespie/elocrypt/releases/download/v2.1.0/elocrypt-v2.1.0-linux-bin.tar.gz) + * [elocrypt-2.1.0-osx-bin.exe](https://github.com/sgillespie/elocrypt/releases/download/v2.1.0/elocrypt-v2.1.0-osx-bin.tar.gz) ## Running Generate a list passwords: @@ -36,8 +36,8 @@ ## Building In order to build or install you will need - * [GHC](https://www.haskell.org/ghc) (tested on 8.0) - * [Haskell Stack](https://haskellstack.org) (tested on 1.24) + * [GHC](https://www.haskell.org/ghc) (tested on 8.6.5) + * [Haskell Stack](https://haskellstack.org) (tested on 2.1.3.1) Build elocrypt: ``` diff --git a/elocrypt.cabal b/elocrypt.cabal --- a/elocrypt.cabal +++ b/elocrypt.cabal @@ -1,5 +1,5 @@ name: elocrypt -version: 2.0.1 +version: 2.1.0 synopsis: Generate easy-to-remember, hard-to-guess passwords homepage: https://www.github.com/sgillespie/elocrypt license: OtherLicense @@ -30,11 +30,13 @@ library exposed-modules: Data.Elocrypt, - Data.Elocrypt.Trigraph + Data.Elocrypt.Trigraph, + Data.Elocrypt.Utils -- other-modules: -- other-extensions: build-depends: base >=4.7 && <5, MonadRandom, + containers, random hs-source-dirs: src/lib default-language: Haskell2010 @@ -53,6 +55,7 @@ MonadRandom, proctest, QuickCheck, + containers, random, tasty, tasty-quickcheck, @@ -63,26 +66,8 @@ other-modules: Test.Elocrypt.Instances, Test.Elocrypt.QuickCheck, Test.Elocrypt.TrigraphTest, + Test.Elocrypt.UtilsTest, Test.ElocryptTest - type: exitcode-stdio-1.0 - -test-suite ui-test - build-depends: base >= 4.7 && <5, - elocrypt, - proctest, - MonadRandom, - QuickCheck, - random, - tasty, - tasty-quickcheck, - tasty-th >= 0.1.7 - default-language: Haskell2010 - hs-source-dirs: test - main-is: IntegTests.hs - other-modules: IntegTest.Elocrypt.PassphraseTest, - IntegTest.Elocrypt.PasswordTest, - Test.Elocrypt.QuickCheck, - Test.Elocrypt.Instances type: exitcode-stdio-1.0 test-suite elocrypt-lint diff --git a/src/cli/Main.hs b/src/cli/Main.hs --- a/src/cli/Main.hs +++ b/src/cli/Main.hs @@ -16,16 +16,18 @@ termLen :: Int termHeight :: Int -version = "elocrypt 2.0.1" +version = "elocrypt 2.1.0" termLen = 80 termHeight = 10 data Options = Options { optCapitals :: Bool, -- Include capital letters? + optDigits :: Bool, -- Inlcude digits? optLength :: Int, -- Size of the password(s) optMaxLength :: Int, optNumber :: Maybe Int, -- Number of passwords to generate optPassType :: PassType, -- Generate passwords or passphrases + optSpecials :: Bool, -- Include special characters? optHelp :: Bool, optVersion :: Bool } deriving (Show) @@ -38,10 +40,12 @@ defaultOptions :: Options defaultOptions = Options { optCapitals = False + , optDigits = False , optLength = 8 , optMaxLength = 10 , optNumber = Nothing , optPassType = Word + , optSpecials = False , optHelp = False , optVersion = False } @@ -54,6 +58,16 @@ (NoArg (\o -> o { optCapitals = True })) "Include at least one capital letter" , Option + ['d'] + ["digits"] + (NoArg (\o -> o { optDigits = True })) + "Include numerals" + , Option + ['s'] + ["symbols"] + (NoArg (\o -> o { optSpecials = True })) + "Include special characters" + , Option ['n'] ["number"] (ReqArg (\n o -> o { optNumber = Just (read n) }) "NUMBER") @@ -132,8 +146,12 @@ lines' = fromMaybe termHeight n getGenOptions :: Options -> GenOptions -getGenOptions Options { optCapitals = caps } = - genOptions { genCapitals = caps } +getGenOptions opts + = genOptions + { genCapitals = optCapitals opts, + genDigits = optDigits opts, + genSpecials = optSpecials opts + } usage :: String usage = usageInfo (intercalate "\n" headerLines) options diff --git a/src/lib/Data/Elocrypt.hs b/src/lib/Data/Elocrypt.hs --- a/src/lib/Data/Elocrypt.hs +++ b/src/lib/Data/Elocrypt.hs @@ -11,27 +11,37 @@ module Data.Elocrypt where import Data.Elocrypt.Trigraph +import Data.Elocrypt.Utils import Control.Monad import Control.Monad.Random hiding (next) import Data.Bool import Data.Char +import Data.List (findIndices) import Data.Maybe +import Data.Ratio import Prelude hiding (min, max) +import qualified Data.Map as M -- * Data Types -- |Options for generating passwords or passphrases. Do not use -- this constructor directly. Instead use 'genOptions' to construct -- an instance. -newtype GenOptions = GenOptions { - genCapitals :: Bool +data GenOptions = GenOptions { + genCapitals :: Bool, + genDigits :: Bool, + genSpecials :: Bool } deriving (Eq, Show) -- |Default options for generating passwords or passphrases. This is -- the preferred way to construct 'GenOptions'. genOptions :: GenOptions -genOptions = GenOptions {genCapitals = False} +genOptions = GenOptions { + genCapitals = False, + genDigits = False, + genSpecials = False +} -- * Random password generators @@ -120,8 +130,15 @@ pass <- if len > 2 then lastN (len - 2) f2' else return (take len f2') let pass' = reverse pass - if genCapitals opts then capitalizeR len pass' else return pass' + -- Apply the transformations in order, if appropriate options specified + let ms = + [(genCapitals opts, capitalizeR), + (genDigits opts, numerizeR), + (genSpecials opts, specializeR) + ] + foldM (\p f -> f len p) pass' . map snd . filter fst $ ms + -- |Plural version of mkPassword. Generate an infinite list of passwords using -- the MonadRandom m. MonadRandom is exposed here for extra control. -- @@ -220,17 +237,37 @@ -- |Randomly capitalize at least 1 character. Additional characters capitalize -- at a probability of 1/12 capitalizeR :: MonadRandom m => Int -> String -> m String -capitalizeR len s = mapM capitalize s >>= capitalize1 len - where capitalize ch = fromList [(ch, 12), (toUpper ch, 1)] +capitalizeR len s = capitalize s >>= capitalize1 len + where capitalize = updateR (return . toUpper) (1 % 12) -- |Randomly capitalize 1 character -capitalize1 - :: MonadRandom m - => Int -- ^ length - -> String -- ^ the string to capitalize - -> m String -capitalize1 len s = capitalize1' <$> getRandomR (0, len - 1) - where - capitalize1' pos = - let (prefix, ch : suffix) = splitAt (pos - 1) s - in prefix ++ (toUpper ch : suffix) +capitalize1 :: MonadRandom m => Int -> String -> m String +capitalize1 len s = getRandomR (0, len - 1) >>= capitalize1' s + where capitalize1' = update1 (return . toUpper) + +-- |Randomly numerize at least 1 character. Additional characters numerize +-- at a probability of 1/6 +numerizeR :: MonadRandom m => Int -> String -> m String +numerizeR len s = numerize s >>= numerize1 len + where numerize = updateR (uniform . toDigit) (1 % 6) + +numerize1 :: MonadRandom m => Int -> String -> m String +numerize1 len s + | null candidates = return s + | otherwise = uniform candidates >>= numerize1' s + where candidates = findIndices (`elem` M.keys numeralConversions) s + numerize1' = update1 (uniform . toDigit) + +-- |Randomly make at least 1 character a symbol. Additional characters specialize +-- at a probability of 1/4 +specializeR :: MonadRandom m => Int -> String -> m String +specialize1 :: MonadRandom m => Int -> String -> m String + +specializeR len s = specialize s >>= specialize1 len + where specialize = updateR (uniform . toSymbol) (1 % 6) + +specialize1 len s + | null candidates = return s + | otherwise = uniform candidates >>= specialize1' s + where candidates = findIndices (`elem` M.keys symbolConversions) s + specialize1' = update1 (uniform . toSymbol) diff --git a/src/lib/Data/Elocrypt/Utils.hs b/src/lib/Data/Elocrypt/Utils.hs new file mode 100644 --- /dev/null +++ b/src/lib/Data/Elocrypt/Utils.hs @@ -0,0 +1,63 @@ +module Data.Elocrypt.Utils where + +import Data.Char (isAlphaNum, isSpace) +import Data.Maybe (fromMaybe) +import Data.Ratio +import qualified Data.Map as M + +import Control.Monad.Random (MonadRandom(), fromList) + +-- |A mapping from letters to numbers that look like them +numeralConversions = M.fromList [ + ('o', ['0']), + ('l', ['1']), + ('z', ['2']), + ('e', ['3']), + ('a', ['4']), + ('s', ['5']), + ('g', ['6', '9']), + ('t', ['7']), + ('b', ['8'])] + +-- |A mapping from letters to symbols that look like them +symbolConversions = M.fromList [ + ('a', ['@']), + ('l', ['!']), + ('s', ['$'])] + +-- |Map a letter to one or more digits, if possible +toDigit :: Char -> String +toDigit c = fromMaybe [c] (numeralConversions M.!? c) + +-- |Map a letter to one or more symbols, if possible +toSymbol :: Char -> String +toSymbol c = fromMaybe [c] (symbolConversions M.!? c) + +-- |Selects special characters +isSymbol :: Char -> Bool +isSymbol c = not (isAlphaNum c || isSpace c) + +-- |Randomly update characters at the specified probability +updateR + :: MonadRandom m + => (Char -> m Char) + -> Rational + -> String + -> m String +updateR f prob = mapM f' + where f' ch = do + ch' <- f ch + fromList [ + (ch, toRational $ denominator prob), + (ch', toRational $ numerator prob)] + +-- |Update character at position pos +update1 + :: Monad m + => (Char -> m Char) -- ^ Update function + -> String -- ^ the string to update + -> Int -- ^ the position to update + -> m String +update1 _ "" _ = return "" +update1 f s pos = (\ch' -> prefix ++ ch' : suffix) <$> f ch + where (prefix, ch : suffix) = splitAt pos s diff --git a/test/IntegTest/Elocrypt/PassphraseTest.hs b/test/IntegTest/Elocrypt/PassphraseTest.hs deleted file mode 100644 --- a/test/IntegTest/Elocrypt/PassphraseTest.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module IntegTest.Elocrypt.PassphraseTest where - -import Control.Monad -import Data.Bool -import Data.Char -import Data.List -import Data.Maybe - -import Test.QuickCheck -import Test.Tasty hiding (Timeout) -import Test.Tasty.QuickCheck (testProperty) -import Test.Tasty.TH -import qualified Test.Proctest as Proctest - -import Test.Elocrypt.QuickCheck - -tests :: TestTree -tests = $(testGroupGenerator) - -elocrypt = "elocrypt" - --- |Passphrases consist of words in specified length range -prop_printsWordsWithLengthRange :: PhraseCliOptions -> Property -prop_printsWordsWithLengthRange (PhraseCliOptions opts) - = isJust minLen && isJust maxLen && fromJust maxLen <= 79 ==> - ioProperty $ do - (_, out, _, _) <- run opts - response <- readHandle out - - let words' = words response - minLen' = fromJust minLen - maxLen' = fromJust maxLen - - return (all ((\n -> n >= minLen' && n <= maxLen') . length) words') - - where CliOptions{cliLength=minLen, cliMaxLength=maxLen} = opts - --- |Passphrases consist of words with specified minimum range -prop_printsWordsWithMinLength:: PhraseCliOptions -> Property -prop_printsWordsWithMinLength(PhraseCliOptions opts) - = isJust minLen && fromJust minLen <= 79 ==> - ioProperty $ do - (_, out, _, _) <- run opts - response <- readHandle out - - return . all ((>= min (fromJust minLen) 10) . length) . words $ response - - where CliOptions{cliLength=minLen} = opts - --- |Prints the specificed number of phrases -prop_printsSpecifiedNumberOfPassphrases :: PhraseCliOptions -> Property -prop_printsSpecifiedNumberOfPassphrases (PhraseCliOptions opts) - = isJust number && - (isJust maxLen || isNothing len) && -- maxLen > len - maybe True (< 79) maxLen ==> -- minLen/maxLen < 79 - - ioProperty $ do - - (_, out, _, _) <- run opts - response <- readHandle out - - let phrases = lines response - - return $ counterexample (failMsg phrases) - (fromJust number == length phrases) - - where CliOptions{cliNumber=number, cliLength=len, cliMaxLength=maxLen} = opts - failMsg p = "length phrases (" ++ show (length p) ++ - ") /= " ++ show (fromJust number) - --- |Prints multiple passwords per line -prop_printsMultipleWordsPerLine :: PhraseCliOptions - -> LessThan20 Int - -> LessThan20 Int - -> Property -prop_printsMultipleWordsPerLine (PhraseCliOptions opts) (LT20 min) (LT20 max) - = ioProperty $ do - let opts' = opts { -- Make sure we can fit 2+ words on a line - cliLength = Just min, - cliMaxLength = Just max} - - (_, out, _, _) <- run opts' - response <- readHandle out - - return $ - all (>1) . tail . reverse . map (length . words) . lines $ response - --- |Always prints a passphrase -prop_printsLongPassphrases :: PhraseCliOptions - -> Positive Int - -> Positive Int - -> Property -prop_printsLongPassphrases (PhraseCliOptions opts) (Positive min) (Positive max) - = forAll (scale (*7) arbitrary) $ \min -> - ioProperty $ do - let minLen = getPositive min - opts' = opts{ - cliLength = Just minLen, - cliMaxLength = Just (minLen + max)} - - (_, out, _, _) <- run opts - response <- readHandle out - - return $ - cover 20 (minLen > 80) "long" $ - all (>=1) . map (length . words) . lines $ response - --- |Prints capitals when specified -prop_printsCapitals :: PhraseCliOptions -> Property -prop_printsCapitals (PhraseCliOptions opts) - = ioProperty $ do - let opts' = opts { cliCapitals = True } - - (_, out, _, _) <- run opts' - response <- readHandle out - - let phrases = lines response - - return $ - cover 80 (any (any isUpper) phrases) "has caps" True diff --git a/test/IntegTest/Elocrypt/PasswordTest.hs b/test/IntegTest/Elocrypt/PasswordTest.hs deleted file mode 100644 --- a/test/IntegTest/Elocrypt/PasswordTest.hs +++ /dev/null @@ -1,98 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module IntegTest.Elocrypt.PasswordTest where - -import Data.Char -import Data.List -import Data.Maybe -import Control.Monad - -import Test.Tasty hiding (Timeout) -import Test.Tasty.QuickCheck (testProperty) -import Test.Tasty.TH - -import Test.Elocrypt.QuickCheck - -tests :: TestTree -tests = $(testGroupGenerator) - -elocrypt = "elocrypt" - --- |All passwords have specified length -prop_printsPasswordsWithLength :: WordCliOptions -> Property -prop_printsPasswordsWithLength (WordCliOptions opts) - = isJust len ==> - ioProperty $ do - (_, out, _, _) <- run opts - response <- readHandle out - - let len' = fromJust len - words' = words response - - return (all ((==) len' . length) words') - - where CliOptions{cliLength=len} = opts - --- |Prints nothing when length is 0 -prop_printsNothingWhenLengthIsZero :: WordCliOptions -> Property -prop_printsNothingWhenLengthIsZero (WordCliOptions opts) - = ioProperty $ do - let opts' = opts { cliLength = Just 0 } - - (_, out, _, _) <- run opts' - response <- readHandle out - return (response == "") - --- |Always prints at least 1 password -prop_printsLongPasswords :: WordCliOptions -> Property -prop_printsLongPasswords (WordCliOptions opts) - = forAll (scale (*7) arbitrary) $ \len -> - ioProperty $ do - let len' = getPositive len - opts' = opts { cliLength = Just len' } - - (_, out, _, _) <- run opts' - response <- readHandle out - - return $ - cover 30 (len' > 80) "long" $ - all (>=1) . map (length . words) . lines $ response - --- |Prints the specified number of passwords -prop_printsNumberPasswords :: Positive Int -> WordCliOptions -> Property -prop_printsNumberPasswords (Positive num) (WordCliOptions opts) - = ioProperty $ do - let opts' = opts { cliNumber = Just num } - - (_, out, _, _) <- run opts' - response <- readHandle out - - let words' = words response - - return $ num == length words' - --- |Prints multiple passwords per line when length is sufficiently small -prop_printsMultiplePasswordsPerLine :: WordCliOptions -> Property -prop_printsMultiplePasswordsPerLine (WordCliOptions opts) - = isNothing len || fromJust len <= 38 ==> - ioProperty $ do - (_, out, _, _) <- run opts - response <- readHandle out - - return $ - all (>1) . tail . reverse . map (length . words) . lines $ response - - where CliOptions{cliLength=len} = opts - --- |Prints capitals when specified -prop_printsCapitals :: WordCliOptions -> Property -prop_printsCapitals (WordCliOptions opts) - = ioProperty $ do - let opts' = opts { cliCapitals = True } - - (_, out, _, _) <- run opts' - response <- readHandle out - - let passes = words response - - return $ - cover 80 (any (any isUpper) passes) "has caps" True diff --git a/test/Test/Elocrypt/QuickCheck.hs b/test/Test/Elocrypt/QuickCheck.hs --- a/test/Test/Elocrypt/QuickCheck.hs +++ b/test/Test/Elocrypt/QuickCheck.hs @@ -32,10 +32,12 @@ -- options data CliOptions = CliOptions { cliCapitals :: Bool, + cliDigits :: Bool, cliLength :: Maybe Int, cliMaxLength :: Maybe Int, cliNumber :: Maybe Int, - cliPassphrase :: Bool + cliPassphrase :: Bool, + cliSpecials :: Bool } deriving Eq instance Show CliOptions where @@ -51,16 +53,20 @@ instance Arbitrary WordCliOptions where arbitrary = do - caps <- arbitrary - len <- arbitrary - num <- arbitrary + caps <- arbitrary + digits <- arbitrary + len <- arbitrary + num <- arbitrary + specials <- arbitrary return $ WordCliOptions CliOptions{ cliCapitals = caps, + cliDigits = digits, cliLength = fromPositive len, cliMaxLength = Nothing, cliNumber = fromPositive num, - cliPassphrase = False + cliPassphrase = False, + cliSpecials = specials } where fromPositive = fmap getPositive @@ -75,10 +81,12 @@ instance Arbitrary PhraseCliOptions where arbitrary = do - caps <- arbitrary - minLen <- arbitrary - maxLen <- arbitrary - num <- arbitrary + caps <- arbitrary + digits <- arbitrary + minLen <- arbitrary + maxLen <- arbitrary + num <- arbitrary + specials <- arbitrary -- CLI gets very inconsistent when len >= 80 -- TODO: Fix ^^^ @@ -87,12 +95,14 @@ return $ PhraseCliOptions CliOptions{ cliCapitals = caps, + cliDigits = digits, cliLength = minLen', cliMaxLength = maxLen', -- CLI gets very inconsistent when number >= 20 -- TODO: Fix ^^^ cliNumber = fromLT20 num, - cliPassphrase = True + cliPassphrase = True, + cliSpecials = specials } newtype LessThan20 n = LT20 { getLT20 :: n } deriving (Eq, Show) @@ -111,13 +121,15 @@ -- |Convert CliOptions into a list of cli arguments getOptions :: CliOptions -> [String] getOptions opts - = caps ++ num ++ phrase ++ len ++ maxLen + = caps ++ digits ++ specials ++ num ++ phrase ++ len ++ maxLen where caps = ["-c" | cliCapitals opts] + digits = ["-d" | cliDigits opts] len = maybe [] (singleton . show) (cliLength opts) maxLen = maybe [] (singleton . show) (cliMaxLength opts) maxLen' = cliLength opts >> cliMaxLength opts num = maybe [] (("-n":) . singleton . show) (cliNumber opts) phrase = ["-p" | cliPassphrase opts] + specials = ["-s" | cliSpecials opts] -- |Run elocrypt with the given options run :: CliOptions -> IO (Handle, Handle, Handle, ProcessHandle) @@ -142,7 +154,7 @@ fromPositive = fmap getPositive readHandle :: Handle -> IO String -readHandle = (<$>) asUtf8Str . waitOutput (seconds 2) 5000 +readHandle = (<$>) asUtf8Str . waitOutput (seconds 5) 5000 assertExitedSuccess :: Timeout -> ProcessHandle -> IO Bool assertExitedSuccess t = fmap (== ExitSuccess) . assertExitedTimeout t diff --git a/test/Test/Elocrypt/UtilsTest.hs b/test/Test/Elocrypt/UtilsTest.hs new file mode 100644 --- /dev/null +++ b/test/Test/Elocrypt/UtilsTest.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.Elocrypt.UtilsTest where + +import Control.Monad.Random +import Data.Maybe (isNothing) +import Data.List (find, elem, sort) +import Data.Ratio ((%)) +import qualified Data.Map as M + +import Test.QuickCheck +import Test.QuickCheck.Monadic (monadicIO) +import Test.Tasty +import Test.Tasty.QuickCheck (testProperty) +import Test.Tasty.TH + +import Data.Elocrypt.Utils +import Test.Elocrypt.QuickCheck +import Test.Elocrypt.Instances + +tests :: TestTree +tests = $(testGroupGenerator) + +-- |Maps letters to all digits 0-9 +prop_numeralConversionsHasAllDigits :: Bool +prop_numeralConversionsHasAllDigits + = sort digits == ['0'..'9'] + where digits = M.foldr (++) [] numeralConversions + +-- |toDigit never returns a letter that looks like a number +prop_toDigitDoesntLookLikeNumber :: Char -> Bool +prop_toDigitDoesntLookLikeNumber c + = isNothing $ find (`elem` candidates) c' + where candidates = M.keys numeralConversions + c' = toDigit c + +-- |toSymbol never returns a letter that looks like a symbol +prop_toSymbolDoesntLookLikeSymbol :: Char -> Bool +prop_toSymbolDoesntLookLikeSymbol c + = isNothing $ find (`elem` M.keys symbolConversions) c' + where c' = toSymbol c + +prop_toSymbolReturnsSymbols :: Bool +prop_toSymbolReturnsSymbols = all isSymbol ss + where ks = M.keys symbolConversions + ss = concatMap toSymbol ks + +-- |isSymbol returns false for letters and numbers +prop_isSymbolAlphaNumReturnsFalse :: Char -> Property +prop_isSymbolAlphaNumReturnsFalse c + = c `elem` (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']) ==> not (isSymbol c) + +prop_isSymbolWhitespaceReturnsFalse :: Bool +prop_isSymbolWhitespaceReturnsFalse = all (not . isSymbol) " \n" + +-- |updateR always updates when prob = 1/0 +prop_updateRAlwaysUpdates :: String -> StdGen -> Bool +prop_updateRAlwaysUpdates s = evalRand $ do + let f _ = return '*' + prob = 99999 % 1 -- Make prob absurdly high since we can't use 0 denoms + s' <- updateR f prob s + + -- Make sure almost all letters are '*' + return $ length (filter (=='*') s') >= length s - 1 + +-- |updateR never updates when prob = 0/1 +prop_updateRNeverUpdates :: String -> StdGen -> Bool +prop_updateRNeverUpdates s = evalRand $ do + let f _ = return '*' + prob = 0 % 1 + s' <- updateR f prob s + + return $ s == s' + +-- |update1 Always updates at least one character +prop_update1AlwaysUpdates1 :: String -> Property +prop_update1AlwaysUpdates1 s = not (null s) ==> do + let f = (const . return) '*' + + pos <- choose (0, length s - 1) + s' <- update1 f s pos + + return $ elem '*' s' + +-- |update1 allows empty string +prop_update1DoesntCrashOnEmpty :: Property +prop_update1DoesntCrashOnEmpty = monadicIO $ do + let f _ = return '*' + s <- update1 f "" 0 + + return (s == "") diff --git a/test/Test/ElocryptTest.hs b/test/Test/ElocryptTest.hs --- a/test/Test/ElocryptTest.hs +++ b/test/Test/ElocryptTest.hs @@ -4,7 +4,7 @@ import Control.Monad import Control.Monad.Random import Data.Bool -import Data.Char +import Data.Char hiding (isSymbol) import Data.List import Data.Maybe import Test.QuickCheck @@ -14,6 +14,7 @@ import Data.Elocrypt import Data.Elocrypt.Trigraph +import Data.Elocrypt.Utils (isSymbol) import Test.Elocrypt.QuickCheck import Test.Elocrypt.Instances @@ -42,11 +43,36 @@ -- |Most passwords have more than one capital prop_newPasswordHasMultipleCaps :: Positive Int -> StdGen -> Property prop_newPasswordHasMultipleCaps (Positive len) gen = - cover 50 (length (filter isUpper pass) > 1) "has multiple caps" - $ any isLower pass + checkCoverage $ + cover 50 (length (filter isUpper pass) > 1) "has multiple caps" True where pass = newPassword (len + 2) opts gen opts = genOptions { genCapitals = True } + +-- |Passwords are all letters when numbers is false +prop_newPasswordIsAlpha :: Positive Int -> StdGen -> Bool +prop_newPasswordIsAlpha (Positive len) gen = all isAlpha pass + where + pass = newPassword len opts gen + opts = genOptions { genDigits = False } + +-- |Most passwords have at least one number +prop_newPasswordHasDigits :: Positive Int -> StdGen -> Property +prop_newPasswordHasDigits (Positive len) gen = + checkCoverage $ + cover 50 (any isDigit pass) "has digits" True + where + pass = newPassword (len + 2) opts gen + opts = genOptions { genDigits = True } + +-- |Most passwords have at least one special character +prop_newPasswordHasSpecials :: Positive Int -> StdGen -> Property +prop_newPasswordHasSpecials (Positive len) gen = + checkCoverage $ + cover 50 (any isSymbol pass) "has specials" True + where + pass = newPassword (len + 2) opts gen + opts = genOptions { genSpecials = True } -- |Third and each successive character is taken from the trigraph prop_3rdCharHasPositiveFrequency diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -5,10 +5,12 @@ import qualified Test.ElocryptTest as PasswordTest import qualified Test.Elocrypt.TrigraphTest as TrigraphTest +import qualified Test.Elocrypt.UtilsTest as UtilsTest main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Unit Tests" [PasswordTest.tests, - TrigraphTest.tests] + TrigraphTest.tests, + UtilsTest.tests]