diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -15,13 +15,18 @@ ``` Binaries are also available: - * [elocrypt-0.6.0-linux-bin.tar.gz](https://github.com/sgillespie/elocrypt/releases/download/v0.4.0/elocrypt-0.4.0-linux-bin.tar.gz) - * [elocrypt-0.6.0-windows-bin.exe](https://github.com/sgillespie/elocrypt/releases/download/v0.4.0/elocrypt-0.4.0-windows-bin.exe) + * [elocrypt-2.0.0-linux-bin.tar.gz](https://github.com/sgillespie/elocrypt/releases/download/v1.0.0/elocrypt-1.0.0-linux-bin.tar.gz) + * [elocrypt-2.0.0-windows-bin.exe](https://github.com/sgillespie/elocrypt/releases/download/v1.0.0/elocrypt-1.0.0-windows-bin.exe) ## Running -Running elocrypt is as simple as: +Generate a list passwords: ``` elocrypt [length] +``` + +You can also generate random phrases (1 per line): +``` +elocrypt --passphrases [min-length] [max-length] ``` ## Obtaining the source diff --git a/elocrypt.cabal b/elocrypt.cabal --- a/elocrypt.cabal +++ b/elocrypt.cabal @@ -1,5 +1,5 @@ name: elocrypt -version: 1.0.0 +version: 2.0.0 synopsis: Generate easy-to-remember, hard-to-guess passwords homepage: https://www.github.com/sgillespie/elocrypt license: OtherLicense @@ -16,7 +16,7 @@ cabal-version: >=1.10 description: - Generates pronounceable, hard-to-guess passwords.. as hard as + Generates pronounceable, hard-to-guess passwords--as hard as Vince Carter's knee cartilage is. source-repository head @@ -51,6 +51,7 @@ build-depends: base >= 4.7 && <5, elocrypt, MonadRandom, + proctest, QuickCheck, random, tasty, @@ -60,6 +61,7 @@ hs-source-dirs: test main-is: Tests.hs other-modules: Test.Elocrypt.Instances, + Test.Elocrypt.QuickCheck, Test.Elocrypt.TrigraphTest, Test.ElocryptTest type: exitcode-stdio-1.0 @@ -79,5 +81,15 @@ 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 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: HLint.hs + build-depends: base >= 4.7 && < 5, + hlint + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 diff --git a/src/cli/Main.hs b/src/cli/Main.hs --- a/src/cli/Main.hs +++ b/src/cli/Main.hs @@ -1,6 +1,7 @@ module Main where import Control.Monad +import Data.Char import Data.List import Data.Maybe (fromMaybe) import System.Console.GetOpt @@ -15,11 +16,12 @@ termLen :: Int termHeight :: Int -version = "elocrypt 1.0.0" +version = "elocrypt 2.0.0" termLen = 80 termHeight = 10 data Options = Options { + optCapitals :: Bool, -- Include capital letters? optLength :: Int, -- Size of the password(s) optMaxLength :: Int, optNumber :: Maybe Int, -- Number of passwords to generate @@ -35,6 +37,7 @@ defaultOptions :: Options defaultOptions = Options { + optCapitals = False, optLength = 8, optMaxLength = 10, optNumber = Nothing, @@ -45,6 +48,10 @@ options :: [OptDescr (Options -> Options)] options = [ + Option ['c'] ["capitals"] + (NoArg (\o -> o { optCapitals = True })) + "Include capital letters", + Option ['n'] ["number"] (ReqArg (\n o -> o { optNumber = Just (read n) }) "NUMBER") "The number of passwords to generate", @@ -87,8 +94,8 @@ return $ case nonopts of (o:os:_) -> opts { optLength = read o, optMaxLength = read os } - (o:_) -> opts { optLength = read o } - [] -> opts + (o:_) -> opts { optLength = read o } + [] -> opts elocryptOpts' :: [String] -> IO (Options, [String]) elocryptOpts' args = case getOpt Permute options args of @@ -102,26 +109,30 @@ exitFailure generate :: RandomGen g => Options -> g -> String -generate opts@Options{optPassType=Word} = passwords opts +generate opts@Options{optPassType=Word} = passwords opts generate opts@Options{optPassType=Phrase} = passphrases opts passwords :: RandomGen g => Options -> g -> String -passwords Options{optLength = len, optNumber = n} gen +passwords opts@Options{optLength = len, optNumber = n} gen = format " " . groupWith splitAt' width " " $ ps - where ps = newPasswords len num False gen -- TODO[sgillespie]: Add caps + where ps = newPasswords len num (getGenOptions opts) gen cols = columns len num = fromMaybe (nWords cols) n width = max termLen (len + 2) passphrases :: RandomGen g => Options -> g -> String -passphrases Options{optLength = minLen, +passphrases opts@Options{optCapitals = caps, + optLength = minLen, optMaxLength = maxLen, optNumber = n} gen = format " " . take lines' . groupWith splitAt' width " " $ passphrase - where passphrase = newPassphrase words' minLen maxLen gen + where passphrase = newPassphrase words' minLen maxLen (getGenOptions opts) gen words' = columns minLen * lines' width = max termLen (maxLen + 1) lines' = fromMaybe termHeight n + +getGenOptions :: Options -> GenOptions +getGenOptions Options{optCapitals=caps} = genOptions{genCapitals=caps} 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 @@ -15,9 +15,26 @@ import Control.Monad import Control.Monad.Random hiding (next) import Data.Bool +import Data.Char import Data.Maybe import Prelude hiding (min, max) +-- * 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 +} deriving (Eq, Show) + +-- |Default options for generating passwords or passphrases. This is +-- the preferred way to construct 'GenOptions'. +genOptions :: GenOptions +genOptions = GenOptions { + genCapitals = False +} + -- * Random password generators -- |Generate a password using the generator g, returning the result and the @@ -26,12 +43,12 @@ -- @ -- -- Generate a password of length 10 using the system generator -- myGenPassword :: IO (String, StdGen) --- myGenPassword = genPassword 10 True \`liftM\` getStdGen +-- myGenPassword = genPassword 10 genOptions \`liftM\` getStdGen -- @ genPassword :: RandomGen g - => Int -- ^ password length - -> Bool -- ^ include capitals? - -> g -- ^ random generator + => Int -- ^ password length + -> GenOptions -- ^ options + -> g -- ^ random generator -> (String, g) genPassword len = runRand . mkPassword len @@ -41,13 +58,13 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myGenPasswords :: IO ([String], StdGen) --- myGenPasswords = (\(ls, g) -> (ls, g) `liftM` genPasswords 10 10 True `liftM` getStdGen +-- myGenPasswords = (\(ls, g) -> (ls, g) `liftM` genPasswords 10 10 genOptions `liftM` getStdGen -- @ genPasswords :: RandomGen g - => Int -- ^ password length - -> Int -- ^ number of passwords - -> Bool -- ^ include capitals? - -> g -- ^ random generator + => Int -- ^ password length + -> Int -- ^ number of passwords + -> GenOptions -- ^ options + -> g -- ^ random generator -> ([String], g) genPasswords len n = runRand . mkPasswords len n @@ -56,12 +73,12 @@ -- @ -- -- Generate a password of length 10 using the system generator -- myNewPassword :: IO String --- myNewPassword = newPassword 10 True \`liftM\` getStdGen +-- myNewPassword = newPassword 10 genOptions \`liftM\` getStdGen -- @ newPassword :: RandomGen g - => Int -- ^ password length - -> Bool -- ^ include capitals? - -> g -- ^ random generator + => Int -- ^ password length + -> GenOptions -- ^ options + -> g -- ^ random generator -> String newPassword len = evalRand . mkPassword len @@ -71,13 +88,13 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myNewPasswords :: IO [String] --- myNewPasswords = genPasswords 10 10 True `liftM` getStdGen +-- myNewPasswords = genPasswords 10 10 genOptions `liftM` getStdGen -- @ newPasswords :: RandomGen g - => Int -- ^ password length - -> Int -- ^ number of passwords - -> Bool -- ^ include capitals? - -> g -- ^ random generator + => Int -- ^ password length + -> Int -- ^ number of passwords + -> GenOptions -- ^ options + -> g -- ^ random generator -> [String] newPasswords len n = evalRand . mkPasswords len n @@ -87,16 +104,16 @@ -- @ -- -- Generate a password of length 10 using the system generator -- myPassword :: IO String --- myPassword = evalRand (mkPassword 10 True) \`liftM\` getStdGen +-- myPassword = evalRand (mkPassword 10 genOptions) \`liftM\` getStdGen -- @ mkPassword :: MonadRandom m - => Int -- ^ password length - -> Bool -- ^ include capitals? + => Int -- ^ password length + -> GenOptions -- ^ options -> m String -mkPassword len _ = do - f2 <- reverse `liftM` first2 +mkPassword len opts = do + f2 <- reverse `liftM` first2 opts if len > 2 - then reverse `liftM` lastN (len - 2) f2 + then reverse `liftM` lastN opts (len - 2) f2 else return . reverse . take len $ f2 -- |Plural version of mkPassword. Generate an infinite list of passwords using @@ -105,12 +122,12 @@ -- @ -- -- Generate an list of length 20 with passwords of length 10 using the system generator -- myMkPasswords :: IO [String] --- myMkPasswords = evalRand (mkPasswords 10 20 True) \`liftM\` getStdGen +-- myMkPasswords = evalRand (mkPasswords 10 20 genOptions) \`liftM\` getStdGen -- @ mkPasswords :: MonadRandom m - => Int -- ^ password length - -> Int -- ^ number of passwords - -> Bool -- ^ include capitals? + => Int -- ^ password length + -> Int -- ^ number of passwords + -> GenOptions -- ^ options -> m [String] mkPasswords len n = replicateM n . mkPassword len @@ -123,15 +140,16 @@ -- -- Generate a passphrase of 10 words, each having a length between 6 and 12, -- -- using the system generator -- myGenPassphrase :: IO (String, StdGen) --- myGenPassphrase = genPassword 10 True \`liftM\` getStdGen +-- myGenPassphrase = genPassword 10 6 10 genOptions \`liftM\` getStdGen -- @ genPassphrase :: RandomGen g - => Int -- ^ number of words - -> Int -- ^ minimum word length - -> Int -- ^ maximum word length - -> g -- ^ random generator + => Int -- ^ number of words + -> Int -- ^ minimum word length + -> Int -- ^ maximum word length + -> GenOptions -- ^ options + -> g -- ^ random generator -> ([String], g) -genPassphrase n min = runRand . mkPassphrase n min +genPassphrase n min max = runRand . mkPassphrase n min max -- |Generate a passphrase using the generator g, returning the result. -- @@ -142,12 +160,13 @@ -- myNewPassphrase = newPassphrase 10 6 12 \`liftM\` getStdGen -- @ newPassphrase :: RandomGen g - => Int -- ^ number of words - -> Int -- ^ minimum word length - -> Int -- ^ maximum word length - -> g -- ^ random generator + => Int -- ^ number of words + -> Int -- ^ minimum word length + -> Int -- ^ maximum word length + -> GenOptions -- ^ options + -> g -- ^ random generator -> [String] -newPassphrase n min = evalRand . mkPassphrase n min +newPassphrase n min max = evalRand . mkPassphrase n min max -- |Generate a finite number of words of random length (between @min@ and @max@ chars) -- using the MonadRandom m. MonadRandom is exposed here for extra control. @@ -158,45 +177,50 @@ -- myPassphrase = evalRand (mkPassphrase 10 6 12) \`liftM\` getStdGen -- @ mkPassphrase :: MonadRandom m - => Int -- ^ number of words - -> Int -- ^ minimum word length - -> Int -- ^ maximum word length + => Int -- ^ number of words + -> Int -- ^ minimum word length + -> Int -- ^ maximum word length + -> GenOptions -- ^ options -> m [String] -mkPassphrase n min max = replicateM n $ - getRandomR (min, max) >>= flip mkPassword False +mkPassphrase n min max opts = replicateM n $ + getRandomR (min, max) >>= flip mkPassword opts -- * Internal --- |The alphabet we sample random values from -alphabet :: [Char] -alphabet = ['a'..'z'] - -- |Generate two random characters. Uses 'Elocrypt.Trigraph.trigragh' -- to generate a weighted list. -first2 :: MonadRandom m => m String -first2 = fromList (map toWeight frequencies) +first2 :: MonadRandom m + => GenOptions + -> m String +first2 opts = fromList (map toWeight frequencies) >>= mapM (capitalizeR caps) where toWeight (s, w) = (s, sum w) + GenOptions{genCapitals=caps} = opts +-- |Generate the last n characters using previous two characters +-- and their 'Elocrypt.Trigraph.trigraph' +lastN :: MonadRandom m => GenOptions -> Int -> String -> m String +lastN _ 0 ls = return ls +lastN opts len ls = next opts ls >>= lastN opts (len - 1) . (:ls) + -- |Generate a random character based on the previous two characters and -- their 'Elocrypt.Trigraph.trigraph' -next :: MonadRandom m => String -> m Char -next (x:xs:_) = fromList . - zip ['a'..'z'] . - defaultFreqs . - fromJust . - findFrequency $ [xs, x] - - -- Fix frequencies if they are all 0, since MonadRandom prohibits this. - -- Use all 1s in this case to give every item an equal weight. - where defaultFreqs :: [Rational] -> [Rational] - defaultFreqs f = bool (replicate 26 1) f (any (>0) f) - --- This shouldn't ever happen -next _ = undefined +next :: MonadRandom m + => GenOptions -- ^ options + -> String -- ^ the prefix + -> m Char +next opts prefix = nextLetter prefix >>= capitalizeR caps + where GenOptions{genCapitals=caps} = opts --- |Generate the last n characters using previous two characters --- and their 'Elocrypt.Trigraph.trigraph' -lastN :: MonadRandom m => Int -> String -> m String -lastN 0 ls = return ls -lastN len ls = next ls >>= lastN (len - 1) . (:ls) +-- |Randomly choose a letter from the trigraph +nextLetter :: MonadRandom m + => String -- ^ the prefix + -> m Char +nextLetter = fromList . fromJust . findWeights . reverse . take 2 +-- |Randomly capitalize a character 10% of the time +capitalizeR :: MonadRandom m + => Bool -- ^ Whether to do the capitalization + -> Char -- ^ The character to capitalize + -> m Char +capitalizeR cap c | cap = fromList [(c, 6), (toUpper c, 1)] + | otherwise = return c diff --git a/src/lib/Data/Elocrypt/Trigraph.hs b/src/lib/Data/Elocrypt/Trigraph.hs --- a/src/lib/Data/Elocrypt/Trigraph.hs +++ b/src/lib/Data/Elocrypt/Trigraph.hs @@ -11,11 +11,24 @@ module Data.Elocrypt.Trigraph where import Control.Monad +import Data.Bool +import Data.Char import Data.List +-- |Search for the character frequencies and return a weighted list +findWeights :: String -- ^ The two letter prefix + -> Maybe [(Char, Rational)] +findWeights = fmap (zip ['a'..'z'] . defaultFrequencies) . findFrequency' + where findFrequency' = findFrequency . map toLower + -- |Search for the character frequencies based on the first a two-letter string findFrequency :: String -> Maybe [Rational] findFrequency s = snd `liftM` find ((==) s . fst) frequencies + +-- |Fix frequencies if they are all 0, since MonadRandom prohibits this. +-- In this case, use all 1s to give every item an equal weight +defaultFrequencies :: [Rational] -> [Rational] +defaultFrequencies f = bool (replicate 26 1) f (any (>0) f) -- | A map of character frequencies, based on a dictionary. The key is a two-letter -- string, and the value is a list of probabilities (a-z). It's form is: diff --git a/test/HLint.hs b/test/HLint.hs new file mode 100644 --- /dev/null +++ b/test/HLint.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import Language.Haskell.HLint (hlint) +import System.Exit (exitFailure, exitSuccess) + +arguments :: [String] +arguments = [ + "src", + "test" + ] + +main :: IO () +main = hlint arguments >>= main' + where main' [] = exitSuccess +main' _ = exitFailure diff --git a/test/IntegTest/Elocrypt/PassphraseTest.hs b/test/IntegTest/Elocrypt/PassphraseTest.hs --- a/test/IntegTest/Elocrypt/PassphraseTest.hs +++ b/test/IntegTest/Elocrypt/PassphraseTest.hs @@ -2,113 +2,120 @@ module IntegTest.Elocrypt.PassphraseTest where import Control.Monad +import Data.Bool +import Data.Char import Data.List import Data.Maybe -import Test.Proctest -import Test.Proctest.Assertions 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.Instances +import Test.Elocrypt.QuickCheck tests :: TestTree tests = $(testGroupGenerator) elocrypt = "elocrypt" -prop_printsWordsWithSpecifiedLengthRange :: PhraseCliArgs -> Property -prop_printsWordsWithSpecifiedLengthRange (PhraseCliArgs args) - = length (getPosParams args) == 2 ==> +-- |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' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts + response <- readHandle out - let (minLen:maxLen:_) = map read (getPosParams args) - words' = words response + let words' = words response + minLen' = fromJust minLen + maxLen' = fromJust maxLen - return (all ((\n -> n >= minLen && n <= maxLen) . length) words') + return (all ((\n -> n >= minLen' && n <= maxLen') . length) words') -prop_printsWordsWithSpecifiedMinLengthRange :: PhraseCliArgs -> Property -prop_printsWordsWithSpecifiedMinLengthRange (PhraseCliArgs args) - = length (getPosParams args) == 1 ==> + 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' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts + response <- readHandle out - let (minLen:_) = map read (getPosParams args) + return . all ((>= min (fromJust minLen) 10) . length) . words $ response - return . all ((>= min minLen 10) . length) . words $ response + where CliOptions{cliLength=minLen} = opts -prop_printsWordsWithDefaultLengthRange :: PhraseCliArgs -> Property -prop_printsWordsWithDefaultLengthRange (PhraseCliArgs args) - = length (getPosParams args) == 0 ==> +-- |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' elocrypt args - response <- readHandle out' - let words' = words response + (_, out, _, _) <- run opts + response <- readHandle out - return (all ((\n -> n >= 8 && n <= 10) . length) words') + let phrases = lines response -prop_printsSpecifiedNumberOfPassphrases :: PhraseCliArgs -> Property -prop_printsSpecifiedNumberOfPassphrases (PhraseCliArgs args) - = isJust (getArg "-n" args) && - length (getPosParams args) /= 1 ==> -- Make sure maxLen > minLen - ioProperty $ do - (_, out', _, _) <- run' elocrypt args - response <- readHandle out' + return $ counterexample (failMsg phrases) + (fromJust number == length phrases) - let number = read . fromJust . getArg "-n" $ args - phrases = lines response + where CliOptions{cliNumber=number, cliLength=len, cliMaxLength=maxLen} = opts + failMsg p = "length phrases (" ++ show (length p) ++ + ") /= " ++ show (fromJust number) - return (number == length phrases) +-- |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} -prop_printsMultipleWordsPerLine :: PhraseCliArgs -> Property -prop_printsMultipleWordsPerLine (PhraseCliArgs args) - = sum (map read (getPosParams args) :: [Integer]) <= 29 ==> - ioProperty $ do - (_, out', _, _) <- run' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts' + response <- readHandle out return $ all (>1) . tail . reverse . map (length . words) . lines $ response -prop_printsLongPassphrases :: GreaterThan79 Int -> GreaterThan0 Int -> Property -prop_printsLongPassphrases (GT79 minLen) (GT0 maxLen) - = ioProperty $ do - (_, out', _, _) <- run' elocrypt ["-p", - show minLen, - show (minLen + maxLen)] - response <- readHandle out' - - return . all (==1) . map (length . words) . lines $ response - -getArg :: String -> [String] -> Maybe String -getArg prefix args = (tail . dropWhile (not . elem')) `liftM` arg - where arg = find (isPrefixOf prefix) args - elem' = (flip elem) [' ', '='] - -getPosParams :: [String] -> [String] -getPosParams = filter ((/= '-') . head) +-- |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)} -run' :: FilePath -> [String] -> IO (Handle, Handle, Handle, ProcessHandle) -run' exe args = do - res@(_, _, _, p) <- run exe args - sleep' - _ <- assertExitedSuccess (seconds 2) p - return res + (_, out, _, _) <- run opts + response <- readHandle out + + return $ + cover (minLen > 80) 20 "long" $ + all (>=1) . map (length . words) . lines $ response -readHandle :: Handle -> IO String -readHandle = (<$>) asUtf8Str . waitOutput (seconds 2) 5000 +-- |Prints capitals when specified +prop_printsCapitals :: PhraseCliOptions -> Property +prop_printsCapitals (PhraseCliOptions opts) + = ioProperty $ do + let opts' = opts { cliCapitals = True } -sleep' :: IO () -sleep' = sleep (seconds 0.0001) + (_, out, _, _) <- run opts' + response <- readHandle out -assertExitedSuccess :: Timeout -> ProcessHandle -> IO Bool -assertExitedSuccess t = liftM (== ExitSuccess) . assertExitedTimeout t + let phrases = lines response -assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool -assertExitedFailure t = liftM not . assertExitedSuccess t + return $ + cover (any (any isUpper) phrases) 80 "has caps" True diff --git a/test/IntegTest/Elocrypt/PasswordTest.hs b/test/IntegTest/Elocrypt/PasswordTest.hs --- a/test/IntegTest/Elocrypt/PasswordTest.hs +++ b/test/IntegTest/Elocrypt/PasswordTest.hs @@ -1,99 +1,98 @@ {-# LANGUAGE TemplateHaskell #-} module IntegTest.Elocrypt.PasswordTest where +import Data.Char import Data.List import Data.Maybe import Control.Monad -import Test.Proctest -import Test.Proctest.Assertions -import Test.QuickCheck import Test.Tasty hiding (Timeout) import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH -import Test.Elocrypt.Instances +import Test.Elocrypt.QuickCheck tests :: TestTree tests = $(testGroupGenerator) elocrypt = "elocrypt" -prop_printsPasswordsWithSpecifiedLength :: CliArgs -> Property -prop_printsPasswordsWithSpecifiedLength (CliArgs args) - = isJust (getPosParam args) ==> +-- |All passwords have specified length +prop_printsPasswordsWithLength :: WordCliOptions -> Property +prop_printsPasswordsWithLength (WordCliOptions opts) + = isJust len ==> ioProperty $ do - (in', out', err', p) <- run' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts + response <- readHandle out - let len = read . fromJust . getPosParam $ args + let len' = fromJust len words' = words response - return (all ((==) len . length) words') + return (all ((==) len' . length) words') -prop_printsNothingWhenSpecifiedLengthIsZero :: CliArgs -> Property -prop_printsNothingWhenSpecifiedLengthIsZero (CliArgs args) - = isNothing (getPosParam args) ==> - ioProperty $ do - let args' = args ++ ["0"] + where CliOptions{cliLength=len} = opts - (in', out', err', p) <- run' elocrypt args' - response <- readHandle out' +-- |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 == "") -prop_printsLongPasswords :: GreaterThan79 Int -> Property -prop_printsLongPasswords (GT79 a) +-- |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 (len' > 80) 30 "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 - (in', out', err', p) <- run' elocrypt [show a] - response <- readHandle out' - return . all (==1) . map (length . words) . lines $ response + let opts' = opts { cliNumber = Just num } -prop_printsSpecifiedNumberOfPasswords :: CliArgs -> Property -prop_printsSpecifiedNumberOfPasswords (CliArgs args) - = isJust (getArg "-n" args) ==> - ioProperty $ do - (in', out', err', p) <- run' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts' + response <- readHandle out - let number = read . fromJust . getArg "-n" $ args - words' = words response + let words' = words response - return (number == length words') + return $ num == length words' -prop_printsMultiplePasswordsPerLine :: CliArgs -> Property -prop_printsMultiplePasswordsPerLine (CliArgs args) - = (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> +-- |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 - (in', out', err', p) <- run' elocrypt args - response <- readHandle out' + (_, out, _, _) <- run opts + response <- readHandle out return $ all (>1) . tail . reverse . map (length . words) . lines $ response --- Utility functions -run' :: FilePath -> [String] -> IO (Handle, Handle, Handle, ProcessHandle) -run' exe args = do - res@(in', out', err', p) <- run exe args - sleep' - assertExitedSuccess (seconds 2) p - return res - -readHandle :: Handle -> IO String -readHandle = (<$>) asUtf8Str . waitOutput (seconds 2) 5000 - -assertExitedSuccess :: Timeout -> ProcessHandle -> IO Bool -assertExitedSuccess t = liftM (== ExitSuccess) . assertExitedTimeout t + where CliOptions{cliLength=len} = opts -assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool -assertExitedFailure t = liftM not . assertExitedSuccess t +-- |Prints capitals when specified +prop_printsCapitals :: WordCliOptions -> Property +prop_printsCapitals (WordCliOptions opts) + = ioProperty $ do + let opts' = opts { cliCapitals = True } -sleep' :: IO () -sleep' = sleep (seconds 0.0001) + (_, out, _, _) <- run opts' + response <- readHandle out -getArg :: String -> [String] -> Maybe String -getArg prefix args = (tail . dropWhile (not . elem')) `liftM` arg - where arg = find (isPrefixOf prefix) args - elem' = (flip elem) [' ', '='] + let passes = words response -getPosParam :: [String] -> Maybe String -getPosParam = find $ (/= '-') . head + return $ + cover (any (any isUpper) passes) 80 "has caps" True diff --git a/test/IntegTests.hs b/test/IntegTests.hs --- a/test/IntegTests.hs +++ b/test/IntegTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} module Main where import Data.Functor diff --git a/test/Test/Elocrypt/Instances.hs b/test/Test/Elocrypt/Instances.hs --- a/test/Test/Elocrypt/Instances.hs +++ b/test/Test/Elocrypt/Instances.hs @@ -6,6 +6,8 @@ import Test.QuickCheck +-- |Representation of possible CLI arguments for a command line +-- app. newtype CliArgs = CliArgs { getArgs :: [String] } deriving Eq @@ -18,9 +20,12 @@ len <- arbitrary `suchThat` (>0) `suchThat` (<=40) :: Gen Int num <- arbitrary `suchThat` (>2) `suchThat` (<=20) :: Gen Int args <- sublistOf ["-n %d" `printf` num, + "-c", show len] return (CliArgs args) +-- |Representation of an elocrypt execution with passphrases turned +-- on. newtype PhraseCliArgs = PhraseCliArgs { getPhraseArgs :: [String] } deriving Eq @@ -41,30 +46,40 @@ return $ PhraseCliArgs ("-p" : args) --- Uh oh! I copy/pasted this! instance Arbitrary StdGen where arbitrary = mkStdGen `liftM` arbitrary +-- |All letters, upper and lower case. newtype AlphaChar = Alpha Char deriving (Eq, Ord, Show) --- + instance Arbitrary AlphaChar where - arbitrary = Alpha `liftM` elements ['a'..'z'] + arbitrary = Alpha <$> elements (['a'..'z'] ++ ['A'..'Z']) +-- |All lowercase letters +newtype LowerAlphaChar = LowerAlpha Char + deriving (Eq, Ord, Show) + +instance Arbitrary LowerAlphaChar where + arbitrary = LowerAlpha <$> elements ['a'..'z'] + +-- |DEPRECATED: Positive integers. newtype GreaterThan0 a = GT0 { getGT0 :: a } deriving (Eq, Ord, Show) instance (Num a, Ord a, Arbitrary a) => Arbitrary (GreaterThan0 a) where arbitrary = GT0 `fmap` (arbitrary `suchThat` (>0)) +-- |DEPRECATED: Integers greater than 2 newtype GreaterThan2 a = GT2 { getGT2 :: a } deriving (Eq, Ord, Show) instance (Num a, Ord a, Arbitrary a) => Arbitrary (GreaterThan2 a) where - arbitrary = GT2 `fmap` (arbitrary `suchThat` (>2)) + arbitrary = GT2 <$> (arbitrary `suchThat` (>2)) +-- |DEPRECATED: Integers greater than 79 newtype GreaterThan79 a = GT79 { getGT79 :: a } deriving (Eq, Ord, Show) instance (Integral a, Random a) => Arbitrary (GreaterThan79 a) where - arbitrary = GT79 `fmap` choose (80, 500) + arbitrary = GT79 <$> choose (80, 500) diff --git a/test/Test/Elocrypt/QuickCheck.hs b/test/Test/Elocrypt/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/test/Test/Elocrypt/QuickCheck.hs @@ -0,0 +1,154 @@ +-- |A re-export of QuickCheck along with some useful instances +module Test.Elocrypt.QuickCheck ( + module Test.QuickCheck, + CliOptions(..), + LessThan20(..), + LessThan40(..), + LessThan79(..), + PhraseCliOptions(..), + WordCliOptions(..), + getOptions, + readHandle, + run + ) where + +import Data.Bool +import Data.List +import Data.Maybe +import System.Random +import Test.QuickCheck +import Test.Proctest hiding (run) +import Test.Proctest.Assertions +import qualified Test.Proctest as Proctest + +import Data.Elocrypt + +instance Arbitrary GenOptions where + arbitrary = do + caps <- arbitrary + return genOptions{genCapitals=caps} + +-- |A representation of elocrypt's command line +-- options +data CliOptions = CliOptions { + cliCapitals :: Bool, + cliLength :: Maybe Int, + cliMaxLength :: Maybe Int, + cliNumber :: Maybe Int, + cliPassphrase :: Bool +} deriving Eq + +instance Show CliOptions where + show = unwords . getOptions + +-- |CliOptions for generating only passwords +newtype WordCliOptions + = WordCliOptions { getWordOpts :: CliOptions } + deriving Eq + +instance Show WordCliOptions where + show = show . getWordOpts + +instance Arbitrary WordCliOptions where + arbitrary = do + caps <- arbitrary + len <- arbitrary + num <- arbitrary + + return $ WordCliOptions CliOptions{ + cliCapitals = caps, + cliLength = fromPositive len, + cliMaxLength = Nothing, + cliNumber = fromPositive num, + cliPassphrase = False + } + + where fromPositive = fmap getPositive + +-- |CliOptions for generating only passphrases +newtype PhraseCliOptions + = PhraseCliOptions { getPhraseOpts :: CliOptions } + deriving Eq + +instance Show PhraseCliOptions where + show = show . getPhraseOpts + +instance Arbitrary PhraseCliOptions where + arbitrary = do + caps <- arbitrary + minLen <- arbitrary + maxLen <- arbitrary + num <- arbitrary + + -- CLI gets very inconsistent when len >= 80 + -- TODO: Fix ^^^ + let minLen' = fromLT40 minLen + maxLen' = (+) <$> minLen' <*> fromLT40 maxLen + + return $ PhraseCliOptions CliOptions{ + cliCapitals = caps, + cliLength = minLen', + cliMaxLength = maxLen', + -- CLI gets very inconsistent when number >= 20 + -- TODO: Fix ^^^ + cliNumber = fromLT20 num, + cliPassphrase = True + } + +newtype LessThan20 n = LT20 { getLT20 :: n } deriving (Eq, Show) +newtype LessThan40 n = LT40 { getLT40 :: n } deriving (Eq, Show) +newtype LessThan79 n = LT79 { getLT79 :: n } deriving (Eq, Show) + +instance (Arbitrary n, Num n, Random n) => Arbitrary (LessThan20 n) where + arbitrary = LT20 <$> choose (1, 20) + +instance (Arbitrary n, Num n, Random n) => Arbitrary (LessThan40 n) where + arbitrary = LT40 <$> choose (1, 40) + +instance (Arbitrary n, Num n, Random n) => Arbitrary (LessThan79 n) where + arbitrary = LT79 <$> choose (1, 79) + +-- |Convert CliOptions into a list of cli arguments +getOptions :: CliOptions -> [String] +getOptions opts + = caps ++ num ++ phrase ++ len ++ maxLen + where caps = ["-c" | cliCapitals 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] + +-- |Run elocrypt with the given options +run :: CliOptions -> IO (Handle, Handle, Handle, ProcessHandle) +run opts = do + res@(_, _, _, p) <- Proctest.run "elocrypt" (getOptions opts) + sleep' + _ <- assertExitedSuccess (seconds 2) p + return res + +-- Utilities +singleton :: a -> [a] +singleton a = [a] + +fromLT20 :: Functor f => f (LessThan20 a) -> f a +fromLT40 :: Functor f => f (LessThan40 a) -> f a +fromLT79 :: Functor f => f (LessThan79 a) -> f a +fromPositive :: Functor f => f (Positive a) -> f a + +fromLT20 = fmap getLT20 +fromLT40 = fmap getLT40 +fromLT79 = fmap getLT79 +fromPositive = fmap getPositive + +readHandle :: Handle -> IO String +readHandle = (<$>) asUtf8Str . waitOutput (seconds 2) 5000 + +assertExitedSuccess :: Timeout -> ProcessHandle -> IO Bool +assertExitedSuccess t = fmap (== ExitSuccess) . assertExitedTimeout t + +assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool +assertExitedFailure t = fmap not . assertExitedSuccess t + +sleep' :: IO () +sleep' = sleep (seconds 0.0001) diff --git a/test/Test/Elocrypt/TrigraphTest.hs b/test/Test/Elocrypt/TrigraphTest.hs --- a/test/Test/Elocrypt/TrigraphTest.hs +++ b/test/Test/Elocrypt/TrigraphTest.hs @@ -2,6 +2,8 @@ module Test.Elocrypt.TrigraphTest where import Control.Monad +import Data.Char +import Data.Maybe import Test.QuickCheck import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH @@ -11,12 +13,29 @@ tests = $(testGroupGenerator) -prop_findFrequencyShouldSucceedWith2Chars :: AlphaChar -> AlphaChar -> Bool -prop_findFrequencyShouldSucceedWith2Chars (Alpha c1) (Alpha c2) - = fromJust (findFrequency [c1, c2]) - where fromJust (Just _) = True - fromJust Nothing = False +-- |Finding a frequency with 2 lowercase letters returns a trigraph +prop_findFrequencyWith2Letters :: LowerAlphaChar -> LowerAlphaChar -> Bool +prop_findFrequencyWith2Letters (LowerAlpha c1) (LowerAlpha c2) + = isJust (findFrequency [c1, c2]) -prop_findFrequencyShouldFailWithNot2Chars :: String -> Property -prop_findFrequencyShouldFailWithNot2Chars str - = length str /= 2 ==> findFrequency str == Nothing +-- |Finding a frequency with more or less than 2 characters results in nothing +prop_findFrequencyWithNot2Letters :: String -> Property +prop_findFrequencyWithNot2Letters str + = not (length str == 2 && all isLower str) ==> isNothing (findFrequency str) + +-- |Finding a weight with 2 letters returns a weighted list +prop_findWeightsWith2Letters :: AlphaChar -> AlphaChar -> Bool +prop_findWeightsWith2Letters (Alpha c1) (Alpha c2) + = isJust (findWeights [c1, c2]) + +-- |Finding a weight with more or less than 2 characters results in nothing +prop_findWeightsWithNot2Letters :: String -> Property +prop_findWeightsWithNot2Letters str + = not (length str == 2 && all isLetter str) ==> isNothing (findWeights str) + +-- |Finding a weight never results in zero weights +prop_findWeightsDefaultsFreqs :: AlphaChar -> AlphaChar -> Bool +prop_findWeightsDefaultsFreqs (Alpha c1) (Alpha c2) + = sum' weights > 0 + where weights = fromJust . findWeights $ [c1, c2] + sum' = foldr ((+) . snd) 0 diff --git a/test/Test/ElocryptTest.hs b/test/Test/ElocryptTest.hs --- a/test/Test/ElocryptTest.hs +++ b/test/Test/ElocryptTest.hs @@ -2,124 +2,174 @@ module Test.ElocryptTest where import Control.Monad -import Control.Monad.Random hiding (next) +import Control.Monad.Random +import Data.Bool +import Data.Char import Data.List import Data.Maybe -import Test.QuickCheck hiding (frequency) +import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH import Data.Elocrypt import Data.Elocrypt.Trigraph +import Test.Elocrypt.QuickCheck import Test.Elocrypt.Instances tests :: TestTree tests = $(testGroupGenerator) -prop_genPasswordShouldBeUnique :: GreaterThan2 Int -> Bool -> StdGen -> Bool -prop_genPasswordShouldBeUnique (GT2 len) caps gen - = p /= fst (genPassword len caps gen') - where (p, gen') = genPassword len caps gen +-- |Passwords have the specified length +prop_newPasswordHasLen :: Positive Int -> GenOptions -> StdGen -> Bool +prop_newPasswordHasLen (Positive len) opts gen + = length pass == len + where pass = newPassword len opts gen -prop_genPasswordsShouldBeUnique - :: GreaterThan2 Int - -> GreaterThan2 Int - -> Bool - -> StdGen - -> Bool -prop_genPasswordsShouldBeUnique (GT2 len) (GT2 n) caps gen - = p /= ps - where (p:ps:_) = fst (genPasswords len n caps gen) +-- |Passwords are all lowercase when caps is false +prop_newPasswordIsLower :: Positive Int -> StdGen -> Bool +prop_newPasswordIsLower (Positive len) gen + = all isLower pass + where pass = newPassword len opts gen + opts = genOptions{genCapitals = False} -prop_newPasswordShouldBeLength :: Int -> Bool -> StdGen -> Property -prop_newPasswordShouldBeLength len caps gen = len > 0 ==> - length (newPassword len caps gen) == len +-- |Passwords with caps generates caps +prop_newPasswordHasCaps :: Positive Int -> StdGen -> Property +prop_newPasswordHasCaps (Positive len) gen + = cover (any isUpper pass) 50 "has caps" $ + any isLower pass + where pass = newPassword (len + 2) opts gen + opts = genOptions{genCapitals = True} -prop_newPasswordShouldConsistOfAlphabet :: Int -> Bool -> StdGen -> Bool -prop_newPasswordShouldConsistOfAlphabet len caps gen - = all (`elem` alphabet) (newPassword len caps gen) +-- |Third and each successive character is taken from the trigraph +prop_3rdCharHasPositiveFrequency + :: Positive Int + -> GenOptions + -> StdGen + -> Property +prop_3rdCharHasPositiveFrequency (Positive len) opts gen + = conjoin $ loop pass + where pass = newPassword (len+2) opts gen + loop (f:s:t:xs) = thirdCharIsInTrigraph [f, s, t] : loop (s:t:xs) + loop _ = [] -prop_newPasswordsShouldBeUnique - :: GreaterThan2 Int - -> GreaterThan2 Int - -> Bool - -> StdGen - -> Bool -prop_newPasswordsShouldBeUnique (GT2 len) (GT2 n) caps gen - = p /= ps - where (p:ps:_) = newPasswords len n caps gen +thirdCharIsInTrigraph :: String -> Property +thirdCharIsInTrigraph pass + = counterexample failMsg $ property (t `elem` candidates) + where (f:s:t:_) = map toLower pass + candidates = map fst . filter ((0/=) . snd) $ frequencies + frequencies = zip ['a'..'z'] . + defaultFrequencies . + fromJust . + findFrequency $ [f, s] -prop_newPasswordShouldHaveLen :: Int -> Bool -> StdGen -> Property -prop_newPasswordShouldHaveLen len caps gen - = len >= 0 ==> length (newPassword len caps gen) == len + failMsg = t : " not in [" ++ candidates ++ "]" -prop_genPassphraseShouldBeUnique - :: GreaterThan2 Int - -> GreaterThan2 Int - -> GreaterThan0 Int +-- First 2 characters have total non-zero frequencies +prop_first2HavePositiveFrequencies + :: Positive Int + -> GenOptions -> StdGen - -> Bool -prop_genPassphraseShouldBeUnique (GT2 n) (GT2 min) (GT0 max) gen - = not . hasDuplicates $ phrase - where phrase = fst (genPassphrase n min (min+max) gen) + -> Property +prop_first2HavePositiveFrequencies (Positive len) opts gen + = counterexample failMsg $ property (sum frequencies > 0) + where pass = newPassword (len+1) opts gen + (f:s:_) = map toLower pass + frequencies = zipWith (curry snd) ['a'..'z'] . + fromJust . + findFrequency $ [f, s] + failMsg = "no candidates for '" ++ [f, s] ++ "'" -prop_newPassphraseShouldBeUnique - :: GreaterThan2 Int - -> GreaterThan2 Int - -> GreaterThan0 Int +-- (len . fst) (genPasswords _ x _ _) = x +prop_newPasswordsHasLen + :: Positive Int + -> Positive Int + -> GenOptions -> StdGen - -> Bool -prop_newPassphraseShouldBeUnique (GT2 n) (GT2 min) (GT0 max) gen - = not . hasDuplicates $ phrase - where phrase = newPassphrase n min (min+max) gen + -> Property +prop_newPasswordsHasLen (Positive len) (Positive num) opts gen + = counterexample failMsg $ property (length passes == num) + where passes = newPasswords len num opts gen + failMsg = show (length passes) ++ " /= " ++ show num -prop_newPassphraseShouldHaveLen - :: GreaterThan2 Int - -> GreaterThan2 Int - -> GreaterThan0 Int +-- (all ((x==) . length) . fst) (genPasswords x _ _ _) = x +prop_newPasswordsAllHaveLen + :: Positive Int + -> Positive Int + -> GenOptions -> StdGen -> Bool -prop_newPassphraseShouldHaveLen (GT2 n) (GT2 min) (GT0 max) gen - = length phrase == n - where phrase = newPassphrase n min (min+max) gen - -prop_first2ShouldHaveLength2 :: StdGen -> Bool -prop_first2ShouldHaveLength2 g = length (evalRand first2 g) == 2 - -prop_nextShouldSkip0Weights :: AlphaChar -> AlphaChar -> StdGen -> Property -prop_nextShouldSkip0Weights (Alpha c1) (Alpha c2) gen = isCandidate next' [c1, c2] - where next' = evalRand (next . reverse $ [c1, c2]) gen - -prop_lastNShouldSkip0Weights :: AlphaChar -> AlphaChar -> Int -> StdGen -> Property -prop_lastNShouldSkip0Weights (Alpha c1) (Alpha c2) len gen - = len > 0 ==> lastNShouldSkip0Weights' lastN' - where lastN' = evalRand (lastN len [c2, c1]) gen - -lastNShouldSkip0Weights' :: String -> Property -lastNShouldSkip0Weights' (p:ps:pss:psss) = isCandidate p [pss, ps] .&&. - lastNShouldSkip0Weights' (ps:pss:psss) -lastNShouldSkip0Weights' _ = property True - --- Utility functions -isCandidate :: Char -> String -> Property -isCandidate c (s:ss:_) = hasCandidates f2 ==> - isJust $ elem c `liftM` findNextCandidates f2 - where f2 = [s, ss] +prop_newPasswordsAllHaveLen (Positive len) (Positive num) opts gen + = all ((len==) . length) passes + where passes = newPasswords len num opts gen -isCandidate _ _ = undefined -- This really shouldn't ever happen +-- |Given the same generator, newPassword and genPassword generates the +-- same password. +prop_newPasswordMatchesGenPassword + :: Positive Int + -> GenOptions + -> StdGen + -> Property +prop_newPasswordMatchesGenPassword (Positive len) opts gen + = counterexample failMsg $ property (pass == pass') + where (pass, _) = genPassword len opts gen + pass' = newPassword len opts gen + failMsg = show pass ++ " /= " ++ show pass' -hasCandidates :: String -> Bool -hasCandidates s = (not . null) `liftM` findNextCandidates s == Just True +-- |Given the same generator, newPasswords and genPasswords genereates +-- the same passwords. +prop_newPasswordsMatchesGenPasswords + :: Positive Int + -> Positive Int + -> GenOptions + -> StdGen + -> Property +prop_newPasswordsMatchesGenPasswords (Positive len) (Positive num) opts gen + = counterexample failMsg $ property (passes == passes') + where (passes, _) = genPasswords len num opts gen + passes' = newPasswords len num opts gen + failMsg = show passes ++ " /= " ++ show passes' -findNextCandidates :: String -> Maybe String -findNextCandidates (c1:c2:_) = map fst `liftM` frequency - where f2 = [c1, c2] - frequency = (filter ((/=0) . snd) . zip ['a'..'z']) `liftM` findFrequency f2 +-- |newPassphrase generates n words +prop_newPassphraseHasLen + :: Positive Int + -> Positive Int + -> Positive Int + -> GenOptions + -> StdGen + -> Property +prop_newPassphraseHasLen (Positive len) (Positive min) (Positive max) opts gen + = counterexample failMsg $ property (length words == len) + where words = newPassphrase len min max opts gen + failMsg = show len ++ " /= length " ++ show words -findNextCandidates _ = Nothing -- This really shouldn't ever happen +-- |newPassphrase generates words in the allowed range +prop_newPassphraseWordsHaveLen + :: Positive Int + -> Positive Int + -> Positive Int + -> GenOptions + -> StdGen + -> Bool +prop_newPassphraseWordsHaveLen + (Positive len) (Positive min) (Positive max) opts gen + = all (\w -> length w >= min && length w <= max') words + where words = newPassphrase len min max' opts gen + max' = min + max -hasDuplicates = hasDuplicates' . sort - where hasDuplicates' (p1:p2:ps) | p1 == p2 = True - | otherwise = hasDuplicates' (p2:ps) - hasDuplicates' _ = False +-- |Given the same generator, genPassphrase and newPassphrase generates +-- the same passphrase +prop_genPassphraseMatchesNewPassphrase + :: Positive Int + -> Positive Int + -> Positive Int + -> GenOptions + -> StdGen + -> Property +prop_genPassphraseMatchesNewPassphrase + (Positive len) (Positive min) (Positive max) opts gen + = counterexample failMsg $ property (words == words') + where (words, _) = genPassphrase len min max' opts gen + words' = newPassphrase len min max' opts gen + max' = min + max + failMsg = show words ++ " /= " ++ show words'