{-# LANGUAGE TemplateHaskell #-} module Test.ElocryptTest where import Control.Monad import Control.Monad.Random hiding (next) import Data.Maybe import System.Random hiding (next) import Test.QuickCheck import Test.Tasty.QuickCheck (testProperty) import Test.Tasty.TH import Data.Elocrypt import Data.Elocrypt.Trigraph import Test.Elocrypt.Instances tests = $(testGroupGenerator) prop_genPasswordShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool prop_genPasswordShouldBeUnique (GT2 len) gen = p /= fst (genPassword len gen') where (p, gen') = genPassword len gen prop_genPasswordsShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool prop_genPasswordsShouldBeUnique (GT2 len) gen = p /= ps where (p:ps:_) = fst (genPasswords len gen) prop_newPasswordShouldBeLength :: GreaterThan2 Int -> StdGen -> Bool prop_newPasswordShouldBeLength (GT2 len) gen = length (newPassword len gen) == len prop_newPasswordShouldConsistOfAlphabet :: GreaterThan2 Int -> StdGen -> Bool prop_newPasswordShouldConsistOfAlphabet (GT2 len) gen = all ((flip elem) alphabet) (newPassword len gen) prop_newPasswordsShouldBeUnique :: GreaterThan2 Int -> StdGen -> Bool prop_newPasswordsShouldBeUnique (GT2 len) gen = p /= ps where (p:ps:_) = newPasswords len gen prop_first2ShouldHaveLength2 :: StdGen -> Bool prop_first2ShouldHaveLength2 g = length (evalRand first2 g) == 2 prop_nextShouldSkip0Weights :: AlphaChar -> AlphaChar -> StdGen -> Property prop_nextShouldSkip0Weights (Alpha c1) (Alpha c2) gen = isCandidate next' [c1, c2] where next' = evalRand (next . reverse $ [c1, c2]) gen 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 (reverse [c1, c2]) len) gen lastNShouldSkip0Weights' :: String -> Property lastNShouldSkip0Weights' (p:ps:pss:psss) = isCandidate p [pss, ps] .&&. lastNShouldSkip0Weights' (ps:pss:psss) lastNShouldSkip0Weights' _ = property True -- Utility functions isCandidate :: Char -> String -> Property isCandidate c (s:ss:sss) = hasCandidates f2 ==> isJust $ elem c `liftM` findNextCandidates f2 where f2 = [s, ss] isCandidate _ _ = undefined -- This really shouldn't ever happen hasCandidates :: String -> Bool hasCandidates s = (not . null) `liftM` findNextCandidates s == Just True findNextCandidates :: String -> Maybe [Char] 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