module Crypto.Classical.Test
(
cycleT
, notSelfT
, diffKeyT
, noSelfMappingT
, stretchT
, plugFromT
, testAll
) where
import Lens.Micro
import Control.Monad (void)
import Crypto.Classical.Cipher
import Crypto.Classical.Letter
import Crypto.Classical.Types
import Crypto.Classical.Util
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Foldable as F
import Test.QuickCheck
instance Arbitrary ByteString where
arbitrary = B.pack . map _char <$> arbitrary
testAll :: IO ()
testAll = void . sequence $ cipherTs ++ otherTs
cipherTs :: [IO ()]
cipherTs = [ cycleT $ (^. caesar)
, cycleT $ (^. affine)
, cycleT $ (^. substitution)
, cycleT $ (^. stream)
, cycleT $ (^. vigenère)
, cycleT $ (^. enigma)
, notSelfT $ (^. caesar)
, notSelfT $ (^. affine)
, notSelfT $ (^. substitution)
, notSelfT $ (^. stream)
, notSelfT $ (^. vigenère)
, notSelfT $ (^. enigma)
, diffKeyT $ (^. caesar)
, diffKeyT $ (^. affine)
, diffKeyT $ (^. substitution)
, diffKeyT $ (^. stream)
, diffKeyT $ (^. vigenère)
, diffKeyT $ (^. enigma)
, noSelfMappingT
]
otherTs :: [IO ()]
otherTs = [ stretchT, plugFromT ]
cycleT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()
cycleT f = do
k <- key <$> prng
quickCheck (\m -> f (encrypt k m >>= decrypt k) == m)
notSelfT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()
notSelfT f = do
k <- key <$> prng
quickCheck (\m -> B.length m > 1 ==> m /= e f k m)
diffKeyT :: (Eq k,Monad c,Cipher k c) => (c ByteString -> ByteString) -> IO ()
diffKeyT f = do
k <- key <$> prng
k' <- key <$> prng
quickCheck (\m -> k /= k' && B.length m > 1 ==> e f k m /= e f k' m)
noSelfMappingT :: IO ()
noSelfMappingT = do
k <- key <$> prng
quickCheck (\m -> all (\(a,b) -> a /= b) $ B.zip m (e _enigma k m))
e :: Cipher k a => (a ByteString -> t) -> k -> ByteString -> t
e f k m = f $ encrypt k m
enig :: IO ByteString
enig = do
k <- key <$> prng
return $ encrypt k "Das ist ein Wetterbericht. Heil Hitler." ^. enigma
stretchT :: IO ()
stretchT = quickCheck prop
where prop :: [Int] -> Property
prop xs = let l = length xs in l > 0 ==> length (stretch xs) == 2 * l
plugFromT :: IO ()
plugFromT = quickCheck prop
where prop :: [(Letter,Letter)] -> Bool
prop xs = let xs' = xs & traverse . both %~ _char in
F.length (plugFrom xs') == 26