Crypto-4.2.5.2: src-test/WordListTest.hs

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

module Main(main) where

import           Codec.Utils     (listFromOctets, listToOctets)
import           Control.Monad   (unless)
import           Data.Bits       (Bits, bitSize)
import           Data.LargeWord  (Word128, Word160, Word192, Word224, Word256, Word96)
import           Data.Word       (Word32, Word64, Word8)
import           Test.QuickCheck

newtype WordsX a = WordsX [a]

instance Show a => Show (WordsX a) where
  show (WordsX x) = show x

instance (Bounded a, Integral a, Bits a) => Arbitrary (WordsX a) where
  arbitrary = fmap WordsX (liftArbitrary $ chooseBoundedIntegral (minBound,maxBound))

checks :: [(String, IO Result)]
checks =
    [ ("Word32", quickCheckWithResult args $
         \w          -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word32]))
    , ("Word64", quickCheckWithResult args $
         \w          -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word64]))
    , ("Word96", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word96]))
    , ("Word128", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word128]))
    , ("Word160", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word160]))
    , ("Word192", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word192]))
    , ("Word224", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word224]))
    , ("Word256", quickCheckWithResult args $
         \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word256]))
    ]
  where
    args = stdArgs { maxSuccess = 1000 }

    -- (listFromOctets . listToOctets) isn't a proper identity due to 'trimNulls'
    hasTrailingZero :: (Eq x, Num x) => [x] -> Bool
    hasTrailingZero [] = False
    hasTrailingZero xs = last xs == 0

main :: IO ()
main = do
   results <- mapM test checks

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

   putStrLn "=> all tests passed!"
 where
   test :: (String, IO a) -> IO a
   test (s, t) = do putStrLn $ "Checking " ++ s
                    putStr "        "
                    t