elocrypt 0.6.0 → 1.0.0
raw patch · 11 files changed
+578/−232 lines, 11 filesdep ~tasty-thPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: tasty-th
API changes (from Hackage documentation)
+ Data.Elocrypt: genPassphrase :: RandomGen g => Int -> Int -> Int -> g -> ([String], g)
+ Data.Elocrypt: newPassphrase :: RandomGen g => Int -> Int -> Int -> g -> [String]
- Data.Elocrypt: genPasswords :: RandomGen g => Int -> Bool -> g -> ([String], g)
+ Data.Elocrypt: genPasswords :: RandomGen g => Int -> Int -> Bool -> g -> ([String], g)
- Data.Elocrypt: mkPassphrase :: Int -> IO [String]
+ Data.Elocrypt: mkPassphrase :: MonadRandom m => Int -> Int -> Int -> m [String]
- Data.Elocrypt: mkPasswords :: MonadRandom m => Int -> Bool -> m [String]
+ Data.Elocrypt: mkPasswords :: MonadRandom m => Int -> Int -> Bool -> m [String]
- Data.Elocrypt: newPasswords :: RandomGen g => Int -> Bool -> g -> [String]
+ Data.Elocrypt: newPasswords :: RandomGen g => Int -> Int -> Bool -> g -> [String]
Files
- README.md +10/−11
- cli-test/CliTests.hs +0/−130
- elocrypt.cabal +10/−9
- src/cli/Main.hs +136/−44
- src/lib/Data/Elocrypt.hs +72/−22
- test/IntegTest/Elocrypt/PassphraseTest.hs +114/−0
- test/IntegTest/Elocrypt/PasswordTest.hs +99/−0
- test/IntegTests.hs +33/−0
- test/Test/Elocrypt/Instances.hs +45/−1
- test/Test/ElocryptTest.hs +57/−13
- test/Tests.hs +2/−2
README.md view
@@ -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
− cli-test/CliTests.hs
@@ -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
elocrypt.cabal view
@@ -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
src/cli/Main.hs view
@@ -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
src/lib/Data/Elocrypt.hs view
@@ -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.
+ test/IntegTest/Elocrypt/PassphraseTest.hs view
@@ -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
+ test/IntegTest/Elocrypt/PasswordTest.hs view
@@ -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
+ test/IntegTests.hs view
@@ -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+ ]++
test/Test/Elocrypt/Instances.hs view
@@ -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)
test/Test/ElocryptTest.hs view
@@ -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
test/Tests.hs view
@@ -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]