Merge branch 'cipher-framework'
This commit is contained in:
Vincent Hanquez
commit
b08c7a223c
9
Crypto/Cipher/AES.hs
Normal file
9
Crypto/Cipher/AES.hs
Normal file
@ -0,0 +1,9 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.AES
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : good
|
||||
module Crypto.Cipher.AES
|
||||
(
|
||||
) where
|
||||
@ -21,7 +21,6 @@ import Foreign.C.String
|
||||
data AES
|
||||
data AESOCB
|
||||
data AESGCM
|
||||
|
||||
------------------------------------------------------------------------
|
||||
foreign import ccall "cryptonite_aes.h cryptonite_aes_initkey"
|
||||
c_aes_init :: Ptr AES -> CString -> CUInt -> IO ()
|
||||
|
||||
60
Crypto/Cipher/Blowfish.hs
Normal file
60
Crypto/Cipher/Blowfish.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Blowfish
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : good
|
||||
--
|
||||
module Crypto.Cipher.Blowfish
|
||||
( Blowfish
|
||||
, Blowfish64
|
||||
, Blowfish128
|
||||
, Blowfish256
|
||||
, Blowfish448
|
||||
) where
|
||||
|
||||
import Crypto.Cipher.Types
|
||||
import Crypto.Cipher.Blowfish.Primitive
|
||||
|
||||
-- | variable keyed blowfish state
|
||||
newtype Blowfish = Blowfish Context
|
||||
|
||||
-- | 64 bit keyed blowfish state
|
||||
newtype Blowfish64 = Blowfish64 Context
|
||||
|
||||
-- | 128 bit keyed blowfish state
|
||||
newtype Blowfish128 = Blowfish128 Context
|
||||
|
||||
-- | 256 bit keyed blowfish state
|
||||
newtype Blowfish256 = Blowfish256 Context
|
||||
|
||||
-- | 448 bit keyed blowfish state
|
||||
newtype Blowfish448 = Blowfish448 Context
|
||||
|
||||
instance Cipher Blowfish where
|
||||
cipherName _ = "blowfish"
|
||||
cipherKeySize _ = KeySizeRange 6 56
|
||||
cipherInit k = Blowfish `fmap` initBlowfish k
|
||||
|
||||
instance BlockCipher Blowfish where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (Blowfish bf) = encrypt bf
|
||||
ecbDecrypt (Blowfish bf) = decrypt bf
|
||||
|
||||
#define INSTANCE_CIPHER(CSTR, NAME, KEYSIZE) \
|
||||
instance Cipher CSTR where \
|
||||
{ cipherName _ = NAME \
|
||||
; cipherKeySize _ = KeySizeFixed KEYSIZE \
|
||||
; cipherInit k = CSTR `fmap` initBlowfish k \
|
||||
}; \
|
||||
instance BlockCipher CSTR where \
|
||||
{ blockSize _ = 8 \
|
||||
; 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)
|
||||
278
Crypto/Cipher/Blowfish/Box.hs
Normal file
278
Crypto/Cipher/Blowfish/Box.hs
Normal file
@ -0,0 +1,278 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Blowfish.Box
|
||||
-- License : BSD-style
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
module Crypto.Cipher.Blowfish.Box
|
||||
( createKeySchedule
|
||||
) where
|
||||
|
||||
import Crypto.Internal.WordArray (mutableArray32FromAddrBE, MutableArray32)
|
||||
|
||||
-- | Create a key schedule mutable array of the pbox followed by
|
||||
-- all the sboxes.
|
||||
createKeySchedule :: IO MutableArray32
|
||||
createKeySchedule = mutableArray32FromAddrBE 1042 "\
|
||||
\\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\
|
||||
\\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\
|
||||
\\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\
|
||||
\\xc0\xac\x29\xb7\xc9\x7c\x50\xdd\x3f\x84\xd5\xb5\xb5\x47\x09\x17\
|
||||
\\x92\x16\xd5\xd9\x89\x79\xfb\x1b\
|
||||
\\xd1\x31\x0b\xa6\x98\xdf\xb5\xac\x2f\xfd\x72\xdb\xd0\x1a\xdf\xb7\
|
||||
\\xb8\xe1\xaf\xed\x6a\x26\x7e\x96\xba\x7c\x90\x45\xf1\x2c\x7f\x99\
|
||||
\\x24\xa1\x99\x47\xb3\x91\x6c\xf7\x08\x01\xf2\xe2\x85\x8e\xfc\x16\
|
||||
\\x63\x69\x20\xd8\x71\x57\x4e\x69\xa4\x58\xfe\xa3\xf4\x93\x3d\x7e\
|
||||
\\x0d\x95\x74\x8f\x72\x8e\xb6\x58\x71\x8b\xcd\x58\x82\x15\x4a\xee\
|
||||
\\x7b\x54\xa4\x1d\xc2\x5a\x59\xb5\x9c\x30\xd5\x39\x2a\xf2\x60\x13\
|
||||
\\xc5\xd1\xb0\x23\x28\x60\x85\xf0\xca\x41\x79\x18\xb8\xdb\x38\xef\
|
||||
\\x8e\x79\xdc\xb0\x60\x3a\x18\x0e\x6c\x9e\x0e\x8b\xb0\x1e\x8a\x3e\
|
||||
\\xd7\x15\x77\xc1\xbd\x31\x4b\x27\x78\xaf\x2f\xda\x55\x60\x5c\x60\
|
||||
\\xe6\x55\x25\xf3\xaa\x55\xab\x94\x57\x48\x98\x62\x63\xe8\x14\x40\
|
||||
\\x55\xca\x39\x6a\x2a\xab\x10\xb6\xb4\xcc\x5c\x34\x11\x41\xe8\xce\
|
||||
\\xa1\x54\x86\xaf\x7c\x72\xe9\x93\xb3\xee\x14\x11\x63\x6f\xbc\x2a\
|
||||
\\x2b\xa9\xc5\x5d\x74\x18\x31\xf6\xce\x5c\x3e\x16\x9b\x87\x93\x1e\
|
||||
\\xaf\xd6\xba\x33\x6c\x24\xcf\x5c\x7a\x32\x53\x81\x28\x95\x86\x77\
|
||||
\\x3b\x8f\x48\x98\x6b\x4b\xb9\xaf\xc4\xbf\xe8\x1b\x66\x28\x21\x93\
|
||||
\\x61\xd8\x09\xcc\xfb\x21\xa9\x91\x48\x7c\xac\x60\x5d\xec\x80\x32\
|
||||
\\xef\x84\x5d\x5d\xe9\x85\x75\xb1\xdc\x26\x23\x02\xeb\x65\x1b\x88\
|
||||
\\x23\x89\x3e\x81\xd3\x96\xac\xc5\x0f\x6d\x6f\xf3\x83\xf4\x42\x39\
|
||||
\\x2e\x0b\x44\x82\xa4\x84\x20\x04\x69\xc8\xf0\x4a\x9e\x1f\x9b\x5e\
|
||||
\\x21\xc6\x68\x42\xf6\xe9\x6c\x9a\x67\x0c\x9c\x61\xab\xd3\x88\xf0\
|
||||
\\x6a\x51\xa0\xd2\xd8\x54\x2f\x68\x96\x0f\xa7\x28\xab\x51\x33\xa3\
|
||||
\\x6e\xef\x0b\x6c\x13\x7a\x3b\xe4\xba\x3b\xf0\x50\x7e\xfb\x2a\x98\
|
||||
\\xa1\xf1\x65\x1d\x39\xaf\x01\x76\x66\xca\x59\x3e\x82\x43\x0e\x88\
|
||||
\\x8c\xee\x86\x19\x45\x6f\x9f\xb4\x7d\x84\xa5\xc3\x3b\x8b\x5e\xbe\
|
||||
\\xe0\x6f\x75\xd8\x85\xc1\x20\x73\x40\x1a\x44\x9f\x56\xc1\x6a\xa6\
|
||||
\\x4e\xd3\xaa\x62\x36\x3f\x77\x06\x1b\xfe\xdf\x72\x42\x9b\x02\x3d\
|
||||
\\x37\xd0\xd7\x24\xd0\x0a\x12\x48\xdb\x0f\xea\xd3\x49\xf1\xc0\x9b\
|
||||
\\x07\x53\x72\xc9\x80\x99\x1b\x7b\x25\xd4\x79\xd8\xf6\xe8\xde\xf7\
|
||||
\\xe3\xfe\x50\x1a\xb6\x79\x4c\x3b\x97\x6c\xe0\xbd\x04\xc0\x06\xba\
|
||||
\\xc1\xa9\x4f\xb6\x40\x9f\x60\xc4\x5e\x5c\x9e\xc2\x19\x6a\x24\x63\
|
||||
\\x68\xfb\x6f\xaf\x3e\x6c\x53\xb5\x13\x39\xb2\xeb\x3b\x52\xec\x6f\
|
||||
\\x6d\xfc\x51\x1f\x9b\x30\x95\x2c\xcc\x81\x45\x44\xaf\x5e\xbd\x09\
|
||||
\\xbe\xe3\xd0\x04\xde\x33\x4a\xfd\x66\x0f\x28\x07\x19\x2e\x4b\xb3\
|
||||
\\xc0\xcb\xa8\x57\x45\xc8\x74\x0f\xd2\x0b\x5f\x39\xb9\xd3\xfb\xdb\
|
||||
\\x55\x79\xc0\xbd\x1a\x60\x32\x0a\xd6\xa1\x00\xc6\x40\x2c\x72\x79\
|
||||
\\x67\x9f\x25\xfe\xfb\x1f\xa3\xcc\x8e\xa5\xe9\xf8\xdb\x32\x22\xf8\
|
||||
\\x3c\x75\x16\xdf\xfd\x61\x6b\x15\x2f\x50\x1e\xc8\xad\x05\x52\xab\
|
||||
\\x32\x3d\xb5\xfa\xfd\x23\x87\x60\x53\x31\x7b\x48\x3e\x00\xdf\x82\
|
||||
\\x9e\x5c\x57\xbb\xca\x6f\x8c\xa0\x1a\x87\x56\x2e\xdf\x17\x69\xdb\
|
||||
\\xd5\x42\xa8\xf6\x28\x7e\xff\xc3\xac\x67\x32\xc6\x8c\x4f\x55\x73\
|
||||
\\x69\x5b\x27\xb0\xbb\xca\x58\xc8\xe1\xff\xa3\x5d\xb8\xf0\x11\xa0\
|
||||
\\x10\xfa\x3d\x98\xfd\x21\x83\xb8\x4a\xfc\xb5\x6c\x2d\xd1\xd3\x5b\
|
||||
\\x9a\x53\xe4\x79\xb6\xf8\x45\x65\xd2\x8e\x49\xbc\x4b\xfb\x97\x90\
|
||||
\\xe1\xdd\xf2\xda\xa4\xcb\x7e\x33\x62\xfb\x13\x41\xce\xe4\xc6\xe8\
|
||||
\\xef\x20\xca\xda\x36\x77\x4c\x01\xd0\x7e\x9e\xfe\x2b\xf1\x1f\xb4\
|
||||
\\x95\xdb\xda\x4d\xae\x90\x91\x98\xea\xad\x8e\x71\x6b\x93\xd5\xa0\
|
||||
\\xd0\x8e\xd1\xd0\xaf\xc7\x25\xe0\x8e\x3c\x5b\x2f\x8e\x75\x94\xb7\
|
||||
\\x8f\xf6\xe2\xfb\xf2\x12\x2b\x64\x88\x88\xb8\x12\x90\x0d\xf0\x1c\
|
||||
\\x4f\xad\x5e\xa0\x68\x8f\xc3\x1c\xd1\xcf\xf1\x91\xb3\xa8\xc1\xad\
|
||||
\\x2f\x2f\x22\x18\xbe\x0e\x17\x77\xea\x75\x2d\xfe\x8b\x02\x1f\xa1\
|
||||
\\xe5\xa0\xcc\x0f\xb5\x6f\x74\xe8\x18\xac\xf3\xd6\xce\x89\xe2\x99\
|
||||
\\xb4\xa8\x4f\xe0\xfd\x13\xe0\xb7\x7c\xc4\x3b\x81\xd2\xad\xa8\xd9\
|
||||
\\x16\x5f\xa2\x66\x80\x95\x77\x05\x93\xcc\x73\x14\x21\x1a\x14\x77\
|
||||
\\xe6\xad\x20\x65\x77\xb5\xfa\x86\xc7\x54\x42\xf5\xfb\x9d\x35\xcf\
|
||||
\\xeb\xcd\xaf\x0c\x7b\x3e\x89\xa0\xd6\x41\x1b\xd3\xae\x1e\x7e\x49\
|
||||
\\x00\x25\x0e\x2d\x20\x71\xb3\x5e\x22\x68\x00\xbb\x57\xb8\xe0\xaf\
|
||||
\\x24\x64\x36\x9b\xf0\x09\xb9\x1e\x55\x63\x91\x1d\x59\xdf\xa6\xaa\
|
||||
\\x78\xc1\x43\x89\xd9\x5a\x53\x7f\x20\x7d\x5b\xa2\x02\xe5\xb9\xc5\
|
||||
\\x83\x26\x03\x76\x62\x95\xcf\xa9\x11\xc8\x19\x68\x4e\x73\x4a\x41\
|
||||
\\xb3\x47\x2d\xca\x7b\x14\xa9\x4a\x1b\x51\x00\x52\x9a\x53\x29\x15\
|
||||
\\xd6\x0f\x57\x3f\xbc\x9b\xc6\xe4\x2b\x60\xa4\x76\x81\xe6\x74\x00\
|
||||
\\x08\xba\x6f\xb5\x57\x1b\xe9\x1f\xf2\x96\xec\x6b\x2a\x0d\xd9\x15\
|
||||
\\xb6\x63\x65\x21\xe7\xb9\xf9\xb6\xff\x34\x05\x2e\xc5\x85\x56\x64\
|
||||
\\x53\xb0\x2d\x5d\xa9\x9f\x8f\xa1\x08\xba\x47\x99\x6e\x85\x07\x6a\
|
||||
\\x4b\x7a\x70\xe9\xb5\xb3\x29\x44\xdb\x75\x09\x2e\xc4\x19\x26\x23\
|
||||
\\xad\x6e\xa6\xb0\x49\xa7\xdf\x7d\x9c\xee\x60\xb8\x8f\xed\xb2\x66\
|
||||
\\xec\xaa\x8c\x71\x69\x9a\x17\xff\x56\x64\x52\x6c\xc2\xb1\x9e\xe1\
|
||||
\\x19\x36\x02\xa5\x75\x09\x4c\x29\xa0\x59\x13\x40\xe4\x18\x3a\x3e\
|
||||
\\x3f\x54\x98\x9a\x5b\x42\x9d\x65\x6b\x8f\xe4\xd6\x99\xf7\x3f\xd6\
|
||||
\\xa1\xd2\x9c\x07\xef\xe8\x30\xf5\x4d\x2d\x38\xe6\xf0\x25\x5d\xc1\
|
||||
\\x4c\xdd\x20\x86\x84\x70\xeb\x26\x63\x82\xe9\xc6\x02\x1e\xcc\x5e\
|
||||
\\x09\x68\x6b\x3f\x3e\xba\xef\xc9\x3c\x97\x18\x14\x6b\x6a\x70\xa1\
|
||||
\\x68\x7f\x35\x84\x52\xa0\xe2\x86\xb7\x9c\x53\x05\xaa\x50\x07\x37\
|
||||
\\x3e\x07\x84\x1c\x7f\xde\xae\x5c\x8e\x7d\x44\xec\x57\x16\xf2\xb8\
|
||||
\\xb0\x3a\xda\x37\xf0\x50\x0c\x0d\xf0\x1c\x1f\x04\x02\x00\xb3\xff\
|
||||
\\xae\x0c\xf5\x1a\x3c\xb5\x74\xb2\x25\x83\x7a\x58\xdc\x09\x21\xbd\
|
||||
\\xd1\x91\x13\xf9\x7c\xa9\x2f\xf6\x94\x32\x47\x73\x22\xf5\x47\x01\
|
||||
\\x3a\xe5\xe5\x81\x37\xc2\xda\xdc\xc8\xb5\x76\x34\x9a\xf3\xdd\xa7\
|
||||
\\xa9\x44\x61\x46\x0f\xd0\x03\x0e\xec\xc8\xc7\x3e\xa4\x75\x1e\x41\
|
||||
\\xe2\x38\xcd\x99\x3b\xea\x0e\x2f\x32\x80\xbb\xa1\x18\x3e\xb3\x31\
|
||||
\\x4e\x54\x8b\x38\x4f\x6d\xb9\x08\x6f\x42\x0d\x03\xf6\x0a\x04\xbf\
|
||||
\\x2c\xb8\x12\x90\x24\x97\x7c\x79\x56\x79\xb0\x72\xbc\xaf\x89\xaf\
|
||||
\\xde\x9a\x77\x1f\xd9\x93\x08\x10\xb3\x8b\xae\x12\xdc\xcf\x3f\x2e\
|
||||
\\x55\x12\x72\x1f\x2e\x6b\x71\x24\x50\x1a\xdd\xe6\x9f\x84\xcd\x87\
|
||||
\\x7a\x58\x47\x18\x74\x08\xda\x17\xbc\x9f\x9a\xbc\xe9\x4b\x7d\x8c\
|
||||
\\xec\x7a\xec\x3a\xdb\x85\x1d\xfa\x63\x09\x43\x66\xc4\x64\xc3\xd2\
|
||||
\\xef\x1c\x18\x47\x32\x15\xd9\x08\xdd\x43\x3b\x37\x24\xc2\xba\x16\
|
||||
\\x12\xa1\x4d\x43\x2a\x65\xc4\x51\x50\x94\x00\x02\x13\x3a\xe4\xdd\
|
||||
\\x71\xdf\xf8\x9e\x10\x31\x4e\x55\x81\xac\x77\xd6\x5f\x11\x19\x9b\
|
||||
\\x04\x35\x56\xf1\xd7\xa3\xc7\x6b\x3c\x11\x18\x3b\x59\x24\xa5\x09\
|
||||
\\xf2\x8f\xe6\xed\x97\xf1\xfb\xfa\x9e\xba\xbf\x2c\x1e\x15\x3c\x6e\
|
||||
\\x86\xe3\x45\x70\xea\xe9\x6f\xb1\x86\x0e\x5e\x0a\x5a\x3e\x2a\xb3\
|
||||
\\x77\x1f\xe7\x1c\x4e\x3d\x06\xfa\x29\x65\xdc\xb9\x99\xe7\x1d\x0f\
|
||||
\\x80\x3e\x89\xd6\x52\x66\xc8\x25\x2e\x4c\xc9\x78\x9c\x10\xb3\x6a\
|
||||
\\xc6\x15\x0e\xba\x94\xe2\xea\x78\xa5\xfc\x3c\x53\x1e\x0a\x2d\xf4\
|
||||
\\xf2\xf7\x4e\xa7\x36\x1d\x2b\x3d\x19\x39\x26\x0f\x19\xc2\x79\x60\
|
||||
\\x52\x23\xa7\x08\xf7\x13\x12\xb6\xeb\xad\xfe\x6e\xea\xc3\x1f\x66\
|
||||
\\xe3\xbc\x45\x95\xa6\x7b\xc8\x83\xb1\x7f\x37\xd1\x01\x8c\xff\x28\
|
||||
\\xc3\x32\xdd\xef\xbe\x6c\x5a\xa5\x65\x58\x21\x85\x68\xab\x98\x02\
|
||||
\\xee\xce\xa5\x0f\xdb\x2f\x95\x3b\x2a\xef\x7d\xad\x5b\x6e\x2f\x84\
|
||||
\\x15\x21\xb6\x28\x29\x07\x61\x70\xec\xdd\x47\x75\x61\x9f\x15\x10\
|
||||
\\x13\xcc\xa8\x30\xeb\x61\xbd\x96\x03\x34\xfe\x1e\xaa\x03\x63\xcf\
|
||||
\\xb5\x73\x5c\x90\x4c\x70\xa2\x39\xd5\x9e\x9e\x0b\xcb\xaa\xde\x14\
|
||||
\\xee\xcc\x86\xbc\x60\x62\x2c\xa7\x9c\xab\x5c\xab\xb2\xf3\x84\x6e\
|
||||
\\x64\x8b\x1e\xaf\x19\xbd\xf0\xca\xa0\x23\x69\xb9\x65\x5a\xbb\x50\
|
||||
\\x40\x68\x5a\x32\x3c\x2a\xb4\xb3\x31\x9e\xe9\xd5\xc0\x21\xb8\xf7\
|
||||
\\x9b\x54\x0b\x19\x87\x5f\xa0\x99\x95\xf7\x99\x7e\x62\x3d\x7d\xa8\
|
||||
\\xf8\x37\x88\x9a\x97\xe3\x2d\x77\x11\xed\x93\x5f\x16\x68\x12\x81\
|
||||
\\x0e\x35\x88\x29\xc7\xe6\x1f\xd6\x96\xde\xdf\xa1\x78\x58\xba\x99\
|
||||
\\x57\xf5\x84\xa5\x1b\x22\x72\x63\x9b\x83\xc3\xff\x1a\xc2\x46\x96\
|
||||
\\xcd\xb3\x0a\xeb\x53\x2e\x30\x54\x8f\xd9\x48\xe4\x6d\xbc\x31\x28\
|
||||
\\x58\xeb\xf2\xef\x34\xc6\xff\xea\xfe\x28\xed\x61\xee\x7c\x3c\x73\
|
||||
\\x5d\x4a\x14\xd9\xe8\x64\xb7\xe3\x42\x10\x5d\x14\x20\x3e\x13\xe0\
|
||||
\\x45\xee\xe2\xb6\xa3\xaa\xab\xea\xdb\x6c\x4f\x15\xfa\xcb\x4f\xd0\
|
||||
\\xc7\x42\xf4\x42\xef\x6a\xbb\xb5\x65\x4f\x3b\x1d\x41\xcd\x21\x05\
|
||||
\\xd8\x1e\x79\x9e\x86\x85\x4d\xc7\xe4\x4b\x47\x6a\x3d\x81\x62\x50\
|
||||
\\xcf\x62\xa1\xf2\x5b\x8d\x26\x46\xfc\x88\x83\xa0\xc1\xc7\xb6\xa3\
|
||||
\\x7f\x15\x24\xc3\x69\xcb\x74\x92\x47\x84\x8a\x0b\x56\x92\xb2\x85\
|
||||
\\x09\x5b\xbf\x00\xad\x19\x48\x9d\x14\x62\xb1\x74\x23\x82\x0e\x00\
|
||||
\\x58\x42\x8d\x2a\x0c\x55\xf5\xea\x1d\xad\xf4\x3e\x23\x3f\x70\x61\
|
||||
\\x33\x72\xf0\x92\x8d\x93\x7e\x41\xd6\x5f\xec\xf1\x6c\x22\x3b\xdb\
|
||||
\\x7c\xde\x37\x59\xcb\xee\x74\x60\x40\x85\xf2\xa7\xce\x77\x32\x6e\
|
||||
\\xa6\x07\x80\x84\x19\xf8\x50\x9e\xe8\xef\xd8\x55\x61\xd9\x97\x35\
|
||||
\\xa9\x69\xa7\xaa\xc5\x0c\x06\xc2\x5a\x04\xab\xfc\x80\x0b\xca\xdc\
|
||||
\\x9e\x44\x7a\x2e\xc3\x45\x34\x84\xfd\xd5\x67\x05\x0e\x1e\x9e\xc9\
|
||||
\\xdb\x73\xdb\xd3\x10\x55\x88\xcd\x67\x5f\xda\x79\xe3\x67\x43\x40\
|
||||
\\xc5\xc4\x34\x65\x71\x3e\x38\xd8\x3d\x28\xf8\x9e\xf1\x6d\xff\x20\
|
||||
\\x15\x3e\x21\xe7\x8f\xb0\x3d\x4a\xe6\xe3\x9f\x2b\xdb\x83\xad\xf7\
|
||||
\\xe9\x3d\x5a\x68\x94\x81\x40\xf7\xf6\x4c\x26\x1c\x94\x69\x29\x34\
|
||||
\\x41\x15\x20\xf7\x76\x02\xd4\xf7\xbc\xf4\x6b\x2e\xd4\xa2\x00\x68\
|
||||
\\xd4\x08\x24\x71\x33\x20\xf4\x6a\x43\xb7\xd4\xb7\x50\x00\x61\xaf\
|
||||
\\x1e\x39\xf6\x2e\x97\x24\x45\x46\x14\x21\x4f\x74\xbf\x8b\x88\x40\
|
||||
\\x4d\x95\xfc\x1d\x96\xb5\x91\xaf\x70\xf4\xdd\xd3\x66\xa0\x2f\x45\
|
||||
\\xbf\xbc\x09\xec\x03\xbd\x97\x85\x7f\xac\x6d\xd0\x31\xcb\x85\x04\
|
||||
\\x96\xeb\x27\xb3\x55\xfd\x39\x41\xda\x25\x47\xe6\xab\xca\x0a\x9a\
|
||||
\\x28\x50\x78\x25\x53\x04\x29\xf4\x0a\x2c\x86\xda\xe9\xb6\x6d\xfb\
|
||||
\\x68\xdc\x14\x62\xd7\x48\x69\x00\x68\x0e\xc0\xa4\x27\xa1\x8d\xee\
|
||||
\\x4f\x3f\xfe\xa2\xe8\x87\xad\x8c\xb5\x8c\xe0\x06\x7a\xf4\xd6\xb6\
|
||||
\\xaa\xce\x1e\x7c\xd3\x37\x5f\xec\xce\x78\xa3\x99\x40\x6b\x2a\x42\
|
||||
\\x20\xfe\x9e\x35\xd9\xf3\x85\xb9\xee\x39\xd7\xab\x3b\x12\x4e\x8b\
|
||||
\\x1d\xc9\xfa\xf7\x4b\x6d\x18\x56\x26\xa3\x66\x31\xea\xe3\x97\xb2\
|
||||
\\x3a\x6e\xfa\x74\xdd\x5b\x43\x32\x68\x41\xe7\xf7\xca\x78\x20\xfb\
|
||||
\\xfb\x0a\xf5\x4e\xd8\xfe\xb3\x97\x45\x40\x56\xac\xba\x48\x95\x27\
|
||||
\\x55\x53\x3a\x3a\x20\x83\x8d\x87\xfe\x6b\xa9\xb7\xd0\x96\x95\x4b\
|
||||
\\x55\xa8\x67\xbc\xa1\x15\x9a\x58\xcc\xa9\x29\x63\x99\xe1\xdb\x33\
|
||||
\\xa6\x2a\x4a\x56\x3f\x31\x25\xf9\x5e\xf4\x7e\x1c\x90\x29\x31\x7c\
|
||||
\\xfd\xf8\xe8\x02\x04\x27\x2f\x70\x80\xbb\x15\x5c\x05\x28\x2c\xe3\
|
||||
\\x95\xc1\x15\x48\xe4\xc6\x6d\x22\x48\xc1\x13\x3f\xc7\x0f\x86\xdc\
|
||||
\\x07\xf9\xc9\xee\x41\x04\x1f\x0f\x40\x47\x79\xa4\x5d\x88\x6e\x17\
|
||||
\\x32\x5f\x51\xeb\xd5\x9b\xc0\xd1\xf2\xbc\xc1\x8f\x41\x11\x35\x64\
|
||||
\\x25\x7b\x78\x34\x60\x2a\x9c\x60\xdf\xf8\xe8\xa3\x1f\x63\x6c\x1b\
|
||||
\\x0e\x12\xb4\xc2\x02\xe1\x32\x9e\xaf\x66\x4f\xd1\xca\xd1\x81\x15\
|
||||
\\x6b\x23\x95\xe0\x33\x3e\x92\xe1\x3b\x24\x0b\x62\xee\xbe\xb9\x22\
|
||||
\\x85\xb2\xa2\x0e\xe6\xba\x0d\x99\xde\x72\x0c\x8c\x2d\xa2\xf7\x28\
|
||||
\\xd0\x12\x78\x45\x95\xb7\x94\xfd\x64\x7d\x08\x62\xe7\xcc\xf5\xf0\
|
||||
\\x54\x49\xa3\x6f\x87\x7d\x48\xfa\xc3\x9d\xfd\x27\xf3\x3e\x8d\x1e\
|
||||
\\x0a\x47\x63\x41\x99\x2e\xff\x74\x3a\x6f\x6e\xab\xf4\xf8\xfd\x37\
|
||||
\\xa8\x12\xdc\x60\xa1\xeb\xdd\xf8\x99\x1b\xe1\x4c\xdb\x6e\x6b\x0d\
|
||||
\\xc6\x7b\x55\x10\x6d\x67\x2c\x37\x27\x65\xd4\x3b\xdc\xd0\xe8\x04\
|
||||
\\xf1\x29\x0d\xc7\xcc\x00\xff\xa3\xb5\x39\x0f\x92\x69\x0f\xed\x0b\
|
||||
\\x66\x7b\x9f\xfb\xce\xdb\x7d\x9c\xa0\x91\xcf\x0b\xd9\x15\x5e\xa3\
|
||||
\\xbb\x13\x2f\x88\x51\x5b\xad\x24\x7b\x94\x79\xbf\x76\x3b\xd6\xeb\
|
||||
\\x37\x39\x2e\xb3\xcc\x11\x59\x79\x80\x26\xe2\x97\xf4\x2e\x31\x2d\
|
||||
\\x68\x42\xad\xa7\xc6\x6a\x2b\x3b\x12\x75\x4c\xcc\x78\x2e\xf1\x1c\
|
||||
\\x6a\x12\x42\x37\xb7\x92\x51\xe7\x06\xa1\xbb\xe6\x4b\xfb\x63\x50\
|
||||
\\x1a\x6b\x10\x18\x11\xca\xed\xfa\x3d\x25\xbd\xd8\xe2\xe1\xc3\xc9\
|
||||
\\x44\x42\x16\x59\x0a\x12\x13\x86\xd9\x0c\xec\x6e\xd5\xab\xea\x2a\
|
||||
\\x64\xaf\x67\x4e\xda\x86\xa8\x5f\xbe\xbf\xe9\x88\x64\xe4\xc3\xfe\
|
||||
\\x9d\xbc\x80\x57\xf0\xf7\xc0\x86\x60\x78\x7b\xf8\x60\x03\x60\x4d\
|
||||
\\xd1\xfd\x83\x46\xf6\x38\x1f\xb0\x77\x45\xae\x04\xd7\x36\xfc\xcc\
|
||||
\\x83\x42\x6b\x33\xf0\x1e\xab\x71\xb0\x80\x41\x87\x3c\x00\x5e\x5f\
|
||||
\\x77\xa0\x57\xbe\xbd\xe8\xae\x24\x55\x46\x42\x99\xbf\x58\x2e\x61\
|
||||
\\x4e\x58\xf4\x8f\xf2\xdd\xfd\xa2\xf4\x74\xef\x38\x87\x89\xbd\xc2\
|
||||
\\x53\x66\xf9\xc3\xc8\xb3\x8e\x74\xb4\x75\xf2\x55\x46\xfc\xd9\xb9\
|
||||
\\x7a\xeb\x26\x61\x8b\x1d\xdf\x84\x84\x6a\x0e\x79\x91\x5f\x95\xe2\
|
||||
\\x46\x6e\x59\x8e\x20\xb4\x57\x70\x8c\xd5\x55\x91\xc9\x02\xde\x4c\
|
||||
\\xb9\x0b\xac\xe1\xbb\x82\x05\xd0\x11\xa8\x62\x48\x75\x74\xa9\x9e\
|
||||
\\xb7\x7f\x19\xb6\xe0\xa9\xdc\x09\x66\x2d\x09\xa1\xc4\x32\x46\x33\
|
||||
\\xe8\x5a\x1f\x02\x09\xf0\xbe\x8c\x4a\x99\xa0\x25\x1d\x6e\xfe\x10\
|
||||
\\x1a\xb9\x3d\x1d\x0b\xa5\xa4\xdf\xa1\x86\xf2\x0f\x28\x68\xf1\x69\
|
||||
\\xdc\xb7\xda\x83\x57\x39\x06\xfe\xa1\xe2\xce\x9b\x4f\xcd\x7f\x52\
|
||||
\\x50\x11\x5e\x01\xa7\x06\x83\xfa\xa0\x02\xb5\xc4\x0d\xe6\xd0\x27\
|
||||
\\x9a\xf8\x8c\x27\x77\x3f\x86\x41\xc3\x60\x4c\x06\x61\xa8\x06\xb5\
|
||||
\\xf0\x17\x7a\x28\xc0\xf5\x86\xe0\x00\x60\x58\xaa\x30\xdc\x7d\x62\
|
||||
\\x11\xe6\x9e\xd7\x23\x38\xea\x63\x53\xc2\xdd\x94\xc2\xc2\x16\x34\
|
||||
\\xbb\xcb\xee\x56\x90\xbc\xb6\xde\xeb\xfc\x7d\xa1\xce\x59\x1d\x76\
|
||||
\\x6f\x05\xe4\x09\x4b\x7c\x01\x88\x39\x72\x0a\x3d\x7c\x92\x7c\x24\
|
||||
\\x86\xe3\x72\x5f\x72\x4d\x9d\xb9\x1a\xc1\x5b\xb4\xd3\x9e\xb8\xfc\
|
||||
\\xed\x54\x55\x78\x08\xfc\xa5\xb5\xd8\x3d\x7c\xd3\x4d\xad\x0f\xc4\
|
||||
\\x1e\x50\xef\x5e\xb1\x61\xe6\xf8\xa2\x85\x14\xd9\x6c\x51\x13\x3c\
|
||||
\\x6f\xd5\xc7\xe7\x56\xe1\x4e\xc4\x36\x2a\xbf\xce\xdd\xc6\xc8\x37\
|
||||
\\xd7\x9a\x32\x34\x92\x63\x82\x12\x67\x0e\xfa\x8e\x40\x60\x00\xe0\
|
||||
\\x3a\x39\xce\x37\xd3\xfa\xf5\xcf\xab\xc2\x77\x37\x5a\xc5\x2d\x1b\
|
||||
\\x5c\xb0\x67\x9e\x4f\xa3\x37\x42\xd3\x82\x27\x40\x99\xbc\x9b\xbe\
|
||||
\\xd5\x11\x8e\x9d\xbf\x0f\x73\x15\xd6\x2d\x1c\x7e\xc7\x00\xc4\x7b\
|
||||
\\xb7\x8c\x1b\x6b\x21\xa1\x90\x45\xb2\x6e\xb1\xbe\x6a\x36\x6e\xb4\
|
||||
\\x57\x48\xab\x2f\xbc\x94\x6e\x79\xc6\xa3\x76\xd2\x65\x49\xc2\xc8\
|
||||
\\x53\x0f\xf8\xee\x46\x8d\xde\x7d\xd5\x73\x0a\x1d\x4c\xd0\x4d\xc6\
|
||||
\\x29\x39\xbb\xdb\xa9\xba\x46\x50\xac\x95\x26\xe8\xbe\x5e\xe3\x04\
|
||||
\\xa1\xfa\xd5\xf0\x6a\x2d\x51\x9a\x63\xef\x8c\xe2\x9a\x86\xee\x22\
|
||||
\\xc0\x89\xc2\xb8\x43\x24\x2e\xf6\xa5\x1e\x03\xaa\x9c\xf2\xd0\xa4\
|
||||
\\x83\xc0\x61\xba\x9b\xe9\x6a\x4d\x8f\xe5\x15\x50\xba\x64\x5b\xd6\
|
||||
\\x28\x26\xa2\xf9\xa7\x3a\x3a\xe1\x4b\xa9\x95\x86\xef\x55\x62\xe9\
|
||||
\\xc7\x2f\xef\xd3\xf7\x52\xf7\xda\x3f\x04\x6f\x69\x77\xfa\x0a\x59\
|
||||
\\x80\xe4\xa9\x15\x87\xb0\x86\x01\x9b\x09\xe6\xad\x3b\x3e\xe5\x93\
|
||||
\\xe9\x90\xfd\x5a\x9e\x34\xd7\x97\x2c\xf0\xb7\xd9\x02\x2b\x8b\x51\
|
||||
\\x96\xd5\xac\x3a\x01\x7d\xa6\x7d\xd1\xcf\x3e\xd6\x7c\x7d\x2d\x28\
|
||||
\\x1f\x9f\x25\xcf\xad\xf2\xb8\x9b\x5a\xd6\xb4\x72\x5a\x88\xf5\x4c\
|
||||
\\xe0\x29\xac\x71\xe0\x19\xa5\xe6\x47\xb0\xac\xfd\xed\x93\xfa\x9b\
|
||||
\\xe8\xd3\xc4\x8d\x28\x3b\x57\xcc\xf8\xd5\x66\x29\x79\x13\x2e\x28\
|
||||
\\x78\x5f\x01\x91\xed\x75\x60\x55\xf7\x96\x0e\x44\xe3\xd3\x5e\x8c\
|
||||
\\x15\x05\x6d\xd4\x88\xf4\x6d\xba\x03\xa1\x61\x25\x05\x64\xf0\xbd\
|
||||
\\xc3\xeb\x9e\x15\x3c\x90\x57\xa2\x97\x27\x1a\xec\xa9\x3a\x07\x2a\
|
||||
\\x1b\x3f\x6d\x9b\x1e\x63\x21\xf5\xf5\x9c\x66\xfb\x26\xdc\xf3\x19\
|
||||
\\x75\x33\xd9\x28\xb1\x55\xfd\xf5\x03\x56\x34\x82\x8a\xba\x3c\xbb\
|
||||
\\x28\x51\x77\x11\xc2\x0a\xd9\xf8\xab\xcc\x51\x67\xcc\xad\x92\x5f\
|
||||
\\x4d\xe8\x17\x51\x38\x30\xdc\x8e\x37\x9d\x58\x62\x93\x20\xf9\x91\
|
||||
\\xea\x7a\x90\xc2\xfb\x3e\x7b\xce\x51\x21\xce\x64\x77\x4f\xbe\x32\
|
||||
\\xa8\xb6\xe3\x7e\xc3\x29\x3d\x46\x48\xde\x53\x69\x64\x13\xe6\x80\
|
||||
\\xa2\xae\x08\x10\xdd\x6d\xb2\x24\x69\x85\x2d\xfd\x09\x07\x21\x66\
|
||||
\\xb3\x9a\x46\x0a\x64\x45\xc0\xdd\x58\x6c\xde\xcf\x1c\x20\xc8\xae\
|
||||
\\x5b\xbe\xf7\xdd\x1b\x58\x8d\x40\xcc\xd2\x01\x7f\x6b\xb4\xe3\xbb\
|
||||
\\xdd\xa2\x6a\x7e\x3a\x59\xff\x45\x3e\x35\x0a\x44\xbc\xb4\xcd\xd5\
|
||||
\\x72\xea\xce\xa8\xfa\x64\x84\xbb\x8d\x66\x12\xae\xbf\x3c\x6f\x47\
|
||||
\\xd2\x9b\xe4\x63\x54\x2f\x5d\x9e\xae\xc2\x77\x1b\xf6\x4e\x63\x70\
|
||||
\\x74\x0e\x0d\x8d\xe7\x5b\x13\x57\xf8\x72\x16\x71\xaf\x53\x7d\x5d\
|
||||
\\x40\x40\xcb\x08\x4e\xb4\xe2\xcc\x34\xd2\x46\x6a\x01\x15\xaf\x84\
|
||||
\\xe1\xb0\x04\x28\x95\x98\x3a\x1d\x06\xb8\x9f\xb4\xce\x6e\xa0\x48\
|
||||
\\x6f\x3f\x3b\x82\x35\x20\xab\x82\x01\x1a\x1d\x4b\x27\x72\x27\xf8\
|
||||
\\x61\x15\x60\xb1\xe7\x93\x3f\xdc\xbb\x3a\x79\x2b\x34\x45\x25\xbd\
|
||||
\\xa0\x88\x39\xe1\x51\xce\x79\x4b\x2f\x32\xc9\xb7\xa0\x1f\xba\xc9\
|
||||
\\xe0\x1c\xc8\x7e\xbc\xc7\xd1\xf6\xcf\x01\x11\xc3\xa1\xe8\xaa\xc7\
|
||||
\\x1a\x90\x87\x49\xd4\x4f\xbd\x9a\xd0\xda\xde\xcb\xd5\x0a\xda\x38\
|
||||
\\x03\x39\xc3\x2a\xc6\x91\x36\x67\x8d\xf9\x31\x7c\xe0\xb1\x2b\x4f\
|
||||
\\xf7\x9e\x59\xb7\x43\xf5\xbb\x3a\xf2\xd5\x19\xff\x27\xd9\x45\x9c\
|
||||
\\xbf\x97\x22\x2c\x15\xe6\xfc\x2a\x0f\x91\xfc\x71\x9b\x94\x15\x25\
|
||||
\\xfa\xe5\x93\x61\xce\xb6\x9c\xeb\xc2\xa8\x64\x59\x12\xba\xa8\xd1\
|
||||
\\xb6\xc1\x07\x5e\xe3\x05\x6a\x0c\x10\xd2\x50\x65\xcb\x03\xa4\x42\
|
||||
\\xe0\xec\x6e\x0e\x16\x98\xdb\x3b\x4c\x98\xa0\xbe\x32\x78\xe9\x64\
|
||||
\\x9f\x1f\x95\x32\xe0\xd3\x92\xdf\xd3\xa0\x34\x2b\x89\x71\xf2\x1e\
|
||||
\\x1b\x0a\x74\x41\x4b\xa3\x34\x8c\xc5\xbe\x71\x20\xc3\x76\x32\xd8\
|
||||
\\xdf\x35\x9f\x8d\x9b\x99\x2f\x2e\xe6\x0b\x6f\x47\x0f\xe3\xf1\x1d\
|
||||
\\xe5\x4c\xda\x54\x1e\xda\xd8\x91\xce\x62\x79\xcf\xcd\x3e\x7e\x6f\
|
||||
\\x16\x18\xb1\x66\xfd\x2c\x1d\x05\x84\x8f\xd2\xc5\xf6\xfb\x22\x99\
|
||||
\\xf5\x23\xf3\x57\xa6\x32\x76\x23\x93\xa8\x35\x31\x56\xcc\xcd\x02\
|
||||
\\xac\xf0\x81\x62\x5a\x75\xeb\xb5\x6e\x16\x36\x97\x88\xd2\x73\xcc\
|
||||
\\xde\x96\x62\x92\x81\xb9\x49\xd0\x4c\x50\x90\x1b\x71\xc6\x56\x14\
|
||||
\\xe6\xc6\xc7\xbd\x32\x7a\x14\x0a\x45\xe1\xd0\x06\xc3\xf2\x7b\x9a\
|
||||
\\xc9\xaa\x53\xfd\x62\xa8\x0f\x00\xbb\x25\xbf\xe2\x35\xbd\xd2\xf6\
|
||||
\\x71\x12\x69\x05\xb2\x04\x02\x22\xb6\xcb\xcf\x7c\xcd\x76\x9c\x2b\
|
||||
\\x53\x11\x3e\xc0\x16\x40\xe3\xd3\x38\xab\xbd\x60\x25\x47\xad\xf0\
|
||||
\\xba\x38\x20\x9c\xf7\x46\xce\x76\x77\xaf\xa1\xc5\x20\x75\x60\x60\
|
||||
\\x85\xcb\xfe\x4e\x8a\xe8\x8d\xd8\x7a\xaa\xf9\xb0\x4c\xf9\xaa\x7e\
|
||||
\\x19\x48\xc2\x5c\x02\xfb\x8a\x8c\x01\xc3\x6a\xe4\xd6\xeb\xe1\xf9\
|
||||
\\x90\xd4\xf8\x69\xa6\x5c\xde\xa0\x3f\x09\x25\x2d\xc2\x08\xe6\x9f\
|
||||
\\xb7\x4e\x61\x32\xce\x77\xe2\x5b\x57\x8f\xdf\xe3\x3a\xc3\x72\xe6\
|
||||
\"#
|
||||
143
Crypto/Cipher/Blowfish/Primitive.hs
Normal file
143
Crypto/Cipher/Blowfish/Primitive.hs
Normal file
@ -0,0 +1,143 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Blowfish.Primitive
|
||||
-- License : BSD-style
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
|
||||
-- Rewritten by Vincent Hanquez (c) 2015
|
||||
--
|
||||
-- Original code:
|
||||
-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
|
||||
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
|
||||
-- (as found in Crypto-4.2.4)
|
||||
|
||||
module Crypto.Cipher.Blowfish.Primitive
|
||||
( Context
|
||||
, initBlowfish
|
||||
, encrypt
|
||||
, decrypt
|
||||
) where
|
||||
|
||||
import Control.Monad (forM_)
|
||||
import Data.Bits
|
||||
import Data.Word
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
import Crypto.Error
|
||||
import Crypto.Internal.Compat
|
||||
import Crypto.Internal.ByteArray
|
||||
import Crypto.Internal.Words
|
||||
import Crypto.Internal.WordArray
|
||||
import Crypto.Cipher.Blowfish.Box
|
||||
|
||||
-- | variable keyed blowfish state
|
||||
data Context = BF (Int -> Word32) -- p
|
||||
(Int -> Word32) -- sbox0
|
||||
(Int -> Word32) -- sbox1
|
||||
(Int -> Word32) -- sbox2
|
||||
(Int -> Word32) -- sbox2
|
||||
|
||||
encrypt, decrypt :: ByteArray ba => Context -> ba -> ba
|
||||
encrypt = cipher
|
||||
decrypt = cipher . decryptContext
|
||||
|
||||
decryptContext :: Context -> Context
|
||||
decryptContext (BF p s0 s1 s2 s3) = BF (\i -> p (17-i)) s0 s1 s2 s3
|
||||
|
||||
cipher :: ByteArray ba => Context -> ba -> ba
|
||||
cipher ctx b
|
||||
| byteArrayLength b == 0 = empty
|
||||
| byteArrayLength b `mod` 8 /= 0 = error "invalid data length"
|
||||
| otherwise = byteArrayMapAsWord64 (coreCrypto ctx) 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 -> CryptoFailable Context
|
||||
keyFromByteString k
|
||||
| B.length k /= (18 * 4) = CryptoFailed CryptoError_KeySizeInvalid
|
||||
| otherwise = CryptoPassed . makeKeySchedule . w8tow32 . B.unpack $ k
|
||||
where
|
||||
w8tow32 :: [Word8] -> [Word32]
|
||||
w8tow32 [] = []
|
||||
w8tow32 (a:b:c:d:xs) = ( (fromIntegral a `shiftL` 24) .|.
|
||||
(fromIntegral b `shiftL` 16) .|.
|
||||
(fromIntegral c `shiftL` 8) .|.
|
||||
(fromIntegral d) ) : w8tow32 xs
|
||||
w8tow32 _ = error $ "internal error: Crypto.Cipher.Blowfish:keyFromByteString"
|
||||
|
||||
coreCrypto :: Context -> Word64 -> Word64
|
||||
coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
|
||||
where
|
||||
-- transform the input @i over 16 rounds
|
||||
doRound :: Word64 -> Int -> Word64
|
||||
doRound i roundIndex
|
||||
| roundIndex == 16 =
|
||||
let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)
|
||||
in rotateL (i `xor` final) 32
|
||||
| otherwise =
|
||||
let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex)
|
||||
newi = ((i `shiftL` 32) `xor` (f newr)) .|. (fromIntegral newr)
|
||||
in doRound newi (roundIndex+1)
|
||||
|
||||
f :: Word32 -> Word64
|
||||
f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff)
|
||||
b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff)
|
||||
c = s2 (fromIntegral $ (t `shiftR` 8) .&. 0xff)
|
||||
d = s3 (fromIntegral $ t .&. 0xff)
|
||||
in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32
|
||||
|
||||
makeKeySchedule :: [Word32] -> Context
|
||||
makeKeySchedule key =
|
||||
let v = unsafeDoIO $ do
|
||||
mv <- createKeySchedule
|
||||
forM_ (zip key [0..17]) $ \(k, i) -> mutableArrayWriteXor32 mv i k
|
||||
prepare mv
|
||||
mutableArray32Freeze mv
|
||||
in BF (\i -> arrayRead32 v i)
|
||||
(\i -> arrayRead32 v (s0+i))
|
||||
(\i -> arrayRead32 v (s1+i))
|
||||
(\i -> arrayRead32 v (s2+i))
|
||||
(\i -> arrayRead32 v (s3+i))
|
||||
where
|
||||
s0 = 18
|
||||
s1 = 274
|
||||
s2 = 530
|
||||
s3 = 786
|
||||
|
||||
prepare mctx = loop 0 0
|
||||
where loop i input
|
||||
| i == 1042 = return ()
|
||||
| otherwise = do
|
||||
ninput <- coreCryptoMutable input
|
||||
let (nl, nr) = w64to32 ninput
|
||||
mutableArrayWrite32 mctx i nl
|
||||
mutableArrayWrite32 mctx (i+1) nr
|
||||
loop (i+2) ninput
|
||||
|
||||
coreCryptoMutable :: Word64 -> IO Word64
|
||||
coreCryptoMutable input = doRound input 0
|
||||
where doRound i roundIndex
|
||||
| roundIndex == 16 = do
|
||||
pVal1 <- mutableArrayRead32 mctx 16
|
||||
pVal2 <- mutableArrayRead32 mctx 17
|
||||
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
|
||||
return $ rotateL (i `xor` final) 32
|
||||
| otherwise = do
|
||||
pVal <- mutableArrayRead32 mctx roundIndex
|
||||
let newr = fromIntegral (i `shiftR` 32) `xor` pVal
|
||||
newr' <- f newr
|
||||
let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr)
|
||||
doRound newi (roundIndex+1)
|
||||
|
||||
|
||||
f :: Word32 -> IO Word64
|
||||
f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff))
|
||||
b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff))
|
||||
c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff))
|
||||
d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff))
|
||||
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
|
||||
28
Crypto/Cipher/Camellia.hs
Normal file
28
Crypto/Cipher/Camellia.hs
Normal file
@ -0,0 +1,28 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Camellia
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
--
|
||||
-- Camellia support. only 128 bit variant available for now.
|
||||
|
||||
module Crypto.Cipher.Camellia
|
||||
( Camellia128
|
||||
) where
|
||||
|
||||
import Crypto.Cipher.Camellia.Primitive
|
||||
import Crypto.Cipher.Types
|
||||
|
||||
-- | Camellia block cipher with 128 bit key
|
||||
newtype Camellia128 = Camellia128 Camellia
|
||||
|
||||
instance Cipher Camellia128 where
|
||||
cipherName _ = "Camellia128"
|
||||
cipherKeySize _ = KeySizeFixed 16
|
||||
cipherInit k = Camellia128 `fmap` initCamellia k
|
||||
|
||||
instance BlockCipher Camellia128 where
|
||||
blockSize _ = 16
|
||||
ecbEncrypt (Camellia128 key) = encrypt key
|
||||
ecbDecrypt (Camellia128 key) = decrypt key
|
||||
284
Crypto/Cipher/Camellia/Primitive.hs
Normal file
284
Crypto/Cipher/Camellia/Primitive.hs
Normal file
@ -0,0 +1,284 @@
|
||||
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Camellia.Primitive
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : Good
|
||||
--
|
||||
-- this only cover Camellia 128 bits for now, API will change once
|
||||
-- 192 and 256 mode are implemented too
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
module Crypto.Cipher.Camellia.Primitive
|
||||
( Camellia
|
||||
, initCamellia
|
||||
, encrypt
|
||||
, decrypt
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Unsafe as B
|
||||
|
||||
import Crypto.Error
|
||||
import Crypto.Internal.ByteArray
|
||||
import Crypto.Internal.Words
|
||||
import Crypto.Internal.WordArray
|
||||
|
||||
data Mode = Decrypt | Encrypt
|
||||
|
||||
w64tow128 :: (Word64, Word64) -> Word128
|
||||
w64tow128 (x1, x2) = Word128 x1 x2
|
||||
|
||||
w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
|
||||
w64tow8 x = (t1, t2, t3, t4, t5, t6, t7, t8)
|
||||
where
|
||||
t1 = fromIntegral (x `shiftR` 56)
|
||||
t2 = fromIntegral (x `shiftR` 48)
|
||||
t3 = fromIntegral (x `shiftR` 40)
|
||||
t4 = fromIntegral (x `shiftR` 32)
|
||||
t5 = fromIntegral (x `shiftR` 24)
|
||||
t6 = fromIntegral (x `shiftR` 16)
|
||||
t7 = fromIntegral (x `shiftR` 8)
|
||||
t8 = fromIntegral (x)
|
||||
|
||||
w8tow64 :: B.ByteString -> Word64
|
||||
w8tow64 b = (sh t1 56 .|. sh t2 48 .|. sh t3 40 .|. sh t4 32 .|. sh t5 24 .|. sh t6 16 .|. sh t7 8 .|. sh t8 0)
|
||||
where
|
||||
t1 = B.unsafeIndex b 0
|
||||
t2 = B.unsafeIndex b 1
|
||||
t3 = B.unsafeIndex b 2
|
||||
t4 = B.unsafeIndex b 3
|
||||
t5 = B.unsafeIndex b 4
|
||||
t6 = B.unsafeIndex b 5
|
||||
t7 = B.unsafeIndex b 6
|
||||
t8 = B.unsafeIndex b 7
|
||||
sh i r = (fromIntegral i) `shiftL` r
|
||||
|
||||
sbox :: Int -> Word8
|
||||
sbox = arrayRead8 t
|
||||
where t = array8
|
||||
"\x70\x82\x2c\xec\xb3\x27\xc0\xe5\xe4\x85\x57\x35\xea\x0c\xae\x41\
|
||||
\\x23\xef\x6b\x93\x45\x19\xa5\x21\xed\x0e\x4f\x4e\x1d\x65\x92\xbd\
|
||||
\\x86\xb8\xaf\x8f\x7c\xeb\x1f\xce\x3e\x30\xdc\x5f\x5e\xc5\x0b\x1a\
|
||||
\\xa6\xe1\x39\xca\xd5\x47\x5d\x3d\xd9\x01\x5a\xd6\x51\x56\x6c\x4d\
|
||||
\\x8b\x0d\x9a\x66\xfb\xcc\xb0\x2d\x74\x12\x2b\x20\xf0\xb1\x84\x99\
|
||||
\\xdf\x4c\xcb\xc2\x34\x7e\x76\x05\x6d\xb7\xa9\x31\xd1\x17\x04\xd7\
|
||||
\\x14\x58\x3a\x61\xde\x1b\x11\x1c\x32\x0f\x9c\x16\x53\x18\xf2\x22\
|
||||
\\xfe\x44\xcf\xb2\xc3\xb5\x7a\x91\x24\x08\xe8\xa8\x60\xfc\x69\x50\
|
||||
\\xaa\xd0\xa0\x7d\xa1\x89\x62\x97\x54\x5b\x1e\x95\xe0\xff\x64\xd2\
|
||||
\\x10\xc4\x00\x48\xa3\xf7\x75\xdb\x8a\x03\xe6\xda\x09\x3f\xdd\x94\
|
||||
\\x87\x5c\x83\x02\xcd\x4a\x90\x33\x73\x67\xf6\xf3\x9d\x7f\xbf\xe2\
|
||||
\\x52\x9b\xd8\x26\xc8\x37\xc6\x3b\x81\x96\x6f\x4b\x13\xbe\x63\x2e\
|
||||
\\xe9\x79\xa7\x8c\x9f\x6e\xbc\x8e\x29\xf5\xf9\xb6\x2f\xfd\xb4\x59\
|
||||
\\x78\x98\x06\x6a\xe7\x46\x71\xba\xd4\x25\xab\x42\x88\xa2\x8d\xfa\
|
||||
\\x72\x07\xb9\x55\xf8\xee\xac\x0a\x36\x49\x2a\x68\x3c\x38\xf1\xa4\
|
||||
\\x40\x28\xd3\x7b\xbb\xc9\x43\xc1\x15\xe3\xad\xf4\x77\xc7\x80\x9e"#
|
||||
|
||||
sbox1 :: Word8 -> Word8
|
||||
sbox1 x = sbox (fromIntegral x)
|
||||
|
||||
sbox2 :: Word8 -> Word8
|
||||
sbox2 x = sbox1 x `rotateL` 1
|
||||
|
||||
sbox3 :: Word8 -> Word8
|
||||
sbox3 x = sbox1 x `rotateL` 7
|
||||
|
||||
sbox4 :: Word8 -> Word8
|
||||
sbox4 x = sbox1 (x `rotateL` 1)
|
||||
|
||||
sigma1, sigma2, sigma3, sigma4, sigma5, sigma6 :: Word64
|
||||
sigma1 = 0xA09E667F3BCC908B
|
||||
sigma2 = 0xB67AE8584CAA73B2
|
||||
sigma3 = 0xC6EF372FE94F82BE
|
||||
sigma4 = 0x54FF53A5F1D36F1C
|
||||
sigma5 = 0x10E527FADE682D1D
|
||||
sigma6 = 0xB05688C2B3E6C1FD
|
||||
|
||||
rotl128 :: Word128 -> Int -> Word128
|
||||
rotl128 v 0 = v
|
||||
rotl128 (Word128 x1 x2) 64 = Word128 x2 x1
|
||||
|
||||
rotl128 v@(Word128 x1 x2) w
|
||||
| w > 64 = (v `rotl128` 64) `rotl128` (w - 64)
|
||||
| otherwise = Word128 (x1high .|. x2low) (x2high .|. x1low)
|
||||
where
|
||||
splitBits i = (i .&. complement x, i .&. x)
|
||||
where x = 2 ^ w - 1
|
||||
(x1high, x1low) = splitBits (x1 `rotateL` w)
|
||||
(x2high, x2low) = splitBits (x2 `rotateL` w)
|
||||
|
||||
data Camellia = Camellia
|
||||
{ k :: Array64
|
||||
, kw :: Array64
|
||||
, ke :: Array64
|
||||
}
|
||||
|
||||
setKeyInterim :: ByteArray key => key -> (Word128, Word128, Word128, Word128)
|
||||
setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)
|
||||
where kL = (byteArrayToW64BE keyseed 0, byteArrayToW64BE keyseed 8)
|
||||
kR = (0, 0)
|
||||
|
||||
kA = let d1 = (fst kL `xor` fst kR)
|
||||
d2 = (snd kL `xor` snd kR)
|
||||
d3 = d2 `xor` feistel d1 sigma1
|
||||
d4 = d1 `xor` feistel d3 sigma2
|
||||
d5 = d4 `xor` (fst kL)
|
||||
d6 = d3 `xor` (snd kL)
|
||||
d7 = d6 `xor` feistel d5 sigma3
|
||||
d8 = d5 `xor` feistel d7 sigma4
|
||||
in (d8, d7)
|
||||
|
||||
kB = let d1 = (fst kA `xor` fst kR)
|
||||
d2 = (snd kA `xor` snd kR)
|
||||
d3 = d2 `xor` feistel d1 sigma5
|
||||
d4 = d1 `xor` feistel d3 sigma6
|
||||
in (d4, d3)
|
||||
|
||||
-- | Initialize a 128-bit key
|
||||
-- Return the initialized key or a error message if the given
|
||||
-- keyseed was not 16-bytes in length.
|
||||
--
|
||||
initCamellia :: ByteArray key
|
||||
=> key -- ^ The key to create the camellia context
|
||||
-> CryptoFailable Camellia
|
||||
initCamellia key
|
||||
| byteArrayLength key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid
|
||||
| otherwise =
|
||||
let (kL, _, kA, _) = setKeyInterim key in
|
||||
|
||||
let (Word128 kw1 kw2) = (kL `rotl128` 0) in
|
||||
let (Word128 k1 k2) = (kA `rotl128` 0) in
|
||||
let (Word128 k3 k4) = (kL `rotl128` 15) in
|
||||
let (Word128 k5 k6) = (kA `rotl128` 15) in
|
||||
let (Word128 ke1 ke2) = (kA `rotl128` 30) in --ke1 = (KA <<< 30) >> 64; ke2 = (KA <<< 30) & MASK64;
|
||||
let (Word128 k7 k8) = (kL `rotl128` 45) in --k7 = (KL <<< 45) >> 64; k8 = (KL <<< 45) & MASK64;
|
||||
let (Word128 k9 _) = (kA `rotl128` 45) in --k9 = (KA <<< 45) >> 64;
|
||||
let (Word128 _ k10) = (kL `rotl128` 60) in
|
||||
let (Word128 k11 k12) = (kA `rotl128` 60) in
|
||||
let (Word128 ke3 ke4) = (kL `rotl128` 77) in
|
||||
let (Word128 k13 k14) = (kL `rotl128` 94) in
|
||||
let (Word128 k15 k16) = (kA `rotl128` 94) in
|
||||
let (Word128 k17 k18) = (kL `rotl128` 111) in
|
||||
let (Word128 kw3 kw4) = (kA `rotl128` 111) in
|
||||
|
||||
CryptoPassed $ Camellia
|
||||
{ kw = array64 4 [ kw1, kw2, kw3, kw4 ]
|
||||
, ke = array64 4 [ ke1, ke2, ke3, ke4 ]
|
||||
, k = array64 18 [ k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14, k15, k16, k17, k18 ]
|
||||
}
|
||||
|
||||
feistel :: Word64 -> Word64 -> Word64
|
||||
feistel fin sk =
|
||||
let x = fin `xor` sk in
|
||||
let (t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x in
|
||||
let t1' = sbox1 t1 in
|
||||
let t2' = sbox2 t2 in
|
||||
let t3' = sbox3 t3 in
|
||||
let t4' = sbox4 t4 in
|
||||
let t5' = sbox2 t5 in
|
||||
let t6' = sbox3 t6 in
|
||||
let t7' = sbox4 t7 in
|
||||
let t8' = sbox1 t8 in
|
||||
let y1 = t1' `xor` t3' `xor` t4' `xor` t6' `xor` t7' `xor` t8' in
|
||||
let y2 = t1' `xor` t2' `xor` t4' `xor` t5' `xor` t7' `xor` t8' in
|
||||
let y3 = t1' `xor` t2' `xor` t3' `xor` t5' `xor` t6' `xor` t8' in
|
||||
let y4 = t2' `xor` t3' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in
|
||||
let y5 = t1' `xor` t2' `xor` t6' `xor` t7' `xor` t8' in
|
||||
let y6 = t2' `xor` t3' `xor` t5' `xor` t7' `xor` t8' in
|
||||
let y7 = t3' `xor` t4' `xor` t5' `xor` t6' `xor` t8' in
|
||||
let y8 = t1' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in
|
||||
w8tow64 $ B.pack [y1, y2, y3, y4, y5, y6, y7, y8]
|
||||
|
||||
fl :: Word64 -> Word64 -> Word64
|
||||
fl fin sk =
|
||||
let (x1, x2) = w64to32 fin in
|
||||
let (k1, k2) = w64to32 sk in
|
||||
let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in
|
||||
let y1 = x1 `xor` (y2 .|. k2) in
|
||||
w32to64 (y1, y2)
|
||||
|
||||
flinv :: Word64 -> Word64 -> Word64
|
||||
flinv fin sk =
|
||||
let (y1, y2) = w64to32 fin in
|
||||
let (k1, k2) = w64to32 sk in
|
||||
let x1 = y1 `xor` (y2 .|. k2) in
|
||||
let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1) in
|
||||
w32to64 (x1, x2)
|
||||
|
||||
{- in decrypt mode 0->17 1->16 ... -}
|
||||
getKeyK :: Mode -> Camellia -> Int -> Word64
|
||||
getKeyK Encrypt key i = k key `arrayRead64` i
|
||||
getKeyK Decrypt key i = k key `arrayRead64` (17 - i)
|
||||
|
||||
{- in decrypt mode 0->3 1->2 2->1 3->0 -}
|
||||
getKeyKe :: Mode -> Camellia -> Int -> Word64
|
||||
getKeyKe Encrypt key i = ke key `arrayRead64` i
|
||||
getKeyKe Decrypt key i = ke key `arrayRead64` (3 - i)
|
||||
|
||||
{- in decrypt mode 0->2 1->3 2->0 3->1 -}
|
||||
getKeyKw :: Mode -> Camellia -> Int -> Word64
|
||||
getKeyKw Encrypt key i = (kw key) `arrayRead64` i
|
||||
getKeyKw Decrypt key i = (kw key) `arrayRead64` ((i + 2) `mod` 4)
|
||||
|
||||
{- perform the following
|
||||
D2 = D2 ^ F(D1, k1); // Round 1
|
||||
D1 = D1 ^ F(D2, k2); // Round 2
|
||||
D2 = D2 ^ F(D1, k3); // Round 3
|
||||
D1 = D1 ^ F(D2, k4); // Round 4
|
||||
D2 = D2 ^ F(D1, k5); // Round 5
|
||||
D1 = D1 ^ F(D2, k6); // Round 6
|
||||
-}
|
||||
doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
|
||||
doBlockRound mode key d1 d2 i =
|
||||
let r1 = d2 `xor` feistel d1 (getKeyK mode key (0+i)) in {- Round 1+i -}
|
||||
let r2 = d1 `xor` feistel r1 (getKeyK mode key (1+i)) in {- Round 2+i -}
|
||||
let r3 = r1 `xor` feistel r2 (getKeyK mode key (2+i)) in {- Round 3+i -}
|
||||
let r4 = r2 `xor` feistel r3 (getKeyK mode key (3+i)) in {- Round 4+i -}
|
||||
let r5 = r3 `xor` feistel r4 (getKeyK mode key (4+i)) in {- Round 5+i -}
|
||||
let r6 = r4 `xor` feistel r5 (getKeyK mode key (5+i)) in {- Round 6+i -}
|
||||
(r6, r5)
|
||||
|
||||
doBlock :: Mode -> Camellia -> Word128 -> Word128
|
||||
doBlock mode key (Word128 d1 d2) =
|
||||
let d1a = d1 `xor` (getKeyKw mode key 0) in {- Prewhitening -}
|
||||
let d2a = d2 `xor` (getKeyKw mode key 1) in
|
||||
|
||||
let (d1b, d2b) = doBlockRound mode key d1a d2a 0 in
|
||||
|
||||
let d1c = fl d1b (getKeyKe mode key 0) in {- FL -}
|
||||
let d2c = flinv d2b (getKeyKe mode key 1) in {- FLINV -}
|
||||
|
||||
let (d1d, d2d) = doBlockRound mode key d1c d2c 6 in
|
||||
|
||||
let d1e = fl d1d (getKeyKe mode key 2) in {- FL -}
|
||||
let d2e = flinv d2d (getKeyKe mode key 3) in {- FLINV -}
|
||||
|
||||
let (d1f, d2f) = doBlockRound mode key d1e d2e 12 in
|
||||
|
||||
let d2g = d2f `xor` (getKeyKw mode key 2) in {- Postwhitening -}
|
||||
let d1g = d1f `xor` (getKeyKw mode key 3) in
|
||||
w64tow128 (d2g, d1g)
|
||||
|
||||
{- encryption for 128 bits blocks -}
|
||||
encryptBlock :: Camellia -> Word128 -> Word128
|
||||
encryptBlock = doBlock Encrypt
|
||||
|
||||
{- decryption for 128 bits blocks -}
|
||||
decryptBlock :: Camellia -> Word128 -> Word128
|
||||
decryptBlock = doBlock Decrypt
|
||||
|
||||
-- | Encrypts the given ByteString using the given Key
|
||||
encrypt :: ByteArray ba
|
||||
=> Camellia -- ^ The key to use
|
||||
-> ba -- ^ The data to encrypt
|
||||
-> ba
|
||||
encrypt key = byteArrayMapAsWord128 (encryptBlock key)
|
||||
|
||||
-- | Decrypts the given ByteString using the given Key
|
||||
decrypt :: ByteArray ba
|
||||
=> Camellia -- ^ The key to use
|
||||
-> ba -- ^ The data to decrypt
|
||||
-> ba
|
||||
decrypt key = byteArrayMapAsWord128 (decryptBlock key)
|
||||
37
Crypto/Cipher/DES.hs
Normal file
37
Crypto/Cipher/DES.hs
Normal file
@ -0,0 +1,37 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.DES
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : good
|
||||
--
|
||||
module Crypto.Cipher.DES
|
||||
( DES
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Crypto.Error
|
||||
import Crypto.Cipher.Types
|
||||
import Crypto.Cipher.DES.Primitive
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
-- | DES Context
|
||||
data DES = DES Word64
|
||||
deriving (Eq)
|
||||
|
||||
instance Cipher DES where
|
||||
cipherName _ = "DES"
|
||||
cipherKeySize _ = KeySizeFixed 8
|
||||
cipherInit k = initDES k
|
||||
|
||||
instance BlockCipher DES where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (DES key) = byteArrayMapAsWord64 (unBlock . encrypt key . Block)
|
||||
ecbDecrypt (DES key) = byteArrayMapAsWord64 (unBlock . decrypt key . Block)
|
||||
|
||||
initDES :: ByteArray key => key -> CryptoFailable DES
|
||||
initDES k
|
||||
| len == 8 = CryptoPassed $ DES key
|
||||
| otherwise = CryptoFailed $ CryptoError_KeySizeInvalid
|
||||
where len = byteArrayLength k
|
||||
key = byteArrayToW64BE k 0
|
||||
220
Crypto/Cipher/DES/Primitive.hs
Normal file
220
Crypto/Cipher/DES/Primitive.hs
Normal file
@ -0,0 +1,220 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.DES.Primitive
|
||||
-- License : BSD-style
|
||||
--
|
||||
-- This module is copy of DES module from Crypto package.
|
||||
-- http://hackage.haskell.org/package/Crypto
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module Crypto.Cipher.DES.Primitive (encrypt, decrypt, Block(..)) where
|
||||
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
newtype Block = Block { unBlock :: Word64 }
|
||||
|
||||
type Rotation = Int
|
||||
type Key = Word64
|
||||
|
||||
type Bits4 = [Bool]
|
||||
type Bits6 = [Bool]
|
||||
type Bits32 = [Bool]
|
||||
type Bits48 = [Bool]
|
||||
type Bits56 = [Bool]
|
||||
type Bits64 = [Bool]
|
||||
|
||||
desXor :: [Bool] -> [Bool] -> [Bool]
|
||||
desXor a b = zipWith xor a b
|
||||
|
||||
desRotate :: [Bool] -> Int -> [Bool]
|
||||
desRotate bits rot = drop rot' bits ++ take rot' bits
|
||||
where rot' = rot `mod` length bits
|
||||
|
||||
bitify :: Word64 -> Bits64
|
||||
bitify w = map (\b -> w .&. (shiftL 1 b) /= 0) [63,62..0]
|
||||
|
||||
unbitify :: Bits64 -> Word64
|
||||
unbitify bs = foldl (\i b -> if b then 1 + shiftL i 1 else shiftL i 1) 0 bs
|
||||
|
||||
initial_permutation :: Bits64 -> Bits64
|
||||
initial_permutation mb = map ((!!) mb) i
|
||||
where i = [57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11, 3,
|
||||
61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15, 7,
|
||||
56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10, 2,
|
||||
60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14, 6]
|
||||
|
||||
{-
|
||||
"\x39\x31\x29\x21\x19\x11\x09\x01\x3b\x33\x2b\x23\x1b\x13\
|
||||
\\x0b\x03\x3d\x35\x2d\x25\x1d\x15\x0d\x05\x3f\x37\x2f\x27\
|
||||
\\x1f\x17\x0f\x07\x38\x30\x28\x20\x18\x10\x08\x00\x3a\x32\
|
||||
\\x2a\x22\x1a\x12\x0a\x02\x3c\x34\x2c\x24\x1c\x14\x0c\x04\
|
||||
\\x3e\x36\x2e\x26\x1e\x16\x0e\x06"
|
||||
-}
|
||||
|
||||
key_transformation :: Bits64 -> Bits56
|
||||
key_transformation kb = map ((!!) kb) i
|
||||
where i = [56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17,
|
||||
9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35,
|
||||
62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21,
|
||||
13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3]
|
||||
{-
|
||||
"\x38\x30\x28\x20\x18\x10\x08\x00\x39\x31\x29\x21\x19\x11\
|
||||
\\x09\x01\x3a\x32\x2a\x22\x1a\x12\x0a\x02\x3b\x33\x2b\x23\
|
||||
\\x3e\x36\x2e\x26\x1e\x16\x0e\x06\x3d\x35\x2d\x25\x1d\x15\
|
||||
\\x0d\x05\x3c\x34\x2c\x24\x1c\x14\x0c\x04\x1b\x13\x0b\x03"
|
||||
-}
|
||||
|
||||
|
||||
des_enc :: Block -> Key -> Block
|
||||
des_enc = do_des [1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28]
|
||||
|
||||
des_dec :: Block -> Key -> Block
|
||||
des_dec = do_des [28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1]
|
||||
|
||||
do_des :: [Rotation] -> Block -> Key -> Block
|
||||
do_des rots (Block m) k = Block $ des_work rots (takeDrop 32 mb) kb
|
||||
where kb = key_transformation $ bitify k
|
||||
mb = initial_permutation $ bitify m
|
||||
|
||||
des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Word64
|
||||
des_work [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml)
|
||||
des_work (r:rs) mb kb = des_work rs mb' kb
|
||||
where mb' = do_round r mb kb
|
||||
|
||||
do_round :: Rotation -> (Bits32, Bits32) -> Bits56 -> (Bits32, Bits32)
|
||||
do_round r (ml, mr) kb = (mr, m')
|
||||
where kb' = get_key kb r
|
||||
comp_kb = compression_permutation kb'
|
||||
expa_mr = expansion_permutation mr
|
||||
res = comp_kb `desXor` expa_mr
|
||||
res' = tail $ iterate (trans 6) ([], res)
|
||||
trans n (_, b) = (take n b, drop n b)
|
||||
res_s = concat $ zipWith (\f (x,_) -> f x) [s_box_1, s_box_2,
|
||||
s_box_3, s_box_4,
|
||||
s_box_5, s_box_6,
|
||||
s_box_7, s_box_8] res'
|
||||
res_p = p_box res_s
|
||||
m' = res_p `desXor` ml
|
||||
|
||||
get_key :: Bits56 -> Rotation -> Bits56
|
||||
get_key kb r = kb'
|
||||
where (kl, kr) = takeDrop 28 kb
|
||||
kb' = desRotate kl r ++ desRotate kr r
|
||||
|
||||
compression_permutation :: Bits56 -> Bits48
|
||||
compression_permutation kb = map ((!!) kb) i
|
||||
where i = [13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9,
|
||||
22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1,
|
||||
40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47,
|
||||
43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31]
|
||||
|
||||
expansion_permutation :: Bits32 -> Bits48
|
||||
expansion_permutation mb = map ((!!) mb) i
|
||||
where i = [31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8,
|
||||
7, 8, 9, 10, 11, 12, 11, 12, 13, 14, 15, 16,
|
||||
15, 16, 17, 18, 19, 20, 19, 20, 21, 22, 23, 24,
|
||||
23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0]
|
||||
|
||||
s_box :: [[Word8]] -> Bits6 -> Bits4
|
||||
s_box s [a,b,c,d,e,f] = to_bool 4 $ (s !! row) !! col
|
||||
where row = sum $ zipWith numericise [a,f] [1, 0]
|
||||
col = sum $ zipWith numericise [b,c,d,e] [3, 2, 1, 0]
|
||||
numericise :: Bool -> Int -> Int
|
||||
numericise = (\x y -> if x then 2^y else 0)
|
||||
|
||||
to_bool :: Int -> Word8 -> [Bool]
|
||||
to_bool 0 _ = []
|
||||
to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1)
|
||||
s_box _ _ = error "DES: internal error bits6 more than 6 elements"
|
||||
|
||||
s_box_1 :: Bits6 -> Bits4
|
||||
s_box_1 = s_box i
|
||||
where i = [[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7],
|
||||
[ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8],
|
||||
[ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0],
|
||||
[15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13]]
|
||||
|
||||
s_box_2 :: Bits6 -> Bits4
|
||||
s_box_2 = s_box i
|
||||
where i = [[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10],
|
||||
[3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5],
|
||||
[0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15],
|
||||
[13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9]]
|
||||
|
||||
s_box_3 :: Bits6 -> Bits4
|
||||
s_box_3 = s_box i
|
||||
where i = [[10, 0, 9, 14 , 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8],
|
||||
[13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1],
|
||||
[13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7],
|
||||
[1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12]]
|
||||
|
||||
s_box_4 :: Bits6 -> Bits4
|
||||
s_box_4 = s_box i
|
||||
where i = [[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15],
|
||||
[13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9],
|
||||
[10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4],
|
||||
[3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14]]
|
||||
|
||||
s_box_5 :: Bits6 -> Bits4
|
||||
s_box_5 = s_box i
|
||||
where i = [[2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9],
|
||||
[14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6],
|
||||
[4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14],
|
||||
[11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3]]
|
||||
|
||||
s_box_6 :: Bits6 -> Bits4
|
||||
s_box_6 = s_box i
|
||||
where i = [[12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11],
|
||||
[10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8],
|
||||
[9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6],
|
||||
[4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13]]
|
||||
|
||||
s_box_7 :: Bits6 -> Bits4
|
||||
s_box_7 = s_box i
|
||||
where i = [[4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1],
|
||||
[13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6],
|
||||
[1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2],
|
||||
[6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12]]
|
||||
|
||||
s_box_8 :: Bits6 -> Bits4
|
||||
s_box_8 = s_box i
|
||||
where i = [[13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7],
|
||||
[1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2],
|
||||
[7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8],
|
||||
[2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11]]
|
||||
|
||||
p_box :: Bits32 -> Bits32
|
||||
p_box kb = map ((!!) kb) i
|
||||
where i = [15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9,
|
||||
1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24]
|
||||
|
||||
final_perm :: Bits64 -> Bits64
|
||||
final_perm kb = map ((!!) kb) i
|
||||
where i = [39, 7, 47, 15, 55, 23, 63, 31, 38, 6, 46, 14, 54, 22, 62, 30,
|
||||
37, 5, 45, 13, 53, 21, 61, 29, 36, 4, 44, 12, 52, 20, 60, 28,
|
||||
35, 3, 43, 11, 51, 19, 59, 27, 34, 2, 42, 10, 50, 18, 58, 26,
|
||||
33, 1, 41, 9, 49, 17, 57, 25, 32, 0, 40 , 8, 48, 16, 56, 24]
|
||||
|
||||
takeDrop :: Int -> [a] -> ([a], [a])
|
||||
takeDrop _ [] = ([], [])
|
||||
takeDrop 0 xs = ([], xs)
|
||||
takeDrop n (x:xs) = (x:ys, zs)
|
||||
where (ys, zs) = takeDrop (n-1) xs
|
||||
|
||||
|
||||
-- | Basic DES encryption which takes a key and a block of plaintext
|
||||
-- and returns the encrypted block of ciphertext according to the standard.
|
||||
|
||||
encrypt :: Word64 -> Block -> Block
|
||||
encrypt = flip des_enc
|
||||
|
||||
-- | Basic DES decryption which takes a key and a block of ciphertext and
|
||||
-- returns the decrypted block of plaintext according to the standard.
|
||||
|
||||
decrypt :: Word64 -> Block -> Block
|
||||
decrypt = flip des_dec
|
||||
25
Crypto/Cipher/DES/Serialization.hs
Normal file
25
Crypto/Cipher/DES/Serialization.hs
Normal file
@ -0,0 +1,25 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.DES.Serialization
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : good
|
||||
--
|
||||
-- basic routine to convert between W64 and bytestring for DES.
|
||||
--
|
||||
module Crypto.Cipher.DES.Serialization
|
||||
( toBS
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Crypto.Cipher.DES.Primitive (Block(..))
|
||||
|
||||
import Crypto.Internal.ByteArray
|
||||
import Crypto.Internal.Endian
|
||||
|
||||
import Data.Word (Word64)
|
||||
import Foreign.Storable
|
||||
import Foreign.Ptr (castPtr, plusPtr, Ptr)
|
||||
|
||||
toBS :: Block -> B.ByteString
|
||||
toBS (Block w) = byteArrayAllocAndFreeze 8 $ \ptr -> poke ptr (toBE64 w)
|
||||
88
Crypto/Cipher/TripleDES.hs
Normal file
88
Crypto/Cipher/TripleDES.hs
Normal file
@ -0,0 +1,88 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.TripleDES
|
||||
-- License : BSD-style
|
||||
-- Stability : experimental
|
||||
-- Portability : ???
|
||||
|
||||
module Crypto.Cipher.TripleDES
|
||||
( DES_EEE3
|
||||
, DES_EDE3
|
||||
, DES_EEE2
|
||||
, DES_EDE2
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Crypto.Error
|
||||
import Crypto.Cipher.Types
|
||||
import Crypto.Cipher.DES.Primitive
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
-- | 3DES with 3 different keys used all in the same direction
|
||||
data DES_EEE3 = DES_EEE3 Word64 Word64 Word64
|
||||
deriving (Eq)
|
||||
|
||||
-- | 3DES with 3 different keys used in alternative direction
|
||||
data DES_EDE3 = DES_EDE3 Word64 Word64 Word64
|
||||
deriving (Eq)
|
||||
|
||||
-- | 3DES where the first and third keys are equal, used in the same direction
|
||||
data DES_EEE2 = DES_EEE2 Word64 Word64 -- key1 and key3 are equal
|
||||
deriving (Eq)
|
||||
|
||||
-- | 3DES where the first and third keys are equal, used in alternative direction
|
||||
data DES_EDE2 = DES_EDE2 Word64 Word64 -- key1 and key3 are equal
|
||||
deriving (Eq)
|
||||
|
||||
instance Cipher DES_EEE3 where
|
||||
cipherName _ = "3DES_EEE"
|
||||
cipherKeySize _ = KeySizeFixed 24
|
||||
cipherInit k = init3DES DES_EEE3 k
|
||||
|
||||
instance Cipher DES_EDE3 where
|
||||
cipherName _ = "3DES_EDE"
|
||||
cipherKeySize _ = KeySizeFixed 24
|
||||
cipherInit k = init3DES DES_EDE3 k
|
||||
|
||||
instance Cipher DES_EDE2 where
|
||||
cipherName _ = "2DES_EDE"
|
||||
cipherKeySize _ = KeySizeFixed 16
|
||||
cipherInit k = init2DES DES_EDE2 k
|
||||
|
||||
instance Cipher DES_EEE2 where
|
||||
cipherName _ = "2DES_EEE"
|
||||
cipherKeySize _ = KeySizeFixed 16
|
||||
cipherInit k = init2DES DES_EEE2 k
|
||||
|
||||
instance BlockCipher DES_EEE3 where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (DES_EEE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (encrypt k3 . encrypt k2 . encrypt k1) . Block)
|
||||
ecbDecrypt (DES_EEE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k3) . Block)
|
||||
|
||||
instance BlockCipher DES_EDE3 where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (DES_EDE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (encrypt k3 . decrypt k2 . encrypt k1) . Block)
|
||||
ecbDecrypt (DES_EDE3 k1 k2 k3) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k3) . Block)
|
||||
|
||||
instance BlockCipher DES_EEE2 where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (DES_EEE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (encrypt k1 . encrypt k2 . encrypt k1) . Block)
|
||||
ecbDecrypt (DES_EEE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k1) . Block)
|
||||
|
||||
instance BlockCipher DES_EDE2 where
|
||||
blockSize _ = 8
|
||||
ecbEncrypt (DES_EDE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (encrypt k1 . decrypt k2 . encrypt k1) . Block)
|
||||
ecbDecrypt (DES_EDE2 k1 k2) = byteArrayMapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k1) . Block)
|
||||
|
||||
init3DES :: ByteArray key => (Word64 -> Word64 -> Word64 -> a) -> key -> CryptoFailable a
|
||||
init3DES constr k
|
||||
| len == 24 = CryptoPassed $ constr k1 k2 k3
|
||||
| otherwise = CryptoFailed CryptoError_KeySizeInvalid
|
||||
where len = byteArrayLength k
|
||||
(k1, k2, k3) = (byteArrayToW64BE k 0, byteArrayToW64BE k 8, byteArrayToW64BE k 16)
|
||||
|
||||
init2DES :: ByteArray key => (Word64 -> Word64 -> a) -> key -> CryptoFailable a
|
||||
init2DES constr k
|
||||
| len == 16 = CryptoPassed $ constr k1 k2
|
||||
| otherwise = CryptoFailed CryptoError_KeySizeInvalid
|
||||
where len = byteArrayLength k
|
||||
(k1, k2) = (byteArrayToW64BE k 0, byteArrayToW64BE k 8)
|
||||
@ -1,3 +1,41 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- symmetric cipher basic types
|
||||
--
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
module Crypto.Cipher.Types
|
||||
(
|
||||
-- * Cipher classes
|
||||
Cipher(..)
|
||||
, BlockCipher(..)
|
||||
, ecbEncryptLegacy
|
||||
, ecbDecryptLegacy
|
||||
, StreamCipher(..)
|
||||
, DataUnitOffset
|
||||
, KeySizeSpecifier(..)
|
||||
, AEAD(..)
|
||||
, AEADState(..)
|
||||
, AEADMode(..)
|
||||
, AEADModeImpl(..)
|
||||
-- , cfb8Encrypt
|
||||
-- , cfb8Decrypt
|
||||
-- * AEAD functions
|
||||
, module Crypto.Cipher.Types.AEAD
|
||||
-- * Initial Vector type and constructor
|
||||
, IV
|
||||
, makeIV
|
||||
, nullIV
|
||||
, ivAdd
|
||||
-- * Authentification Tag
|
||||
, AuthTag(..)
|
||||
) where
|
||||
|
||||
import Crypto.Cipher.Types.Base
|
||||
import Crypto.Cipher.Types.Block
|
||||
import Crypto.Cipher.Types.Stream
|
||||
import Crypto.Cipher.Types.AEAD
|
||||
|
||||
63
Crypto/Cipher/Types/AEAD.hs
Normal file
63
Crypto/Cipher/Types/AEAD.hs
Normal file
@ -0,0 +1,63 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.AEAD
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- AEAD cipher basic types
|
||||
--
|
||||
module Crypto.Cipher.Types.AEAD where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Crypto.Cipher.Types.Base
|
||||
import Crypto.Cipher.Types.Block
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
-- | Append associated data into the AEAD state
|
||||
aeadAppendHeader :: BlockCipher a => AEAD a -> ByteString -> AEAD a
|
||||
aeadAppendHeader (AEAD cipher (AEADState state)) bs =
|
||||
AEAD cipher $ AEADState (aeadStateAppendHeader cipher state bs)
|
||||
|
||||
-- | Encrypt input and append into the AEAD state
|
||||
aeadEncrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a)
|
||||
aeadEncrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst))
|
||||
where (output, nst) = aeadStateEncrypt cipher state input
|
||||
|
||||
-- | Decrypt input and append into the AEAD state
|
||||
aeadDecrypt :: BlockCipher a => AEAD a -> ByteString -> (ByteString, AEAD a)
|
||||
aeadDecrypt (AEAD cipher (AEADState state)) input = (output, AEAD cipher (AEADState nst))
|
||||
where (output, nst) = aeadStateDecrypt cipher state input
|
||||
|
||||
-- | Finalize the AEAD state and create an authentification tag
|
||||
aeadFinalize :: BlockCipher a => AEAD a -> Int -> AuthTag
|
||||
aeadFinalize (AEAD cipher (AEADState state)) len =
|
||||
aeadStateFinalize cipher state len
|
||||
|
||||
-- | Simple AEAD encryption
|
||||
aeadSimpleEncrypt :: BlockCipher a
|
||||
=> AEAD a -- ^ A new AEAD Context
|
||||
-> B.ByteString -- ^ Optional Authentified Header
|
||||
-> B.ByteString -- ^ Optional Plaintext
|
||||
-> Int -- ^ Tag length
|
||||
-> (AuthTag, B.ByteString) -- ^ Authentification tag and ciphertext
|
||||
aeadSimpleEncrypt aeadIni header input taglen = (tag, output)
|
||||
where aead = aeadAppendHeader aeadIni header
|
||||
(output, aeadFinal) = aeadEncrypt aead input
|
||||
tag = aeadFinalize aeadFinal taglen
|
||||
|
||||
-- | Simple AEAD decryption
|
||||
aeadSimpleDecrypt :: BlockCipher a
|
||||
=> AEAD a -- ^ A new AEAD Context
|
||||
-> B.ByteString -- ^ Optional Authentified Header
|
||||
-> B.ByteString -- ^ Optional Plaintext
|
||||
-> AuthTag -- ^ Tag length
|
||||
-> Maybe B.ByteString -- ^ Plaintext
|
||||
aeadSimpleDecrypt aeadIni header input authTag
|
||||
| tag == authTag = Just output
|
||||
| otherwise = Nothing
|
||||
where aead = aeadAppendHeader aeadIni header
|
||||
(output, aeadFinal) = aeadDecrypt aead input
|
||||
tag = aeadFinalize aeadFinal (byteArrayLength authTag)
|
||||
|
||||
60
Crypto/Cipher/Types/Base.hs
Normal file
60
Crypto/Cipher/Types/Base.hs
Normal file
@ -0,0 +1,60 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.Base
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- symmetric cipher basic types
|
||||
--
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Crypto.Cipher.Types.Base
|
||||
( KeySizeSpecifier(..)
|
||||
, Cipher(..)
|
||||
, AuthTag(..)
|
||||
, AEADMode(..)
|
||||
, DataUnitOffset
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Data.ByteString (ByteString)
|
||||
|
||||
import Crypto.Internal.ByteArray
|
||||
import Crypto.Error
|
||||
|
||||
-- | Different specifier for key size in bytes
|
||||
data KeySizeSpecifier =
|
||||
KeySizeRange Int Int -- ^ in the range [min,max]
|
||||
| KeySizeEnum [Int] -- ^ one of the specified values
|
||||
| KeySizeFixed Int -- ^ a specific size
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- | Offset inside an XTS data unit, measured in block size.
|
||||
type DataUnitOffset = Word32
|
||||
|
||||
-- | Authentification Tag for AE cipher mode
|
||||
newtype AuthTag = AuthTag { unAuthTag :: ByteString }
|
||||
deriving (Show, ByteArrayAccess)
|
||||
|
||||
instance Eq AuthTag where
|
||||
(AuthTag a) == (AuthTag b) = byteArrayConstEq a b
|
||||
|
||||
-- | AEAD Mode
|
||||
data AEADMode =
|
||||
AEAD_OCB -- OCB3
|
||||
| AEAD_CCM
|
||||
| AEAD_EAX
|
||||
| AEAD_CWC
|
||||
| AEAD_GCM
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- | Symmetric cipher class.
|
||||
class Cipher cipher where
|
||||
-- | Initialize a cipher context from a key
|
||||
cipherInit :: ByteArray key => key -> CryptoFailable cipher
|
||||
-- | Cipher name
|
||||
cipherName :: cipher -> String
|
||||
-- | return the size of the key required for this cipher.
|
||||
-- Some cipher accept any size for key
|
||||
cipherKeySize :: cipher -> KeySizeSpecifier
|
||||
299
Crypto/Cipher/Types/Block.hs
Normal file
299
Crypto/Cipher/Types/Block.hs
Normal file
@ -0,0 +1,299 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.Block
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- block cipher basic types
|
||||
--
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Crypto.Cipher.Types.Block
|
||||
(
|
||||
-- * BlockCipher
|
||||
BlockCipher(..)
|
||||
, ecbEncryptLegacy
|
||||
, ecbDecryptLegacy
|
||||
-- * initialization vector (IV)
|
||||
, IV(..)
|
||||
, makeIV
|
||||
, nullIV
|
||||
, ivAdd
|
||||
-- * XTS
|
||||
, XTS
|
||||
-- * AEAD
|
||||
, AEAD(..)
|
||||
, AEADState(..)
|
||||
, AEADModeImpl(..)
|
||||
-- * CFB 8 bits
|
||||
--, cfb8Encrypt
|
||||
--, cfb8Decrypt
|
||||
) where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Byteable
|
||||
import Data.Word
|
||||
import Crypto.Cipher.Types.Base
|
||||
--import Crypto.Cipher.Types.GF
|
||||
import Crypto.Cipher.Types.Utils
|
||||
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
import Foreign.Ptr
|
||||
import Foreign.Storable
|
||||
|
||||
-- | an IV parametrized by the cipher
|
||||
data IV c = forall byteArray . ByteArray byteArray => IV byteArray
|
||||
|
||||
instance BlockCipher c => ByteArrayAccess (IV c) where
|
||||
withByteArray (IV z) f = withByteArray z f
|
||||
byteArrayLength (IV z) = byteArrayLength z
|
||||
instance Eq (IV c) where
|
||||
(IV a) == (IV b) = byteArrayEq a b
|
||||
|
||||
type XTS cipher = (cipher, cipher)
|
||||
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
|
||||
-> DataUnitOffset -- ^ Offset in the data unit in number of blocks
|
||||
-> ByteString -- ^ Data
|
||||
-> ByteString -- ^ Processed Data
|
||||
|
||||
-- | Symmetric block cipher class
|
||||
class Cipher cipher => BlockCipher cipher where
|
||||
-- | Return the size of block required for this block cipher
|
||||
blockSize :: cipher -> Int
|
||||
|
||||
-- | Encrypt blocks
|
||||
--
|
||||
-- the input string need to be multiple of the block size
|
||||
ecbEncrypt :: ByteArray ba => cipher -> ba -> ba
|
||||
|
||||
-- | Decrypt blocks
|
||||
--
|
||||
-- the input string need to be multiple of the block size
|
||||
ecbDecrypt :: ByteArray ba => cipher -> ba -> ba
|
||||
|
||||
-- | encrypt using the CBC mode.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize
|
||||
cbcEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
|
||||
cbcEncrypt = cbcEncryptGeneric
|
||||
-- | decrypt using the CBC mode.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize
|
||||
cbcDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
|
||||
cbcDecrypt = cbcDecryptGeneric
|
||||
|
||||
-- | encrypt using the CFB mode.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize
|
||||
cfbEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
|
||||
cfbEncrypt = cfbEncryptGeneric
|
||||
-- | decrypt using the CFB mode.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize
|
||||
cfbDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
|
||||
cfbDecrypt = cfbDecryptGeneric
|
||||
|
||||
-- | combine using the CTR mode.
|
||||
--
|
||||
-- CTR mode produce a stream of randomized data that is combined
|
||||
-- (by XOR operation) with the input stream.
|
||||
--
|
||||
-- encryption and decryption are the same operation.
|
||||
--
|
||||
-- input can be of any size
|
||||
ctrCombine :: ByteArray ba => cipher -> IV cipher -> ba -> ba
|
||||
ctrCombine = ctrCombineGeneric
|
||||
|
||||
-- | Initialize a new AEAD State
|
||||
--
|
||||
-- When Nothing is returns, it means the mode is not handled.
|
||||
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.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize, and the cipher
|
||||
-- need to process 128 bits block only
|
||||
xtsEncrypt :: (cipher, cipher)
|
||||
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
|
||||
-> DataUnitOffset -- ^ Offset in the data unit in number of blocks
|
||||
-> ByteString -- ^ Plaintext
|
||||
-> ByteString -- ^ Ciphertext
|
||||
xtsEncrypt = undefined -- xtsEncryptGeneric
|
||||
|
||||
-- | decrypt using the XTS mode.
|
||||
--
|
||||
-- input need to be a multiple of the blocksize, and the cipher
|
||||
-- need to process 128 bits block only
|
||||
xtsDecrypt :: (cipher, cipher)
|
||||
-> IV cipher -- ^ Usually represent the Data Unit (e.g. disk sector)
|
||||
-> DataUnitOffset -- ^ Offset in the data unit in number of blocks
|
||||
-> ByteString -- ^ Ciphertext
|
||||
-> ByteString -- ^ Plaintext
|
||||
xtsDecrypt = undefined -- xtsDecryptGeneric
|
||||
|
||||
-- | Authenticated Encryption with Associated Data algorithms
|
||||
data AEAD cipher = AEAD cipher (AEADState cipher)
|
||||
|
||||
-- | Wrapper for any AEADState
|
||||
data AEADState cipher = forall st . AEADModeImpl cipher st => AEADState st
|
||||
|
||||
-- | Class of AEAD Mode implementation
|
||||
class BlockCipher cipher => AEADModeImpl cipher state where
|
||||
aeadStateAppendHeader :: cipher -> state -> ByteString -> state
|
||||
aeadStateEncrypt :: cipher -> state -> ByteString -> (ByteString, state)
|
||||
aeadStateDecrypt :: cipher -> state -> ByteString -> (ByteString, state)
|
||||
aeadStateFinalize :: cipher -> state -> Int -> AuthTag
|
||||
|
||||
-- | Create an IV for a specified block cipher
|
||||
makeIV :: (Byteable b, BlockCipher c) => b -> Maybe (IV c)
|
||||
makeIV b = toIV undefined
|
||||
where toIV :: BlockCipher c => c -> Maybe (IV c)
|
||||
toIV cipher
|
||||
| byteableLength b == sz = Just (IV $ toBytes b)
|
||||
| otherwise = Nothing
|
||||
where sz = blockSize cipher
|
||||
|
||||
-- | Create an IV that is effectively representing the number 0
|
||||
nullIV :: BlockCipher c => IV c
|
||||
nullIV = toIV undefined
|
||||
where toIV :: BlockCipher c => c -> IV c
|
||||
toIV cipher = IV $ B.replicate (blockSize cipher) 0
|
||||
|
||||
-- | Increment an IV by a number.
|
||||
--
|
||||
-- Assume the IV is in Big Endian format.
|
||||
ivAdd :: BlockCipher c => IV c -> Int -> IV c
|
||||
ivAdd (IV b) i = IV $ copy b
|
||||
where copy :: ByteArray bs => bs -> bs
|
||||
copy bs = byteArrayCopyAndFreeze bs $ \p -> do
|
||||
let until0 accu = do
|
||||
r <- loop accu (byteArrayLength bs - 1) p
|
||||
case r of
|
||||
0 -> return ()
|
||||
_ -> until0 r
|
||||
until0 i
|
||||
|
||||
loop :: Int -> Int -> Ptr Word8 -> IO Int
|
||||
loop 0 _ _ = return 0
|
||||
loop acc ofs p = do
|
||||
v <- peek (p `plusPtr` ofs) :: IO Word8
|
||||
let accv = acc + fromIntegral v
|
||||
(hi,lo) = accv `divMod` 256
|
||||
poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)
|
||||
if ofs == 0
|
||||
then return hi
|
||||
else loop hi (ofs - 1) p
|
||||
|
||||
cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
|
||||
cbcEncryptGeneric cipher ivini input = byteArrayConcat $ doEnc ivini $ chunk (blockSize cipher) input
|
||||
where doEnc _ [] = []
|
||||
doEnc iv (i:is) =
|
||||
let o = ecbEncrypt cipher $ byteArrayXor iv i
|
||||
in o : doEnc (IV o) is
|
||||
|
||||
cbcDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
|
||||
cbcDecryptGeneric cipher ivini input = byteArrayConcat $ doDec ivini $ chunk (blockSize cipher) input
|
||||
where
|
||||
doDec _ [] = []
|
||||
doDec iv (i:is) =
|
||||
let o = byteArrayXor iv $ ecbDecrypt cipher i
|
||||
in o : doDec (IV i) is
|
||||
|
||||
cfbEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
|
||||
cfbEncryptGeneric cipher ivini input = byteArrayConcat $ doEnc ivini $ chunk (blockSize cipher) input
|
||||
where
|
||||
doEnc _ [] = []
|
||||
doEnc (IV iv) (i:is) =
|
||||
let o = byteArrayXor i $ ecbEncrypt cipher iv
|
||||
in o : doEnc (IV o) is
|
||||
|
||||
cfbDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
|
||||
cfbDecryptGeneric cipher ivini input = byteArrayConcat $ doDec ivini $ chunk (blockSize cipher) input
|
||||
where
|
||||
doDec _ [] = []
|
||||
doDec (IV iv) (i:is) =
|
||||
let o = byteArrayXor i $ ecbEncrypt cipher iv
|
||||
in o : doDec (IV i) is
|
||||
|
||||
ctrCombineGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba
|
||||
ctrCombineGeneric cipher ivini input = byteArrayConcat $ doCnt ivini $ chunk (blockSize cipher) input
|
||||
where doCnt _ [] = []
|
||||
doCnt iv@(IV ivd) (i:is) =
|
||||
let ivEnc = ecbEncrypt cipher ivd
|
||||
in byteArrayXor i ivEnc : doCnt (ivAdd iv 1) is
|
||||
|
||||
{-
|
||||
xtsEncryptGeneric :: BlockCipher128 cipher => XTS cipher
|
||||
xtsEncryptGeneric = xtsGeneric ecbEncrypt
|
||||
|
||||
xtsDecryptGeneric :: BlockCipher128 cipher => XTS cipher
|
||||
xtsDecryptGeneric = xtsGeneric ecbDecrypt
|
||||
|
||||
xtsGeneric :: BlockCipher128 cipher
|
||||
=> (cipher -> B.ByteString -> B.ByteString)
|
||||
-> (cipher, cipher)
|
||||
-> IV cipher
|
||||
-> DataUnitOffset
|
||||
-> ByteString
|
||||
-> ByteString
|
||||
xtsGeneric f (cipher, tweakCipher) iv sPoint input
|
||||
| blockSize cipher /= 16 = error "XTS mode is only available with cipher that have a block size of 128 bits"
|
||||
| otherwise = byteArrayConcat $ doXts iniTweak $ chunk (blockSize cipher) input
|
||||
where encTweak = ecbEncrypt tweakCipher iv
|
||||
iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint
|
||||
doXts _ [] = []
|
||||
doXts tweak (i:is) =
|
||||
let o = bxor (f cipher $ bxor i tweak) tweak
|
||||
in o : doXts (xtsGFMul tweak) is
|
||||
-}
|
||||
|
||||
{-
|
||||
-- | Encrypt using CFB mode in 8 bit output
|
||||
--
|
||||
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
|
||||
cfb8Encrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
|
||||
cfb8Encrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
|
||||
where loop d iv@(IV i) m
|
||||
| B.null m = return ()
|
||||
| otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
|
||||
where m' = if B.length m < blockSize ctx
|
||||
then m `B.append` B.replicate (blockSize ctx - B.length m) 0
|
||||
else B.take (blockSize ctx) m
|
||||
r = cfbEncrypt ctx iv m'
|
||||
out = B.head r
|
||||
ni = IV (B.drop 1 i `B.snoc` out)
|
||||
|
||||
-- | Decrypt using CFB mode in 8 bit output
|
||||
--
|
||||
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
|
||||
cfb8Decrypt :: BlockCipher a => a -> IV a -> B.ByteString -> B.ByteString
|
||||
cfb8Decrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
|
||||
where loop d iv@(IV i) m
|
||||
| B.null m = return ()
|
||||
| otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
|
||||
where m' = if B.length m < blockSize ctx
|
||||
then m `B.append` B.replicate (blockSize ctx - B.length m) 0
|
||||
else B.take (blockSize ctx) m
|
||||
r = cfbDecrypt ctx iv m'
|
||||
out = B.head r
|
||||
ni = IV (B.drop 1 i `B.snoc` B.head m')
|
||||
-}
|
||||
49
Crypto/Cipher/Types/GF.hs
Normal file
49
Crypto/Cipher/Types/GF.hs
Normal file
@ -0,0 +1,49 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.GF
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- Slow Galois Field arithmetic for generic XTS and GCM implementation
|
||||
--
|
||||
module Crypto.Cipher.Types.GF
|
||||
(
|
||||
-- * XTS support
|
||||
xtsGFMul
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Internal as B
|
||||
import Data.Byteable
|
||||
import Foreign.Storable
|
||||
import Foreign.Ptr
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
-- block size need to be 128 bits.
|
||||
--
|
||||
-- FIXME: add support for big endian.
|
||||
xtsGFMul :: ByteString -> ByteString
|
||||
xtsGFMul b
|
||||
| B.length b == 16 = B.unsafeCreate (B.length b) $ \dst ->
|
||||
withBytePtr b $ \src -> do
|
||||
(hi,lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8)
|
||||
poke (castPtr dst) lo
|
||||
poke (castPtr dst `plusPtr` 8) hi
|
||||
| otherwise = error "unsupported block size in GF"
|
||||
where gf :: Word64 -> Word64 -> (Word64, Word64)
|
||||
gf srcLo srcHi =
|
||||
((if carryLo then (.|. 1) else id) (srcHi `shiftL` 1)
|
||||
,(if carryHi then xor 0x87 else id) $ (srcLo `shiftL` 1)
|
||||
)
|
||||
where carryHi = srcHi `testBit` 63
|
||||
carryLo = srcLo `testBit` 63
|
||||
{-
|
||||
const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL);
|
||||
uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0);
|
||||
a->q[1] = cpu_to_le64((le64_to_cpu(a->q[1]) << 1) | (a->q[0] & gf_mask ? 1 : 0));
|
||||
a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r;
|
||||
-}
|
||||
20
Crypto/Cipher/Types/Stream.hs
Normal file
20
Crypto/Cipher/Types/Stream.hs
Normal file
@ -0,0 +1,20 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.Stream
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- stream cipher basic types
|
||||
--
|
||||
module Crypto.Cipher.Types.Stream
|
||||
( StreamCipher(..)
|
||||
) where
|
||||
|
||||
import Crypto.Cipher.Types.Base
|
||||
import Data.ByteString (ByteString)
|
||||
|
||||
-- | Symmetric stream cipher class
|
||||
class Cipher cipher => StreamCipher cipher where
|
||||
-- | Combine using the stream cipher
|
||||
streamCombine :: cipher -> ByteString -> (ByteString, cipher)
|
||||
19
Crypto/Cipher/Types/Utils.hs
Normal file
19
Crypto/Cipher/Types/Utils.hs
Normal file
@ -0,0 +1,19 @@
|
||||
-- |
|
||||
-- Module : Crypto.Cipher.Types.Utils
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
-- basic utility for cipher related stuff
|
||||
--
|
||||
module Crypto.Cipher.Types.Utils where
|
||||
|
||||
import Crypto.Internal.ByteArray
|
||||
|
||||
chunk :: ByteArray b => Int -> b -> [b]
|
||||
chunk sz bs = split bs
|
||||
where split b | byteArrayLength b <= sz = [b]
|
||||
| otherwise =
|
||||
let (b1, b2) = byteArraySplit sz b
|
||||
in b1 : split b2
|
||||
12
Crypto/Error.hs
Normal file
12
Crypto/Error.hs
Normal file
@ -0,0 +1,12 @@
|
||||
-- |
|
||||
-- Module : Crypto.Error
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : Stable
|
||||
-- Portability : Excellent
|
||||
--
|
||||
module Crypto.Error
|
||||
( module Crypto.Error.Types
|
||||
) where
|
||||
|
||||
import Crypto.Error.Types
|
||||
68
Crypto/Error/Types.hs
Normal file
68
Crypto/Error/Types.hs
Normal file
@ -0,0 +1,68 @@
|
||||
-- |
|
||||
-- Module : Crypto.Error.Types
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : Good
|
||||
--
|
||||
-- Cryptographic Error enumeration and handling
|
||||
--
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
module Crypto.Error.Types
|
||||
( CryptoError(..)
|
||||
, CryptoFailable(..)
|
||||
, throwCryptoErrorIO
|
||||
, throwCryptoError
|
||||
) where
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import Data.Data
|
||||
|
||||
import Crypto.Internal.Imports
|
||||
|
||||
-- | Enumeration of all possible errors that can be found in this library
|
||||
data CryptoError =
|
||||
-- symmetric cipher errors
|
||||
CryptoError_KeySizeInvalid
|
||||
| CryptoError_IvSizeInvalid
|
||||
deriving (Show,Eq,Enum,Data,Typeable)
|
||||
|
||||
instance E.Exception CryptoError
|
||||
|
||||
-- | A simple Either like type to represent a computation that can fail
|
||||
--
|
||||
-- 2 possibles values are:
|
||||
-- * 'CryptoPassed' :
|
||||
data CryptoFailable a =
|
||||
CryptoPassed a
|
||||
| CryptoFailed CryptoError
|
||||
|
||||
instance Functor CryptoFailable where
|
||||
fmap f (CryptoPassed a) = CryptoPassed (f a)
|
||||
fmap _ (CryptoFailed r) = CryptoFailed r
|
||||
|
||||
instance Applicative CryptoFailable where
|
||||
pure a = CryptoPassed a
|
||||
(<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
|
||||
instance Monad CryptoFailable where
|
||||
return a = CryptoPassed a
|
||||
(>>=) m1 m2 = do
|
||||
case m1 of
|
||||
CryptoPassed a -> m2 a
|
||||
CryptoFailed e -> CryptoFailed e
|
||||
|
||||
throwCryptoErrorIO :: CryptoFailable a -> IO a
|
||||
throwCryptoErrorIO (CryptoFailed e) = E.throwIO e
|
||||
throwCryptoErrorIO (CryptoPassed r) = return r
|
||||
|
||||
throwCryptoError :: CryptoFailable a -> a
|
||||
throwCryptoError (CryptoFailed e) = E.throw e
|
||||
throwCryptoError (CryptoPassed r) = r
|
||||
|
||||
{-
|
||||
eitherCryptoError :: CryptoFailable a -> Either CryptoError a
|
||||
eitherCryptoError = undefined
|
||||
|
||||
maybeCryptoError :: CryptoFailable a -> Maybe a
|
||||
maybeCryptoError = undefined
|
||||
-}
|
||||
@ -12,47 +12,69 @@
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
module Crypto.Internal.ByteArray
|
||||
( ByteArray(..)
|
||||
, ByteArrayAccess(..)
|
||||
, byteArrayAllocAndFreeze
|
||||
, empty
|
||||
-- , split
|
||||
, byteArrayCopyAndFreeze
|
||||
, byteArraySplit
|
||||
, byteArrayXor
|
||||
, byteArrayEq
|
||||
, byteArrayConstEq
|
||||
, byteArrayConcat
|
||||
, byteArrayToBS
|
||||
, byteArrayFromBS
|
||||
, byteArrayToW64BE
|
||||
, byteArrayToW64LE
|
||||
, byteArrayMapAsWord64
|
||||
, byteArrayMapAsWord128
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
import Data.Word
|
||||
import Data.SecureMem
|
||||
import Crypto.Internal.Memory
|
||||
import Crypto.Internal.Compat
|
||||
import Crypto.Internal.Endian
|
||||
import Crypto.Internal.Bytes (bufXor, bufCopy)
|
||||
import Crypto.Internal.Words
|
||||
import Foreign.Ptr
|
||||
import Foreign.Storable
|
||||
import Foreign.ForeignPtr
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B (length)
|
||||
import qualified Data.ByteString.Internal as B
|
||||
|
||||
class ByteArray ba where
|
||||
byteArrayAlloc :: Int -> (Ptr p -> IO ()) -> IO ba
|
||||
class ByteArrayAccess ba where
|
||||
byteArrayLength :: ba -> Int
|
||||
withByteArray :: ba -> (Ptr p -> IO a) -> IO a
|
||||
|
||||
instance ByteArray Bytes where
|
||||
byteArrayAlloc = bytesAlloc
|
||||
class ByteArrayAccess ba => ByteArray ba where
|
||||
byteArrayAlloc :: Int -> (Ptr p -> IO ()) -> IO ba
|
||||
|
||||
instance ByteArrayAccess Bytes where
|
||||
byteArrayLength = bytesLength
|
||||
withByteArray = withBytes
|
||||
instance ByteArray Bytes where
|
||||
byteArrayAlloc = bytesAlloc
|
||||
|
||||
instance ByteArrayAccess ByteString where
|
||||
byteArrayLength = B.length
|
||||
withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
|
||||
where (fptr, off, _) = B.toForeignPtr b
|
||||
instance ByteArray ByteString where
|
||||
byteArrayAlloc sz f = do
|
||||
fptr <- B.mallocByteString sz
|
||||
withForeignPtr fptr (f . castPtr)
|
||||
return $! B.PS fptr 0 sz
|
||||
byteArrayLength = B.length
|
||||
withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)
|
||||
where (fptr, off, _) = B.toForeignPtr b
|
||||
|
||||
instance ByteArrayAccess SecureMem where
|
||||
byteArrayLength = secureMemGetSize
|
||||
withByteArray b f = withSecureMemPtr b (f . castPtr)
|
||||
instance ByteArray SecureMem where
|
||||
byteArrayAlloc sz f = do
|
||||
out <- allocateSecureMem sz
|
||||
withSecureMemPtr out (f . castPtr)
|
||||
return out
|
||||
byteArrayLength = secureMemGetSize
|
||||
withByteArray b f = withSecureMemPtr b (f . castPtr)
|
||||
|
||||
byteArrayAllocAndFreeze :: ByteArray a => Int -> (Ptr p -> IO ()) -> a
|
||||
byteArrayAllocAndFreeze sz f = unsafeDoIO (byteArrayAlloc sz f)
|
||||
@ -60,9 +82,22 @@ byteArrayAllocAndFreeze sz f = unsafeDoIO (byteArrayAlloc sz f)
|
||||
empty :: ByteArray a => a
|
||||
empty = unsafeDoIO (byteArrayAlloc 0 $ \_ -> return ())
|
||||
|
||||
{-
|
||||
split :: ByteArray bs => Int -> bs -> (bs, bs)
|
||||
split n bs
|
||||
-- | Create a xor of bytes between a and b.
|
||||
--
|
||||
-- the returns byte array is the size of the smallest input.
|
||||
byteArrayXor :: (ByteArrayAccess a, ByteArrayAccess b, ByteArray c) => a -> b -> c
|
||||
byteArrayXor a b =
|
||||
byteArrayAllocAndFreeze n $ \pc ->
|
||||
withByteArray a $ \pa ->
|
||||
withByteArray b $ \pb ->
|
||||
bufXor pc pa pb n
|
||||
where
|
||||
n = min la lb
|
||||
la = byteArrayLength a
|
||||
lb = byteArrayLength b
|
||||
|
||||
byteArraySplit :: ByteArray bs => Int -> bs -> (bs, bs)
|
||||
byteArraySplit n bs
|
||||
| n <= 0 = (empty, bs)
|
||||
| n >= len = (bs, empty)
|
||||
| otherwise = unsafeDoIO $ do
|
||||
@ -71,4 +106,110 @@ split n bs
|
||||
b2 <- byteArrayAlloc (len - n) $ \r -> bufCopy r (p `plusPtr` n) (len - n)
|
||||
return (b1, b2)
|
||||
where len = byteArrayLength bs
|
||||
-}
|
||||
|
||||
byteArrayConcat :: ByteArray bs => [bs] -> bs
|
||||
byteArrayConcat [] = empty
|
||||
byteArrayConcat allBs = byteArrayAllocAndFreeze total (loop allBs)
|
||||
where
|
||||
total = sum $ map byteArrayLength allBs
|
||||
|
||||
loop [] _ = return ()
|
||||
loop (b:bs) dst = do
|
||||
let sz = byteArrayLength b
|
||||
withByteArray b $ \p -> bufCopy dst p sz
|
||||
loop bs (dst `plusPtr` sz)
|
||||
|
||||
byteArrayCopyAndFreeze :: (ByteArray bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2
|
||||
byteArrayCopyAndFreeze bs f =
|
||||
byteArrayAllocAndFreeze (byteArrayLength bs) $ \d -> do
|
||||
withByteArray bs $ \s -> bufCopy d s (byteArrayLength bs)
|
||||
f (castPtr d)
|
||||
|
||||
byteArrayEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
|
||||
byteArrayEq b1 b2
|
||||
| l1 /= l2 = False
|
||||
| otherwise = unsafeDoIO $
|
||||
withByteArray b1 $ \p1 ->
|
||||
withByteArray b2 $ \p2 ->
|
||||
loop l1 p1 p2
|
||||
where
|
||||
l1 = byteArrayLength b1
|
||||
l2 = byteArrayLength b2
|
||||
loop :: Int -> Ptr Word8 -> Ptr Word8 -> IO Bool
|
||||
loop 0 _ _ = return True
|
||||
loop i p1 p2 = do
|
||||
e <- (==) <$> peek p1 <*> peek p2
|
||||
if e then loop (i-1) (p1 `plusPtr` 1) (p2 `plusPtr` 1) else return False
|
||||
|
||||
-- | A constant time equality test for 2 ByteArrayAccess values.
|
||||
--
|
||||
-- If values are of 2 different sizes, the function will abort early
|
||||
-- without comparing any bytes.
|
||||
--
|
||||
-- compared to == , this function will go over all the bytes
|
||||
-- present before yielding a result even when knowing the
|
||||
-- overall result early in the processing.
|
||||
byteArrayConstEq :: (ByteArrayAccess bs1, ByteArrayAccess bs2) => bs1 -> bs2 -> Bool
|
||||
byteArrayConstEq b1 b2
|
||||
| l1 /= l2 = False
|
||||
| otherwise = unsafeDoIO $
|
||||
withByteArray b1 $ \p1 ->
|
||||
withByteArray b2 $ \p2 ->
|
||||
loop l1 True p1 p2
|
||||
where
|
||||
l1 = byteArrayLength b1
|
||||
l2 = byteArrayLength b2
|
||||
loop :: Int -> Bool -> Ptr Word8 -> Ptr Word8 -> IO Bool
|
||||
loop 0 !ret _ _ = return ret
|
||||
loop i !ret p1 p2 = do
|
||||
e <- (==) <$> peek p1 <*> peek p2
|
||||
loop (i-1) (ret &&! e) (p1 `plusPtr` 1) (p2 `plusPtr` 1)
|
||||
|
||||
-- Bool == Bool
|
||||
(&&!) :: Bool -> Bool -> Bool
|
||||
True &&! True = True
|
||||
True &&! False = False
|
||||
False &&! True = False
|
||||
False &&! False = False
|
||||
|
||||
byteArrayToBS :: ByteArray bs => bs -> ByteString
|
||||
byteArrayToBS bs = byteArrayCopyAndFreeze bs (\_ -> return ())
|
||||
|
||||
byteArrayFromBS :: ByteArray bs => ByteString -> bs
|
||||
byteArrayFromBS bs = byteArrayCopyAndFreeze bs (\_ -> return ())
|
||||
|
||||
byteArrayToW64BE :: ByteArrayAccess bs => bs -> Int -> Word64
|
||||
byteArrayToW64BE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromBE64 <$> peek (p `plusPtr` ofs)
|
||||
|
||||
byteArrayToW64LE :: ByteArrayAccess bs => bs -> Int -> Word64
|
||||
byteArrayToW64LE bs ofs = unsafeDoIO $ withByteArray bs $ \p -> fromLE64 <$> peek (p `plusPtr` ofs)
|
||||
|
||||
byteArrayMapAsWord128 :: ByteArray bs => (Word128 -> Word128) -> bs -> bs
|
||||
byteArrayMapAsWord128 f bs =
|
||||
byteArrayAllocAndFreeze len $ \dst ->
|
||||
withByteArray bs $ \src ->
|
||||
loop (len `div` 16) dst src
|
||||
where
|
||||
len = byteArrayLength bs
|
||||
loop 0 _ _ = return ()
|
||||
loop i d s = do
|
||||
w1 <- peek s
|
||||
w2 <- peek (s `plusPtr` 8)
|
||||
let (Word128 r1 r2) = f (Word128 (fromBE64 w1) (fromBE64 w2))
|
||||
poke d (toBE64 r1)
|
||||
poke (d `plusPtr` 8) (toBE64 r2)
|
||||
loop (i-1) (d `plusPtr` 16) (s `plusPtr` 16)
|
||||
|
||||
byteArrayMapAsWord64 :: ByteArray bs => (Word64 -> Word64) -> bs -> bs
|
||||
byteArrayMapAsWord64 f bs =
|
||||
byteArrayAllocAndFreeze len $ \dst ->
|
||||
withByteArray bs $ \src ->
|
||||
loop (len `div` 8) dst src
|
||||
where
|
||||
len = byteArrayLength bs
|
||||
loop 0 _ _ = return ()
|
||||
loop i d s = do
|
||||
w <- peek s
|
||||
let r = f (fromBE64 w)
|
||||
poke d (toBE64 r)
|
||||
loop (i-1) (d `plusPtr` 8) (s `plusPtr` 8)
|
||||
|
||||
@ -12,15 +12,12 @@
|
||||
module Crypto.Internal.Compat
|
||||
( unsafeDoIO
|
||||
, popCount
|
||||
, byteSwap64
|
||||
) where
|
||||
|
||||
import System.IO.Unsafe
|
||||
#if MIN_VERSION_base(4,5,0)
|
||||
import Data.Bits (popCount)
|
||||
#else
|
||||
import Data.Word (Word64)
|
||||
import Data.Bits (testBit, shiftR)
|
||||
#endif
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
-- | perform io for hashes that do allocation and ffi.
|
||||
-- unsafeDupablePerformIO is used when possible as the
|
||||
@ -40,3 +37,12 @@ popCount n = loop 0 n
|
||||
where loop c 0 = c
|
||||
loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
|
||||
#endif
|
||||
|
||||
#if !(MIN_VERSION_base(4,7,0))
|
||||
byteSwap64 :: Word64 -> Word64
|
||||
byteSwap64 w =
|
||||
(w `shiftR` 56) .|. (w `shiftL` 56)
|
||||
.|. ((w `shiftR` 40) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 40)
|
||||
.|. ((w `shiftR` 24) .&. 0xff0000) .|. ((w .&. 0xff0000) `shiftL` 24)
|
||||
.|. ((w `shiftR` 8) .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
|
||||
#endif
|
||||
|
||||
49
Crypto/Internal/CompatPrim.hs
Normal file
49
Crypto/Internal/CompatPrim.hs
Normal file
@ -0,0 +1,49 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.CompatPrim
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : Compat
|
||||
--
|
||||
-- This module try to keep all the difference between versions of ghc primitive
|
||||
-- or other needed packages, so that modules don't need to use CPP.
|
||||
--
|
||||
-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
|
||||
-- to write compat code for primitives
|
||||
--
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
module Crypto.Internal.CompatPrim
|
||||
( be32Prim
|
||||
, byteswap32Prim
|
||||
, booleanPrim
|
||||
) where
|
||||
|
||||
import GHC.Prim
|
||||
|
||||
#ifdef ARCH_IS_LITTLE_ENDIAN
|
||||
be32Prim :: Word# -> Word#
|
||||
be32Prim = byteswap32Prim
|
||||
#else
|
||||
be32Prim w = w
|
||||
#endif
|
||||
|
||||
byteswap32Prim :: Word# -> Word#
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
byteswap32Prim w = byteSwap32# w
|
||||
#else
|
||||
byteswap32Prim w =
|
||||
let a = uncheckedShiftL# w 24#
|
||||
b = and# (uncheckedShiftL# w 8#) 0x00ff0000##
|
||||
c = and# (uncheckedShiftRL# w 8#) 0x0000ff00##
|
||||
d = and# (uncheckedShiftRL# w 24#) 0x000000ff##
|
||||
in or# a (or# b (or# c d))
|
||||
#endif
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
booleanPrim :: Int# -> Bool
|
||||
booleanPrim v = tagToEnum# v
|
||||
#else
|
||||
booleanPrim :: Bool -> Bool
|
||||
booleanPrim b = b
|
||||
#endif
|
||||
41
Crypto/Internal/Endian.hs
Normal file
41
Crypto/Internal/Endian.hs
Normal file
@ -0,0 +1,41 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.Endian
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : good
|
||||
--
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Crypto.Internal.Endian
|
||||
( fromBE64, toBE64
|
||||
, fromLE64, toLE64
|
||||
) where
|
||||
|
||||
import Crypto.Internal.Compat (byteSwap64)
|
||||
import Data.Word (Word64)
|
||||
|
||||
#ifdef ARCH_IS_LITTLE_ENDIAN
|
||||
fromLE64 :: Word64 -> Word64
|
||||
fromLE64 = id
|
||||
|
||||
toLE64 :: Word64 -> Word64
|
||||
toLE64 = id
|
||||
|
||||
fromBE64 :: Word64 -> Word64
|
||||
fromBE64 = byteSwap64
|
||||
|
||||
toBE64 :: Word64 -> Word64
|
||||
toBE64 = byteSwap64
|
||||
#else
|
||||
fromLE64 :: Word64 -> Word64
|
||||
fromLE64 = byteSwap64
|
||||
|
||||
toLE64 :: Word64 -> Word64
|
||||
toLE64 = byteSwap64
|
||||
|
||||
fromBE64 :: Word64 -> Word64
|
||||
fromBE64 = id
|
||||
|
||||
toBE64 :: Word64 -> Word64
|
||||
toBE64 = id
|
||||
#endif
|
||||
15
Crypto/Internal/Imports.hs
Normal file
15
Crypto/Internal/Imports.hs
Normal file
@ -0,0 +1,15 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.Imports
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : unknown
|
||||
--
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Crypto.Internal.Imports
|
||||
( module X
|
||||
) where
|
||||
|
||||
import Data.Word as X
|
||||
import Control.Applicative as X
|
||||
import Control.Monad as X (forM, forM_, void)
|
||||
137
Crypto/Internal/WordArray.hs
Normal file
137
Crypto/Internal/WordArray.hs
Normal file
@ -0,0 +1,137 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.Compat
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : stable
|
||||
-- Portability : Good
|
||||
--
|
||||
-- Small and self contained array representation
|
||||
-- with limited safety for internal use.
|
||||
--
|
||||
-- the array produced should never be exposed to the user directly
|
||||
--
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
module Crypto.Internal.WordArray
|
||||
( Array8
|
||||
, Array32
|
||||
, Array64
|
||||
, MutableArray32
|
||||
, array8
|
||||
, array32
|
||||
, mutableArray32
|
||||
, array64
|
||||
, arrayRead8
|
||||
, arrayRead32
|
||||
, arrayRead64
|
||||
, mutableArrayRead32
|
||||
, mutableArrayWrite32
|
||||
, mutableArrayWriteXor32
|
||||
, mutableArray32FromAddrBE
|
||||
, mutableArray32Freeze
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Data.Bits (xor)
|
||||
import Crypto.Internal.Compat
|
||||
import Crypto.Internal.CompatPrim
|
||||
import GHC.Prim
|
||||
import GHC.Types
|
||||
import GHC.Word
|
||||
|
||||
data Array8 = Array8 Addr#
|
||||
|
||||
data Array32 = Array32 ByteArray#
|
||||
|
||||
data Array64 = Array64 ByteArray#
|
||||
|
||||
data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
|
||||
|
||||
array8 :: Addr# -> Array8
|
||||
array8 = Array8
|
||||
|
||||
array32 :: Int -> [Word32] -> Array32
|
||||
array32 (I# n) l = unsafeDoIO $ IO $ \s ->
|
||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||
(# s', mbarr #) -> loop 0# s' mbarr l
|
||||
where
|
||||
loop _ st mb [] = freezeArray mb st
|
||||
loop i st mb ((W32# x):xs)
|
||||
| booleanPrim (i ==# n) = freezeArray mb st
|
||||
| otherwise =
|
||||
let st' = writeWord32Array# mb i x st
|
||||
in loop (i +# 1#) st' mb xs
|
||||
freezeArray mb st =
|
||||
case unsafeFreezeByteArray# mb st of
|
||||
(# st', b #) -> (# st', Array32 b #)
|
||||
{-# NOINLINE array32 #-}
|
||||
|
||||
array64 :: Int -> [Word64] -> Array64
|
||||
array64 (I# n) l = unsafeDoIO $ IO $ \s ->
|
||||
case newAlignedPinnedByteArray# (n *# 8#) 8# s of
|
||||
(# s', mbarr #) -> loop 0# s' mbarr l
|
||||
where
|
||||
loop _ st mb [] = freezeArray mb st
|
||||
loop i st mb ((W64# x):xs)
|
||||
| booleanPrim (i ==# n) = freezeArray mb st
|
||||
| otherwise =
|
||||
let st' = writeWord64Array# mb i x st
|
||||
in loop (i +# 1#) st' mb xs
|
||||
freezeArray mb st =
|
||||
case unsafeFreezeByteArray# mb st of
|
||||
(# st', b #) -> (# st', Array64 b #)
|
||||
{-# NOINLINE array64 #-}
|
||||
|
||||
mutableArray32 :: Int -> [Word32] -> IO MutableArray32
|
||||
mutableArray32 (I# n) l = IO $ \s ->
|
||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||
(# s', mbarr #) -> loop 0# s' mbarr l
|
||||
where
|
||||
loop _ st mb [] = (# st, MutableArray32 mb #)
|
||||
loop i st mb ((W32# x):xs)
|
||||
| booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
|
||||
| otherwise =
|
||||
let st' = writeWord32Array# mb i x st
|
||||
in loop (i +# 1#) st' mb xs
|
||||
|
||||
mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
|
||||
mutableArray32FromAddrBE (I# n) a = IO $ \s ->
|
||||
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
|
||||
(# s', mbarr #) -> loop 0# s' mbarr
|
||||
where
|
||||
loop i st mb
|
||||
| booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
|
||||
| otherwise =
|
||||
let st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
|
||||
in loop (i +# 1#) st' mb
|
||||
|
||||
mutableArray32Freeze :: MutableArray32 -> IO Array32
|
||||
mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
|
||||
case unsafeFreezeByteArray# mb st of
|
||||
(# st', b #) -> (# st', Array32 b #)
|
||||
|
||||
arrayRead8 :: Array8 -> Int -> Word8
|
||||
arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
|
||||
{-# INLINE arrayRead8 #-}
|
||||
|
||||
arrayRead32 :: Array32 -> Int -> Word32
|
||||
arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
|
||||
{-# INLINE arrayRead32 #-}
|
||||
|
||||
arrayRead64 :: Array64 -> Int -> Word64
|
||||
arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
|
||||
{-# INLINE arrayRead64 #-}
|
||||
|
||||
mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
|
||||
mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
|
||||
{-# INLINE mutableArrayRead32 #-}
|
||||
|
||||
mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
||||
mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let s' = writeWord32Array# m o w s in (# s', () #)
|
||||
{-# INLINE mutableArrayWrite32 #-}
|
||||
|
||||
mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
|
||||
mutableArrayWriteXor32 m o w =
|
||||
mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
|
||||
{-# INLINE mutableArrayWriteXor32 #-}
|
||||
26
Crypto/Internal/Words.hs
Normal file
26
Crypto/Internal/Words.hs
Normal file
@ -0,0 +1,26 @@
|
||||
-- |
|
||||
-- Module : Crypto.Internal.Words
|
||||
-- License : BSD-style
|
||||
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
||||
-- Stability : experimental
|
||||
-- Portability : unknown
|
||||
--
|
||||
-- Extra Word size
|
||||
--
|
||||
module Crypto.Internal.Words
|
||||
( Word128(..)
|
||||
, w64to32
|
||||
, w32to64
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Data.Bits
|
||||
|
||||
-- should probably use crypto large word ?
|
||||
data Word128 = Word128 !Word64 !Word64 deriving (Show, Eq)
|
||||
|
||||
w64to32 :: Word64 -> (Word32, Word32)
|
||||
w64to32 w = (fromIntegral (w `shiftR` 32), fromIntegral w)
|
||||
|
||||
w32to64 :: (Word32, Word32) -> Word64
|
||||
w32to64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)
|
||||
@ -17,6 +17,7 @@ extra-doc-files: README.md
|
||||
extra-source-files: cbits/*.h
|
||||
cbits/aes/*.h
|
||||
cbits/aes/x86ni_impl.c
|
||||
tests/*.hs
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -27,10 +28,17 @@ Flag support_aesni
|
||||
Default: True
|
||||
|
||||
Library
|
||||
Exposed-modules: Crypto.Cipher.ChaCha
|
||||
Crypto.Cipher.Salsa
|
||||
Exposed-modules: Crypto.Cipher.AES
|
||||
Crypto.Cipher.Blowfish
|
||||
Crypto.Cipher.Camellia
|
||||
Crypto.Cipher.ChaCha
|
||||
Crypto.Cipher.DES
|
||||
Crypto.Cipher.RC4
|
||||
Crypto.Cipher.Salsa
|
||||
Crypto.Cipher.TripleDES
|
||||
Crypto.Cipher.Types
|
||||
Crypto.Data.AFIS
|
||||
Crypto.Error
|
||||
Crypto.MAC.Poly1305
|
||||
Crypto.MAC.HMAC
|
||||
Crypto.Number.Basic
|
||||
@ -79,7 +87,20 @@ Library
|
||||
Crypto.Random.Entropy
|
||||
Crypto.Random.EntropyPool
|
||||
Crypto.Random.Entropy.Unsafe
|
||||
Crypto.Internal.ByteArray
|
||||
Other-modules: Crypto.Cipher.AES.Internal
|
||||
Crypto.Cipher.Blowfish.Box
|
||||
Crypto.Cipher.Blowfish.Primitive
|
||||
Crypto.Cipher.Camellia.Primitive
|
||||
Crypto.Cipher.DES.Primitive
|
||||
Crypto.Cipher.DES.Serialization
|
||||
Crypto.Cipher.Types.AEAD
|
||||
Crypto.Cipher.Types.Base
|
||||
Crypto.Cipher.Types.Block
|
||||
Crypto.Cipher.Types.GF
|
||||
Crypto.Cipher.Types.Stream
|
||||
Crypto.Cipher.Types.Utils
|
||||
Crypto.Error.Types
|
||||
Crypto.Hash.Utils
|
||||
Crypto.Hash.Utils.Cpu
|
||||
Crypto.Hash.Types
|
||||
@ -105,9 +126,13 @@ Library
|
||||
Crypto.PubKey.Internal
|
||||
Crypto.PubKey.ElGamal
|
||||
Crypto.Internal.Compat
|
||||
Crypto.Internal.CompatPrim
|
||||
Crypto.Internal.Bytes
|
||||
Crypto.Internal.ByteArray
|
||||
Crypto.Internal.Endian
|
||||
Crypto.Internal.Imports
|
||||
Crypto.Internal.Memory
|
||||
Crypto.Internal.Words
|
||||
Crypto.Internal.WordArray
|
||||
Build-depends: base >= 4.3 && < 5
|
||||
, bytestring
|
||||
, securemem >= 0.1.7
|
||||
@ -139,6 +164,10 @@ Library
|
||||
, cbits/cryptonite_whirlpool.c
|
||||
, cbits/cryptonite_scrypt.c
|
||||
include-dirs: cbits
|
||||
|
||||
-- FIXME armel or mispel is also little endian.
|
||||
-- might be a good idea to also add a runtime autodetect mode.
|
||||
-- ARCH_ENDIAN_UNKNOWN
|
||||
if (arch(i386) || arch(x86_64))
|
||||
CPP-options: -DARCH_IS_LITTLE_ENDIAN
|
||||
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
{ "path": "cbits" },
|
||||
{ "path": "tests", "file_exclude_patterns": ["*.html"] },
|
||||
{ "path": "benchs" },
|
||||
{ "path": "gen" },
|
||||
{ "path": "gen" }
|
||||
],
|
||||
"settings":
|
||||
{
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module BlockCipher
|
||||
( KAT_ECB(..)
|
||||
, KAT_CBC(..)
|
||||
@ -5,21 +6,30 @@ module BlockCipher
|
||||
, KAT_CTR(..)
|
||||
, KAT_XTS(..)
|
||||
, KAT_AEAD(..)
|
||||
, testECB
|
||||
, testKatCBC
|
||||
, testKatCFB
|
||||
, testKatCTR
|
||||
, testKatXTS
|
||||
, testKatAEAD
|
||||
, KATs(..)
|
||||
, defaultKATs
|
||||
, testBlockCipher
|
||||
, CipherInfo
|
||||
) where
|
||||
|
||||
import Imports
|
||||
import Data.Maybe
|
||||
import Crypto.Error
|
||||
import Crypto.Cipher.Types
|
||||
import Crypto.Internal.ByteArray
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- KAT
|
||||
------------------------------------------------------------------------
|
||||
|
||||
type BlockSize = Int
|
||||
type KeySize = Int
|
||||
type CipherInfo a = (BlockSize, KeySize, ByteString -> a)
|
||||
|
||||
instance Show (IV c) where
|
||||
show _ = "IV"
|
||||
|
||||
-- | ECB KAT
|
||||
data KAT_ECB = KAT_ECB
|
||||
{ ecbKey :: ByteString -- ^ Key
|
||||
@ -71,6 +81,20 @@ 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) =
|
||||
@ -124,6 +148,312 @@ testKatAEAD cipherInit aeadInit aeadAppendHeader aeadEncrypt aeadDecrypt aeadFin
|
||||
(dbs,aeadDFinal) = aeadDecrypt aeadHeaded (aeadCiphertext d)
|
||||
etag = aeadFinalize aeadEFinal (aeadTaglen d)
|
||||
dtag = aeadFinalize aeadDFinal (aeadTaglen d)
|
||||
-}
|
||||
|
||||
is :: [Int]
|
||||
is = [1..]
|
||||
testKATs :: BlockCipher cipher
|
||||
=> KATs
|
||||
-> cipher
|
||||
-> TestTree
|
||||
testKATs kats cipher = testGroup "KAT"
|
||||
( maybeGroup makeECBTest "ECB" (kat_ECB kats)
|
||||
++ maybeGroup makeCBCTest "CBC" (kat_CBC kats)
|
||||
++ maybeGroup makeCFBTest "CFB" (kat_CFB kats)
|
||||
++ maybeGroup makeCTRTest "CTR" (kat_CTR kats)
|
||||
-- ++ maybeGroup makeXTSTest "XTS" (kat_XTS kats)
|
||||
-- ++ maybeGroup makeAEADTest "AEAD" (kat_AEAD kats)
|
||||
)
|
||||
where makeECBTest i d =
|
||||
[ testCase ("E" ++ i) (ecbEncrypt ctx (ecbPlaintext d) @?= ecbCiphertext d)
|
||||
, testCase ("D" ++ i) (ecbDecrypt ctx (ecbCiphertext d) @?= ecbPlaintext d)
|
||||
]
|
||||
where ctx = cipherInitNoErr (cipherMakeKey cipher $ ecbKey d)
|
||||
makeCBCTest i d =
|
||||
[ testCase ("E" ++ i) (cbcEncrypt ctx iv (cbcPlaintext d) @?= cbcCiphertext d)
|
||||
, testCase ("D" ++ i) (cbcDecrypt ctx iv (cbcCiphertext d) @?= cbcPlaintext d)
|
||||
]
|
||||
where ctx = cipherInitNoErr (cipherMakeKey cipher $ cbcKey d)
|
||||
iv = cipherMakeIV cipher $ cbcIV d
|
||||
makeCFBTest i d =
|
||||
[ testCase ("E" ++ i) (cfbEncrypt ctx iv (cfbPlaintext d) @?= cfbCiphertext d)
|
||||
, testCase ("D" ++ i) (cfbDecrypt ctx iv (cfbCiphertext d) @?= cfbPlaintext d)
|
||||
]
|
||||
where ctx = cipherInitNoErr (cipherMakeKey cipher $ cfbKey d)
|
||||
iv = cipherMakeIV cipher $ cfbIV d
|
||||
makeCTRTest i d =
|
||||
[ testCase ("E" ++ i) (ctrCombine ctx iv (ctrPlaintext d) @?= ctrCiphertext d)
|
||||
, testCase ("D" ++ i) (ctrCombine ctx iv (ctrCiphertext d) @?= ctrPlaintext d)
|
||||
]
|
||||
where ctx = cipherInitNoErr (cipherMakeKey cipher $ ctrKey d)
|
||||
iv = cipherMakeIV cipher $ ctrIV d
|
||||
{-
|
||||
makeXTSTest i d =
|
||||
[ testCase ("E" ++ i) (xtsEncrypt ctx iv 0 (xtsPlaintext d) @?= xtsCiphertext d)
|
||||
, testCase ("D" ++ i) (xtsDecrypt ctx iv 0 (xtsCiphertext d) @?= xtsPlaintext d)
|
||||
]
|
||||
where ctx1 = cipherInit (cipherMakeKey cipher $ xtsKey1 d)
|
||||
ctx2 = cipherInit (cipherMakeKey cipher $ xtsKey2 d)
|
||||
ctx = (ctx1, ctx2)
|
||||
iv = cipherMakeIV cipher $ xtsIV d
|
||||
makeAEADTest i d =
|
||||
[ testCase ("AE" ++ i) (etag @?= aeadTag d)
|
||||
, testCase ("AD" ++ i) (dtag @?= aeadTag d)
|
||||
, testCase ("E" ++ i) (ebs @?= aeadCiphertext d)
|
||||
, testCase ("D" ++ i) (dbs @?= aeadPlaintext d)
|
||||
]
|
||||
where ctx = cipherInit (cipherMakeKey cipher $ aeadKey d)
|
||||
aead = maybe (error $ "cipher doesn't support aead mode: " ++ show (aeadMode d)) id
|
||||
$ aeadInit (aeadMode d) ctx (aeadIV d)
|
||||
aeadHeaded = aeadAppendHeader aead (aeadHeader d)
|
||||
(ebs,aeadEFinal) = aeadEncrypt aeadHeaded (aeadPlaintext d)
|
||||
(dbs,aeadDFinal) = aeadDecrypt aeadHeaded (aeadCiphertext d)
|
||||
etag = aeadFinalize aeadEFinal (aeadTaglen d)
|
||||
dtag = aeadFinalize aeadDFinal (aeadTaglen d)
|
||||
-}
|
||||
|
||||
cipherInitNoErr :: BlockCipher c => Key c -> c
|
||||
cipherInitNoErr (Key k) =
|
||||
case cipherInit k of
|
||||
CryptoPassed a -> a
|
||||
CryptoFailed e -> error (show e)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- 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)
|
||||
|
||||
newtype Key a = Key ByteString
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- | 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 iv ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (CFBUnit a) where
|
||||
show (CFBUnit key iv b) = "CFB(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (CFB8Unit a) where
|
||||
show (CFB8Unit key iv b) = "CFB8(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (CTRUnit a) where
|
||||
show (CTRUnit key iv b) = "CTR(key=" ++ show key ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (XTSUnit a) where
|
||||
show (XTSUnit key1 key2 iv b) = "XTS(key1=" ++ show key1 ++ ",key2=" ++ show key2 ++ ",iv=" ++ show iv ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (AEADUnit a) where
|
||||
show (AEADUnit key iv aad b) = "AEAD(key=" ++ show key ++ ",iv=" ++ show iv ++ ",aad=" ++ show (unPlaintext aad) ++ ",input=" ++ show b ++ ")"
|
||||
instance Show (StreamUnit a) where
|
||||
show (StreamUnit key b) = "Stream(key=" ++ show 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
|
||||
Key . 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 key (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
|
||||
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,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 key testIV (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
|
||||
plaintext `assertEq` cbcDecrypt ctx testIV (cbcEncrypt ctx testIV plaintext)
|
||||
|
||||
testProperty_CFB (CFBUnit key testIV (unPlaintextBS -> plaintext)) = withCtx key $ \ctx ->
|
||||
plaintext `assertEq` cfbDecrypt ctx testIV (cfbEncrypt ctx testIV plaintext)
|
||||
|
||||
{-
|
||||
testProperty_CFB8 (CFB8Unit (cipherInit -> ctx) testIV (unPlaintext -> plaintext)) =
|
||||
plaintext `assertEq` cfb8Decrypt ctx testIV (cfb8Encrypt ctx testIV plaintext)
|
||||
-}
|
||||
|
||||
testProperty_CTR (CTRUnit key testIV (unPlaintext -> plaintext)) = withCtx key $ \ctx ->
|
||||
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 key testIV (unPlaintext -> aad) (unPlaintext -> plaintext)) = withCtx key $ \ctx ->
|
||||
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) && (eTag `byteArrayEq` dTag)
|
||||
Nothing -> True
|
||||
|
||||
withCtx :: Cipher c => Key c -> (c -> a) -> a
|
||||
withCtx (Key key) f =
|
||||
case cipherInit key of
|
||||
CryptoFailed e -> error ("init failed: " ++ show e)
|
||||
CryptoPassed ctx -> f ctx
|
||||
|
||||
{-
|
||||
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
|
||||
-}
|
||||
|
||||
-- | 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)
|
||||
(testBlockCipherBasic cipher ++ testBlockCipherModes cipher ++ testBlockCipherAEAD 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
|
||||
|
||||
cipherMakeKey :: Cipher cipher => cipher -> ByteString -> Key cipher
|
||||
cipherMakeKey _ bs = Key bs
|
||||
|
||||
cipherMakeIV :: BlockCipher cipher => cipher -> ByteString -> IV cipher
|
||||
cipherMakeIV _ bs = fromJust $ makeIV bs
|
||||
|
||||
maybeGroup :: (String -> t -> [TestTree]) -> TestName -> [t] -> [TestTree]
|
||||
maybeGroup mkTest groupName l
|
||||
| null l = []
|
||||
| otherwise = [testGroup groupName (concatMap (\(i, d) -> mkTest (show i) d) $ zip nbs l)]
|
||||
where nbs :: [Int]
|
||||
nbs = [0..]
|
||||
|
||||
@ -2,20 +2,13 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
module KAT_AFIS (tests) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Imports
|
||||
|
||||
import Crypto.Hash
|
||||
import Crypto.Random
|
||||
import qualified Crypto.Data.AFIS as AFIS
|
||||
|
||||
import Data.ByteString.Char8 ()
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.QuickCheck
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
mergeVec =
|
||||
[ (3
|
||||
, hash :: HashFunctionBS SHA1
|
||||
|
||||
@ -1,9 +1,8 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module KAT_Blowfish where
|
||||
|
||||
--import Crypto.Cipher.Blowfish
|
||||
--import Data.ByteString.Char8 () -- orphan IsString for older bytestring versions
|
||||
import Imports
|
||||
import Crypto.Cipher.Blowfish
|
||||
import Imports ()
|
||||
import BlockCipher
|
||||
|
||||
vectors_ecb = -- key plaintext cipher
|
||||
@ -43,12 +42,6 @@ vectors_ecb = -- key plaintext cipher
|
||||
, KAT_ECB "\xFE\xDC\xBA\x98\x76\x54\x32\x10" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x6B\x5C\x5A\x9C\x5D\x9E\x0A\x5A"
|
||||
]
|
||||
|
||||
{-
|
||||
kats = defaultKATs { kat_ECB = vectors_ecb }
|
||||
|
||||
main = defaultMain
|
||||
[ testBlockCipher kats (undefined :: Blowfish64)
|
||||
]
|
||||
-}
|
||||
|
||||
tests = testGroup "Blowfish" []
|
||||
tests = testBlockCipher kats (undefined :: Blowfish64)
|
||||
|
||||
34
tests/KAT_Camellia.hs
Normal file
34
tests/KAT_Camellia.hs
Normal file
@ -0,0 +1,34 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
module KAT_Camellia (tests) where
|
||||
|
||||
import Imports ()
|
||||
import BlockCipher
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Crypto.Cipher.Camellia
|
||||
|
||||
vectors_camellia128 =
|
||||
[ KAT_ECB (B.replicate 16 0) (B.replicate 16 0) (B.pack [0x3d,0x02,0x80,0x25,0xb1,0x56,0x32,0x7c,0x17,0xf7,0x62,0xc1,0xf2,0xcb,0xca,0x71])
|
||||
, KAT_ECB (B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10])
|
||||
(B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10])
|
||||
(B.pack [0x67,0x67,0x31,0x38,0x54,0x96,0x69,0x73,0x08,0x57,0x06,0x56,0x48,0xea,0xbe,0x43])
|
||||
]
|
||||
|
||||
vectors_camellia192 =
|
||||
[ KAT_ECB (B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10,0x00,0x11,0x22,0x33,0x44,0x55,0x66,0x77]) (B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10]) (B.pack [0xb4,0x99,0x34,0x01,0xb3,0xe9,0x96,0xf8,0x4e,0xe5,0xce,0xe7,0xd7,0x9b,0x09,0xb9])
|
||||
]
|
||||
|
||||
vectors_camellia256 =
|
||||
[ KAT_ECB (B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10 ,0x00,0x11,0x22,0x33,0x44,0x55,0x66,0x77,0x88,0x99,0xaa,0xbb,0xcc,0xdd,0xee,0xff])
|
||||
(B.pack [0x01,0x23,0x45,0x67,0x89,0xab,0xcd,0xef,0xfe,0xdc,0xba,0x98,0x76,0x54,0x32,0x10])
|
||||
(B.pack [0x9a,0xcc,0x23,0x7d,0xff,0x16,0xd7,0x6c,0x20,0xef,0x7c,0x91,0x9e,0x3a,0x75,0x09])
|
||||
]
|
||||
|
||||
kats128 = defaultKATs { kat_ECB = vectors_camellia128 }
|
||||
kats192 = defaultKATs { kat_ECB = vectors_camellia192 }
|
||||
kats256 = defaultKATs { kat_ECB = vectors_camellia256 }
|
||||
|
||||
tests = testBlockCipher kats128 (undefined :: Camellia128)
|
||||
49
tests/KAT_DES.hs
Normal file
49
tests/KAT_DES.hs
Normal file
@ -0,0 +1,49 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module KAT_DES (tests) where
|
||||
|
||||
import Imports
|
||||
import BlockCipher
|
||||
import qualified Crypto.Cipher.DES as DES
|
||||
|
||||
vectors_ecb = -- key plaintext ciphertext
|
||||
[ KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\x00\x00\x00\x00\x00\x00\x00\x00" "\x8C\xA6\x4D\xE9\xC1\xB1\x23\xA7"
|
||||
, KAT_ECB "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x73\x59\xB2\x16\x3E\x4E\xDC\x58"
|
||||
, KAT_ECB "\x30\x00\x00\x00\x00\x00\x00\x00" "\x10\x00\x00\x00\x00\x00\x00\x01" "\x95\x8E\x6E\x62\x7A\x05\x55\x7B"
|
||||
, KAT_ECB "\x11\x11\x11\x11\x11\x11\x11\x11" "\x11\x11\x11\x11\x11\x11\x11\x11" "\xF4\x03\x79\xAB\x9E\x0E\xC5\x33"
|
||||
, KAT_ECB "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x11\x11\x11\x11\x11\x11\x11\x11" "\x17\x66\x8D\xFC\x72\x92\x53\x2D"
|
||||
, KAT_ECB "\x11\x11\x11\x11\x11\x11\x11\x11" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x8A\x5A\xE1\xF8\x1A\xB8\xF2\xDD"
|
||||
, KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\x00\x00\x00\x00\x00\x00\x00\x00" "\x8C\xA6\x4D\xE9\xC1\xB1\x23\xA7"
|
||||
, KAT_ECB "\xFE\xDC\xBA\x98\x76\x54\x32\x10" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xED\x39\xD9\x50\xFA\x74\xBC\xC4"
|
||||
, KAT_ECB "\x7C\xA1\x10\x45\x4A\x1A\x6E\x57" "\x01\xA1\xD6\xD0\x39\x77\x67\x42" "\x69\x0F\x5B\x0D\x9A\x26\x93\x9B"
|
||||
, KAT_ECB "\x01\x31\xD9\x61\x9D\xC1\x37\x6E" "\x5C\xD5\x4C\xA8\x3D\xEF\x57\xDA" "\x7A\x38\x9D\x10\x35\x4B\xD2\x71"
|
||||
, KAT_ECB "\x07\xA1\x13\x3E\x4A\x0B\x26\x86" "\x02\x48\xD4\x38\x06\xF6\x71\x72" "\x86\x8E\xBB\x51\xCA\xB4\x59\x9A"
|
||||
, KAT_ECB "\x38\x49\x67\x4C\x26\x02\x31\x9E" "\x51\x45\x4B\x58\x2D\xDF\x44\x0A" "\x71\x78\x87\x6E\x01\xF1\x9B\x2A"
|
||||
, KAT_ECB "\x04\xB9\x15\xBA\x43\xFE\xB5\xB6" "\x42\xFD\x44\x30\x59\x57\x7F\xA2" "\xAF\x37\xFB\x42\x1F\x8C\x40\x95"
|
||||
, KAT_ECB "\x01\x13\xB9\x70\xFD\x34\xF2\xCE" "\x05\x9B\x5E\x08\x51\xCF\x14\x3A" "\x86\xA5\x60\xF1\x0E\xC6\xD8\x5B"
|
||||
, KAT_ECB "\x01\x70\xF1\x75\x46\x8F\xB5\xE6" "\x07\x56\xD8\xE0\x77\x47\x61\xD2" "\x0C\xD3\xDA\x02\x00\x21\xDC\x09"
|
||||
, KAT_ECB "\x43\x29\x7F\xAD\x38\xE3\x73\xFE" "\x76\x25\x14\xB8\x29\xBF\x48\x6A" "\xEA\x67\x6B\x2C\xB7\xDB\x2B\x7A"
|
||||
, KAT_ECB "\x07\xA7\x13\x70\x45\xDA\x2A\x16" "\x3B\xDD\x11\x90\x49\x37\x28\x02" "\xDF\xD6\x4A\x81\x5C\xAF\x1A\x0F"
|
||||
, KAT_ECB "\x04\x68\x91\x04\xC2\xFD\x3B\x2F" "\x26\x95\x5F\x68\x35\xAF\x60\x9A" "\x5C\x51\x3C\x9C\x48\x86\xC0\x88"
|
||||
, KAT_ECB "\x37\xD0\x6B\xB5\x16\xCB\x75\x46" "\x16\x4D\x5E\x40\x4F\x27\x52\x32" "\x0A\x2A\xEE\xAE\x3F\xF4\xAB\x77"
|
||||
, KAT_ECB "\x1F\x08\x26\x0D\x1A\xC2\x46\x5E" "\x6B\x05\x6E\x18\x75\x9F\x5C\xCA" "\xEF\x1B\xF0\x3E\x5D\xFA\x57\x5A"
|
||||
, KAT_ECB "\x58\x40\x23\x64\x1A\xBA\x61\x76" "\x00\x4B\xD6\xEF\x09\x17\x60\x62" "\x88\xBF\x0D\xB6\xD7\x0D\xEE\x56"
|
||||
, KAT_ECB "\x02\x58\x16\x16\x46\x29\xB0\x07" "\x48\x0D\x39\x00\x6E\xE7\x62\xF2" "\xA1\xF9\x91\x55\x41\x02\x0B\x56"
|
||||
, KAT_ECB "\x49\x79\x3E\xBC\x79\xB3\x25\x8F" "\x43\x75\x40\xC8\x69\x8F\x3C\xFA" "\x6F\xBF\x1C\xAF\xCF\xFD\x05\x56"
|
||||
, KAT_ECB "\x4F\xB0\x5E\x15\x15\xAB\x73\xA7" "\x07\x2D\x43\xA0\x77\x07\x52\x92" "\x2F\x22\xE4\x9B\xAB\x7C\xA1\xAC"
|
||||
, KAT_ECB "\x49\xE9\x5D\x6D\x4C\xA2\x29\xBF" "\x02\xFE\x55\x77\x81\x17\xF1\x2A" "\x5A\x6B\x61\x2C\xC2\x6C\xCE\x4A"
|
||||
, KAT_ECB "\x01\x83\x10\xDC\x40\x9B\x26\xD6" "\x1D\x9D\x5C\x50\x18\xF7\x28\xC2" "\x5F\x4C\x03\x8E\xD1\x2B\x2E\x41"
|
||||
, KAT_ECB "\x1C\x58\x7F\x1C\x13\x92\x4F\xEF" "\x30\x55\x32\x28\x6D\x6F\x29\x5A" "\x63\xFA\xC0\xD0\x34\xD9\xF7\x93"
|
||||
, KAT_ECB "\x01\x01\x01\x01\x01\x01\x01\x01" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x61\x7B\x3A\x0C\xE8\xF0\x71\x00"
|
||||
, KAT_ECB "\x1F\x1F\x1F\x1F\x0E\x0E\x0E\x0E" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xDB\x95\x86\x05\xF8\xC8\xC6\x06"
|
||||
, KAT_ECB "\xE0\xFE\xE0\xFE\xF1\xFE\xF1\xFE" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xED\xBF\xD1\xC6\x6C\x29\xCC\xC7"
|
||||
, KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x35\x55\x50\xB2\x15\x0E\x24\x51"
|
||||
, KAT_ECB "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x00\x00\x00\x00\x00\x00\x00\x00" "\xCA\xAA\xAF\x4D\xEA\xF1\xDB\xAE"
|
||||
, KAT_ECB "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x00\x00\x00\x00\x00\x00\x00\x00" "\xD5\xD4\x4F\xF7\x20\x68\x3D\x0D"
|
||||
, KAT_ECB "\xFE\xDC\xBA\x98\x76\x54\x32\x10" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x2A\x2B\xB0\x08\xDF\x97\xC2\xF2"
|
||||
]
|
||||
|
||||
kats = defaultKATs { kat_ECB = vectors_ecb }
|
||||
|
||||
tests = localOption (QuickCheckTests 5)
|
||||
$ testBlockCipher kats (undefined :: DES.DES)
|
||||
12
tests/KAT_TripleDES.hs
Normal file
12
tests/KAT_TripleDES.hs
Normal file
@ -0,0 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module KAT_TripleDES (tests) where
|
||||
|
||||
import Imports
|
||||
import BlockCipher
|
||||
import qualified Crypto.Cipher.TripleDES as TripleDES
|
||||
|
||||
kats = defaultKATs
|
||||
|
||||
tests = localOption (QuickCheckTests 5)
|
||||
$ testBlockCipher kats (undefined :: TripleDES.DES_EEE3)
|
||||
@ -1,14 +1,10 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Byteable
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.ByteString.Char8 ()
|
||||
import Test.Tasty
|
||||
import Test.Tasty.QuickCheck
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import Imports
|
||||
|
||||
import qualified Crypto.Cipher.ChaCha as ChaCha
|
||||
import qualified Crypto.Cipher.Salsa as Salsa
|
||||
@ -21,8 +17,11 @@ import qualified KAT_PBKDF2
|
||||
import qualified KAT_Curve25519
|
||||
import qualified KAT_PubKey
|
||||
import qualified KAT_Scrypt
|
||||
import qualified KAT_RC4
|
||||
import qualified KAT_Blowfish
|
||||
import qualified KAT_Camellia
|
||||
import qualified KAT_DES
|
||||
import qualified KAT_RC4
|
||||
import qualified KAT_TripleDES
|
||||
import qualified KAT_AFIS
|
||||
|
||||
b8_128_k0_i0 = "\xe2\x8a\x5f\xa4\xa6\x7f\x8c\x5d\xef\xed\x3e\x6f\xb7\x30\x34\x86\xaa\x84\x27\xd3\x14\x19\xa7\x29\x57\x2d\x77\x79\x53\x49\x11\x20\xb6\x4a\xb8\xe7\x2b\x8d\xeb\x85\xcd\x6a\xea\x7c\xb6\x08\x9a\x10\x18\x24\xbe\xeb\x08\x81\x4a\x42\x8a\xab\x1f\xa2\xc8\x16\x08\x1b\x8a\x26\xaf\x44\x8a\x1b\xa9\x06\x36\x8f\xd8\xc8\x38\x31\xc1\x8c\xec\x8c\xed\x81\x1a\x02\x8e\x67\x5b\x8d\x2b\xe8\xfc\xe0\x81\x16\x5c\xea\xe9\xf1\xd1\xb7\xa9\x75\x49\x77\x49\x48\x05\x69\xce\xb8\x3d\xe6\xa0\xa5\x87\xd4\x98\x4f\x19\x92\x5f\x5d\x33\x8e\x43\x0d"
|
||||
@ -81,8 +80,11 @@ tests = testGroup "cryptonite"
|
||||
, KAT_PubKey.tests
|
||||
, KAT_PBKDF2.tests
|
||||
, KAT_Scrypt.tests
|
||||
, KAT_RC4.tests
|
||||
, KAT_Blowfish.tests
|
||||
, KAT_Camellia.tests
|
||||
, KAT_DES.tests
|
||||
, KAT_RC4.tests
|
||||
, KAT_TripleDES.tests
|
||||
, KAT_AFIS.tests
|
||||
]
|
||||
where chachaRunSimple expected rounds klen nonceLen =
|
||||
|
||||
Loading…
Reference in New Issue
Block a user