Crypto-4.2.5.2: src-test/QuickTest.hs

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Main(main) where

import           Codec.Encryption.AES      as AES
import           Codec.Encryption.Blowfish as Blowfish
import           Codec.Encryption.Modes
import           Codec.Encryption.Padding
import           Codec.Utils
import           Control.Monad             (unless)
import           Data.Bits
import           Data.Char
import           Data.LargeWord
import           Data.Word
import           Numeric
import           Test.QuickCheck

instance Arbitrary Word128 where
   arbitrary =
      do n <- choose ((fromIntegral (minBound::Word128))::Integer,
                      (fromIntegral (maxBound::Word128))::Integer)
         return (fromIntegral n)

prop_decryptEncrypt k b = b == Blowfish.decrypt k (Blowfish.encrypt k b)
   where types = (k :: Word8, b :: Word64)

prop_AESIdempotent k b = b == AES.decrypt k (AES.encrypt k b)
   where types = (k :: Word128, b :: Word128)

prop_unCbcCbc iv k bs =
   bs == (unPkcs5 $ unCbc Blowfish.decrypt iv k $ cbc Blowfish.encrypt iv k $ pkcs5 bs)
      where types =(k :: Word8, iv :: Word64, bs :: [Octet])

prop_unPkcs5Pkcs5 os =
   os == (unPkcs5 $ ((pkcs5 os)::[Word64]))
      where types = (os :: [Octet])

prop_unNullsNulls os =
   all (/=0) os ==>
      os == (unPadNulls $ ((padNulls os)::[Word64]))
         where types = (os :: [Octet])

prop_fromOctetsToOctets k n =
   k >= 0 && n > 1 ==>
      k == (fromOctets n $ toOctets n k)
         where types = (k :: Int, n :: Word8)

prop_unTwosCompTwosComp n =
   n < (0) ==>
      collect n $
      forAll g $
      \n -> n == (fromTwosComp $ toTwosComp n)
      where types = (n::Int)
            g = do n <- choose (minBound::Int,maxBound::Int)
                   return (13*n)

main :: IO ()
main = do
    results <- sequence
      [ quickCheckWithResult args prop_decryptEncrypt
      , quickCheckWithResult args prop_AESIdempotent
      , quickCheckWithResult args prop_unCbcCbc
      , quickCheckWithResult args prop_unPkcs5Pkcs5
      , quickCheckWithResult args prop_unNullsNulls
      , quickCheckWithResult args prop_fromOctetsToOctets
      , quickCheckWithResult args prop_unTwosCompTwosComp
      ]

    unless (all isSuccess results) $ do
      fail "SOME TESTS FAILED!"

    putStrLn "=> all tests passed!"
  where
    args = stdArgs { maxSuccess = 500 }