PasswordTest.hs

{-# 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