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 7.10 and 7.8) - * cabal-install (tested on 1.20 and 1.22) + * GHC (tested on 8.0) + * cabal-install (tested on 1.24) ## Installing Elocrypt is on [Hackage](https://hackage.haskell.org/package/elocrypt). Installation is as easy as: @@ -15,9 +15,8 @@ ``` Binaries are also available: - * [elocrypt-0.4.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.4.0-osx-bin.tar.gz](https://github.com/sgillespie/elocrypt/releases/download/v0.4.0/elocrypt-0.4.0-osx-bin.tar.gz) - * [elocrypt-0.4.0-windows-bin.exe](https://github.com/sgillespie/elocrypt/releases/download/v0.4.0/elocrypt-0.4.0-windows-bin.exe) + * [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) ## Running Running elocrypt is as simple as: @@ -32,23 +31,23 @@ ## Building In order to build or install you will need - * GHC (tested on 7.10 and 7.8) - * cabal-install (tested on 1.20 and 1.22) + * [GHC](https://www.haskell.org/ghc) (tested on 8.0) + * [Haskell Stack](https://haskellstack.org) (tested on 1.24) Build elocrypt: ``` -cabal configure -cabal build +stack setup +stack build ``` Then, install (if desired): ``` -cabal install +stack install ``` ## API Documentation The full API documentation is on hackage @ https://hackage.haskell.org/package/elocrypt/docs. To build the documentation yourself, run ``` -cabal haddock +stack haddock ``` ### API Examples diff --git a/cli-test/CliTests.hs b/cli-test/CliTests.hs deleted file mode 100644 --- a/cli-test/CliTests.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,12 +1,12 @@ name: elocrypt -version: 0.6.0 +version: 1.0.0 synopsis: Generate easy-to-remember, hard-to-guess passwords homepage: https://www.github.com/sgillespie/elocrypt license: OtherLicense license-file: LICENSE author: Sean Gillespie maintainer: sean@mistersg.net -copyright: Copyright: (c) 2015 Sean Gillespie +copyright: Copyright: (c) 2017 Sean Gillespie category: Cryptography build-type: Simple extra-source-files: README.md, @@ -26,7 +26,7 @@ source-repository this type: git location: https://github.com/sgillespie/elocrypt.git - tag: v0.6.0 + tag: v1.0.0 library exposed-modules: Data.Elocrypt, @@ -55,7 +55,7 @@ random, tasty, tasty-quickcheck, - tasty-th + tasty-th >= 0.1.7 default-language: Haskell2010 hs-source-dirs: test main-is: Tests.hs @@ -73,10 +73,11 @@ random, tasty, tasty-quickcheck, - tasty-th + tasty-th >= 0.1.7 default-language: Haskell2010 - hs-source-dirs: cli-test, - test - main-is: CliTests.hs - other-modules: Test.Elocrypt.Instances + hs-source-dirs: test + main-is: IntegTests.hs + other-modules: IntegTest.Elocrypt.PassphraseTest, + IntegTest.Elocrypt.PasswordTest, + 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,10 +11,57 @@ import Data.Elocrypt -version = "elocrypt 0.6.0" -termLen = 80 +version :: String +termLen :: Int +termHeight :: Int + +version = "elocrypt 1.0.0" +termLen = 80 termHeight = 10 +data Options = Options { + optLength :: Int, -- Size of the password(s) + optMaxLength :: Int, + optNumber :: Maybe Int, -- Number of passwords to generate + optPassType :: PassType, -- Generate passwords or passphrases + optHelp :: Bool, + optVersion :: Bool + } deriving (Show) + +data PassType + = Phrase + | Word + deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { + optLength = 8, + optMaxLength = 10, + optNumber = Nothing, + optPassType = Word, + optHelp = False, + optVersion = False + } + +options :: [OptDescr (Options -> Options)] +options = [ + Option ['n'] ["number"] + (ReqArg (\n o -> o { optNumber = Just (read n) }) "NUMBER") + "The number of passwords to generate", + + Option ['p'] ["passphrase"] + (NoArg (\o -> o { optPassType = Phrase })) + "Generate passphrases instead of passwords", + + Option ['h'] ["help"] + (NoArg (\o -> o { optHelp = True })) + "Show this help", + + Option ['v'] ["version"] + (NoArg (\o -> o { optVersion = True })) + "Show version and exit" + ] + main :: IO () main = do args <- getArgs @@ -24,63 +71,108 @@ when (optHelp opts) $ do hPutStrLn stderr usage exitSuccess + when (optVersion opts) $ do hPutStrLn stderr version exitSuccess - -- TODO[sgillespie]: REFACTOR ME? - if (optLength opts == 0) - then exitSuccess - else putStrLn (passwords opts gen) - -passwords :: RandomGen g => Options -> g -> String -passwords opts gen = format . group' cols $ ps - 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) - else 1 - num = fromMaybe ((if cols == 0 then 1 else cols) * termHeight) (optNumber opts) - -group' :: Int -> [a] -> [[a]] -group' _ [] = [] -group' i ls = g:(group' i ls') - where (g, ls') = splitAt i ls - -data Options - = Options { optLength :: Int, -- Size of the password(s) - optNumber :: Maybe Int, -- Number of passwords to generate - optHelp :: Bool, - optVersion :: Bool } - deriving (Show) - -defaultOptions :: Options -defaultOptions = Options { optLength = 8, - optNumber = Nothing, - optHelp = False, - optVersion = False } + when (optLength opts == 0) + exitSuccess -- Nothing to do -options :: [OptDescr (Options -> Options)] -options = [Option ['n'] ["number"] (ReqArg (\n o -> o {optNumber = Just (read n)}) "NUMBER") "The number of passwords to generate", - Option ['h'] ["help"] (NoArg (\o -> o { optHelp = True })) "Show this help", - Option ['v'] ["version"] (NoArg (\o -> o { optVersion = True })) "Show version and exit"] + putStrLn (generate opts gen) elocryptOpts :: [String] -> IO Options elocryptOpts args = do (opts, nonopts) <- elocryptOpts' args - return $ if (null nonopts) - then opts - else opts { optLength = read (head nonopts) } + return $ case nonopts of + (o:os:_) -> opts { optLength = read o, optMaxLength = read os } + (o:_) -> opts { optLength = read o } + [] -> opts + elocryptOpts' :: [String] -> IO (Options, [String]) elocryptOpts' args = case getOpt Permute options args of - (opts, nonopts, []) -> return (foldl (flip id) defaultOptions opts, nonopts) + (opts, nonopts, []) -> do + let opts' = foldl (flip id) defaultOptions opts + return (opts', nonopts) + (_ , _ , errs) -> do - -- TODO: Refactor me hPutStrLn stderr (concat errs) hPutStrLn stderr usage exitFailure +generate :: RandomGen g => Options -> g -> String +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 + = format " " . groupWith splitAt' width " " $ ps + where ps = newPasswords len num False gen -- TODO[sgillespie]: Add caps + cols = columns len + num = fromMaybe (nWords cols) n + width = max termLen (len + 2) + +passphrases :: RandomGen g => Options -> g -> String +passphrases Options{optLength = minLen, + optMaxLength = maxLen, + optNumber = n} gen + = format " " . take lines' . groupWith splitAt' width " " $ passphrase + where passphrase = newPassphrase words' minLen maxLen gen + words' = columns minLen * lines' + width = max termLen (maxLen + 1) + lines' = fromMaybe termHeight n + usage :: String -usage = usageInfo header options - where header = "Usage: elocrypt [option...] length" +usage = usageInfo (intercalate "\n" headerLines) options + where headerLines = [ + "Usage: elocrypt [option...] length", + " elocrypt -p [option...] min-length max-length" + ] + +-- Utilities + +-- Calculate the number of passwords to print per line +columns :: Int -> Int +columns len | len <= termLen - 2 = termLen `div` (len + 2) + | otherwise = 1 + +-- Format a 2D list of Strings, +-- 1 list per line +format :: String -> [[String]] -> String +format sep = intercalate "\n" . map (intercalate sep) + +-- Calculate the number of words to print +nWords :: Int -> Int +nWords cols = termHeight * cols + +-- Group a 2D array with a function by total length +groupWith + :: (Int -> [a] -> [[a]] -> ([[a]], [[a]])) + -> Int + -> [a] + -> [[a]] + -> [[[a]]] +groupWith _ _ _ [] = [] +groupWith f i sep ls | null groups = [[head ls]] + | otherwise = groups + where groups = groupWith' f i sep ls + +groupWith' + :: (Int -> [a] -> [[a]] -> ([[a]], [[a]])) + -> Int + -> [a] + -> [[a]] + -> [[[a]]] +groupWith' _ _ _ [] = [] +groupWith' f i sep ls = g : groupWith f i sep ls' + where (g, ls') = f i sep ls + +-- Split a 2D array by the total length +splitAt' :: Int -> [a] -> [[a]] -> ([[a]], [[a]]) +splitAt' 0 _ ls = ([], ls) +splitAt' _ _ [] = ([], []) +splitAt' n sep (l:ls) | n >= length l + sl = (l:xs, xs') + | otherwise = ([], l:ls) + where (xs, xs') = splitAt' (n - length l - sl) sep ls + sl = length sep 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 @@ -16,11 +16,7 @@ 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 +import Prelude hiding (min, max) -- * Random password generators @@ -45,14 +41,15 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myGenPasswords :: IO ([String], StdGen) --- myGenPasswords = (\(ls, g) -> (take 10 ls, g) `liftM` genPasswords 10 True `liftM` getStdGen +-- myGenPasswords = (\(ls, g) -> (ls, g) `liftM` genPasswords 10 10 True `liftM` getStdGen -- @ genPasswords :: RandomGen g => Int -- ^ password length + -> Int -- ^ number of passwords -> Bool -- ^ include capitals? -> g -- ^ random generator -> ([String], g) -genPasswords len = runRand . mkPasswords len +genPasswords len n = runRand . mkPasswords len n -- |Generate a password using the generator g, returning the result. -- @@ -74,28 +71,29 @@ -- @ -- -- Generate 10 passwords of length 10 using the system generator -- myNewPasswords :: IO [String] --- myNewPasswords = (take 10 . genPasswords 10 True) `liftM` getStdGen +-- myNewPasswords = genPasswords 10 10 True `liftM` getStdGen -- @ newPasswords :: RandomGen g => Int -- ^ password length + -> Int -- ^ number of passwords -> Bool -- ^ include capitals? -> g -- ^ random generator -> [String] -newPasswords len = evalRand . mkPasswords len +newPasswords len n = evalRand . mkPasswords len n -- |Generate a password using the MonadRandom m. MonadRandom is exposed here -- for extra control. -- -- @ -- -- Generate a password of length 10 using the system generator --- myPasswords :: IO String --- myPasswords = evalRand (mkPassword 10 True) \`liftM\` getStdGen +-- myPassword :: IO String +-- myPassword = evalRand (mkPassword 10 True) \`liftM\` getStdGen -- @ mkPassword :: MonadRandom m => Int -- ^ password length -> Bool -- ^ include capitals? -> m String -mkPassword len caps = do +mkPassword len _ = do f2 <- reverse `liftM` first2 if len > 2 then reverse `liftM` lastN (len - 2) f2 @@ -105,22 +103,74 @@ -- the MonadRandom m. MonadRandom is exposed here for extra control. -- -- @ --- -- Generate an infinite list of passwords of length 10 using the system generator +-- -- Generate an list of length 20 with passwords of length 10 using the system generator -- myMkPasswords :: IO [String] --- myMkPasswords = evalRand (mkPasswords 10 True) \`liftM\` getStdGen +-- myMkPasswords = evalRand (mkPasswords 10 20 True) \`liftM\` getStdGen -- @ mkPasswords :: MonadRandom m => Int -- ^ password length + -> Int -- ^ number of passwords -> Bool -- ^ include capitals? -> m [String] -mkPasswords len = sequence . repeat . mkPassword len +mkPasswords len n = replicateM n . mkPassword len +-- * Random passphrase generators + +-- |Generate a passphrase using the generator g, returning the result and the +-- updated generator. +-- +-- @ +-- -- 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 +-- @ +genPassphrase :: RandomGen g + => Int -- ^ number of words + -> Int -- ^ minimum word length + -> Int -- ^ maximum word length + -> g -- ^ random generator + -> ([String], g) +genPassphrase n min = runRand . mkPassphrase n min + +-- |Generate a passphrase using the generator g, returning the result. +-- +-- @ +-- -- Generate a passphrase of 10 words, each having a length between 6 an 12, +-- -- using the system generator. +-- myNewPassphrase :: IO String +-- 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 + -> [String] +newPassphrase n min = evalRand . mkPassphrase n min + +-- |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. +-- +-- @ +-- -- Generate a passphrase of 10 words, each having a length between 6 and 12. +-- myPassphrase :: IO String +-- myPassphrase = evalRand (mkPassphrase 10 6 12) \`liftM\` getStdGen +-- @ +mkPassphrase :: MonadRandom m + => Int -- ^ number of words + -> Int -- ^ minimum word length + -> Int -- ^ maximum word length + -> m [String] +mkPassphrase n min max = replicateM n $ + getRandomR (min, max) >>= flip mkPassword False + +-- * Internal + -- |The alphabet we sample random values from alphabet :: [Char] alphabet = ['a'..'z'] --- * Internal - -- |Generate two random characters. Uses 'Elocrypt.Trigraph.trigragh' -- to generate a weighted list. first2 :: MonadRandom m => m String @@ -130,11 +180,11 @@ -- |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] +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. diff --git a/test/IntegTest/Elocrypt/PassphraseTest.hs b/test/IntegTest/Elocrypt/PassphraseTest.hs new file mode 100644 --- /dev/null +++ b/test/IntegTest/Elocrypt/PassphraseTest.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE TemplateHaskell #-} +module IntegTest.Elocrypt.PassphraseTest where + +import Control.Monad +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 Test.Elocrypt.Instances + +tests :: TestTree +tests = $(testGroupGenerator) + +elocrypt = "elocrypt" + +prop_printsWordsWithSpecifiedLengthRange :: PhraseCliArgs -> Property +prop_printsWordsWithSpecifiedLengthRange (PhraseCliArgs args) + = length (getPosParams args) == 2 ==> + ioProperty $ do + (_, out', _, _) <- run' elocrypt args + response <- readHandle out' + + let (minLen:maxLen:_) = map read (getPosParams args) + words' = words response + + return (all ((\n -> n >= minLen && n <= maxLen) . length) words') + +prop_printsWordsWithSpecifiedMinLengthRange :: PhraseCliArgs -> Property +prop_printsWordsWithSpecifiedMinLengthRange (PhraseCliArgs args) + = length (getPosParams args) == 1 ==> + ioProperty $ do + (_, out', _, _) <- run' elocrypt args + response <- readHandle out' + + let (minLen:_) = map read (getPosParams args) + + return . all ((>= min minLen 10) . length) . words $ response + +prop_printsWordsWithDefaultLengthRange :: PhraseCliArgs -> Property +prop_printsWordsWithDefaultLengthRange (PhraseCliArgs args) + = length (getPosParams args) == 0 ==> + ioProperty $ do + (_, out', _, _) <- run' elocrypt args + response <- readHandle out' + + let words' = words response + + return (all ((\n -> n >= 8 && n <= 10) . length) words') + +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' + + let number = read . fromJust . getArg "-n" $ args + phrases = lines response + + return (number == length phrases) + +prop_printsMultipleWordsPerLine :: PhraseCliArgs -> Property +prop_printsMultipleWordsPerLine (PhraseCliArgs args) + = sum (map read (getPosParams args) :: [Integer]) <= 29 ==> + ioProperty $ do + (_, out', _, _) <- run' elocrypt args + 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) + +run' :: FilePath -> [String] -> IO (Handle, Handle, Handle, ProcessHandle) +run' exe args = do + res@(_, _, _, p) <- run exe args + sleep' + _ <- assertExitedSuccess (seconds 2) p + return res + +readHandle :: Handle -> IO String +readHandle = (<$>) asUtf8Str . waitOutput (seconds 2) 5000 + +sleep' :: IO () +sleep' = sleep (seconds 0.0001) + +assertExitedSuccess :: Timeout -> ProcessHandle -> IO Bool +assertExitedSuccess t = liftM (== ExitSuccess) . assertExitedTimeout t + +assertExitedFailure :: Timeout -> ProcessHandle -> IO Bool +assertExitedFailure t = liftM not . assertExitedSuccess t diff --git a/test/IntegTest/Elocrypt/PasswordTest.hs b/test/IntegTest/Elocrypt/PasswordTest.hs new file mode 100644 --- /dev/null +++ b/test/IntegTest/Elocrypt/PasswordTest.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE TemplateHaskell #-} +module IntegTest.Elocrypt.PasswordTest where + +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 + +tests :: TestTree +tests = $(testGroupGenerator) + +elocrypt = "elocrypt" + +prop_printsPasswordsWithSpecifiedLength :: CliArgs -> Property +prop_printsPasswordsWithSpecifiedLength (CliArgs args) + = isJust (getPosParam args) ==> + ioProperty $ do + (in', out', err', p) <- run' elocrypt args + response <- readHandle out' + + let len = read . fromJust . getPosParam $ args + words' = words response + + return (all ((==) len . length) words') + +prop_printsNothingWhenSpecifiedLengthIsZero :: CliArgs -> Property +prop_printsNothingWhenSpecifiedLengthIsZero (CliArgs args) + = isNothing (getPosParam args) ==> + ioProperty $ do + let args' = args ++ ["0"] + + (in', out', err', p) <- run' elocrypt args' + response <- readHandle out' + return (response == "") + +prop_printsLongPasswords :: GreaterThan79 Int -> Property +prop_printsLongPasswords (GT79 a) + = ioProperty $ do + (in', out', err', p) <- run' elocrypt [show a] + response <- readHandle out' + return . all (==1) . map (length . words) . lines $ response + +prop_printsSpecifiedNumberOfPasswords :: CliArgs -> Property +prop_printsSpecifiedNumberOfPasswords (CliArgs args) + = isJust (getArg "-n" args) ==> + ioProperty $ do + (in', out', err', p) <- run' elocrypt args + response <- readHandle out' + + let number = read . fromJust . getArg "-n" $ args + words' = words response + + return (number == length words') + +prop_printsMultiplePasswordsPerLine :: CliArgs -> Property +prop_printsMultiplePasswordsPerLine (CliArgs args) + = (read . fromMaybe "8" . getPosParam $ args) <= 38 ==> + ioProperty $ do + (in', out', err', p) <- run' elocrypt args + 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 + +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/test/IntegTests.hs b/test/IntegTests.hs new file mode 100644 --- /dev/null +++ b/test/IntegTests.hs @@ -0,0 +1,33 @@ +{-# 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 qualified IntegTest.Elocrypt.PasswordTest as PasswordTest +import qualified IntegTest.Elocrypt.PassphraseTest as PassphraseTest + +main :: IO () +main = defaultMain (options tests) + +options :: TestTree -> TestTree +options = localOption (QuickCheckTests 10) + +tests :: TestTree +tests = testGroup "Integration Tests" [ + PasswordTest.tests, + PassphraseTest.tests + ] + + 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 @@ -2,16 +2,60 @@ import Control.Monad import System.Random +import Text.Printf + import Test.QuickCheck +newtype CliArgs + = CliArgs { getArgs :: [String] } + deriving Eq + +instance Show CliArgs where + show = unwords . 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) + +newtype PhraseCliArgs + = PhraseCliArgs { getPhraseArgs :: [String] } + deriving Eq + +instance Show PhraseCliArgs where + show = unwords . getPhraseArgs + +instance Arbitrary PhraseCliArgs where + arbitrary = do + num <- arbitrary `suchThat` (>2) `suchThat` (<=20) :: Gen Int + minLen <- arbitrary `suchThat` (>0) `suchThat` (<=40) :: Gen Int + maxLen <- arbitrary `suchThat` (>0) `suchThat` (<=40) :: Gen Int + + -- Need Either [], [num], or [num, minLength, maxLength] + args <- sublistOf ["-n %d" `printf` num, + show minLen, + show (maxLen + minLen)] + + return $ PhraseCliArgs ("-p" : args) + +-- Uh oh! I copy/pasted this! instance Arbitrary StdGen where arbitrary = mkStdGen `liftM` arbitrary newtype AlphaChar = Alpha Char deriving (Eq, Ord, Show) - +-- instance Arbitrary AlphaChar where arbitrary = Alpha `liftM` elements ['a'..'z'] + +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)) newtype GreaterThan2 a = GT2 { getGT2 :: a } deriving (Eq, Ord, Show) diff --git a/test/Test/ElocryptTest.hs b/test/Test/ElocryptTest.hs --- a/test/Test/ElocryptTest.hs +++ b/test/Test/ElocryptTest.hs @@ -3,9 +3,9 @@ import Control.Monad import Control.Monad.Random hiding (next) +import Data.List import Data.Maybe -import System.Random hiding (next) -import Test.QuickCheck +import Test.QuickCheck hiding (frequency) import Test.Tasty import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH @@ -22,10 +22,15 @@ = p /= fst (genPassword len caps gen') where (p, gen') = genPassword len caps gen -prop_genPasswordsShouldBeUnique :: GreaterThan2 Int -> Bool -> StdGen -> Bool -prop_genPasswordsShouldBeUnique (GT2 len) caps 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 caps gen) + where (p:ps:_) = fst (genPasswords len n caps gen) prop_newPasswordShouldBeLength :: Int -> Bool -> StdGen -> Property prop_newPasswordShouldBeLength len caps gen = len > 0 ==> @@ -33,17 +38,52 @@ prop_newPasswordShouldConsistOfAlphabet :: Int -> Bool -> StdGen -> Bool prop_newPasswordShouldConsistOfAlphabet len caps gen - = all ((flip elem) alphabet) (newPassword len caps gen) + = all (`elem` alphabet) (newPassword len caps gen) -prop_newPasswordsShouldBeUnique :: GreaterThan2 Int -> Bool -> StdGen -> Bool -prop_newPasswordsShouldBeUnique (GT2 len) caps gen +prop_newPasswordsShouldBeUnique + :: GreaterThan2 Int + -> GreaterThan2 Int + -> Bool + -> StdGen + -> Bool +prop_newPasswordsShouldBeUnique (GT2 len) (GT2 n) caps gen = p /= ps - where (p:ps:_) = newPasswords len caps gen + where (p:ps:_) = newPasswords len n caps gen prop_newPasswordShouldHaveLen :: Int -> Bool -> StdGen -> Property prop_newPasswordShouldHaveLen len caps gen = len >= 0 ==> length (newPassword len caps gen) == len +prop_genPassphraseShouldBeUnique + :: GreaterThan2 Int + -> GreaterThan2 Int + -> GreaterThan0 Int + -> StdGen + -> Bool +prop_genPassphraseShouldBeUnique (GT2 n) (GT2 min) (GT0 max) gen + = not . hasDuplicates $ phrase + where phrase = fst (genPassphrase n min (min+max) gen) + +prop_newPassphraseShouldBeUnique + :: GreaterThan2 Int + -> GreaterThan2 Int + -> GreaterThan0 Int + -> StdGen + -> Bool +prop_newPassphraseShouldBeUnique (GT2 n) (GT2 min) (GT0 max) gen + = not . hasDuplicates $ phrase + where phrase = newPassphrase n min (min+max) gen + +prop_newPassphraseShouldHaveLen + :: GreaterThan2 Int + -> GreaterThan2 Int + -> GreaterThan0 Int + -> 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 @@ -54,8 +94,7 @@ prop_lastNShouldSkip0Weights :: AlphaChar -> AlphaChar -> Int -> StdGen -> Property prop_lastNShouldSkip0Weights (Alpha c1) (Alpha c2) len gen = len > 0 ==> lastNShouldSkip0Weights' lastN' - where f2 = [c1, c2] - lastN' = evalRand (lastN len [c2, c1]) gen + where lastN' = evalRand (lastN len [c2, c1]) gen lastNShouldSkip0Weights' :: String -> Property lastNShouldSkip0Weights' (p:ps:pss:psss) = isCandidate p [pss, ps] .&&. @@ -64,7 +103,7 @@ -- Utility functions isCandidate :: Char -> String -> Property -isCandidate c (s:ss:sss) = hasCandidates f2 ==> +isCandidate c (s:ss:_) = hasCandidates f2 ==> isJust $ elem c `liftM` findNextCandidates f2 where f2 = [s, ss] @@ -73,9 +112,14 @@ hasCandidates :: String -> Bool hasCandidates s = (not . null) `liftM` findNextCandidates s == Just True -findNextCandidates :: String -> Maybe [Char] +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 findNextCandidates _ = Nothing -- This really shouldn't ever happen + +hasDuplicates = hasDuplicates' . sort + where hasDuplicates' (p1:p2:ps) | p1 == p2 = True + | otherwise = hasDuplicates' (p2:ps) + hasDuplicates' _ = False diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -10,5 +10,5 @@ main = defaultMain tests tests :: TestTree -tests = testGroup "All Tests" [PasswordTest.tests, - TrigraphTest.tests] +tests = testGroup "Unit Tests" [PasswordTest.tests, + TrigraphTest.tests]