diff --git a/cli-test/CliTests.hs b/cli-test/CliTests.hs new file mode 100644 --- /dev/null +++ b/cli-test/CliTests.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Data.Functor +import Data.List +import Data.Maybe +import Control.Monad +import Text.Printf + +import Test.Proctest +import Test.Proctest.Assertions +import Test.QuickCheck +import Test.QuickCheck.Property +import Test.Tasty hiding (Timeout) +import Test.Tasty.QuickCheck (QuickCheckTests(..), testProperty) +import Test.Tasty.TH + +import Test.Elocrypt.Instances + +main :: IO () +main = defaultMain (options tests) + +options :: TestTree -> TestTree +options = localOption (QuickCheckTests 10) + +tests :: TestTree +tests = testGroup "CLI Tests" [testGroup'] + +testGroup' = $(testGroupGenerator) + +newtype CliArgs = CliArgs { getArgs :: [String] } + deriving Eq + +instance Show CliArgs where + show = concat . intersperse " " . getArgs + +instance Arbitrary CliArgs where + arbitrary = do + len <- arbitrary `suchThat` (>0) `suchThat` (<=40) :: Gen Int + num <- arbitrary `suchThat` (>2) `suchThat` (<=20) :: Gen Int + args <- sublistOf ["-n %d" `printf` num, + show len] + return (CliArgs args) + +prop_shouldPrintPasswordsWithLength :: CliArgs -> Property +prop_shouldPrintPasswordsWithLength (CliArgs args) + = isJust (getPosParam args) ==> + ioProperty $ do + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args + response <- readHandle out' + + let len = read . fromJust . getPosParam $ args + words' = words response + + return (all ((==) len . length) words') + +prop_shouldPrintNumberPasswords :: CliArgs -> Property +prop_shouldPrintNumberPasswords (CliArgs args) + = isJust (getArg "-n" args) ==> + ioProperty $ do + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args + response <- readHandle out' + + let number = read . fromJust . getArg "-n" $ args + words' = words response + + return (number == length words') + +prop_shouldPrintMultPasswordsPerLine :: CliArgs -> Property +prop_shouldPrintMultPasswordsPerLine (CliArgs args) + = (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> + ioProperty $ do + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args + response <- readHandle out' + return . all (>1) . tail . reverse . map length . map words . lines $ response + +prop_shouldPrintDefaultMultPasswordsPerLine :: CliArgs -> Property +prop_shouldPrintDefaultMultPasswordsPerLine (CliArgs args) + = isNothing (getArg "-n" args) ==> + (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> + ioProperty $ do + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args + response <- readHandle out' + return . all (>1) . tail . reverse . map length . map words . lines $ response + +prop_shouldNotPrintZeroPasswords :: CliArgs -> Property +prop_shouldNotPrintZeroPasswords (CliArgs args) + = isNothing (getPosParam args) ==> + ioProperty $ do + let args' = args ++ ["0"] + + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args' + response <- readHandle out' + return (response == "") + +prop_shouldPrintLongPasswords :: GreaterThan79 Int -> Property +prop_shouldPrintLongPasswords (GT79 a) + = ioProperty $ do + (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" [show a] + response <- readHandle out' + return . all (==1) . map length . map 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 + +assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool +assertExitedFailure t = liftM not . assertExitedSuccess t + +sleep' :: IO () +sleep' = sleep (seconds 0.0001) + +getArg :: String -> [String] -> Maybe String +getArg prefix args = (tail . dropWhile (not . elem')) `liftM` arg + where arg = find (isPrefixOf prefix) args + elem' = (flip elem) [' ', '='] + +getPosParam :: [String] -> Maybe String +getPosParam = find $ (/= '-') . head diff --git a/cli-test/Tests.hs b/cli-test/Tests.hs deleted file mode 100644 --- a/cli-test/Tests.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main where - -import Data.Functor -import Data.List -import Data.Maybe -import Control.Monad -import Text.Printf - -import Test.Proctest -import Test.Proctest.Assertions -import Test.QuickCheck -import Test.QuickCheck.Property -import Test.Tasty hiding (Timeout) -import Test.Tasty.QuickCheck (QuickCheckTests(..), testProperty) -import Test.Tasty.TH - -import Test.Elocrypt.Instances - -main :: IO () -main = defaultMain (options tests) - -options :: TestTree -> TestTree -options = localOption (QuickCheckTests 10) - -tests :: TestTree -tests = testGroup "CLI Tests" [testGroup'] - -testGroup' = $(testGroupGenerator) - -newtype CliArgs = CliArgs { getArgs :: [String] } - deriving Eq - -instance Show CliArgs where - show = concat . intersperse " " . getArgs - -instance Arbitrary CliArgs where - arbitrary = do - len <- arbitrary `suchThat` (>0) `suchThat` (<=40) :: Gen Int - num <- arbitrary `suchThat` (>2) `suchThat` (<=20) :: Gen Int - args <- sublistOf ["-n %d" `printf` num, - show len] - return (CliArgs args) - -prop_shouldPrintPasswordsWithLength :: CliArgs -> Property -prop_shouldPrintPasswordsWithLength (CliArgs args) - = isJust (getPosParam args) ==> - ioProperty $ do - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args - response <- readHandle out' - - let len = read . fromJust . getPosParam $ args - words' = words response - - return (all ((==) len . length) words') - -prop_shouldPrintNumberPasswords :: CliArgs -> Property -prop_shouldPrintNumberPasswords (CliArgs args) - = isJust (getArg "-n" args) ==> - ioProperty $ do - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args - response <- readHandle out' - - let number = read . fromJust . getArg "-n" $ args - words' = words response - - return (number == length words') - -prop_shouldPrintMultPasswordsPerLine :: CliArgs -> Property -prop_shouldPrintMultPasswordsPerLine (CliArgs args) - = (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> - ioProperty $ do - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args - response <- readHandle out' - return . all (>1) . tail . reverse . map length . map words . lines $ response - -prop_shouldPrintDefaultMultPasswordsPerLine :: CliArgs -> Property -prop_shouldPrintDefaultMultPasswordsPerLine (CliArgs args) - = isNothing (getArg "-n" args) ==> - (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> - ioProperty $ do - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args - response <- readHandle out' - return . all (>1) . tail . reverse . map length . map words . lines $ response - -prop_shouldNotPrintZeroPasswords :: CliArgs -> Property -prop_shouldNotPrintZeroPasswords (CliArgs args) - = isNothing (getPosParam args) ==> - ioProperty $ do - let args' = args ++ ["0"] - - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" args' - response <- readHandle out' - return (response == "") - -prop_shouldPrintLongPasswords :: GreaterThan79 Int -> Property -prop_shouldPrintLongPasswords (GT79 a) - = ioProperty $ do - (in', out', err', p) <- run' "dist/build/elocrypt/elocrypt" [show a] - response <- readHandle out' - return . all (==1) . map length . map 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 - -assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool -assertExitedFailure t = liftM not . assertExitedSuccess t - -sleep' :: IO () -sleep' = sleep (seconds 0.0001) - -getArg :: String -> [String] -> Maybe String -getArg prefix args = (tail . dropWhile (not . elem')) `liftM` arg - where arg = find (isPrefixOf prefix) args - elem' = (flip elem) [' ', '='] - -getPosParam :: [String] -> Maybe String -getPosParam = find $ (/= '-') . head diff --git a/elocrypt.cabal b/elocrypt.cabal --- a/elocrypt.cabal +++ b/elocrypt.cabal @@ -1,5 +1,5 @@ name: elocrypt -version: 0.4.1 +version: 0.6.0 synopsis: Generate easy-to-remember, hard-to-guess passwords homepage: https://www.github.com/sgillespie/elocrypt license: OtherLicense @@ -26,21 +26,21 @@ source-repository this type: git location: https://github.com/sgillespie/elocrypt.git - tag: v0.4.1 + tag: v0.6.0 library exposed-modules: Data.Elocrypt, Data.Elocrypt.Trigraph -- other-modules: -- other-extensions: - build-depends: base >=4.7 && <4.9, + build-depends: base >=4.7 && <5, MonadRandom, random hs-source-dirs: src/lib default-language: Haskell2010 executable elocrypt - build-depends: base >= 4.7 && <4.9, + build-depends: base >= 4.7 && <5, elocrypt, random default-language: Haskell2010 @@ -48,7 +48,7 @@ main-is: Main.hs test-suite test - build-depends: base >= 4.7 && <4.9, + build-depends: base >= 4.7 && <5, elocrypt, MonadRandom, QuickCheck, @@ -59,10 +59,13 @@ default-language: Haskell2010 hs-source-dirs: test main-is: Tests.hs + other-modules: Test.Elocrypt.Instances, + Test.Elocrypt.TrigraphTest, + Test.ElocryptTest type: exitcode-stdio-1.0 test-suite ui-test - build-depends: base >= 4.7 && <4.9, + build-depends: base >= 4.7 && <5, elocrypt, proctest, MonadRandom, @@ -74,5 +77,6 @@ default-language: Haskell2010 hs-source-dirs: cli-test, test - main-is: Tests.hs + main-is: CliTests.hs + other-modules: Test.Elocrypt.Instances type: exitcode-stdio-1.0 diff --git a/src/cli/Main.hs b/src/cli/Main.hs --- a/src/cli/Main.hs +++ b/src/cli/Main.hs @@ -11,7 +11,7 @@ import Data.Elocrypt -version = "elocrypt 0.4.1" +version = "elocrypt 0.6.0" termLen = 80 termHeight = 10 @@ -35,7 +35,7 @@ passwords :: RandomGen g => Options -> g -> String passwords opts gen = format . group' cols $ ps - where ps = take num . newPasswords (optLength opts) $ gen + where ps = take num . newPasswords (optLength opts) False $ gen -- TODO[sgillespie]: Add caps format = concat . intersperse "\n" . map (concat . intersperse " ") cols = if optLength opts <= termLen - 2 then termLen `div` (optLength opts + 2) 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 @@ -14,9 +14,14 @@ import Control.Monad import Control.Monad.Random hiding (next) +import Data.Bool import Data.Maybe import System.Random hiding (next) +-- |Generate a finite number of words of random length (between 3 and 9 chars). +mkPassphrase :: Int -> IO [String] +mkPassphrase n = sequence $ replicate n $ randomRIO (3, 9) >>= flip mkPassword False + -- * Random password generators -- |Generate a password using the generator g, returning the result and the @@ -25,13 +30,14 @@ -- @ -- -- Generate a password of length 10 using the system generator -- myGenPassword :: IO (String, StdGen) --- myGenPassword = genPassword 10 \`liftM\` getStdGen +-- myGenPassword = genPassword 10 True \`liftM\` getStdGen -- @ genPassword :: RandomGen g - => Int -- ^ password length - -> g -- ^ random generator + => Int -- ^ password length + -> Bool -- ^ include capitals? + -> g -- ^ random generator -> (String, g) -genPassword = runRand . mkPassword +genPassword len = runRand . mkPassword len -- |Plural version of genPassword. Generates an infinite list of passwords -- using the generator g, returning the result and the updated generator. @@ -39,26 +45,28 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myGenPasswords :: IO ([String], StdGen) --- myGenPasswords = (\(ls, g) -> (take 10 ls, g) `liftM` genPasswords 10 `liftM` getStdGen +-- myGenPasswords = (\(ls, g) -> (take 10 ls, g) `liftM` genPasswords 10 True `liftM` getStdGen -- @ genPasswords :: RandomGen g - => Int -- ^ password length - -> g -- ^ random generator + => Int -- ^ password length + -> Bool -- ^ include capitals? + -> g -- ^ random generator -> ([String], g) -genPasswords = runRand . mkPasswords +genPasswords len = runRand . mkPasswords len -- |Generate a password using the generator g, returning the result. -- -- @ -- -- Generate a password of length 10 using the system generator -- myNewPassword :: IO String --- myNewPassword = newPassword 10 \`liftM\` getStdGen +-- myNewPassword = newPassword 10 True \`liftM\` getStdGen -- @ newPassword :: RandomGen g - => Int -- ^ password length - -> g -- ^ random generator + => Int -- ^ password length + -> Bool -- ^ include capitals? + -> g -- ^ random generator -> String -newPassword = evalRand . mkPassword +newPassword len = evalRand . mkPassword len -- |Plural version of newPassword. Generates an infinite list of passwords -- using the generator g, returning the result @@ -66,13 +74,14 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myNewPasswords :: IO [String] --- myNewPasswords = (take 10 . genPasswords 10) `liftM` getStdGen +-- myNewPasswords = (take 10 . genPasswords 10 True) `liftM` getStdGen -- @ newPasswords :: RandomGen g - => Int -- ^ password length - -> g -- ^ random generator + => Int -- ^ password length + -> Bool -- ^ include capitals? + -> g -- ^ random generator -> [String] -newPasswords = evalRand . mkPasswords +newPasswords len = evalRand . mkPasswords len -- |Generate a password using the MonadRandom m. MonadRandom is exposed here -- for extra control. @@ -80,12 +89,13 @@ -- @ -- -- Generate a password of length 10 using the system generator -- myPasswords :: IO String --- myPasswords = evalRand (mkPassword 10) \`liftM\` getStdGen +-- myPasswords = evalRand (mkPassword 10 True) \`liftM\` getStdGen -- @ mkPassword :: MonadRandom m - => Int -- ^ password length + => Int -- ^ password length + -> Bool -- ^ include capitals? -> m String -mkPassword len = do +mkPassword len caps = do f2 <- reverse `liftM` first2 if len > 2 then reverse `liftM` lastN (len - 2) f2 @@ -97,13 +107,14 @@ -- @ -- -- Generate an infinite list of passwords of length 10 using the system generator -- myMkPasswords :: IO [String] --- myMkPasswords = evalRand (mkPasswords 10) \`liftM\` getStdGen +-- myMkPasswords = evalRand (mkPasswords 10 True) \`liftM\` getStdGen -- @ mkPasswords :: MonadRandom m - => Int -- ^ password length + => Int -- ^ password length + -> Bool -- ^ include capitals? -> m [String] -mkPasswords = sequence . repeat . mkPassword - +mkPasswords len = sequence . repeat . mkPassword len + -- |The alphabet we sample random values from alphabet :: [Char] alphabet = ['a'..'z'] @@ -119,10 +130,23 @@ -- |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'] . fromJust . findFrequency $ [xs,x] +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 + -- |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) + diff --git a/test/Test/ElocryptTest.hs b/test/Test/ElocryptTest.hs --- a/test/Test/ElocryptTest.hs +++ b/test/Test/ElocryptTest.hs @@ -6,6 +6,7 @@ import Data.Maybe import System.Random hiding (next) import Test.QuickCheck +import Test.Tasty import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH @@ -13,33 +14,35 @@ import Data.Elocrypt.Trigraph import Test.Elocrypt.Instances +tests :: TestTree tests = $(testGroupGenerator) -prop_genPasswordShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool -prop_genPasswordShouldBeUnique (GT2 len) gen - = p /= fst (genPassword len gen') - where (p, gen') = genPassword len gen +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 -prop_genPasswordsShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool -prop_genPasswordsShouldBeUnique (GT2 len) gen +prop_genPasswordsShouldBeUnique :: GreaterThan2 Int -> Bool -> StdGen -> Bool +prop_genPasswordsShouldBeUnique (GT2 len) caps gen = p /= ps - where (p:ps:_) = fst (genPasswords len gen) + where (p:ps:_) = fst (genPasswords len caps gen) -prop_newPasswordShouldBeLength :: Int -> StdGen -> Property -prop_newPasswordShouldBeLength len gen = len > 0 ==> length (newPassword len gen) == len +prop_newPasswordShouldBeLength :: Int -> Bool -> StdGen -> Property +prop_newPasswordShouldBeLength len caps gen = len > 0 ==> + length (newPassword len caps gen) == len -prop_newPasswordShouldConsistOfAlphabet :: Int -> StdGen -> Bool -prop_newPasswordShouldConsistOfAlphabet len gen - = all ((flip elem) alphabet) (newPassword len gen) +prop_newPasswordShouldConsistOfAlphabet :: Int -> Bool -> StdGen -> Bool +prop_newPasswordShouldConsistOfAlphabet len caps gen + = all ((flip elem) alphabet) (newPassword len caps gen) -prop_newPasswordsShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool -prop_newPasswordsShouldBeUnique (GT2 len) gen +prop_newPasswordsShouldBeUnique :: GreaterThan2 Int -> Bool -> StdGen -> Bool +prop_newPasswordsShouldBeUnique (GT2 len) caps gen = p /= ps - where (p:ps:_) = newPasswords len gen + where (p:ps:_) = newPasswords len caps gen -prop_newPasswordShouldHaveLen :: Int -> StdGen -> Property -prop_newPasswordShouldHaveLen len gen - = len >= 0 ==> length (newPassword len gen) == len +prop_newPasswordShouldHaveLen :: Int -> Bool -> StdGen -> Property +prop_newPasswordShouldHaveLen len caps gen + = len >= 0 ==> length (newPassword len caps gen) == len prop_first2ShouldHaveLength2 :: StdGen -> Bool prop_first2ShouldHaveLength2 g = length (evalRand first2 g) == 2