diff --git a/Crypto/Cipher/Blowfish.hs b/Crypto/Cipher/Blowfish.hs index 55c467b..c5b010d 100644 --- a/Crypto/Cipher/Blowfish.hs +++ b/Crypto/Cipher/Blowfish.hs @@ -14,7 +14,6 @@ module Crypto.Cipher.Blowfish , Blowfish448 ) where -import Data.Byteable import Crypto.Cipher.Types import Crypto.Cipher.Blowfish.Primitive @@ -36,29 +35,26 @@ newtype Blowfish448 = Blowfish448 Context instance Cipher Blowfish where cipherName _ = "blowfish" cipherKeySize _ = KeySizeRange 6 56 - cipherInit k = undefined -- either error Blowfish $ initBlowfish (toBytes k) + cipherInit k = Blowfish `fmap` initBlowfish k -{- instance BlockCipher Blowfish where blockSize _ = 8 - ecbEncrypt (Blowfish bf) = encrypt bf - ecbDecrypt (Blowfish bf) = decrypt bf + ecbEncrypt (Blowfish bf) = ecbEncryptLegacy encrypt bf + ecbDecrypt (Blowfish bf) = ecbDecryptLegacy decrypt bf #define INSTANCE_CIPHER(CSTR, NAME, KEYSIZE) \ instance Cipher CSTR where \ { cipherName _ = NAME \ ; cipherKeySize _ = KeySizeFixed KEYSIZE \ - ; cipherInit k = either error CSTR $ initBlowfish (toBytes k) \ + ; cipherInit k = CSTR `fmap` initBlowfish k \ }; \ instance BlockCipher CSTR where \ { blockSize _ = 8 \ - ; ecbEncrypt (CSTR bf) = encrypt bf \ - ; ecbDecrypt (CSTR bf) = decrypt bf \ + ; ecbEncrypt (CSTR bf) = ecbEncryptLegacy encrypt bf \ + ; ecbDecrypt (CSTR bf) = ecbDecryptLegacy decrypt bf \ }; INSTANCE_CIPHER(Blowfish64, "blowfish64", 8) INSTANCE_CIPHER(Blowfish128, "blowfish128", 16) INSTANCE_CIPHER(Blowfish256, "blowfish256", 32) INSTANCE_CIPHER(Blowfish448, "blowfish448", 56) - --} diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index f4aa72d..6cf706c 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -22,6 +22,9 @@ import Data.Char import Data.Word import qualified Data.ByteString as B +import Crypto.Error +import Crypto.Internal.ByteArray + type Pbox = Vector Word32 type Sbox = Vector Word32 @@ -42,16 +45,17 @@ cipher (p, bs) b | B.length b `mod` 8 /= 0 = error "invalid data length" | otherwise = B.concat $ doChunks 8 (fromW32Pair . coreCrypto p bs . toW32Pair) b -initBlowfish :: B.ByteString -> Either String Context -initBlowfish b - | B.length b > (448 `div` 8) = fail "key too large" - | B.length b == 0 = keyFromByteString (B.replicate (18*4) 0) - | otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack $ b +initBlowfish :: ByteArray key => key -> CryptoFailable Context +initBlowfish key + | len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid + | len == 0 = keyFromByteString (B.replicate (18*4) 0) + | otherwise = keyFromByteString . B.pack . take (18*4) . cycle . B.unpack . byteArrayToBS $ key + where len = byteArrayLength key -keyFromByteString :: B.ByteString -> Either String Context +keyFromByteString :: B.ByteString -> CryptoFailable Context keyFromByteString k - | B.length k /= (18 * 4) = fail "Incorrect expanded key length." - | otherwise = return . bfMakeKey . (\ws -> V.generate 18 (ws!!)) . w8tow32 . B.unpack $ k + | B.length k /= (18 * 4) = CryptoFailed CryptoError_KeySizeInvalid + | otherwise = CryptoPassed . bfMakeKey . (\ws -> V.generate 18 (ws!!)) . w8tow32 . B.unpack $ k where w8tow32 :: [Word8] -> [Word32] w8tow32 [] = [] diff --git a/Crypto/Cipher/Camellia.hs b/Crypto/Cipher/Camellia.hs index 34a2bf7..d51e21a 100644 --- a/Crypto/Cipher/Camellia.hs +++ b/Crypto/Cipher/Camellia.hs @@ -13,7 +13,6 @@ module Crypto.Cipher.Camellia import Crypto.Cipher.Camellia.Primitive import Crypto.Cipher.Types -import Data.Byteable -- | Camellia block cipher with 128 bit key newtype Camellia128 = Camellia128 Camellia @@ -25,5 +24,5 @@ instance Cipher Camellia128 where instance BlockCipher Camellia128 where blockSize _ = 16 - ecbEncrypt (Camellia128 key) ba = encrypt key (byteArrayToBS ba) - ecbDecrypt (Camellia128 key) ba = decrypt key (byteArrayToBS ba) + ecbEncrypt (Camellia128 key) = ecbEncryptLegacy encrypt key + ecbDecrypt (Camellia128 key) = ecbDecryptLegacy decrypt key diff --git a/Crypto/Cipher/Camellia/Primitive.hs b/Crypto/Cipher/Camellia/Primitive.hs index cae9fa8..62f3c33 100644 --- a/Crypto/Cipher/Camellia/Primitive.hs +++ b/Crypto/Cipher/Camellia/Primitive.hs @@ -22,6 +22,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B import Crypto.Error +import Crypto.Internal.ByteArray data Mode = Decrypt | Encrypt @@ -166,12 +167,13 @@ setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB) -- Return the initialized key or a error message if the given -- keyseed was not 16-bytes in length. -- -initCamellia :: B.ByteString -- ^ The seed to use when creating the key +initCamellia :: ByteArray key + => key -- ^ The key to create the camellia context -> CryptoFailable Camellia -initCamellia keyseed - | B.length keyseed /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid - | otherwise = - let (kL, _, kA, _) = setKeyInterim keyseed in +initCamellia key + | byteArrayLength key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid + | otherwise = + let (kL, _, kA, _) = setKeyInterim (byteArrayToBS key) in let (kw1, kw2) = w128tow64 (kL `rotl128` 0) in let (k1, k2) = w128tow64 (kA `rotl128` 0) in diff --git a/Crypto/Cipher/DES.hs b/Crypto/Cipher/DES.hs index b04f21c..9108471 100644 --- a/Crypto/Cipher/DES.hs +++ b/Crypto/Cipher/DES.hs @@ -9,11 +9,11 @@ module Crypto.Cipher.DES ( DES ) where -import Data.Byteable import Data.Word +import Crypto.Error import Crypto.Cipher.Types import Crypto.Cipher.DES.Primitive -import Crypto.Cipher.DES.Serialization +import Crypto.Internal.ByteArray -- | DES Context data DES = DES Word64 @@ -31,9 +31,9 @@ instance BlockCipher DES where ecbDecrypt (DES key) = unblockify . map (decrypt key) . blockify -} -initDES :: b -> DES +initDES :: ByteArray key => key -> CryptoFailable DES initDES k - | len == 8 = DES key - | otherwise = error "DES: not a valid key length (valid=8)" - where len = byteableLength k - (Block key) = toW64 $ toBytes k + | len == 8 = CryptoPassed $ DES key + | otherwise = CryptoFailed $ CryptoError_KeySizeInvalid + where len = byteArrayLength k + key = byteArrayToW64BE k 0 diff --git a/Crypto/Cipher/TripleDES.hs b/Crypto/Cipher/TripleDES.hs index 7642b0c..1550dfe 100644 --- a/Crypto/Cipher/TripleDES.hs +++ b/Crypto/Cipher/TripleDES.hs @@ -19,7 +19,6 @@ import Crypto.Error import Crypto.Internal.ByteArray import Crypto.Cipher.Types import Crypto.Cipher.DES.Primitive -import Crypto.Cipher.DES.Serialization -- | 3DES with 3 different keys used all in the same direction data DES_EEE3 = DES_EEE3 Word64 Word64 Word64 diff --git a/Crypto/Cipher/Types.hs b/Crypto/Cipher/Types.hs index f200a22..7005ac9 100644 --- a/Crypto/Cipher/Types.hs +++ b/Crypto/Cipher/Types.hs @@ -13,6 +13,8 @@ module Crypto.Cipher.Types -- * Cipher classes Cipher(..) , BlockCipher(..) + , ecbEncryptLegacy + , ecbDecryptLegacy , StreamCipher(..) , DataUnitOffset , KeySizeSpecifier(..) diff --git a/Crypto/Cipher/Types/Block.hs b/Crypto/Cipher/Types/Block.hs index d79e07e..5906ee2 100644 --- a/Crypto/Cipher/Types/Block.hs +++ b/Crypto/Cipher/Types/Block.hs @@ -14,6 +14,8 @@ module Crypto.Cipher.Types.Block ( -- * BlockCipher BlockCipher(..) + , ecbEncryptLegacy + , ecbDecryptLegacy -- * initialization vector (IV) , IV(..) , makeIV @@ -111,6 +113,18 @@ class Cipher cipher => BlockCipher cipher where aeadInit :: Byteable iv => AEADMode -> cipher -> iv -> Maybe (AEAD cipher) aeadInit _ _ _ = Nothing +ecbEncryptLegacy :: ByteArray ba + => (cipher -> ByteString -> ByteString) + -> cipher -> ba -> ba +ecbEncryptLegacy f cipher input = + byteArrayFromBS $ f cipher (byteArrayToBS input) + +ecbDecryptLegacy :: ByteArray ba + => (cipher -> ByteString -> ByteString) + -> cipher -> ba -> ba +ecbDecryptLegacy f cipher input = + byteArrayFromBS $ f cipher (byteArrayToBS input) + -- | class of block cipher with a 128 bits block size class BlockCipher cipher => BlockCipher128 cipher where -- | encrypt using the XTS mode. diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs index 46eedb7..8cd5fce 100644 --- a/Crypto/Internal/ByteArray.hs +++ b/Crypto/Internal/ByteArray.hs @@ -19,6 +19,7 @@ module Crypto.Internal.ByteArray , byteArrayXor , byteArrayConcat , byteArrayToBS + , byteArrayFromBS , byteArrayToW64BE ) where @@ -114,6 +115,9 @@ byteArrayCopyAndFreeze bs f = byteArrayToBS :: ByteArray bs => bs -> ByteString byteArrayToBS bs = byteArrayCopyAndFreeze bs (\_ -> return ()) +byteArrayFromBS :: ByteArray bs => ByteString -> bs +byteArrayFromBS bs = byteArrayCopyAndFreeze bs (\_ -> return ()) + byteArrayToW64BE :: ByteArray bs => bs -> Int -> Word64 byteArrayToW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromBE64 <$> peek (p `plusPtr` ofs) diff --git a/cryptonite.sublime-project b/cryptonite.sublime-project index c5b1dc0..81e67cb 100644 --- a/cryptonite.sublime-project +++ b/cryptonite.sublime-project @@ -5,7 +5,7 @@ { "path": "cbits" }, { "path": "tests", "file_exclude_patterns": ["*.html"] }, { "path": "benchs" }, - { "path": "gen" }, + { "path": "gen" } ], "settings": { diff --git a/tests/BlockCipher.hs b/tests/BlockCipher.hs index 28b0e3c..b96370e 100644 --- a/tests/BlockCipher.hs +++ b/tests/BlockCipher.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} module BlockCipher ( KAT_ECB(..) , KAT_CBC(..) @@ -15,6 +16,13 @@ module BlockCipher ) where import Imports +import Data.Maybe +import Crypto.Cipher.Types +import qualified Data.ByteString as B + +------------------------------------------------------------------------ +-- KAT +------------------------------------------------------------------------ type BlockSize = Int type KeySize = Int @@ -71,6 +79,19 @@ data KAT_AEAD = KAT_AEAD , aeadTag :: ByteString -- ^ expected tag } deriving (Show,Eq) +-- | all the KATs. use defaultKATs to prevent compilation error +-- from future expansion of this data structure +data KATs = KATs + { kat_ECB :: [KAT_ECB] + , kat_CBC :: [KAT_CBC] + , kat_CFB :: [KAT_CFB] + , kat_CTR :: [KAT_CTR] + , kat_XTS :: [KAT_XTS] + , kat_AEAD :: [KAT_AEAD] + } deriving (Show,Eq) + +defaultKATs = KATs [] [] [] [] [] [] + testECB (_, _, cipherInit) ecbEncrypt ecbDecrypt kats = testGroup "ECB" (concatMap katTest (zip is kats) {- ++ propTests-}) where katTest (i,d) = @@ -125,5 +146,227 @@ testKatAEAD cipherInit aeadInit aeadAppendHeader aeadEncrypt aeadDecrypt aeadFin etag = aeadFinalize aeadEFinal (aeadTaglen d) dtag = aeadFinalize aeadDFinal (aeadTaglen d) +------------------------------------------------------------------------ +-- Properties +------------------------------------------------------------------------ + +-- | any sized bytestring +newtype Plaintext a = Plaintext { unPlaintext :: B.ByteString } + deriving (Show,Eq) + +-- | A multiple of blocksize bytestring +newtype PlaintextBS a = PlaintextBS { unPlaintextBS :: B.ByteString } + deriving (Show,Eq) + +type Key a = ByteString + +-- | a ECB unit test +data ECBUnit a = ECBUnit (Key a) (PlaintextBS a) + deriving (Eq) + +-- | a CBC unit test +data CBCUnit a = CBCUnit (Key a) (IV a) (PlaintextBS a) + deriving (Eq) + +-- | a CBC unit test +data CFBUnit a = CFBUnit (Key a) (IV a) (PlaintextBS a) + deriving (Eq) + +-- | a CFB unit test +data CFB8Unit a = CFB8Unit (Key a) (IV a) (Plaintext a) + deriving (Eq) + +-- | a CTR unit test +data CTRUnit a = CTRUnit (Key a) (IV a) (Plaintext a) + deriving (Eq) + +-- | a XTS unit test +data XTSUnit a = XTSUnit (Key a) (Key a) (IV a) (PlaintextBS a) + deriving (Eq) + +-- | a AEAD unit test +data AEADUnit a = AEADUnit (Key a) B.ByteString (Plaintext a) (Plaintext a) + deriving (Eq) + +-- | Stream cipher unit test +data StreamUnit a = StreamUnit (Key a) (Plaintext a) + deriving (Eq) + +instance Show (ECBUnit a) where + show (ECBUnit key b) = "ECB(key=" ++ show key ++ ",input=" ++ show b ++ ")" +instance Show (CBCUnit a) where + show (CBCUnit key iv b) = "CBC(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")" +instance Show (CFBUnit a) where + show (CFBUnit key iv b) = "CFB(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")" +instance Show (CFB8Unit a) where + show (CFB8Unit key iv b) = "CFB8(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")" +instance Show (CTRUnit a) where + show (CTRUnit key iv b) = "CTR(key=" ++ show key ++ ",iv=" ++ show (unPlaintext iv) ++ ",input=" ++ show b ++ ")" +instance Show (XTSUnit a) where + show (XTSUnit key1 key2 iv b) = "XTS(key1=" ++ show (toBytes key1) ++ ",key2=" ++ show (toBytes key2) ++ ",iv=" ++ show (toBytes iv) ++ ",input=" ++ show b ++ ")" +instance Show (AEADUnit a) where + show (AEADUnit key iv aad b) = "AEAD(key=" ++ show (toBytes key) ++ ",iv=" ++ show iv ++ ",aad=" ++ show (toBytes aad) ++ ",input=" ++ show b ++ ")" +instance Show (StreamUnit a) where + show (StreamUnit key b) = "Stream(key=" ++ show (toBytes key) ++ ",input=" ++ show b ++ ")" + +-- | Generate an arbitrary valid key for a specific block cipher +generateKey :: Cipher a => Gen (Key a) +generateKey = keyFromCipher undefined + where keyFromCipher :: Cipher a => a -> Gen (Key a) + keyFromCipher cipher = do + sz <- case cipherKeySize cipher of + KeySizeRange low high -> choose (low, high) + KeySizeFixed v -> return v + KeySizeEnum l -> elements l + B.pack <$> replicateM sz arbitrary + +-- | Generate an arbitrary valid IV for a specific block cipher +generateIv :: BlockCipher a => Gen (IV a) +generateIv = ivFromCipher undefined + where ivFromCipher :: BlockCipher a => a -> Gen (IV a) + ivFromCipher cipher = fromJust . makeIV . B.pack <$> replicateM (blockSize cipher) arbitrary + +-- | Generate an arbitrary valid IV for AEAD for a specific block cipher +generateIvAEAD :: Gen B.ByteString +generateIvAEAD = choose (12,90) >>= \sz -> (B.pack <$> replicateM sz arbitrary) + +-- | Generate a plaintext multiple of blocksize bytes +generatePlaintextMultipleBS :: BlockCipher a => Gen (PlaintextBS a) +generatePlaintextMultipleBS = choose (1,128) >>= \size -> replicateM (size * 16) arbitrary >>= return . PlaintextBS . B.pack + +-- | Generate any sized plaintext +generatePlaintext :: Gen (Plaintext a) +generatePlaintext = choose (0,324) >>= \size -> replicateM size arbitrary >>= return . Plaintext . B.pack + +instance BlockCipher a => Arbitrary (ECBUnit a) where + arbitrary = ECBUnit <$> generateKey + <*> generatePlaintextMultipleBS + +instance BlockCipher a => Arbitrary (CBCUnit a) where + arbitrary = CBCUnit <$> generateKey + <*> generateIv + <*> generatePlaintextMultipleBS + +instance BlockCipher a => Arbitrary (CFBUnit a) where + arbitrary = CFBUnit <$> generateKey + <*> generateIv + <*> generatePlaintextMultipleBS + +instance BlockCipher a => Arbitrary (CFB8Unit a) where + arbitrary = CFB8Unit <$> generateKey <*> generateIv <*> generatePlaintext + +instance BlockCipher a => Arbitrary (CTRUnit a) where + arbitrary = CTRUnit <$> generateKey + <*> generateIv + <*> generatePlaintext + +instance BlockCipher a => Arbitrary (XTSUnit a) where + arbitrary = XTSUnit <$> generateKey + <*> generateKey + <*> generateIv + <*> generatePlaintextMultipleBS + +instance BlockCipher a => Arbitrary (AEADUnit a) where + arbitrary = AEADUnit <$> generateKey + <*> generateIvAEAD + <*> generatePlaintext + <*> generatePlaintext + +instance StreamCipher a => Arbitrary (StreamUnit a) where + arbitrary = StreamUnit <$> generateKey + <*> generatePlaintext + +testBlockCipherBasic :: BlockCipher a => a -> [TestTree] +testBlockCipherBasic cipher = [ testProperty "ECB" ecbProp ] + where ecbProp = toTests cipher + toTests :: BlockCipher a => a -> (ECBUnit a -> Bool) + toTests _ = testProperty_ECB + testProperty_ECB (ECBUnit (cipherInit -> ctx) (toBytes -> plaintext)) = + plaintext `assertEq` ecbDecrypt ctx (ecbEncrypt ctx plaintext) + +testBlockCipherModes :: BlockCipher a => a -> [TestTree] +testBlockCipherModes cipher = + [ testProperty "CBC" cbcProp + , testProperty "CFB" cfbProp + , testProperty "CFB8" cfb8Prop + , testProperty "CTR" ctrProp + ] + where (cbcProp,cfbProp,cfb8Prop,ctrProp) = toTests cipher + toTests :: BlockCipher a + => a + -> ((CBCUnit a -> Bool), (CFBUnit a -> Bool), (CFB8Unit a -> Bool), (CTRUnit a -> Bool)) + toTests _ = (testProperty_CBC + ,testProperty_CFB + --,testProperty_CFB8 + ,testProperty_CTR + ) + testProperty_CBC (CBCUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = + plaintext `assertEq` cbcDecrypt ctx testIV (cbcEncrypt ctx testIV plaintext) + + testProperty_CFB (CFBUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = + plaintext `assertEq` cfbDecrypt ctx testIV (cfbEncrypt ctx testIV plaintext) + +{- + testProperty_CFB8 (CFB8Unit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = + plaintext `assertEq` cfb8Decrypt ctx testIV (cfb8Encrypt ctx testIV plaintext) +-} + + testProperty_CTR (CTRUnit (cipherInit -> ctx) testIV (toBytes -> plaintext)) = + plaintext `assertEq` ctrCombine ctx testIV (ctrCombine ctx testIV plaintext) + +testBlockCipherAEAD :: BlockCipher a => a -> [TestTree] +testBlockCipherAEAD cipher = + [ testProperty "OCB" (aeadProp AEAD_OCB) + , testProperty "CCM" (aeadProp AEAD_CCM) + , testProperty "EAX" (aeadProp AEAD_EAX) + , testProperty "CWC" (aeadProp AEAD_CWC) + , testProperty "GCM" (aeadProp AEAD_GCM) + ] + where aeadProp = toTests cipher + toTests :: BlockCipher a => a -> (AEADMode -> AEADUnit a -> Bool) + toTests _ = testProperty_AEAD + testProperty_AEAD mode (AEADUnit (cipherInit -> ctx) testIV (toBytes -> aad) (toBytes -> plaintext)) = + case aeadInit mode ctx testIV of + Just iniAead -> + let aead = aeadAppendHeader iniAead aad + (eText, aeadE) = aeadEncrypt aead plaintext + (dText, aeadD) = aeadDecrypt aead eText + eTag = aeadFinalize aeadE (blockSize ctx) + dTag = aeadFinalize aeadD (blockSize ctx) + in (plaintext `assertEq` dText) && (toBytes eTag `assertEq` toBytes dTag) + Nothing -> True + +{- +testBlockCipherXTS :: BlockCipher a => a -> [TestTree] +testBlockCipherXTS cipher = [testProperty "XTS" xtsProp] + where xtsProp = toTests cipher + toTests :: BlockCipher a => a -> (XTSUnit a -> Bool) + toTests _ = testProperty_XTS + + testProperty_XTS (XTSUnit (cipherInit -> ctx1) (cipherInit -> ctx2) testIV (toBytes -> plaintext)) + | blockSize ctx1 == 16 = plaintext `assertEq` xtsDecrypt (ctx1, ctx2) testIV 0 (xtsEncrypt (ctx1, ctx2) testIV 0 plaintext) + | otherwise = True +-} +testBlockCipherXTS = [] + +-- | Test a generic block cipher for properties +-- related to block cipher modes. +testModes :: BlockCipher a => a -> [TestTree] +testModes cipher = + [ testGroup "decrypt.encrypt==id" + (testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD cipher ++ testBlockCipherXTS cipher) + ] + +-- | Return tests for a specific blockcipher and a list of KATs +testBlockCipher :: BlockCipher a => KATs -> a -> TestTree +testBlockCipher kats cipher = testGroup (cipherName cipher) + ( (if kats == defaultKATs then [] else [testKATs kats cipher]) + ++ testModes cipher + ) + +assertEq :: ByteString -> ByteString -> Bool +assertEq b1 b2 | b1 /= b2 = error ("b1: " ++ show b1 ++ " b2: " ++ show b2) + | otherwise = True + is :: [Int] is = [1..] diff --git a/tests/KAT_Blowfish.hs b/tests/KAT_Blowfish.hs index e9e432e..997be1f 100644 --- a/tests/KAT_Blowfish.hs +++ b/tests/KAT_Blowfish.hs @@ -1,8 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module KAT_Blowfish where ---import Crypto.Cipher.Blowfish ---import Data.ByteString.Char8 () -- orphan IsString for older bytestring versions +import Crypto.Cipher.Blowfish import Imports import BlockCipher @@ -44,7 +43,6 @@ vectors_ecb = -- key plaintext cipher ] {- -kats = defaultKATs { kat_ECB = vectors_ecb } main = defaultMain [ testBlockCipher kats (undefined :: Blowfish64)