packages feed

nettle-0.4: src/Tests/Ciphers/Utils.hs

module Ciphers.Utils
	( Key(..)
	, genByteString
	, genKey'
	, genKey
	, genTypedKey
	, runCryptoFailable
	, genCipher
	, genIV
	, genUnalignedBlockCipherInput
	, genBlockCipherInput
	, initCipher
	, convertToShowable
	, assertEq
	) where

import Test.QuickCheck (Gen(..), elements, choose, vectorOf)

import Control.Monad (liftM)
import Crypto.Cipher.Types as CCT
import Crypto.Error
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B

data Key c a = Key c a

genByteString :: Int -> Gen B.ByteString
genByteString len = liftM B.pack $ vectorOf len (choose (0,255))

runMaybe :: (Monad m) => Maybe x -> m x
runMaybe Nothing = error "got nothing"
runMaybe (Just x) = return x

genKey' :: CCT.KeySizeSpecifier -> Gen B.ByteString
genKey' spec = case spec of
	CCT.KeySizeRange bot top -> choose (bot, top) >>= genByteString
	CCT.KeySizeEnum list     -> elements list >>= genByteString
	CCT.KeySizeFixed f       -> genByteString f

genKey :: CCT.Cipher c => c -> Gen (B.ByteString)
genKey c = genKey' (CCT.cipherKeySize c)

genTypedKey :: CCT.Cipher c => c -> Gen (Key c B.ByteString)
genTypedKey c = liftM (Key c) $ genKey' (CCT.cipherKeySize c)

runCryptoFailable :: CCT.Cipher c => CryptoFailable c -> c
runCryptoFailable (CryptoFailed e) = error $ show e
runCryptoFailable (CryptoPassed x) = x

genCipher :: CCT.Cipher c => c -> Gen c
genCipher c = liftM (runCryptoFailable . CCT.cipherInit) $ (genKey c)

genIV :: CCT.BlockCipher c => c -> Gen (IV c)
genIV c = genByteString (CCT.blockSize c) >>= runMaybe . CCT.makeIV

genBlockCipherInput :: CCT.BlockCipher c => c -> Int -> Gen B.ByteString
genBlockCipherInput c blocks = genByteString (CCT.blockSize c * blocks)

genUnalignedBlockCipherInput :: CCT.Cipher c => c -> Int -> Gen B.ByteString
genUnalignedBlockCipherInput c bytes = genByteString bytes

initCipher :: (CCT.Cipher c, BA.ByteArray ba) => Key c ba -> c
initCipher (Key _ k) = runCryptoFailable $ CCT.cipherInit k

convertToShowable :: BA.ByteArrayAccess a => a -> BA.Bytes
convertToShowable = BA.convert

assertEq :: (BA.ByteArrayAccess a, BA.ByteArrayAccess b) => a -> b -> Bool
assertEq b1 b2 | BA.eq b1 b2 = True
               | otherwise = error ("b1: " ++ show (convertToShowable b1) ++ " b2: " ++ show (convertToShowable b2))