packages feed

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 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]