Crypto-4.2.5.1/0000755156011600244210000000000012062104420013050 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/0000755156011600244210000000000012062104420014065 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/Binary/0000755156011600244210000000000012062104420015311 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/Binary/BubbleBabble.hs0000755156011600244210000000272312062104420020137 0ustar 1312888Domain Usersmodule Codec.Binary.BubbleBabble(encode) where import Data.Array.Unboxed import Data.Bits import Data.Word import Codec.Utils vowel :: UArray Int Char vowel = listArray (0,5) "aeiouy" consonant :: UArray Int Char consonant = listArray (0,16) "bcdfghklmnprstvzx" -- | Encode binary data into the bubble babble human readable encoding. -- Bubble Babble is an encoding that represents binary data as psuedowords -- which are more pronouncable and memorable than standard hexadecimal encoding. -- -- It is mainly used for representing cryptographic fingerprints. -- In addition, there is an amount of redundancy and error correction built into -- the representation so that transcription errors can be more readily identified. -- -- see: http://en.wikipedia.org/wiki/Bubble_Babble -- encode :: [Octet] -> String encode cs = 'x' : bb 1 (map fromIntegral cs) where bb seed [] = vcvx ((seed `mod` 6),16,(seed `div` 6)) bb seed [x] = vcvx ((((x `shiftR` 6) .&. 3) + seed) `mod` 6, (x `shiftR` 2) .&. 15, ((x .&. 3) + (seed `div` 6)) `mod` 6) bb seed (x:y:xs) = vcvcc (a,b,c,d,e) $ bb ((seed * 5 + (x * 7 + y)) `mod` 36) xs where a = (((x `shiftR` 6) .&. 3) + seed) `mod` 6 b = (x `shiftR` 2) .&. 15 c = ((x .&. 3) + (seed `div` 6)) `mod` 6 d = (y `shiftR` 4) .&. 15 e = y .&. 15 vcvx (a,b,c) = vowel!a : consonant!b : vowel!c : "x" vcvcc (a,b,c,d,e) xs = vowel!a : consonant!b : vowel!c : consonant!d : '-' : consonant!e : xs Crypto-4.2.5.1/Codec/Encryption/0000755156011600244210000000000012062104420016217 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/Encryption/AES.hs0000755156011600244210000000355312062104420017174 0ustar 1312888Domain Users{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.AES -- Copyright : (c) Dominic Steinitz 2004 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Takes the AES module supplied by Lukasz Anforowicz and wraps it so it can -- used with the standard modes. -- ----------------------------------------------------------------------------- module Codec.Encryption.AES ( -- * Function Types encrypt, decrypt, AESKey) where import Codec.Encryption.AESAux import Data.LargeWord import Codec.Utils import Data.Word import Data.Bits class (Bits a, Integral a) => AESKeyIndirection a class AESKeyIndirection a => AESKey a instance AESKeyIndirection Word128 instance AESKeyIndirection Word192 instance AESKeyIndirection Word256 instance AESKey Word128 instance AESKey Word192 instance AESKey Word256 -- | Basic AES encryption which takes a key and a block of plaintext -- and returns the encrypted block of ciphertext according to the standard. encrypt :: AESKey a => a -> Word128 -> Word128 encrypt k p = case bitSize k of 128 -> f aes128Encrypt k p 192 -> f aes192Encrypt k p 256 -> f aes256Encrypt k p f g k p = fromIntegral $ fromOctets 256 $ g (i2osp (bitSize k `div` bitSize (0::Octet)) $ fromIntegral k) (i2osp (bitSize p `div` bitSize (0::Octet)) $ fromIntegral p) -- | Basic AES decryption which takes a key and a block of ciphertext and -- returns the decrypted block of plaintext according to the standard. decrypt :: AESKey a => a -> Word128 -> Word128 decrypt k p = case bitSize k of 128 -> f aes128Decrypt k p 192 -> f aes192Decrypt k p 256 -> f aes256Decrypt k p Crypto-4.2.5.1/Codec/Encryption/AESAux.hs0000755156011600244210000006023512062104420017652 0ustar 1312888Domain Users-- | Advanced Encryption System (specification can be found in FIPS-197) module Codec.Encryption.AESAux( aes128Encrypt, aes192Encrypt, aes256Encrypt, aes128Decrypt, aes192Decrypt, aes256Decrypt, ) where import Data.Bits import Data.Int(Int) import Data.Word(Word32) import Codec.Utils(Octet) aes128Encrypt :: [Octet] -- ^ key (16 octets) -> [Octet] -- ^ msg (16 octets) -> [Octet] -- ^ enciphered msg (16 octets) aes128Encrypt = aesEncrypt 10 4 aes192Encrypt :: [Octet] -- ^ key (24 octets) -> [Octet] -- ^ msg (16 octets) -> [Octet] -- ^ enciphered msg (16 octets) aes192Encrypt = aesEncrypt 12 6 aes256Encrypt :: [Octet] -- ^ key (32 octets) -> [Octet] -- ^ msg (16 octets) -> [Octet] -- ^ enciphered msg (16 octets) aes256Encrypt = aesEncrypt 14 8 aes128Decrypt :: [Octet] -- ^ key (16 octets) -> [Octet] -- ^ enciphered msg (16 octets) -> [Octet] -- ^ deciphered msg (16 octets) aes128Decrypt = aesDecrypt 10 4 aes192Decrypt :: [Octet] -- ^ key (24 octets) -> [Octet] -- ^ enciphered msg (16 octets) -> [Octet] -- ^ deciphered msg (16 octets) aes192Decrypt = aesDecrypt 12 6 aes256Decrypt :: [Octet] -- ^ key (32 octets) -> [Octet] -- ^ enciphered msg (16 octets) -> [Octet] -- ^ deciphered msg (16 octets) aes256Decrypt = aesDecrypt 14 8 aesEncrypt :: Int -- ^ nr -> Int -- ^ nk -> [Octet] -- ^ key -> [Octet] -- ^ msg -> [Octet] -- ^ enciphered msg aesEncrypt nr nk key [i00, i10, i20, i30, i01, i11, i21, i31, i02, i12, i22, i32, i03, i13, i23, i33] = [fo o00, fo o10, fo o20, fo o30, fo o01, fo o11, fo o21, fo o31, fo o02, fo o12, fo o22, fo o32, fo o03, fo o13, fo o23, fo o33] where State (o00, o01, o02, o03) (o10, o11, o12, o13) (o20, o21, o22, o23) (o30, o31, o32, o33) = transform ( State(fi i00, fi i01, fi i02, fi i03) (fi i10, fi i11, fi i12, fi i13) (fi i20, fi i21, fi i22, fi i23) (fi i30, fi i31, fi i32, fi i33)) fi = (fromIntegral :: Octet -> Word32) fo = (fromIntegral :: Word32 -> Octet) (kt0:kts) = genAddRoundKey (generateKeys nr nk key) transform = foldr (.) kt0 (reverse rest) mss = replicate (nr - 1) (mixColumns . shiftRows . subBytes) rest = zipWith (.) kts (mss ++ [shiftRows . subBytes ]) aesDecrypt :: Int -- ^ nr -> Int -- ^ nk -> [Octet] -- ^ key -> [Octet] -- ^ enciphered msg -> [Octet] -- ^ deciphered msg aesDecrypt nr nk key [i00, i10, i20, i30, i01, i11, i21, i31, i02, i12, i22, i32, i03, i13, i23, i33] = [fo o00, fo o10, fo o20, fo o30, fo o01, fo o11, fo o21, fo o31, fo o02, fo o12, fo o22, fo o32, fo o03, fo o13, fo o23, fo o33] where State (o00, o01, o02, o03) (o10, o11, o12, o13) (o20, o21, o22, o23) (o30, o31, o32, o33) = transform ( State(fi i00, fi i01, fi i02, fi i03) (fi i10, fi i11, fi i12, fi i13) (fi i20, fi i21, fi i22, fi i23) (fi i30, fi i31, fi i32, fi i33)) fi = (fromIntegral :: Octet -> Word32) fo = (fromIntegral :: Word32 -> Octet) (kt0:kts) = reverse (genAddRoundKey (generateKeys nr nk key)) transform = foldr (.) kt0 (reverse rest) ssm = replicate (nr - 1) (subBytesRev . shiftRowsRev . mixColumnsRev) rest = zipWith (.) kts ([subBytesRev . shiftRowsRev] ++ ssm) data State = State !(Word32, Word32, Word32, Word32) !(Word32, Word32, Word32, Word32) !(Word32, Word32, Word32, Word32) !(Word32, Word32, Word32, Word32) sbox :: Word32 -> Word32 sboxRev :: Word32 -> Word32 sbox 0x00 = 0x63 sbox 0x01 = 0x7C sbox 0x02 = 0x77 sbox 0x03 = 0x7B sbox 0x04 = 0xF2 sbox 0x05 = 0x6B sbox 0x06 = 0x6F sbox 0x07 = 0xC5 sbox 0x08 = 0x30 sbox 0x09 = 0x01 sbox 0x0a = 0x67 sbox 0x0b = 0x2B sbox 0x0c = 0xFE sbox 0x0d = 0xD7 sbox 0x0e = 0xAB sbox 0x0f = 0x76 sbox 0x10 = 0xCA sbox 0x11 = 0x82 sbox 0x12 = 0xC9 sbox 0x13 = 0x7D sbox 0x14 = 0xFA sbox 0x15 = 0x59 sbox 0x16 = 0x47 sbox 0x17 = 0xF0 sbox 0x18 = 0xAD sbox 0x19 = 0xD4 sbox 0x1a = 0xA2 sbox 0x1b = 0xAF sbox 0x1c = 0x9C sbox 0x1d = 0xA4 sbox 0x1e = 0x72 sbox 0x1f = 0xC0 sbox 0x20 = 0xB7 sbox 0x21 = 0xFD sbox 0x22 = 0x93 sbox 0x23 = 0x26 sbox 0x24 = 0x36 sbox 0x25 = 0x3F sbox 0x26 = 0xF7 sbox 0x27 = 0xCC sbox 0x28 = 0x34 sbox 0x29 = 0xA5 sbox 0x2a = 0xE5 sbox 0x2b = 0xF1 sbox 0x2c = 0x71 sbox 0x2d = 0xD8 sbox 0x2e = 0x31 sbox 0x2f = 0x15 sbox 0x30 = 0x04 sbox 0x31 = 0xC7 sbox 0x32 = 0x23 sbox 0x33 = 0xC3 sbox 0x34 = 0x18 sbox 0x35 = 0x96 sbox 0x36 = 0x05 sbox 0x37 = 0x9A sbox 0x38 = 0x07 sbox 0x39 = 0x12 sbox 0x3a = 0x80 sbox 0x3b = 0xE2 sbox 0x3c = 0xEB sbox 0x3d = 0x27 sbox 0x3e = 0xB2 sbox 0x3f = 0x75 sbox 0x40 = 0x09 sbox 0x41 = 0x83 sbox 0x42 = 0x2C sbox 0x43 = 0x1A sbox 0x44 = 0x1B sbox 0x45 = 0x6E sbox 0x46 = 0x5A sbox 0x47 = 0xA0 sbox 0x48 = 0x52 sbox 0x49 = 0x3B sbox 0x4a = 0xD6 sbox 0x4b = 0xB3 sbox 0x4c = 0x29 sbox 0x4d = 0xE3 sbox 0x4e = 0x2F sbox 0x4f = 0x84 sbox 0x50 = 0x53 sbox 0x51 = 0xD1 sbox 0x52 = 0x00 sbox 0x53 = 0xED sbox 0x54 = 0x20 sbox 0x55 = 0xFC sbox 0x56 = 0xB1 sbox 0x57 = 0x5B sbox 0x58 = 0x6A sbox 0x59 = 0xCB sbox 0x5a = 0xBE sbox 0x5b = 0x39 sbox 0x5c = 0x4A sbox 0x5d = 0x4C sbox 0x5e = 0x58 sbox 0x5f = 0xCF sbox 0x60 = 0xD0 sbox 0x61 = 0xEF sbox 0x62 = 0xAA sbox 0x63 = 0xFB sbox 0x64 = 0x43 sbox 0x65 = 0x4D sbox 0x66 = 0x33 sbox 0x67 = 0x85 sbox 0x68 = 0x45 sbox 0x69 = 0xF9 sbox 0x6a = 0x02 sbox 0x6b = 0x7F sbox 0x6c = 0x50 sbox 0x6d = 0x3C sbox 0x6e = 0x9F sbox 0x6f = 0xA8 sbox 0x70 = 0x51 sbox 0x71 = 0xA3 sbox 0x72 = 0x40 sbox 0x73 = 0x8F sbox 0x74 = 0x92 sbox 0x75 = 0x9D sbox 0x76 = 0x38 sbox 0x77 = 0xF5 sbox 0x78 = 0xBC sbox 0x79 = 0xB6 sbox 0x7a = 0xDA sbox 0x7b = 0x21 sbox 0x7c = 0x10 sbox 0x7d = 0xFF sbox 0x7e = 0xF3 sbox 0x7f = 0xD2 sbox 0x80 = 0xCD sbox 0x81 = 0x0C sbox 0x82 = 0x13 sbox 0x83 = 0xEC sbox 0x84 = 0x5F sbox 0x85 = 0x97 sbox 0x86 = 0x44 sbox 0x87 = 0x17 sbox 0x88 = 0xC4 sbox 0x89 = 0xA7 sbox 0x8a = 0x7E sbox 0x8b = 0x3D sbox 0x8c = 0x64 sbox 0x8d = 0x5D sbox 0x8e = 0x19 sbox 0x8f = 0x73 sbox 0x90 = 0x60 sbox 0x91 = 0x81 sbox 0x92 = 0x4F sbox 0x93 = 0xDC sbox 0x94 = 0x22 sbox 0x95 = 0x2A sbox 0x96 = 0x90 sbox 0x97 = 0x88 sbox 0x98 = 0x46 sbox 0x99 = 0xEE sbox 0x9a = 0xB8 sbox 0x9b = 0x14 sbox 0x9c = 0xDE sbox 0x9d = 0x5E sbox 0x9e = 0x0B sbox 0x9f = 0xDB sbox 0xa0 = 0xE0 sbox 0xa1 = 0x32 sbox 0xa2 = 0x3A sbox 0xa3 = 0x0A sbox 0xa4 = 0x49 sbox 0xa5 = 0x06 sbox 0xa6 = 0x24 sbox 0xa7 = 0x5C sbox 0xa8 = 0xC2 sbox 0xa9 = 0xD3 sbox 0xaa = 0xAC sbox 0xab = 0x62 sbox 0xac = 0x91 sbox 0xad = 0x95 sbox 0xae = 0xE4 sbox 0xaf = 0x79 sbox 0xb0 = 0xE7 sbox 0xb1 = 0xC8 sbox 0xb2 = 0x37 sbox 0xb3 = 0x6D sbox 0xb4 = 0x8D sbox 0xb5 = 0xD5 sbox 0xb6 = 0x4E sbox 0xb7 = 0xA9 sbox 0xb8 = 0x6C sbox 0xb9 = 0x56 sbox 0xba = 0xF4 sbox 0xbb = 0xEA sbox 0xbc = 0x65 sbox 0xbd = 0x7A sbox 0xbe = 0xAE sbox 0xbf = 0x08 sbox 0xc0 = 0xBA sbox 0xc1 = 0x78 sbox 0xc2 = 0x25 sbox 0xc3 = 0x2E sbox 0xc4 = 0x1C sbox 0xc5 = 0xA6 sbox 0xc6 = 0xB4 sbox 0xc7 = 0xC6 sbox 0xc8 = 0xE8 sbox 0xc9 = 0xDD sbox 0xca = 0x74 sbox 0xcb = 0x1F sbox 0xcc = 0x4B sbox 0xcd = 0xBD sbox 0xce = 0x8B sbox 0xcf = 0x8A sbox 0xd0 = 0x70 sbox 0xd1 = 0x3E sbox 0xd2 = 0xB5 sbox 0xd3 = 0x66 sbox 0xd4 = 0x48 sbox 0xd5 = 0x03 sbox 0xd6 = 0xF6 sbox 0xd7 = 0x0E sbox 0xd8 = 0x61 sbox 0xd9 = 0x35 sbox 0xda = 0x57 sbox 0xdb = 0xB9 sbox 0xdc = 0x86 sbox 0xdd = 0xC1 sbox 0xde = 0x1D sbox 0xdf = 0x9E sbox 0xe0 = 0xE1 sbox 0xe1 = 0xF8 sbox 0xe2 = 0x98 sbox 0xe3 = 0x11 sbox 0xe4 = 0x69 sbox 0xe5 = 0xD9 sbox 0xe6 = 0x8E sbox 0xe7 = 0x94 sbox 0xe8 = 0x9B sbox 0xe9 = 0x1E sbox 0xea = 0x87 sbox 0xeb = 0xE9 sbox 0xec = 0xCE sbox 0xed = 0x55 sbox 0xee = 0x28 sbox 0xef = 0xDF sbox 0xf0 = 0x8C sbox 0xf1 = 0xA1 sbox 0xf2 = 0x89 sbox 0xf3 = 0x0D sbox 0xf4 = 0xBF sbox 0xf5 = 0xE6 sbox 0xf6 = 0x42 sbox 0xf7 = 0x68 sbox 0xf8 = 0x41 sbox 0xf9 = 0x99 sbox 0xfa = 0x2D sbox 0xfb = 0x0F sbox 0xfc = 0xB0 sbox 0xfd = 0x54 sbox 0xfe = 0xBB sbox 0xff = 0x16 {----} sboxRev 0x63 = 0x00 sboxRev 0x7C = 0x01 sboxRev 0x77 = 0x02 sboxRev 0x7B = 0x03 sboxRev 0xF2 = 0x04 sboxRev 0x6B = 0x05 sboxRev 0x6F = 0x06 sboxRev 0xC5 = 0x07 sboxRev 0x30 = 0x08 sboxRev 0x01 = 0x09 sboxRev 0x67 = 0x0a sboxRev 0x2B = 0x0b sboxRev 0xFE = 0x0c sboxRev 0xD7 = 0x0d sboxRev 0xAB = 0x0e sboxRev 0x76 = 0x0f sboxRev 0xCA = 0x10 sboxRev 0x82 = 0x11 sboxRev 0xC9 = 0x12 sboxRev 0x7D = 0x13 sboxRev 0xFA = 0x14 sboxRev 0x59 = 0x15 sboxRev 0x47 = 0x16 sboxRev 0xF0 = 0x17 sboxRev 0xAD = 0x18 sboxRev 0xD4 = 0x19 sboxRev 0xA2 = 0x1a sboxRev 0xAF = 0x1b sboxRev 0x9C = 0x1c sboxRev 0xA4 = 0x1d sboxRev 0x72 = 0x1e sboxRev 0xC0 = 0x1f sboxRev 0xB7 = 0x20 sboxRev 0xFD = 0x21 sboxRev 0x93 = 0x22 sboxRev 0x26 = 0x23 sboxRev 0x36 = 0x24 sboxRev 0x3F = 0x25 sboxRev 0xF7 = 0x26 sboxRev 0xCC = 0x27 sboxRev 0x34 = 0x28 sboxRev 0xA5 = 0x29 sboxRev 0xE5 = 0x2a sboxRev 0xF1 = 0x2b sboxRev 0x71 = 0x2c sboxRev 0xD8 = 0x2d sboxRev 0x31 = 0x2e sboxRev 0x15 = 0x2f sboxRev 0x04 = 0x30 sboxRev 0xC7 = 0x31 sboxRev 0x23 = 0x32 sboxRev 0xC3 = 0x33 sboxRev 0x18 = 0x34 sboxRev 0x96 = 0x35 sboxRev 0x05 = 0x36 sboxRev 0x9A = 0x37 sboxRev 0x07 = 0x38 sboxRev 0x12 = 0x39 sboxRev 0x80 = 0x3a sboxRev 0xE2 = 0x3b sboxRev 0xEB = 0x3c sboxRev 0x27 = 0x3d sboxRev 0xB2 = 0x3e sboxRev 0x75 = 0x3f sboxRev 0x09 = 0x40 sboxRev 0x83 = 0x41 sboxRev 0x2C = 0x42 sboxRev 0x1A = 0x43 sboxRev 0x1B = 0x44 sboxRev 0x6E = 0x45 sboxRev 0x5A = 0x46 sboxRev 0xA0 = 0x47 sboxRev 0x52 = 0x48 sboxRev 0x3B = 0x49 sboxRev 0xD6 = 0x4a sboxRev 0xB3 = 0x4b sboxRev 0x29 = 0x4c sboxRev 0xE3 = 0x4d sboxRev 0x2F = 0x4e sboxRev 0x84 = 0x4f sboxRev 0x53 = 0x50 sboxRev 0xD1 = 0x51 sboxRev 0x00 = 0x52 sboxRev 0xED = 0x53 sboxRev 0x20 = 0x54 sboxRev 0xFC = 0x55 sboxRev 0xB1 = 0x56 sboxRev 0x5B = 0x57 sboxRev 0x6A = 0x58 sboxRev 0xCB = 0x59 sboxRev 0xBE = 0x5a sboxRev 0x39 = 0x5b sboxRev 0x4A = 0x5c sboxRev 0x4C = 0x5d sboxRev 0x58 = 0x5e sboxRev 0xCF = 0x5f sboxRev 0xD0 = 0x60 sboxRev 0xEF = 0x61 sboxRev 0xAA = 0x62 sboxRev 0xFB = 0x63 sboxRev 0x43 = 0x64 sboxRev 0x4D = 0x65 sboxRev 0x33 = 0x66 sboxRev 0x85 = 0x67 sboxRev 0x45 = 0x68 sboxRev 0xF9 = 0x69 sboxRev 0x02 = 0x6a sboxRev 0x7F = 0x6b sboxRev 0x50 = 0x6c sboxRev 0x3C = 0x6d sboxRev 0x9F = 0x6e sboxRev 0xA8 = 0x6f sboxRev 0x51 = 0x70 sboxRev 0xA3 = 0x71 sboxRev 0x40 = 0x72 sboxRev 0x8F = 0x73 sboxRev 0x92 = 0x74 sboxRev 0x9D = 0x75 sboxRev 0x38 = 0x76 sboxRev 0xF5 = 0x77 sboxRev 0xBC = 0x78 sboxRev 0xB6 = 0x79 sboxRev 0xDA = 0x7a sboxRev 0x21 = 0x7b sboxRev 0x10 = 0x7c sboxRev 0xFF = 0x7d sboxRev 0xF3 = 0x7e sboxRev 0xD2 = 0x7f sboxRev 0xCD = 0x80 sboxRev 0x0C = 0x81 sboxRev 0x13 = 0x82 sboxRev 0xEC = 0x83 sboxRev 0x5F = 0x84 sboxRev 0x97 = 0x85 sboxRev 0x44 = 0x86 sboxRev 0x17 = 0x87 sboxRev 0xC4 = 0x88 sboxRev 0xA7 = 0x89 sboxRev 0x7E = 0x8a sboxRev 0x3D = 0x8b sboxRev 0x64 = 0x8c sboxRev 0x5D = 0x8d sboxRev 0x19 = 0x8e sboxRev 0x73 = 0x8f sboxRev 0x60 = 0x90 sboxRev 0x81 = 0x91 sboxRev 0x4F = 0x92 sboxRev 0xDC = 0x93 sboxRev 0x22 = 0x94 sboxRev 0x2A = 0x95 sboxRev 0x90 = 0x96 sboxRev 0x88 = 0x97 sboxRev 0x46 = 0x98 sboxRev 0xEE = 0x99 sboxRev 0xB8 = 0x9a sboxRev 0x14 = 0x9b sboxRev 0xDE = 0x9c sboxRev 0x5E = 0x9d sboxRev 0x0B = 0x9e sboxRev 0xDB = 0x9f sboxRev 0xE0 = 0xa0 sboxRev 0x32 = 0xa1 sboxRev 0x3A = 0xa2 sboxRev 0x0A = 0xa3 sboxRev 0x49 = 0xa4 sboxRev 0x06 = 0xa5 sboxRev 0x24 = 0xa6 sboxRev 0x5C = 0xa7 sboxRev 0xC2 = 0xa8 sboxRev 0xD3 = 0xa9 sboxRev 0xAC = 0xaa sboxRev 0x62 = 0xab sboxRev 0x91 = 0xac sboxRev 0x95 = 0xad sboxRev 0xE4 = 0xae sboxRev 0x79 = 0xaf sboxRev 0xE7 = 0xb0 sboxRev 0xC8 = 0xb1 sboxRev 0x37 = 0xb2 sboxRev 0x6D = 0xb3 sboxRev 0x8D = 0xb4 sboxRev 0xD5 = 0xb5 sboxRev 0x4E = 0xb6 sboxRev 0xA9 = 0xb7 sboxRev 0x6C = 0xb8 sboxRev 0x56 = 0xb9 sboxRev 0xF4 = 0xba sboxRev 0xEA = 0xbb sboxRev 0x65 = 0xbc sboxRev 0x7A = 0xbd sboxRev 0xAE = 0xbe sboxRev 0x08 = 0xbf sboxRev 0xBA = 0xc0 sboxRev 0x78 = 0xc1 sboxRev 0x25 = 0xc2 sboxRev 0x2E = 0xc3 sboxRev 0x1C = 0xc4 sboxRev 0xA6 = 0xc5 sboxRev 0xB4 = 0xc6 sboxRev 0xC6 = 0xc7 sboxRev 0xE8 = 0xc8 sboxRev 0xDD = 0xc9 sboxRev 0x74 = 0xca sboxRev 0x1F = 0xcb sboxRev 0x4B = 0xcc sboxRev 0xBD = 0xcd sboxRev 0x8B = 0xce sboxRev 0x8A = 0xcf sboxRev 0x70 = 0xd0 sboxRev 0x3E = 0xd1 sboxRev 0xB5 = 0xd2 sboxRev 0x66 = 0xd3 sboxRev 0x48 = 0xd4 sboxRev 0x03 = 0xd5 sboxRev 0xF6 = 0xd6 sboxRev 0x0E = 0xd7 sboxRev 0x61 = 0xd8 sboxRev 0x35 = 0xd9 sboxRev 0x57 = 0xda sboxRev 0xB9 = 0xdb sboxRev 0x86 = 0xdc sboxRev 0xC1 = 0xdd sboxRev 0x1D = 0xde sboxRev 0x9E = 0xdf sboxRev 0xE1 = 0xe0 sboxRev 0xF8 = 0xe1 sboxRev 0x98 = 0xe2 sboxRev 0x11 = 0xe3 sboxRev 0x69 = 0xe4 sboxRev 0xD9 = 0xe5 sboxRev 0x8E = 0xe6 sboxRev 0x94 = 0xe7 sboxRev 0x9B = 0xe8 sboxRev 0x1E = 0xe9 sboxRev 0x87 = 0xea sboxRev 0xE9 = 0xeb sboxRev 0xCE = 0xec sboxRev 0x55 = 0xed sboxRev 0x28 = 0xee sboxRev 0xDF = 0xef sboxRev 0x8C = 0xf0 sboxRev 0xA1 = 0xf1 sboxRev 0x89 = 0xf2 sboxRev 0x0D = 0xf3 sboxRev 0xBF = 0xf4 sboxRev 0xE6 = 0xf5 sboxRev 0x42 = 0xf6 sboxRev 0x68 = 0xf7 sboxRev 0x41 = 0xf8 sboxRev 0x99 = 0xf9 sboxRev 0x2D = 0xfa sboxRev 0x0F = 0xfb sboxRev 0xB0 = 0xfc sboxRev 0x54 = 0xfd sboxRev 0xBB = 0xfe sboxRev 0x16 = 0xff xtime :: Word32 -> Word32 xtime x = b where a = x `shiftL` 1 b = if a .&. (0x0100) == 0 then a else a `xor` 0x11b xtimeX2 :: Word32 -> Word32 --xtimeX2 = xtime . xtime xtimeX2 x = c where a = x `shiftL` 2 b = if a .&. (0x0200) == 0 then a else a `xor` 0x236 c = if b .&. (0x0100) == 0 then b else b `xor` 0x11b xtimeX3 :: Word32 -> Word32 --xtimeX3 = xtime . xtime . xtime xtimeX3 x = d where a = x `shiftL` 3 b = if a .&. (0x0400) == 0 then a else a `xor` 0x46c c = if b .&. (0x0200) == 0 then b else b `xor` 0x236 d = if c .&. (0x0100) == 0 then c else c `xor` 0x11b xtime03 :: Word32 -> Word32 xtime03 x = x `xor` (xtime x) xtime0e :: Word32 -> Word32 xtime0e x = xtime (x `xor` (xtime (x `xor` (xtime x)))) xtime09 :: Word32 -> Word32 xtime09 x = x `xor` (xtimeX3 x) xtime0d :: Word32 -> Word32 xtime0d x = x `xor` (xtimeX2 (x `xor` (xtime x))) xtime0b :: Word32 -> Word32 xtime0b x = x `xor` (xtime (x `xor` (xtimeX2 x))) generateKey :: Int -> Int -> Word32 -> Word32 -> Word32 generateKey nk i wIminus1 wIminusNk = (temp' `xor` wIminusNk) where temp' = if (i `mod` nk) == 0 then (subword(rotword temp)) `xor` rcon else if (nk > 6) && ((i `mod` nk) == 4) then subword temp else temp temp = wIminus1 subword :: Word32 -> Word32 subword w = (a `shiftL` 24) .|. (b `shiftL` 16) .|. (c `shiftL` 8) .|. d where a = sbox ((w `shiftR` 24) .&. 0xff) b = sbox ((w `shiftR` 16) .&. 0xff) c = sbox ((w `shiftR` 8) .&. 0xff) d = sbox ( w .&. 0xff) rotword :: Word32 -> Word32 rotword w = w `rotateL` 8 rcon :: Word32 rcon = ((fromIntegral rconMSB)::Word32) `shiftL` 24 rconMSB = (iterate xtime 0x01) !! ((i `div` nk) - 1) wordify :: [Octet] -> [Word32] wordify [] = [] wordify octets = firstWord:otherWords where (firstWord, otherOctets) = getWord32 octets otherWords = wordify otherOctets generateKeys :: Int -> Int -> [Octet] -> [Word32] generateKeys nr nk mainKey = -- assert ((nk * 4) == length mainKey) $ (take (4 * (nr + 1)) xs) where xs = (wordify mainKey) ++ (zipWith3 (generateKey nk) (drop nk [0,1..]) (drop (nk - 1) xs) xs ) subBytes :: State -> State subBytes (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (sbox s00, sbox s01, sbox s02, sbox s03) (sbox s10, sbox s11, sbox s12, sbox s13) (sbox s20, sbox s21, sbox s22, sbox s23) (sbox s30, sbox s31, sbox s32, sbox s33) subBytesRev :: State -> State subBytesRev (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (sboxRev s00, sboxRev s01, sboxRev s02, sboxRev s03) (sboxRev s10, sboxRev s11, sboxRev s12, sboxRev s13) (sboxRev s20, sboxRev s21, sboxRev s22, sboxRev s23) (sboxRev s30, sboxRev s31, sboxRev s32, sboxRev s33) shiftRows :: State -> State shiftRows (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (s00, s01, s02, s03) (s11, s12, s13, s10) (s22, s23, s20, s21) (s33, s30, s31, s32) shiftRowsRev :: State -> State shiftRowsRev (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (s00, s01, s02, s03) (s13, s10, s11, s12) (s22, s23, s20, s21) (s31, s32, s33, s30) mixColumn:: (Word32, Word32, Word32, Word32) -> (Word32, Word32, Word32, Word32) mixColumn (s0,s1,s2,s3) = ((xtime s0) `xor` (xtime03 s1) `xor` s2 `xor` s3 , s0 `xor` (xtime s1) `xor` (xtime03 s2) `xor` s3 , s0 `xor` s1 `xor` (xtime s2) `xor` (xtime03 s3), (xtime03 s0) `xor` s1 `xor` s2 `xor` (xtime s3)) mixColumns :: State -> State mixColumns (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (r00, r01, r02, r03) (r10, r11, r12, r13) (r20, r21, r22, r23) (r30, r31, r32, r33) where (r00, r10, r20, r30) = mixColumn (s00, s10, s20, s30) (r01, r11, r21, r31) = mixColumn (s01, s11, s21, s31) (r02, r12, r22, r32) = mixColumn (s02, s12, s22, s32) (r03, r13, r23, r33) = mixColumn (s03, s13, s23, s33) mixColumnRev :: (Word32, Word32, Word32, Word32) -> (Word32, Word32, Word32, Word32) mixColumnRev (s0,s1,s2,s3) = ((xtime0e s0) `xor` (xtime0b s1) `xor` (xtime0d s2) `xor` (xtime09 s3), (xtime09 s0) `xor` (xtime0e s1) `xor` (xtime0b s2) `xor` (xtime0d s3), (xtime0d s0) `xor` (xtime09 s1) `xor` (xtime0e s2) `xor` (xtime0b s3), (xtime0b s0) `xor` (xtime0d s1) `xor` (xtime09 s2) `xor` (xtime0e s3)) mixColumnsRev :: State -> State mixColumnsRev (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (r00, r01, r02, r03) (r10, r11, r12, r13) (r20, r21, r22, r23) (r30, r31, r32, r33) where (r00, r10, r20, r30) = mixColumnRev (s00, s10, s20, s30) (r01, r11, r21, r31) = mixColumnRev (s01, s11, s21, s31) (r02, r12, r22, r32) = mixColumnRev (s02, s12, s22, s32) (r03, r13, r23, r33) = mixColumnRev (s03, s13, s23, s33) addRoundKey :: State -> State -> State addRoundKey (State (k00, k01, k02, k03) (k10, k11, k12, k13) (k20, k21, k22, k23) (k30, k31, k32, k33)) (State (s00, s01, s02, s03) (s10, s11, s12, s13) (s20, s21, s22, s23) (s30, s31, s32, s33)) = State (s00 `xor` k00, s01 `xor` k01, s02 `xor` k02, s03 `xor` k03) (s10 `xor` k10, s11 `xor` k11, s12 `xor` k12, s13 `xor` k13) (s20 `xor` k20, s21 `xor` k21, s22 `xor` k22, s23 `xor` k23) (s30 `xor` k30, s31 `xor` k31, s32 `xor` k32, s33 `xor` k33) genAddRoundKey :: [Word32] -> [State -> State] genAddRoundKey [] = [] genAddRoundKey (a:b:c:d:ks) = (addRoundKey k):(genAddRoundKey ks) where k = State (fromIntegral s00, fromIntegral s01, fromIntegral s02, fromIntegral s03) (fromIntegral s10, fromIntegral s11, fromIntegral s12, fromIntegral s13) (fromIntegral s20, fromIntegral s21, fromIntegral s22, fromIntegral s23) (fromIntegral s30, fromIntegral s31, fromIntegral s32, fromIntegral s33) [s00, s10, s20, s30] = putWord32 a [s01, s11, s21, s31] = putWord32 b [s02, s12, s22, s32] = putWord32 c [s03, s13, s23, s33] = putWord32 d getWord32 :: [Octet] -> (Word32, [Octet]) getWord32 (a:b:c:d:xs) = (x, xs) where x = ((fromIntegral a) `shiftL` 24) .|. ((fromIntegral b) `shiftL` 16) .|. ((fromIntegral c) `shiftL` 8) .|. ((fromIntegral d) ) putWord32 :: Word32 -> [Octet] --a bit slower putWord32 x = map fromIntegral [a,b,c,d] putWord32 x = [fromIntegral a, fromIntegral b, fromIntegral c, fromIntegral d] where a = (x `shiftR` 24) b = (x `shiftR` 16) .&. 255 c = (x `shiftR` 8) .&. 255 d = (x ) .&. 255 {- testGenerateKeys128 :: Test testGenerateKeys128 = let key = [0x2b, 0x7e, 0x15, 0x16, 0x28, 0xae, 0xd2, 0xa6, 0xab, 0xf7, 0x15, 0x88, 0x09, 0xcf, 0x4f, 0x3c] expected = [0x2b7e1516, 0x28aed2a6, 0xabf71588, 0x09cf4f3c, 0xa0fafe17, 0x88542cb1, 0x23a33939, 0x2a6c7605, 0xf2c295f2, 0x7a96b943, 0x5935807a, 0x7359f67f, 0x3d80477d, 0x4716fe3e, 0x1e237e44, 0x6d7a883b, 0xef44a541, 0xa8525b7f, 0xb671253b, 0xdb0bad00, 0xd4d1c6f8, 0x7c839d87, 0xcaf2b8bc, 0x11f915bc, 0x6d88a37a, 0x110b3efd, 0xdbf98641, 0xca0093fd, 0x4e54f70e, 0x5f5fc9f3, 0x84a64fb2, 0x4ea6dc4f, 0xead27321, 0xb58dbad2, 0x312bf560, 0x7f8d292f, 0xac7766f3, 0x19fadc21, 0x28d12941, 0x575c006e, 0xd014f9a8, 0xc9ee2589, 0xe13f0cc8, 0xb6630ca6 ] in TestCase (do assertEqual "" expected (generateKeys 10 4 key) ) testGenerateKeys192 :: Test testGenerateKeys192 = let key = [0x8e, 0x73, 0xb0, 0xf7, 0xda, 0x0e, 0x64, 0x52, 0xc8, 0x10, 0xf3, 0x2b, 0x80, 0x90, 0x79, 0xe5, 0x62, 0xf8, 0xea, 0xd2, 0x52, 0x2c, 0x6b, 0x7b] expected = [0x8e73b0f7, 0xda0e6452, 0xc810f32b, 0x809079e5, 0x62f8ead2, 0x522c6b7b, 0xfe0c91f7, 0x2402f5a5, 0xec12068e, 0x6c827f6b, 0x0e7a95b9, 0x5c56fec2, 0x4db7b4bd, 0x69b54118, 0x85a74796, 0xe92538fd, 0xe75fad44, 0xbb095386, 0x485af057, 0x21efb14f ] in TestCase (do assertEqual "" expected (take (length expected) (generateKeys 12 6 key)) ) testGenerateKeys256 :: Test testGenerateKeys256 = let key = [0x60, 0x3d, 0xeb, 0x10, 0x15, 0xca, 0x71, 0xbe, 0x2b, 0x73, 0xae, 0xf0, 0x85, 0x7d, 0x77, 0x81, 0x1f, 0x35, 0x2c, 0x07, 0x3b, 0x61, 0x08, 0xd7, 0x2d, 0x98, 0x10, 0xa3, 0x09, 0x14, 0xdf, 0xf4] expected = [0x603deb10, 0x15ca71be, 0x2b73aef0, 0x857d7781, 0x1f352c07, 0x3b6108d7, 0x2d9810a3, 0x0914dff4, 0x9ba35411, 0x8e6925af, 0xa51a8b5f, 0x2067fcde, 0xa8b09c1a, 0x93d194cd, 0xbe49846e, 0xb75d5b9a, 0xd59aecb8, 0x5bf3c917, 0xfee94248, 0xde8ebe96 ] in TestCase (do assertEqual "" expected (take (length expected) (generateKeys 14 8 key)) ) testAes128 :: Test testAes128 = let key = [0x2b, 0x7e, 0x15, 0x16, 0x28, 0xae, 0xd2, 0xa6, 0xab, 0xf7, 0x15, 0x88, 0x09, 0xcf, 0x4f, 0x3c] input = [0x32, 0x43, 0xf6, 0xa8, 0x88, 0x5a, 0x30, 0x8d, 0x31, 0x31, 0x98, 0xa2, 0xe0, 0x37, 0x07, 0x34] output = [0x39, 0x25, 0x84, 0x1d, 0x02, 0xdc, 0x09, 0xfb, 0xdc, 0x11, 0x85, 0x97, 0x19, 0x6a, 0x0b, 0x32] in TestCase (do assertEqual "encrypt test" output (aes128Encrypt key input) assertEqual "encrypt/decrypt test" input (aes128Decrypt key (aes128Encrypt key input)) ) testAesRandom :: Test testAesRandom = TestCase (do key128 <- getRandomOctets 16 key192 <- getRandomOctets 24 key256 <- getRandomOctets 32 msg <- getRandomOctets 16 assertEqual "aes128" msg (aes128Decrypt key128 (aes128Encrypt key128 msg)) assertEqual "aes192" msg (aes192Decrypt key192 (aes192Encrypt key192 msg)) assertEqual "aes256" msg (aes256Decrypt key256 (aes256Encrypt key256 msg)) ) -- | HUnit tests tests :: Test tests = TestList [ TestLabel "testGenerateKeys128" testGenerateKeys128, TestLabel "testGenerateKeys192" testGenerateKeys192, TestLabel "testGenerateKeys256" testGenerateKeys256, TestLabel "testAes128" testAes128, TestLabel "testAesRandom" testAesRandom ] -} Crypto-4.2.5.1/Codec/Encryption/Blowfish.hs0000755156011600244210000000356512062104420020344 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Coded.Encryption.Blowfish -- Copyright : (c) Dominic Steinitz 2003 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : non-portable -- -- Takes the Blowfish module supplied by Doug Hoyte and wraps it so it can -- used with the standard modes. -- ----------------------------------------------------------------------------- module Codec.Encryption.Blowfish ( -- * Function Types encrypt, decrypt ) where import Data.Bits import Data.Word import Data.Char import Codec.Utils import Codec.Encryption.BlowfishAux -- * Basic Blowfish Encryption -- | Basic Blowfish encryption which takes a key and a block of plaintext -- and returns the encrypted block of ciphertext according to the standard. -- Typical keys are Word8, Word16, Word32, Word64, Word128. See -- . encrypt :: (Integral a) => a -> Word64 -> Word64 encrypt k p = mergeWord32 (lo,hi) where lo = head e hi = head $ tail e e = bfEnc (bfMakeKey (map (chr . fromIntegral) (toOctets 256 k))) [lo',hi'] (lo',hi') = (splitZord64 p) -- | Basic Blowfish decryption which takes a key and a block of ciphertext -- and returns the decrypted block of plaintext. decrypt :: (Integral a) => a -> Word64 -> Word64 decrypt k p = mergeWord32 (lo,hi) where lo = head d hi = head $ tail d d = bfDec (bfMakeKey (map (chr . fromIntegral) (toOctets 256 k))) [lo',hi'] (lo',hi') = splitZord64 p splitZord64 :: Word64 -> (Word32,Word32) splitZord64 x = (fromIntegral (shiftR (x .&. 0xffffffff00000000) 32), fromIntegral (x .&. 0x00000000ffffffff)) mergeWord32 :: (Word32,Word32) -> Word64 mergeWord32 (lo,hi) = shift (fromIntegral lo) 32 + fromIntegral hi Crypto-4.2.5.1/Codec/Encryption/BlowfishAux.hs0000755156011600244210000004037412062104420021021 0ustar 1312888Domain Users-- BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte -- -- Doug has kindly agreed to release this under BSD. -- -- Haskell implementation of Bruce Schneier's blowfish encryption algorithm. -- This implementation uses 16 rounds and produces the same ciphertext as -- the OpenBSD and Paul Kocher 16-round implementations. -- -- The function bfMakeKey should be passed a list of Chars. These represent -- the key. It will return a datatype called "BF", which contains the -- initialized key information. -- -- The function bfEnc is passed a BF datatype representing the key and a -- list of 2 Word32s (the plaintext). It returns a list of 2 Word32s -- (the ciphertext). -- -- The function bfDec is passed a BF datatype representing the key and a list -- of 2 Word32s (the ciphertext) and a BF datatype representing the key. It -- returns a list of 2 Word32s (the plaintext). module Codec.Encryption.BlowfishAux (bfMakeKey, bfEnc, bfDec) where import Data.Array import Data.Bits import Data.Word import Data.Char type Pbox = Array Word32 Word32 type Sbox = Array Word32 Word32 data BF = BF Pbox Sbox Sbox Sbox Sbox bfEnc :: BF -> [Word32] -> [Word32] bfEnc a b = aux a b 0 where aux :: BF -> [Word32] -> Word32 -> [Word32] aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) where newl = l `xor` (p ! i) newr = r `xor` (f newl) f :: Word32 -> Word32 f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) where a = (t `shiftR` 24) b = ((t `shiftL` 8) `shiftR` 24) c = ((t `shiftL` 16) `shiftR` 24) d = ((t `shiftL` 24) `shiftR` 24) bfDec :: BF -> [Word32] -> [Word32] bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a where revP :: Pbox -> Pbox revP x = x//[(i, x ! (17-i)) | i <- [0..17]] bfMakeKey :: [Char] -> BF bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 string2Pbox :: [Char] -> Pbox string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] where xtext = zipWith (xor) (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) [iPbox ! (fromIntegral i) | i <- [0..17]] charsToWord32s [] = [] charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks makeTo72 k 72 = [] makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) doShift [] i = [] doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) compress4 [] = [] compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc procKey :: [Word32] -> BF -> Word32 -> BF procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) where [nl,nr] = bfEnc tpbf [l,r] newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) ---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ iPbox :: Pbox iPbox = array (0,17) (zip [0..17] [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) iSbox0 :: Sbox iSbox0 = array (0,255) (zip [0..255] [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) iSbox1 :: Sbox iSbox1 = array (0,255) (zip [0..255] [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) iSbox2 :: Sbox iSbox2 = array (0,255) (zip [0..255] [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) iSbox3 :: Sbox iSbox3 = array (0,255) (zip [0..255] [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) Crypto-4.2.5.1/Codec/Encryption/DES.hs0000755156011600244210000000215312062104420017172 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.DES -- Copyright : (c) Dominic Steinitz 2003 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Takes the DES module supplied by Ian Lynagh and wraps it so it can -- used with the standard modes. -- -- See . -- ----------------------------------------------------------------------------- module Codec.Encryption.DES ( -- * Function Types encrypt, decrypt) where import Codec.Encryption.DESAux import Data.Word -- | 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 -> Word64 -> Word64 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 -> Word64 -> Word64 decrypt = flip des_dec Crypto-4.2.5.1/Codec/Encryption/DESAux.hs0000755156011600244210000001644212062104420017656 0ustar 1312888Domain Users{-# LANGUAGE FlexibleInstances #-} module Codec.Encryption.DESAux (des_enc, des_dec) where import Data.Word import Data.Bits type Rotation = Int type Key = Word64 type Message = Word64 type Enc = Word64 type BitsX = [Bool] type Bits4 = [Bool] type Bits6 = [Bool] type Bits32 = [Bool] type Bits48 = [Bool] type Bits56 = [Bool] type Bits64 = [Bool] instance Num [Bool] instance Bits [Bool] where a `xor` b = (zipWith (\x y -> (not x && y) || (x && not y)) a b) rotate 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] 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] des_enc :: Message -> Key -> Enc des_enc = do_des [1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28] des_dec :: Message -> Key -> Enc des_dec = do_des [28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1] do_des :: [Rotation] -> Message -> Key -> Enc do_des rots m k = des_work rots (takeDrop 32 mb) kb where kb = key_transformation $ bitify k mb = initial_permutation $ bitify m des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Enc 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 `xor` 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 `xor` ml get_key :: Bits56 -> Rotation -> Bits56 get_key kb r = kb' where (kl, kr) = takeDrop 28 kb kb' = rotateL kl r ++ rotateL 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 = (\x y -> if x then 2^y else 0) to_bool 0 _ = [] to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1) 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 Crypto-4.2.5.1/Codec/Encryption/Modes.hs0000755156011600244210000000356512062104420017636 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.Modes -- Copyright : (c) Dominic Steinitz 2001-2003 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- This module currently supports Cipher Block Chaining (CBC) mode. -- See for further details. -- ----------------------------------------------------------------------------- module Codec.Encryption.Modes ( -- * Function types cbc, unCbc ) where import Data.Word import Data.Bits -- * CBC or Cipher Block Chaining Mode -- | In CBC or Cipher Block Chaining mode each block is XORed with -- the previous enciphered block before encryption. For the first -- block, start with an initialization vector. -- Take an encryption function, an initialisation vector, a key and -- a list of blocks and return the encrypted blocks using CBC. cbc :: Bits block => (key -> block -> block) -> block -> key -> [block] -> [block] cbc e iv k ps = ciphers where ciphers = map (e k) feedIns feedIns = zipWith xor (iv : ciphers) ps -- | To decipher in CBC or Cipher Block Chaining mode, decipher -- each block, then XOR the result with the previous block of -- plaintext result. Note that the initialization vector is treated as the -- zeroth block of plaintext. -- Take a decryption function, an initialisation vector, a key and a list -- of encrypted blocks using CBC and return plaintext blocks. unCbc :: Bits block => (key -> block -> block) -> block -> key -> [block] -> [block] unCbc d iv k ms = outOfCbcs where beforeXOrs = map (d k) ms outOfCbcs = zipWith xor (iv : ms) beforeXOrs Crypto-4.2.5.1/Codec/Encryption/Padding.hs0000755156011600244210000000733512062104420020134 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.Padding -- Copyright : (c) Dominic Steinitz 2003 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Padding algorithms for use with block ciphers. -- -- This module currently supports: -- -- * PKCS5 padding and unpadding. -- -- * Null padding and unpadding. -- ----------------------------------------------------------------------------- module Codec.Encryption.Padding ( -- * Function types pkcs5, unPkcs5, padNulls, unPadNulls ) where import Data.Word import Data.Bits import Data.List import Codec.Utils -- | When the last block of plaintext is shorter than the block size then it -- must be padded. PKCS5 specifies that the padding octets should each -- contain the number of octets which must be stripped off. So, for example, -- with a block size of 8, \"0a0b0c\" will be padded with \"05\" resulting in -- \"0a0b0c0505050505\". If the final block is a full block of 8 octets -- then a whole block of \"0808080808080808\" is appended. pkcs5 :: (Integral a, Bits a) => [Octet] -> [a] pkcs5 s = pad p s where p n = replicate n (fromIntegral n) -- | When the last block of plaintext is shorter than the block size then it -- must be padded. Nulls padding specifies that the padding octets should each -- contain a null. So, for example, -- with a block size of 8, \"0a0b0c\" will be padded to -- \"0a0b0c0000000000\". If the final block is a full block of 8 octets -- then a whole block of \"0000000000000000\" is appended. -- NB this is only suitable for data which does not contain nulls, -- for example, ASCII. padNulls :: (Integral a, Bits a) => [Octet] -> [a] padNulls s = pad p s where p n = replicate n 0 testPad s = pad p s where p n = replicate (n-1) 0xff ++ [fromIntegral n] pad p s = blocks where octetSize = (bitSize $ head blocks) `div` 8 blocks = map (fromOctets 256) (unfoldr h $ concat $ unfoldr g s) g :: [Octet] -> Maybe ([Octet],[Octet]) g x | l == 0 = Nothing | l < octetSize = Just (t ++ (p (octetSize-l)), []) | d == [] = Just (t ++ (p octetSize), []) | otherwise = Just (t, d) where l = length t t = take octetSize x d = drop octetSize x h :: [Octet] -> Maybe ([Octet],[Octet]) h x | x == [] = Nothing | otherwise = Just (take octetSize x, drop octetSize x) -- | Take a list of blocks padded using the method described in PKCS5 -- (see ) -- and return the list of unpadded octets. NB this function does not -- currently check that the padded block is correctly formed and should -- only be used for blocks that have been padded correctly. unPkcs5 :: (Bits a, Integral a) => [a] -> [Octet] unPkcs5 s = unPad h s where h octetSize x = take (octetSize - (fromIntegral (last x))) x -- | Take a list of blocks padded with nulls -- and return the list of unpadded octets. NB if the blocks contain -- a null then the result is unpredictable. unPadNulls :: (Bits a, Integral a) => [a] -> [Octet] unPadNulls s = unPad h s where h _ x = takeWhile (/=0) x unPad p s = concat $ unfoldr g s where g :: (Integral a, Bits a) => [a] -> Maybe ([Octet],[a]) g x | t == [] = Nothing | d == [] = Just (s, []) | otherwise = Just (v, d) where t = take 1 x d = drop 1 x u = head t octetSize = (bitSize u) `div` 8 v = i2osp octetSize u s = p octetSize v Crypto-4.2.5.1/Codec/Encryption/RSA/0000755156011600244210000000000012062104420016644 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/Encryption/RSA/EMEOAEP.hs0000755156011600244210000000736212062104420020266 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Coded.Encryption.RSA.EMEOAEP -- Copyright : (c) David J. Sankel 2003, Dominic Steinitz 2003 -- License : GPL (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : non-portable -- -- A modified version of the EMEOAEP module supplied by David J. Sankel -- (). -- -- As the original code is GPL, this has to be. -- This code is free software; you can redistribute it and\/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This code is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this code; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111\-1307 USA ----------------------------------------------------------------------------- module Codec.Encryption.RSA.EMEOAEP( -- * Function Types encode, decode )where import Codec.Utils (Octet) import Data.Bits xorOctets :: Bits a => [a] -> [a] -> [a] xorOctets = zipWith xor -- | Take a mask generating function, a hash function, a label (which may be -- null), a random seed, the modulus of the key and the message and returns -- an encoded message. NB you could pass in the length of the modulus -- but it seems safer to pass in the modulus itself and calculate the -- length when required. See -- for more -- details. encode :: (([Octet] -> [Octet]) -> [Octet] -> Int -> [Octet]) -> ([Octet] -> [Octet]) -> [Octet] -> [Octet] -> [Octet] -> [Octet] -> [Octet] encode mgf hash p seed n m = if length m > emLen - 2*hLen - 2 then error "Codec.Encryption.EMEOAEP.encode: message too long" else em where emLen = length n mLen = length m ps = take (emLen-mLen-2*hLen-2) $ repeat $ 0x00 pHash = hash p hLen = length pHash db = pHash ++ ps ++ [0x01] ++ m dbMask = mgf hash seed (length db) maskedDB = db `xorOctets` dbMask seedMask = mgf hash maskedDB hLen maskedSeed = seed `xorOctets` seedMask em = [0x00] ++ maskedSeed ++ maskedDB -- | Take a mask generating function, a hash function, a label (which may be -- null) and the message and returns the decoded. decode :: (([Octet] -> [Octet]) -> [Octet] -> Int -> [Octet]) -> ([Octet] -> [Octet]) -> [Octet] -> [Octet] -> [Octet] decode mgf hash p em = if length em < 2*hLen + 1 || one /= 0x01 || pHash' /= pHash || y /= [0x00] then error "Codec.Encryption.EMEOAEP.decode: decryption error" else m where (y,rest) = splitAt 1 em pHash = hash p hLen = length pHash (maskedSeed,maskedDB) = splitAt hLen rest seedMask = mgf hash maskedDB hLen seed = maskedSeed `xorOctets` seedMask emLen = length em dbMask = mgf hash seed (emLen - hLen - 1) db = maskedDB `xorOctets` dbMask (pHash',rest') = splitAt hLen db (one:m) = dropWhile (== 0x00) rest' Crypto-4.2.5.1/Codec/Encryption/RSA/MGF.hs0000755156011600244210000000176412062104420017624 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.RSA.MGF -- Copyright : (c) Dominic Steinitz 2003 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Implements the mask generation function as specified in: -- -- ----------------------------------------------------------------------------- module Codec.Encryption.RSA.MGF ( -- * Function Types mgf) where import Codec.Utils (Octet, i2osp) -- | Take a hash function, a seed and the intended length of the -- the mask and deliver a mask of the requested length. mgf :: ([Octet] -> [Octet]) -> [Octet] -> Int -> [Octet] mgf hash z l = take l $ concat $ hashes where hashes = map f [0..(l `div` hLen)] hLen = length $ f 0 f = hash . (z++) . (i2osp 4) Crypto-4.2.5.1/Codec/Encryption/RSA/NumberTheory.hs0000755156011600244210000001571012062104420021632 0ustar 1312888Domain Users--Copyright 2001, 2002, 2003 David J. Sankel -- --This file is part of rsa-haskell. --rsa-haskell is free software; you can redistribute it and/or modify --it under the terms of the GNU General Public License as published by --the Free Software Foundation; either version 2 of the License, or --(at your option) any later version. -- --rsa-haskell is distributed in the hope that it will be useful, --but WITHOUT ANY WARRANTY; without even the implied warranty of --MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --GNU General Public License for more details. -- --You should have received a copy of the GNU General Public License --along with rsa-haskell; if not, write to the Free Software --Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA module Codec.Encryption.RSA.NumberTheory( inverse, extEuclGcd, simplePrimalityTest, getPrime, pg, isPrime, rabinMillerPrimalityTest, expmod, factor, testInverse, primes, (/|), randomOctet ) where import System.Random(getStdRandom,randomR) --The following line is required for ghc optomized implementation -- (see comments beginning with GHC): -- import Bits(setBit) import Data.List(elemIndex) import Data.Maybe(fromJust) import Data.Char(chr,ord) import Data.Bits(xor) --Precondition: the integer is >= 0 randomOctet :: Int -> IO( String ) randomOctet n | n < 0 = error "randomOctet argument doesn't meet preconditions" | otherwise = (sequence $ take n $ repeat $ getStdRandom (randomR( 0,255) )) >>= (return . (map chr) ) --Returns a list [r_1,r_2,r_3,r_4, . . ., r_n ] where -- a = p_1^r_1 * p_2^r_2 * p_3^r_3 * . . . * p_n^r_n factor :: Integer -> [Int] factor = factor_1 --An implimentation of factor factor_1 :: Integer -> [Int] factor_1 a = reverse . dropWhile (== 0) . reverse . map (\x -> largestPower x a) . takeWhile (<= a ) $ primes --Another implimentation of factor factor_2 :: Integer -> [Integer] factor_2 a = let p = map (fromIntegral) . reverse . dropWhile (== 0) . reverse . map (\x -> largestPower x a) . takeWhile (<= a `div` 2) $ primes in if (length p == 0) then (take ((fromIntegral . fromJust $ elemIndex a primes)-1) (repeat 0)) ++ [1] else p --Find the inverse of x (mod n) inverse :: Integer -> Integer -> Integer inverse x n = (fst (extEuclGcd x n)) `mod` n testInverse :: Integer ->Integer -> Bool testInverse a b = ((inverse a b)*a) `mod` b == 1 --Extended Eucildean algorithm --Returns (x,y) where gcd(a,b) = xa + yb extEuclGcd :: Integer -> Integer -> (Integer,Integer) extEuclGcd a b = extEuclGcd_iter a b (1,0) (0,1) extEuclGcd_iter :: Integer -> Integer -> (Integer,Integer) -> (Integer,Integer) -> (Integer,Integer) extEuclGcd_iter a b (c1,c2) (d1,d2) | (a > b) && (r1 == 0) = (d1,d2) | (a > b) && (r1 /= 0) = extEuclGcd_iter (a - (q1*b)) b (c1 - (q1*d1), c2 - (q1*d2)) (d1,d2) | (a <= b) && (r2 == 0) = (c1,c2) | (a <= b) && (r2 /= 0) = extEuclGcd_iter a (b - (q2*a)) (c1,c2) ( d1 - (q2*c1), d2- (q2*c2)) where q1 = a `div` b q2 = b `div` a r1 = a `mod` b r2 = b `mod` a -- This will return a random Integer of n bits. The highest order bit -- will always be 1. -- GHC optomized implementation -- getNumber :: Int -> IO Integer -- getNumber n = do -- i <- getStdRandom ( randomR (0, a-1 ) ) -- return (setBit i (n-1)) -- where -- a = (2^n) ::Integer --This is the portable version getNumber :: Int -> IO Integer getNumber n = do i <- getStdRandom ( randomR (0, a-1 ) ) return (i+(2^(n-1))) where a = (2^(n-1)) ::Integer --Returns a probable prime number of nBits bits -- GHC optomized implementation -- getPrime :: Int -> IO Integer -- getPrime nBits = do -- r <- getNumber nBits -- let p = (setBit r 0) --Make it odd for speed -- pIsPrime <- isPrime p -- if( pIsPrime ) -- then return p -- else getPrime nBits --This is the portable version getPrime :: Int -> IO Integer getPrime nBits = do r <- getNumber nBits let p = if( 2 /| r ) then r else r+1 pIsPrime <- isPrime p if( pIsPrime ) then return p else getPrime nBits --Prime Generate: --Generates a prime p | minimum <= p <= maximum and gcd p e == 1 pg :: Integer -> Integer -> Integer -> IO(Integer) pg minimum maximum e = do p <- getStdRandom( randomR( minimum, maximum ) ) pIsPrime <- isPrime p if( pIsPrime && (gcd p e) == 1 ) then return p else pg minimum maximum e isPrime :: Integer -> IO Bool isPrime a | (a <= 1) = return False | (a <= 2000) = return (simplePrimalityTest a) | otherwise = if (simplePrimalityTest a) then do --Do this 5 times for saftey test <- mapM rabinMillerPrimalityTest $ take 5 $ repeat a return (and test) else return False simplePrimalityTest :: Integer -> Bool simplePrimalityTest a = foldr (&&) True (map (/| a)(takeWhile ( Integer -> Int largestPower x y = fromJust . elemIndex False . map (\b -> (y `mod` x^b) == 0) $ [1..] rabinMillerPrimalityTest :: Integer -> IO Bool rabinMillerPrimalityTest p = rabinMillerPrimalityTest_iter_1 p b m where b = fromIntegral $ largestPower 2 (p-1) m = (p-1) `div` (2^b) --The ?prime? Number -> The amount of iterations -> b -> m rabinMillerPrimalityTest_iter_1 :: Integer -> Integer -> Integer -> IO Bool rabinMillerPrimalityTest_iter_1 p b m = do a <- getStdRandom ( randomR (0, 2000 ) ) return (rabinMillerPrimalityTest_iter_2 p b 0 (expmod a m p)) rabinMillerPrimalityTest_iter_2 :: Integer -> Integer -> Integer -> Integer -> Bool rabinMillerPrimalityTest_iter_2 p b j z | (z == 1) || (z == p-1) = True | (j > 0) && (z == 1) = False | (j+1 < b) && (z /= p-1) = (rabinMillerPrimalityTest_iter_2 p b (j+1) ((z^2) `mod` p )) | z == p - 1 = True | (j+1 == b) && (z /= p-1) = False --a^x (mod m) expmod :: Integer -> Integer -> Integer -> Integer expmod a x m | x == 0 = 1 | x == 1 = a `mod` m | even x = let p = (expmod a (x `div` 2) m) `mod` m in (p^2) `mod` m | otherwise = (a * expmod a (x-1) m) `mod` m --Largest x where x^2 < i intSqrt :: Integer -> Integer intSqrt i = floor (sqrt (fromIntegral i ) ) --The doesn't divide function (/|) :: Integer -> Integer -> Bool a /| b = b `mod` a /= 0 --List of primes primes :: [Integer] primes = 2:[x | x <- [3,5..], foldr (&&) True ( map ( /| x ) (takeWhile (<=(intSqrt x)) primes ) ) ] Crypto-4.2.5.1/Codec/Encryption/RSA.hs0000755156011600244210000000556112062104420017212 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Coded.Encryption.RSA -- Copyright : (c) David J. Sankel 2003, Dominic Steinitz 2003 -- License : GPL (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : non-portable -- -- A modified version of the RSA module supplied by David J. Sankel -- (). -- -- As the original code is GPL, this has to be. -- This code is free software; you can redistribute it and\/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This code is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this code; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111\-1307 USA ----------------------------------------------------------------------------- module Codec.Encryption.RSA( -- * Function Types encrypt, decrypt )where import Codec.Utils import Codec.Encryption.RSA.NumberTheory rsaep :: (Integer , Integer) -> Integer -> Integer rsaep (n,e) m | m < 0 || m > n-1 = error "Codec.Encryption.RSA.rsaep: message too long" | otherwise = expmod m e n -- | Take the modulus of the RSA key and the public exponent expressed -- as lists of octets and the plaintext also expressed as a list of -- octets and return the ciphertext as a list of octets. Of course, -- these are all large integers but using lists of octets makes -- everything easier. See -- for more -- details. encrypt :: ([Octet],[Octet]) -> [Octet] -> [Octet] encrypt (n,e) m = i2osp (length n) $ rsaep (fromOctets 256 n, fromOctets 256 e) (fromOctets 256 m) rsadp :: (Integer , Integer) -> Integer -> Integer rsadp (n,d) c | c < 0 || c > n-1 = error "Codec.Encryption.RSA.rsadp: decryption error" | otherwise = expmod c d n -- | Take the modulus of the RSA key and the private exponent expressed -- as lists of octets and the ciphertext also expressed as a list of -- octets and return the plaintext as a list of octets. decrypt :: ([Octet],[Octet]) -> [Octet] -> [Octet] decrypt (n,e) m | lc > lm = error "Codec.Encryption.RSA.rsadp: decryption error" | otherwise = i2osp (length n) $ rsadp (fromOctets 256 n, fromOctets 256 e) (fromOctets 256 m) where lc = length $ dropWhile (==0x00) m lm = length $ dropWhile (==0x00) n Crypto-4.2.5.1/Codec/Encryption/TEA.hs0000755156011600244210000000612012062104420017166 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Encryption.TEA -- Copyright : (c) John Meacham 2008 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : john@repetae.net (http://repetae.net/) -- Stability : experimental -- Portability : portable -- -- Implementation of the TEA tiny encryption algorithm -- ----------------------------------------------------------------------------- module Codec.Encryption.TEA( TEAKey(TEAKey), encrypt, decrypt ) where import Data.Bits import Data.Word -- We don't use LargeKey for both efficiency and practical reasons. data TEAKey = TEAKey {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 delta :: Word32 delta = 0x9e3779b9 rounds = 32 encrypt :: TEAKey -> Word64 -> Word64 encrypt (TEAKey k0 k1 k2 k3) v = f rounds 0 v0 v1 where v0,v1 :: Word32 v0 = fromIntegral v v1 = fromIntegral $ v `shiftR` 32 f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined f 0 _ v0 v1 = (fromIntegral v1 `shiftL` 32) .|. (fromIntegral v0 .&. 0xffffffff) f n sum v0 v1 = f (n - 1) sum' v0' v1' where sum' = sum + delta v0' = (v0 + (((v1 `shiftL` 4) + k0) `xor` (v1 + sum') `xor` ((v1 `shiftR` 5) + k1))) v1' = (v1 + (((v0' `shiftL` 4) + k2) `xor` (v0' + sum') `xor` ((v0' `shiftR` 5) + k3))) decrypt :: TEAKey -> Word64 -> Word64 decrypt (TEAKey k0 k1 k2 k3) v = f rounds 0xC6EF3720 v0 v1 where v0,v1 :: Word32 v0 = fromIntegral v v1 = fromIntegral $ v `shiftR` 32 f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined f 0 _ v0 v1 = (fromIntegral v1 `shiftL` 32) .|. (fromIntegral v0 .&. 0xFFFFFFFF) f n sum v0 v1 = f (n - 1) (sum - delta) v0' v1' where v1' = (v1 - (((v0 `shiftL` 4) + k2) `xor` (v0 + sum) `xor` ((v0 `shiftR` 5) + k3))) v0' = (v0 - (((v1' `shiftL` 4) + k0) `xor` (v1' + sum) `xor` ((v1' `shiftR` 5) + k1))) {- void encrypt (unsigned long* v, unsigned long* k) { unsigned long v0=v[0], v1=v[1], sum=0, i; /* set up */ unsigned long delta=0x9e3779b9; /* a key schedule constant */ unsigned long k0=k[0], k1=k[1], k2=k[2], k3=k[3]; /* cache key */ for (i=0; i < 32; i++) { /* basic cycle start */ sum += delta; v0 += ((v1<<4) + k0) ^ (v1 + sum) ^ ((v1>>5) + k1); v1 += ((v0<<4) + k2) ^ (v0 + sum) ^ ((v0>>5) + k3); /* end cycle */ } v[0]=v0; v[1]=v1; } void decrypt (unsigned long* v, unsigned long* k) { unsigned long v0=v[0], v1=v[1], sum=0xC6EF3720, i; /* set up */ unsigned long delta=0x9e3779b9; /* a key schedule constant */ unsigned long k0=k[0], k1=k[1], k2=k[2], k3=k[3]; /* cache key */ for (i=0; i<32; i++) { /* basic cycle start */ v1 -= ((v0<<4) + k2) ^ (v0 + sum) ^ ((v0>>5) + k3); v0 -= ((v1<<4) + k0) ^ (v1 + sum) ^ ((v1>>5) + k1); sum -= delta; /* end cycle */ } v[0]=v0; v[1]=v1; } -} Crypto-4.2.5.1/Codec/Text/0000755156011600244210000000000012062104420015011 5ustar 1312888Domain UsersCrypto-4.2.5.1/Codec/Text/Raw.hs0000755156011600244210000000212712062104420016103 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Coded.Text.Raw -- Copyright : (c) Dominic Steinitz 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- ----------------------------------------------------------------------------- module Codec.Text.Raw( hexdump, hexdumpBy, ) where import Data.List import Codec.Utils import Numeric import Text.PrettyPrint split :: Int -> [a] -> [[a]] split n xs = unfoldr (g n) xs g :: Int -> [a] -> Maybe ([a],[a]) g n [] = Nothing g n y = Just (splitAt n y) sh x | x < 16 = '0':(showHex x "") | otherwise = showHex x "" type OctetsPerLine = Int hexdump :: OctetsPerLine -> [Octet] -> Doc hexdump n = vcat . map hcat . map (intersperse colon) . map (map (text . sh)) . split n hexdumpBy :: String -> OctetsPerLine -> [Octet] -> Doc hexdumpBy s n = vcat . map hcat . map (intersperse (text s)) . map (map (text . sh)) . split n Crypto-4.2.5.1/Codec/Utils.hs0000755156011600244210000001041312062104420015523 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Codec.Utils -- Copyright : (c) Dominic Steinitz 2003 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Utilities for coding and decoding. -- ----------------------------------------------------------------------------- module Codec.Utils ( -- * Types and Constants Octet, msb, -- * Octet Conversion Functions fromTwosComp, toTwosComp, toOctets, fromOctets, listFromOctets, listToOctets, i2osp ) where import Data.Word import Data.Bits powersOf n = 1 : (map (*n) (powersOf n)) toBase x = map fromIntegral . reverse . map (flip mod x) . takeWhile (/=0) . iterate (flip div x) -- | Take a number a convert it to base n as a list of octets. toOctets :: (Integral a, Integral b) => a -> b -> [Octet] toOctets n x = (toBase n . fromIntegral) x -- | This is used to (approximately) get back to a starting word list. -- For example, if you have a list of 3 Word8 and try to convert them to -- a Word32, the Word32 will get null-padded, and without correction, you -- will get 4 Word8s when converting back. This corrects it. -- Unfortunately, it also means you will have errors if trying to convert -- Word8 lists with nulls on the end. trimNulls :: [Word8] -> [Word8] trimNulls = reverse . (dropWhile (== 0)) . reverse -- | Converts a list of numbers into a list of octets. -- The resultant list has nulls trimmed from the end to make this the dual -- of listFromOctets (except when the original octet list ended with nulls; -- see 'trimNulls'). listToOctets :: (Bits a, Integral a) => [a] -> [Octet] listToOctets x = trimNulls $ concat paddedOctets where paddedOctets :: [[Octet]] paddedOctets = map (padTo bytes) rawOctets rawOctets :: [[Octet]] rawOctets = map (reverse . toOctets 256) x padTo :: Int -> [Octet] -> [Octet] padTo x y = take x $ y ++ repeat 0 bytes :: Int bytes = bitSize (head x) `div` 8 -- | The basic type for encoding and decoding. type Octet = Word8 -- | The most significant bit of an 'Octet'. msb :: Int msb = bitSize (undefined::Octet) - 1 -- | Take a list of octets (a number expressed in base n) and convert it -- to a number. fromOctets :: (Integral a, Integral b) => a -> [Octet] -> b fromOctets n x = fromIntegral $ sum $ zipWith (*) (powersOf n) (reverse (map fromIntegral x)) -- | See 'listToOctets'. listFromOctets :: (Integral a, Bits a) => [Octet] -> [a] listFromOctets [] = [] listFromOctets x = result where result = first : rest first = fromOctets 256 first' first' = reverse $ take bytes x rest = listFromOctets $ drop bytes x bytes = bitSize first `div` 8 -- | Take the length of the required number of octets and convert the -- number to base 256 padding it out to the required length. If the -- required length is less than the number of octets of the converted -- number then return the converted number. NB this is different from -- the standard -- but mimics how replicate behaves. i2osp :: Integral a => Int -> a -> [Octet] i2osp l y = pad ++ z where pad = replicate (l - unPaddedLen) (0x00::Octet) z = toOctets 256 y unPaddedLen = length z -- | Convert from twos complement. fromTwosComp :: Integral a => [Octet] -> a fromTwosComp x = conv x where conv [] = 0 conv w@(x:xs) = if (testBit x msb) then neg w else pos w neg w@(x:xs) = let z=(clearBit x msb):xs in fromIntegral((fromOctets 256 z)- (128*(256^((length w)-1)))) pos w = fromIntegral(fromOctets 256 w) toTwosComp :: Integral a => a -> [Octet] toTwosComp x | x < 0 = reverse . plusOne . reverse . (map complement) $ u | x == 0 = [0x00] | otherwise = u where z@(y:ys) = toBase 256 (abs x) u = if testBit y msb then 0x00:z else z plusOne :: [Octet] -> [Octet] plusOne [] = [1] plusOne (x:xs) = if x == 0xff then 0x00:(plusOne xs) else (x+1):xs Crypto-4.2.5.1/Crypto.cabal0000755156011600244210000000715012062104420015322 0ustar 1312888Domain UsersName: Crypto Version: 4.2.5.1 License: OtherLicense License-File: ReadMe.tex Author: Dominic Steinitz Maintainer: Caylee Hogg Copyright: Dominic Steinitz 2003 - 2007 Stability: Alpha Category: Cryptography, Codec Synopsis: Collects together existing Haskell cryptographic functions into a package Description: DES, Blowfish, AES, TEA, SHA1, MD5, RSA, BubbleBabble, Hexdump, Support for Word128, Word192 and Word256 and Beyond, PKCS5 Padding, Various Encryption Modes e.g. Cipher Block Chaining all in one package, with HUnit and QuickCheck tests, and examples. Data-Files: CryptoHomePage.html Build-Type: Simple Cabal-Version: >= 1.2 Tested-With: GHC==6.8.2 GHC==6.10.1 flag small_base description: choose the new smaller, split-up base package. Library Exposed-Modules: Codec.Binary.BubbleBabble, Codec.Encryption.RSA, Codec.Encryption.RSA.EMEOAEP, Codec.Encryption.RSA.MGF, Codec.Encryption.RSA.NumberTheory, Codec.Encryption.DES, Codec.Encryption.AES, Codec.Encryption.TEA, Codec.Encryption.Blowfish, Codec.Encryption.Modes, Codec.Encryption.Padding, Codec.Text.Raw, Codec.Utils, Data.Digest.MD5, Data.Digest.SHA1, Data.Digest.SHA2, Data.Digest.SHA224, Data.Digest.SHA256, Data.Digest.SHA384, Data.Digest.SHA512, Data.LargeWord, Data.HMAC Build-Depends: QuickCheck >= 2.4.0.1, HUnit if flag(small_base) Build-Depends: base >= 3, base < 5, array, random, pretty else Build-Depends: base < 3 Ghc-options: -fregs-graph Extensions: FlexibleInstances, TypeSynonymInstances Other-modules: Codec.Encryption.BlowfishAux, Codec.Encryption.DESAux, Codec.Encryption.AESAux, Data.Digest.MD5Aux Executable SymmetricTest Main-Is: SymmetricTest.hs Ghc-options: -fregs-graph Other-modules: Codec.Utils Codec.Encryption.Blowfish Codec.Encryption.Modes Codec.Encryption.Padding Codec.Encryption.DES Codec.Encryption.AES Data.LargeWord Executable SHA1Test Main-Is: SHA1Test.hs Ghc-options: -fregs-graph Other-modules: Codec.Text.Raw Data.Digest.SHA1 Executable RSATest Main-Is: RSATest.hs Ghc-options: -fregs-graph Other-modules: Codec.Utils Data.Digest.SHA1 Codec.Encryption.RSA.MGF Codec.Encryption.RSA.EMEOAEP Codec.Encryption.RSA Executable QuickTest Main-Is: QuickTest.hs Ghc-options: -fregs-graph Extensions: TypeSynonymInstances Other-modules: Codec.Utils Codec.Encryption.Blowfish Codec.Encryption.AES Codec.Encryption.Modes Codec.Encryption.Padding Data.LargeWord Executable HMACTest Main-Is: HMACTest.hs Other-modules: Codec.Utils Data.HMAC Executable WordListTest Main-Is: WordListTest.hs Other-modules: Data.LargeWord Crypto-4.2.5.1/CryptoHomePage.html0000755156011600244210000000366712062104420016643 0ustar 1312888Domain Users The Haskell Cryptographic Library

The Haskell Cryptographic Library

The Haskell Cryptographic Library collects together existing Haskell cryptographic functions into one cabalized package, with HUnit tests, QuickCheck properties, examples showing how to interwork with other cryptographic implementations and examples showing how to handle other ASN.1 definitions.

Downloading

Stable releases of Crypto can be found in the Hackage package database:

For the latest version, you can use the development repository. You can download it:

Resources

Contact

All questions, comments, bug reports, flames, requests for updates / changes and suggestions should be directed to .

Crypto-4.2.5.1/Data/0000755156011600244210000000000012062104420013721 5ustar 1312888Domain UsersCrypto-4.2.5.1/Data/Digest/0000755156011600244210000000000012062104420015140 5ustar 1312888Domain UsersCrypto-4.2.5.1/Data/Digest/MD5.hs0000755156011600244210000000243012062104420016063 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.Digest.MD5 -- Copyright : (c) Dominic Steinitz 2004 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Takes the MD5 module supplied by Ian Lynagh and wraps it so it -- takes [Octet] and returns [Octet] where the length of the result -- is always 16. -- See -- and . -- ----------------------------------------------------------------------------- module Data.Digest.MD5 ( -- * Function Types hash) where import Data.Digest.MD5Aux import Codec.Utils import Data.Char(chr) import Data.List(unfoldr) import Numeric(readHex) -- | Take [Octet] and return [Octet] according to the standard. -- The length of the result is always 16 octets or 128 bits as required -- by the standard. hash :: [Octet] -> [Octet] hash xs = unfoldr f $ md5s $ Str $ map (chr . fromIntegral) xs where f :: String -> Maybe (Octet,String) f [] = Nothing f (x:y:zs) = Just (fromIntegral a,zs) where [(a,_)] = readHex (x:y:[]) Crypto-4.2.5.1/Data/Digest/MD5Aux.hs0000755156011600244210000003074712062104420016555 0ustar 1312888Domain Usersmodule Data.Digest.MD5Aux (md5, md5s, md5i, MD5(..), ABCD(..), Zord64, Str(..), BoolList(..), WordList(..)) where import Data.Char import Data.Bits import Data.Word {- Nasty kludge to create a type Zord64 which is really a Word64 but works how we want in hugs ands nhc98 too... Also need a rotate left function that actually works. #ifdef __GLASGOW_HASKELL__ #define rotL rotateL #include "Zord64_EASY.hs" #else > import Zord64_HARD > rotL :: Word32 -> Rotation -> Word32 > rotL a s = shiftL a s .|. shiftL a (s-32) #endif -} rotL x = rotateL x type Zord64 = Word64 -- ===================== TYPES AND CLASS DEFINTIONS ======================== type XYZ = (Word32, Word32, Word32) type Rotation = Int newtype ABCD = ABCD (Word32, Word32, Word32, Word32) deriving (Eq, Show) newtype Str = Str String newtype BoolList = BoolList [Bool] newtype WordList = WordList ([Word32], Zord64) -- Anything we want to work out the MD5 of must be an instance of class MD5 class MD5 a where get_next :: a -> ([Word32], Int, a) -- get the next blocks worth -- \ \ \------ the rest of the input -- \ \--------- the number of bits returned -- \--------------- the bits returned in 32bit words len_pad :: Zord64 -> a -> a -- append the padding and length finished :: a -> Bool -- Have we run out of input yet? -- Mainly exists because it's fairly easy to do MD5s on input where the -- length is not a multiple of 8 instance MD5 BoolList where get_next (BoolList s) = (bools_to_word32s ys, length ys, BoolList zs) where (ys, zs) = splitAt 512 s len_pad l (BoolList bs) = BoolList (bs ++ [True] ++ replicate (fromIntegral $ (447 - l) .&. 511) False ++ [l .&. (shiftL 1 x) > 0 | x <- (mangle [0..63])] ) where mangle [] = [] mangle xs = reverse ys ++ mangle zs where (ys, zs) = splitAt 8 xs finished (BoolList s) = s == [] -- The string instance is fairly straightforward instance MD5 Str where get_next (Str s) = (string_to_word32s ys, 8 * length ys, Str zs) where (ys, zs) = splitAt 64 s len_pad c64 (Str s) = Str (s ++ padding ++ l) where padding = '\128':replicate (fromIntegral zeros) '\000' zeros = shiftR ((440 - c64) .&. 511) 3 l = length_to_chars 8 c64 finished (Str s) = s == "" -- YA instance that is believed will be useful instance MD5 WordList where get_next (WordList (ws, l)) = (xs, fromIntegral taken, WordList (ys, l - taken)) where (xs, ys) = splitAt 16 ws taken = if l > 511 then 512 else l .&. 511 len_pad c64 (WordList (ws, l)) = WordList (beginning ++ nextish ++ blanks ++ size, newlen) where beginning = if length ws > 0 then start ++ lastone' else [] start = init ws lastone = last ws offset = c64 .&. 31 lastone' = [if offset > 0 then lastone + theone else lastone] theone = shiftL (shiftR 128 (fromIntegral $ offset .&. 7)) (fromIntegral $ offset .&. (31 - 7)) nextish = if offset == 0 then [128] else [] c64' = c64 + (32 - offset) num_blanks = (fromIntegral $ shiftR ((448 - c64') .&. 511) 5) blanks = replicate num_blanks 0 lowsize = fromIntegral $ c64 .&. (shiftL 1 32 - 1) topsize = fromIntegral $ shiftR c64 32 size = [lowsize, topsize] newlen = l .&. (complement 511) + if c64 .&. 511 >= 448 then 1024 else 512 finished (WordList (_, z)) = z == 0 instance Num ABCD where ABCD (a1, b1, c1, d1) + ABCD (a2, b2, c2, d2) = ABCD (a1 + a2, b1 + b2, c1 + c2, d1 + d2) -- ===================== EXPORTED FUNCTIONS ======================== -- The simplest function, gives you the MD5 of a string as 4-tuple of -- 32bit words. md5 :: (MD5 a) => a -> ABCD md5 m = md5_main False 0 magic_numbers m -- Returns a hex number ala the md5sum program md5s :: (MD5 a) => a -> String md5s = abcd_to_string . md5 -- Returns an integer equivalent to the above hex number md5i :: (MD5 a) => a -> Integer md5i = abcd_to_integer . md5 -- ===================== THE CORE ALGORITHM ======================== -- Decides what to do. The first argument indicates if padding has been -- added. The second is the length mod 2^64 so far. Then we have the -- starting state, the rest of the string and the final state. md5_main :: (MD5 a) => Bool -- Have we added padding yet? -> Zord64 -- The length so far mod 2^64 -> ABCD -- The initial state -> a -- The non-processed portion of the message -> ABCD -- The resulting state md5_main padded ilen abcd m = if finished m && padded then abcd else md5_main padded' (ilen + 512) (abcd + abcd') m'' where (m16, l, m') = get_next m len' = ilen + fromIntegral l ((m16', _, m''), padded') = if not padded && l < 512 then (get_next $ len_pad len' m, True) else ((m16, l, m'), padded) abcd' = md5_do_block abcd m16' -- md5_do_block processes a 512 bit block by calling md5_round 4 times to -- apply each round with the correct constants and permutations of the -- block md5_do_block :: ABCD -- Initial state -> [Word32] -- The block to be processed - 16 32bit words -> ABCD -- Resulting state md5_do_block abcd0 w = abcd4 where (r1, r2, r3, r4) = rounds {- map (\x -> w !! x) [1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12] -- [(5 * x + 1) `mod` 16 | x <- [0..15]] map (\x -> w !! x) [5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2] -- [(3 * x + 5) `mod` 16 | x <- [0..15]] map (\x -> w !! x) [0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9] -- [(7 * x) `mod` 16 | x <- [0..15]] -} perm5 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15] = [c1,c6,c11,c0,c5,c10,c15,c4,c9,c14,c3,c8,c13,c2,c7,c12] perm5 _ = error "broke at perm5" perm3 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15] = [c5,c8,c11,c14,c1,c4,c7,c10,c13,c0,c3,c6,c9,c12,c15,c2] perm3 _ = error "broke at perm3" perm7 [c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15] = [c0,c7,c14,c5,c12,c3,c10,c1,c8,c15,c6,c13,c4,c11,c2,c9] perm7 _ = error "broke at perm7" abcd1 = md5_round md5_f abcd0 w r1 abcd2 = md5_round md5_g abcd1 (perm5 w) r2 abcd3 = md5_round md5_h abcd2 (perm3 w) r3 abcd4 = md5_round md5_i abcd3 (perm7 w) r4 -- md5_round does one of the rounds. It takes an auxiliary function and foldls -- (md5_inner_function f) to repeatedly apply it to the initial state with the -- correct constants md5_round :: (XYZ -> Word32) -- Auxiliary function (F, G, H or I -- for those of you with a copy of -- the prayer book^W^WRFC) -> ABCD -- Initial state -> [Word32] -- The 16 32bit words of input -> [(Rotation, Word32)] -- The list of 16 rotations and -- additive constants -> ABCD -- Resulting state md5_round f abcd s ns = foldl (md5_inner_function f) abcd ns' where ns' = zipWith (\x (y, z) -> (y, x + z)) s ns -- Apply one of the functions md5_[fghi] and put the new ABCD together md5_inner_function :: (XYZ -> Word32) -- Auxiliary function -> ABCD -- Initial state -> (Rotation, Word32) -- The rotation and additive -- constant (X[i] + T[j]) -> ABCD -- Resulting state md5_inner_function f (ABCD (a, b, c, d)) (s, ki) = ABCD (d, a', b, c) where mid_a = a + f(b,c,d) + ki rot_a = rotL mid_a s a' = b + rot_a -- The 4 auxiliary functions md5_f :: XYZ -> Word32 md5_f (x, y, z) = z `xor` (x .&. (y `xor` z)) {- optimised version of: (x .&. y) .|. ((complement x) .&. z) -} md5_g :: XYZ -> Word32 md5_g (x, y, z) = md5_f (z, x, y) {- was: (x .&. z) .|. (y .&. (complement z)) -} md5_h :: XYZ -> Word32 md5_h (x, y, z) = x `xor` y `xor` z md5_i :: XYZ -> Word32 md5_i (x, y, z) = y `xor` (x .|. (complement z)) -- The magic numbers from the RFC. magic_numbers :: ABCD magic_numbers = ABCD (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476) -- The 4 lists of (rotation, additive constant) tuples, one for each round rounds :: ([(Rotation, Word32)], [(Rotation, Word32)], [(Rotation, Word32)], [(Rotation, Word32)]) rounds = (r1, r2, r3, r4) where r1 = [(s11, 0xd76aa478), (s12, 0xe8c7b756), (s13, 0x242070db), (s14, 0xc1bdceee), (s11, 0xf57c0faf), (s12, 0x4787c62a), (s13, 0xa8304613), (s14, 0xfd469501), (s11, 0x698098d8), (s12, 0x8b44f7af), (s13, 0xffff5bb1), (s14, 0x895cd7be), (s11, 0x6b901122), (s12, 0xfd987193), (s13, 0xa679438e), (s14, 0x49b40821)] r2 = [(s21, 0xf61e2562), (s22, 0xc040b340), (s23, 0x265e5a51), (s24, 0xe9b6c7aa), (s21, 0xd62f105d), (s22, 0x2441453), (s23, 0xd8a1e681), (s24, 0xe7d3fbc8), (s21, 0x21e1cde6), (s22, 0xc33707d6), (s23, 0xf4d50d87), (s24, 0x455a14ed), (s21, 0xa9e3e905), (s22, 0xfcefa3f8), (s23, 0x676f02d9), (s24, 0x8d2a4c8a)] r3 = [(s31, 0xfffa3942), (s32, 0x8771f681), (s33, 0x6d9d6122), (s34, 0xfde5380c), (s31, 0xa4beea44), (s32, 0x4bdecfa9), (s33, 0xf6bb4b60), (s34, 0xbebfbc70), (s31, 0x289b7ec6), (s32, 0xeaa127fa), (s33, 0xd4ef3085), (s34, 0x4881d05), (s31, 0xd9d4d039), (s32, 0xe6db99e5), (s33, 0x1fa27cf8), (s34, 0xc4ac5665)] r4 = [(s41, 0xf4292244), (s42, 0x432aff97), (s43, 0xab9423a7), (s44, 0xfc93a039), (s41, 0x655b59c3), (s42, 0x8f0ccc92), (s43, 0xffeff47d), (s44, 0x85845dd1), (s41, 0x6fa87e4f), (s42, 0xfe2ce6e0), (s43, 0xa3014314), (s44, 0x4e0811a1), (s41, 0xf7537e82), (s42, 0xbd3af235), (s43, 0x2ad7d2bb), (s44, 0xeb86d391)] s11 = 7 s12 = 12 s13 = 17 s14 = 22 s21 = 5 s22 = 9 s23 = 14 s24 = 20 s31 = 4 s32 = 11 s33 = 16 s34 = 23 s41 = 6 s42 = 10 s43 = 15 s44 = 21 -- ===================== CONVERSION FUNCTIONS ======================== -- Turn the 4 32 bit words into a string representing the hex number they -- represent. abcd_to_string :: ABCD -> String abcd_to_string (ABCD (a,b,c,d)) = concat $ map display_32bits_as_hex [a,b,c,d] -- Split the 32 bit word up, swap the chunks over and convert the numbers -- to their hex equivalents. display_32bits_as_hex :: Word32 -> String display_32bits_as_hex w = swap_pairs cs where cs = map (\x -> getc $ (shiftR w (4*x)) .&. 15) [0..7] getc n = (['0'..'9'] ++ ['a'..'f']) !! (fromIntegral n) swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs swap_pairs _ = [] -- Convert to an integer, performing endianness magic as we go abcd_to_integer :: ABCD -> Integer abcd_to_integer (ABCD (a,b,c,d)) = rev_num a * 2^(96 :: Int) + rev_num b * 2^(64 :: Int) + rev_num c * 2^(32 :: Int) + rev_num d rev_num :: Word32 -> Integer rev_num i = toInteger j `mod` (2^(32 :: Int)) -- NHC's fault ~~~~~~~~~~~~~~~~~~~~~ where j = foldl (\so_far next -> shiftL so_far 8 + (shiftR i next .&. 255)) 0 [0,8,16,24] -- Used to convert a 64 byte string to 16 32bit words string_to_word32s :: String -> [Word32] string_to_word32s "" = [] string_to_word32s ss = this:string_to_word32s ss' where (s, ss') = splitAt 4 ss this = foldr (\c w -> shiftL w 8 + (fromIntegral.ord) c) 0 s -- Used to convert a list of 512 bools to 16 32bit words bools_to_word32s :: [Bool] -> [Word32] bools_to_word32s [] = [] bools_to_word32s bs = this:bools_to_word32s rest where (bs1, bs1') = splitAt 8 bs (bs2, bs2') = splitAt 8 bs1' (bs3, bs3') = splitAt 8 bs2' (bs4, rest) = splitAt 8 bs3' this = boolss_to_word32 [bs1, bs2, bs3, bs4] bools_to_word8 = foldl (\w b -> shiftL w 1 + if b then 1 else 0) 0 boolss_to_word32 = foldr (\w8 w -> shiftL w 8 + bools_to_word8 w8) 0 -- Convert the size into a list of characters used by the len_pad function -- for strings length_to_chars :: Int -> Zord64 -> String length_to_chars 0 _ = [] length_to_chars p n = this:length_to_chars (p-1) (shiftR n 8) where this = chr $ fromIntegral $ n .&. 255 Crypto-4.2.5.1/Data/Digest/SHA1.hs0000755156011600244210000000726012062104420016200 0ustar 1312888Domain Users{-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA1 -- Copyright : (c) Dominic Steinitz 2007 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Take [Word8] and return Word160. -- See for the specification. -- ----------------------------------------------------------------------------- module Data.Digest.SHA1( Word160(Word160), hash, lift2, toInteger ) where import Data.Bits import Data.List import Data.Word import Data.Array.IArray import Codec.Utils import Prelude hiding (toInteger) rotL :: Bits b => Int -> b -> b rotL = flip rotateL data Word160 = Word160 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 deriving (Eq, Show) toInteger :: Word160 -> Integer toInteger (Word160 a b c d e) = let n = fromIntegral e + (fromIntegral d `shiftL` 32) + (fromIntegral c `shiftL` 64) + (fromIntegral b `shiftL` 96) + (fromIntegral a `shiftL` 128) in n `seq` n lift2 :: (Word32 -> Word32 -> Word32) -> Word160 -> Word160 -> Word160 lift2 f a@(Word160 x1 x2 x3 x4 x5) b@(Word160 y1 y2 y3 y4 y5) = Word160 (f x1 y1) (f x2 y2) (f x3 y3) (f x4 y4) (f x5 y5) f n x y z | n <= 19 = (x .&. y) .|. ((complement x) .&. z) | n <= 39 = x `xor` y `xor` z | n <= 59 = (x .&. y) .|. (x .&. z) .|. (y .&. z) | n <= 79 = x `xor` y `xor` z k n | n <= 19 = 0x5a827999 | n <= 39 = 0x6ed9eba1 | n <= 59 = 0x8f1bbcdc | n <= 79 = 0xca62c1d6 data AccAndWord160 = AccAndWord160 !Int !Word160 -- Word160 -> Word512 -> Word160 oneBlock ss xs = tt where us :: Array Int Word32 us = accumArray (curry snd) 0 (0,79) (zip [0..15] xs ++ map (\(x,y) -> (x, rotL 1 y))[(i, xxor i) | i<-[16..79]]) where xxor i = us ! (i-16) `xor` us ! (i-3) `xor` us ! (i-8) `xor` us ! (i-14) g (AccAndWord160 n (Word160 a b c d e)) w = AccAndWord160 (n+1) (Word160 ((rotL 5 a) + (f n b c d) + e + w + (k n)) a (rotL 30 b) c d) (AccAndWord160 _ tt) = foldl' g (AccAndWord160 0 ss) (elems us) ss :: Word160 ss = Word160 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0 pad = pad' 0 where pad' l [] = [0x80] ++ ps ++ lb where pl = (64-(l+9)) `mod` 64 ps = replicate pl 0x00 lb = i2osp 8 (8*l) pad' l (x:xs) = x : (pad' $! l+1) xs -- otherwise (l+1) it will be deferred until replicate blockWord8sIn512 :: [Word8] -> [[Word8]] blockWord8sIn512 = unfoldr g where g [] = Nothing g xs = Just (splitAt 64 xs) fromBytes :: (Num a, Bits a) => [a] -> a fromBytes input = let dofb accum [] = accum dofb accum (x:xs) = dofb ((shiftL accum 8) .|. x) xs in dofb 0 input blockWord8sIn32 :: [Word8] -> [[Word8]] blockWord8sIn32 = unfoldr g where g [] = Nothing g xs = Just (splitAt 4 xs) getWord32s :: [Word8] -> [Word32] getWord32s = map fromBytes . map (map fromIntegral) . blockWord8sIn32 blockWord32sIn512 :: [Word8] -> [[Word32]] blockWord32sIn512 = (map getWord32s) . blockWord8sIn512 . pad hashOnce ss a = lift2 (+) ss (oneBlock ss a) hash :: [Word8] -> Word160 hash = foldl' hashOnce ss . blockWord32sIn512 Crypto-4.2.5.1/Data/Digest/SHA2.hs0000755156011600244210000003264512062104420016206 0ustar 1312888Domain Users{-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA2 -- Copyright : (c) Russell O'Connor 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Implements SHA-256, SHA-384, SHA-512, and SHA-224 as defined in FIPS 180-2 -- . -- ----------------------------------------------------------------------------- module Data.Digest.SHA2 (sha256, sha256Ascii, Hash256 ,sha512, sha512Ascii, Hash512 ,sha384, sha384Ascii, Hash384 ,sha224, sha224Ascii, Hash224 ,toOctets) where import Data.Word import Data.Bits import Data.List import Numeric import Test.HUnit ch x y z = (x .&. y) `xor` (complement x .&. z) maj x y z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z) class (Num w, Bits w) => ShaData w where bigSigma0 :: w -> w bigSigma1 :: w -> w smallSigma0 :: w -> w smallSigma1 :: w -> w ks :: [w] instance ShaData Word32 where bigSigma0 x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 bigSigma1 x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 smallSigma0 x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 smallSigma1 x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 ks = [0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5 ,0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174 ,0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da ,0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967 ,0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85 ,0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070 ,0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3 ,0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2] instance ShaData Word64 where bigSigma0 x = rotateR x 28 `xor` rotateR x 34 `xor` rotateR x 39 bigSigma1 x = rotateR x 14 `xor` rotateR x 18 `xor` rotateR x 41 smallSigma0 x = rotateR x 1 `xor` rotateR x 8 `xor` shiftR x 7 smallSigma1 x = rotateR x 19 `xor` rotateR x 61 `xor` shiftR x 6 ks = [0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f, 0xe9b5dba58189dbbc ,0x3956c25bf348b538, 0x59f111f1b605d019, 0x923f82a4af194f9b, 0xab1c5ed5da6d8118 ,0xd807aa98a3030242, 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2 ,0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235, 0xc19bf174cf692694 ,0xe49b69c19ef14ad2, 0xefbe4786384f25e3, 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65 ,0x2de92c6f592b0275, 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5 ,0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f, 0xbf597fc7beef0ee4 ,0xc6e00bf33da88fc2, 0xd5a79147930aa725, 0x06ca6351e003826f, 0x142929670a0e6e70 ,0x27b70a8546d22ffc, 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df ,0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6, 0x92722c851482353b ,0xa2bfe8a14cf10364, 0xa81a664bbc423001, 0xc24b8b70d0f89791, 0xc76c51a30654be30 ,0xd192e819d6ef5218, 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8 ,0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99, 0x34b0bcb5e19b48a8 ,0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb, 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3 ,0x748f82ee5defb2fc, 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec ,0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915, 0xc67178f2e372532b ,0xca273eceea26619c, 0xd186b8c721c0c207, 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178 ,0x06f067aa72176fba, 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b ,0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc, 0x431d67c49c100d4c ,0x4cc5d4becb3e42b6, 0x597f299cfc657e2a, 0x5fcb6fab3ad6faec, 0x6c44198c4a475817] blockSize = 16 ----------------------------------------------------------------------------- -- | 'padding' currently requires that the bitSize of @a@ divide the bitSize -- of @w@ ----------------------------------------------------------------------------- padding :: (ShaData w, Bits a, Integral a) => [a] -> [[w]] padding x = unfoldr block $ paddingHelper x 0 (0::Int) (0::Integer) where block [] = Nothing block x = Just $ splitAt blockSize x paddingHelper x o on n | on == (bitSize o) = o:paddingHelper x 0 0 n paddingHelper (x:xs) o on n | on < (bitSize o) = paddingHelper xs ((shiftL o bs) .|. (fromIntegral x)) (on+bs) $! (n+fromIntegral bs) where bs = bitSize x paddingHelper [] o on n = (shiftL (shiftL o 1 .|. 1) (bso-on-1)): (zeros ((-(fromIntegral n-on+3*bso)) `mod` (blockSize*bso))) [fromIntegral (shiftR n bso), fromIntegral n] where bso = bitSize o zeros 0 = id zeros n | 0 < n = let z=0 in (z:) . (zeros (n-bitSize z)) data Hash8 w = Hash8 !w !w !w !w !w !w !w !w deriving (Eq, Ord) type Hash256 = Hash8 Word32 type Hash512 = Hash8 Word64 data Hash384 = Hash384 !Word64 !Word64 !Word64 !Word64 !Word64 !Word64 deriving (Eq, Ord) data Hash224 = Hash224 !Word32 !Word32 !Word32 !Word32 !Word32 !Word32 !Word32 deriving (Eq, Ord) instance (Integral a, Show a) => Show (Hash8 a) where showsPrec _ (Hash8 a b c d e f g h) = (showHex a) . (' ':) . (showHex b) . (' ':) . (showHex c) . (' ':) . (showHex d) . (' ':) . (showHex e) . (' ':) . (showHex f) . (' ':) . (showHex g) . (' ':) . (showHex h) instance Show Hash384 where showsPrec _ (Hash384 a b c d e f) = (showHex a) . (' ':) . (showHex b) . (' ':) . (showHex c) . (' ':) . (showHex d) . (' ':) . (showHex e) . (' ':) . (showHex f) instance Show Hash224 where showsPrec _ (Hash224 a b c d e f g) = (showHex a) . (' ':) . (showHex b) . (' ':) . (showHex c) . (' ':) . (showHex d) . (' ':) . (showHex e) . (' ':) . (showHex f) . (' ':) . (showHex g) class (Eq h, Ord h, Show h) => Hash h where toOctets :: h -> [Word8] bitsToOctets x = helper (bitSize x) x [] where helper s x r | s <= 0 = r | otherwise = helper (s-bs) (shiftR x bs) ((fromIntegral x):r) where bs = bitSize (head r) instance (Integral h, Bits h, Show h) => Hash (Hash8 h) where toOctets (Hash8 x0 x1 x2 x3 x4 x5 x6 x7) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5, x6, x7] instance Hash Hash384 where toOctets (Hash384 x0 x1 x2 x3 x4 x5) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5] instance Hash Hash224 where toOctets (Hash224 x0 x1 x2 x3 x4 x5 x6) = bitsToOctets =<< [x0, x1, x2, x3, x4, x5, x6] shaStep :: (ShaData w) => Hash8 w -> [w] -> Hash8 w shaStep h m = (foldl' (flip id) h (zipWith mkStep3 ks ws)) `plus` h where ws = m++zipWith4 smallSigma (drop (blockSize-2) ws) (drop (blockSize-7) ws) (drop (blockSize-15) ws) (drop (blockSize-16) ws) where smallSigma a b c d = smallSigma1 a + b + smallSigma0 c + d mkStep3 k w (Hash8 a b c d e f g h) = Hash8 (t1+t2) a b c (d+t1) e f g where t1 = h + bigSigma1 e + ch e f g + k + w t2 = bigSigma0 a + maj a b c (Hash8 x0 x1 x2 x3 x4 x5 x6 x7) `plus` (Hash8 y0 y1 y2 y3 y4 y5 y6 y7) = Hash8 (x0+y0) (x1+y1) (x2+y2) (x3+y3) (x4+y4) (x5+y5) (x6+y6) (x7+y7) ----------------------------------------------------------------------------- -- | Due to the limitations of 'padding', 'sha' currently requires that the -- bitSize of @a@ divide the bitSize of @w@ ----------------------------------------------------------------------------- sha :: (ShaData w, Bits a, Integral a) => Hash8 w -> [a] -> Hash8 w sha h0 x = foldl' shaStep h0 $ padding x stringToOctets :: String -> [Word8] stringToOctets = map (fromIntegral . fromEnum) ----------------------------------------------------------------------------- -- | 'sha256' currently requires that the bitSize of @a@ divide 32 ----------------------------------------------------------------------------- sha256 :: (Bits a, Integral a) => [a] -> Hash256 sha256 = sha $ Hash8 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19 ----------------------------------------------------------------------------- -- | 'sha384' currently requires that the bitSize of @a@ divide 64 ----------------------------------------------------------------------------- sha384 :: (Bits a, Integral a) => [a] -> Hash384 sha384 x = Hash384 x0 x1 x2 x3 x4 x5 where Hash8 x0 x1 x2 x3 x4 x5 x6 x7 = flip sha x $ Hash8 0xcbbb9d5dc1059ed8 0x629a292a367cd507 0x9159015a3070dd17 0x152fecd8f70e5939 0x67332667ffc00b31 0x8eb44a8768581511 0xdb0c2e0d64f98fa7 0x47b5481dbefa4fa4 ----------------------------------------------------------------------------- -- | 'sha384' currently requires that the bitSize of @a@ divide 64 ----------------------------------------------------------------------------- sha512 :: (Bits a, Integral a) => [a] -> Hash512 sha512 = sha $ Hash8 0x6a09e667f3bcc908 0xbb67ae8584caa73b 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 0x510e527fade682d1 0x9b05688c2b3e6c1f 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 ----------------------------------------------------------------------------- -- | 'sha224' currently requires that the bitSize of @a@ divide 32 ----------------------------------------------------------------------------- sha224 :: (Bits a, Integral a) => [a] -> Hash224 sha224 x = Hash224 x0 x1 x2 x3 x4 x5 x6 where Hash8 x0 x1 x2 x3 x4 x5 x6 x7 = flip sha x $ Hash8 0xc1059ed8 0x367cd507 0x3070dd17 0xf70e5939 0xffc00b31 0x68581511 0x64f98fa7 0xbefa4fa4 ----------------------------------------------------------------------------- -- ** Hashing Strings -- | @shaXXXAscii@ assumes that all characters of the strings are -- ISO-latin-1 characters. ie. each characters fits in one octet. ----------------------------------------------------------------------------- sha256Ascii :: String -> Hash256 sha256Ascii = sha256 . stringToOctets sha384Ascii :: String -> Hash384 sha384Ascii = sha384 . stringToOctets sha512Ascii :: String -> Hash512 sha512Ascii = sha512 . stringToOctets sha224Ascii :: String -> Hash224 sha224Ascii = sha224 . stringToOctets ----------------------------------------------------------------------------- -- ** Test cases -- | Below are test cases from the FIPS 180-2 document ----------------------------------------------------------------------------- -- Should this go into it's own module? test_sha256 = "SHA-256" ~: test [sha256Ascii "abc" ~?= Hash8 0xba7816bf 0x8f01cfea 0x414140de 0x5dae2223 0xb00361a3 0x96177a9c 0xb410ff61 0xf20015ad ,sha256Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" ~?= Hash8 0x248d6a61 0xd20638b8 0xe5c02693 0x0c3e6039 0xa33ce459 0x64ff2167 0xf6ecedd4 0x19db06c1 ,sha256Ascii (replicate 1000000 'a') ~?= Hash8 0xcdc76e5c 0x9914fb92 0x81a1c7e2 0x84d73e67 0xf1809a48 0xa497200e 0x046d39cc 0xc7112cd0] test_sha512 = "SHA-512" ~: test [sha512Ascii "abc" ~?= Hash8 0xddaf35a193617aba 0xcc417349ae204131 0x12e6fa4e89a97ea2 0x0a9eeee64b55d39a 0x2192992a274fc1a8 0x36ba3c23a3feebbd 0x454d4423643ce80e 0x2a9ac94fa54ca49f ,sha512Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"++ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu") ~?= Hash8 0x8e959b75dae313da 0x8cf4f72814fc143f 0x8f7779c6eb9f7fa1 0x7299aeadb6889018 0x501d289e4900f7e4 0x331b99dec4b5433a 0xc7d329eeb6dd2654 0x5e96e55b874be909 ,sha512Ascii (replicate 1000000 'a') ~?= Hash8 0xe718483d0ce76964 0x4e2e42c7bc15b463 0x8e1f98b13b204428 0x5632a803afa973eb 0xde0ff244877ea60a 0x4cb0432ce577c31b 0xeb009c5c2c49aa2e 0x4eadb217ad8cc09b] test_sha384 = "SHA-384" ~: test [sha384Ascii "abc" ~?= Hash384 0xcb00753f45a35e8b 0xb5a03d699ac65007 0x272c32ab0eded163 0x1a8b605a43ff5bed 0x8086072ba1e7cc23 0x58baeca134c825a7 ,sha384Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"++ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu") ~?= Hash384 0x09330c33f71147e8 0x3d192fc782cd1b47 0x53111b173b3b05d2 0x2fa08086e3b0f712 0xfcc7c71a557e2db9 0x66c3e9fa91746039 ,sha384Ascii (replicate 1000000 'a') ~?= Hash384 0x9d0e1809716474cb 0x086e834e310a4a1c 0xed149e9c00f24852 0x7972cec5704c2a5b 0x07b8b3dc38ecc4eb 0xae97ddd87f3d8985] test_sha224 = "SHA-224" ~: test [sha224Ascii "abc" ~?= Hash224 0x23097d22 0x3405d822 0x8642a477 0xbda255b3 0x2aadbce4 0xbda0b3f7 0xe36c9da7 ,sha224Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" ~?= Hash224 0x75388b16 0x512776cc 0x5dba5da1 0xfd890150 0xb0c6455c 0xb4f58b19 0x52522525 ,sha224Ascii (replicate 1000000 'a') ~?= Hash224 0x20794655 0x980c91d8 0xbbb4c1ea 0x97618a4b 0xf03f4258 0x1948b2ee 0x4ee7ad67] test_sha2 = "SHA-2" ~: test [test_sha256, test_sha512, test_sha384, test_sha224] -- Test with: -- ghc -no-recomp -O --make Data/Digest/SHA2.hs -main-is Data.Digest.SHA2.moduleTest -o moduleTest && ./moduleTest && rm moduleTest moduleTest = runTestTT test_sha2Crypto-4.2.5.1/Data/Digest/SHA224.hs0000755156011600244210000000155012062104420016343 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA224 -- Copyright : (c) Russell O'Connor 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Takes the SHA2 module supplied and wraps it so it -- takes [Octet] and returns [Octet] where the length of the result -- is always 28. -- and . -- ----------------------------------------------------------------------------- module Data.Digest.SHA224 ( -- * Function Types hash) where import Data.Digest.SHA2 as SHA2 import Codec.Utils -- | Take [Octet] and return [Octet] according to the standard. -- The length of the result is always 28 octets or 224 bits as required -- by the standard. hash :: [Octet] -> [Octet] hash = SHA2.toOctets . SHA2.sha224Crypto-4.2.5.1/Data/Digest/SHA256.hs0000755156011600244210000000155012062104420016350 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA256 -- Copyright : (c) Russell O'Connor 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Takes the SHA2 module supplied and wraps it so it -- takes [Octet] and returns [Octet] where the length of the result -- is always 32. -- and . -- ----------------------------------------------------------------------------- module Data.Digest.SHA256 ( -- * Function Types hash) where import Data.Digest.SHA2 as SHA2 import Codec.Utils -- | Take [Octet] and return [Octet] according to the standard. -- The length of the result is always 32 octets or 256 bits as required -- by the standard. hash :: [Octet] -> [Octet] hash = SHA2.toOctets . SHA2.sha256Crypto-4.2.5.1/Data/Digest/SHA384.hs0000755156011600244210000000155012062104420016352 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA384 -- Copyright : (c) Russell O'Connor 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Takes the SHA2 module supplied and wraps it so it -- takes [Octet] and returns [Octet] where the length of the result -- is always 48. -- and . -- ----------------------------------------------------------------------------- module Data.Digest.SHA384 ( -- * Function Types hash) where import Data.Digest.SHA2 as SHA2 import Codec.Utils -- | Take [Octet] and return [Octet] according to the standard. -- The length of the result is always 48 octets or 384 bits as required -- by the standard. hash :: [Octet] -> [Octet] hash = SHA2.toOctets . SHA2.sha384Crypto-4.2.5.1/Data/Digest/SHA512.hs0000755156011600244210000000155012062104420016343 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.Digest.SHA512 -- Copyright : (c) Russell O'Connor 2006 -- License : BSD-style (see the file ReadMe.tex) -- -- Takes the SHA2 module supplied and wraps it so it -- takes [Octet] and returns [Octet] where the length of the result -- is always 64. -- and . -- ----------------------------------------------------------------------------- module Data.Digest.SHA512 ( -- * Function Types hash) where import Data.Digest.SHA2 as SHA2 import Codec.Utils -- | Take [Octet] and return [Octet] according to the standard. -- The length of the result is always 64 octets or 512 bits as required -- by the standard. hash :: [Octet] -> [Octet] hash = SHA2.toOctets . SHA2.sha512Crypto-4.2.5.1/Data/HMAC.hs0000755156011600244210000000747012062104420015000 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.HMAC -- Copyright : (c) Greg Heartsfield 2007 -- License : BSD-style (see the file ReadMe.tex) -- -- Implements HMAC (hashed message authentication code) as defined in FIPS 198 -- . -- ----------------------------------------------------------------------------- module Data.HMAC( -- * Function Types hmac, hmac_sha1, hmac_md5, -- * Data Types HashMethod(HashMethod, digest, input_blocksize), ) where import Data.Digest.SHA1 as SHA1 import Data.Digest.MD5 as MD5 import Data.Word (Word32) import Data.Bits (shiftR, xor, bitSize, Bits) import Codec.Utils (Octet) -- | HMAC works over any hash function, which is represented by -- HashMethod. A hash function and input block size must -- be specified. data HashMethod = HashMethod { -- | An arbitrary hash function digest :: [Octet] -> [Octet], -- | Bit size of an input block to the hash function input_blocksize :: Int} -- Some useful digest functions for use with HMAC. sha1_hm = HashMethod (w160_to_w8s . SHA1.hash) 512 md5_hm = HashMethod MD5.hash 512 -- | Compute an HMAC using SHA-1 as the underlying hash function. hmac_sha1 :: [Octet] -- ^ Secret key -> [Octet] -- ^ Message text -> [Octet] -- ^ Resulting HMAC-SHA1 value hmac_sha1 = hmac sha1_hm -- | Compute an HMAC using MD5 as the underlying hash function. hmac_md5 :: [Octet] -- ^ Secret key -> [Octet] -- ^ Message text -> [Octet] -- ^ Resulting HMAC-MD5 value hmac_md5 = hmac md5_hm w160_to_w8s :: Word160 -> [Octet] w160_to_w8s w = concat $ map w32_to_w8s (w160_to_w32s w) w160_to_w32s :: Word160 -> [Word32] w160_to_w32s (Word160 a b c d e) = a : b : c : d : e : [] w32_to_w8s :: Word32 -> [Octet] w32_to_w8s a = (fromIntegral (shiftR a 24)) : (fromIntegral (shiftR a 16)) : (fromIntegral (shiftR a 8)) : (fromIntegral a) : [] -- | Generalized function for creating HMACs on a specified -- hash function. hmac :: HashMethod -- ^ Hash function and associated block size -> [Octet] -- ^ Secret key -> [Octet] -- ^ Message text -> [Octet] -- ^ Resulting HMAC value hmac h uk m = hash (opad ++ (hash (ipad ++ m))) where hash = digest h (opad, ipad) = process_pads key (make_start_pad bs opad_pattern) (make_start_pad bs ipad_pattern) bs = input_blocksize h key = key_from_user h uk -- Create a key of the proper size from the user-supplied key. -- Keys greater than blocksize get hashed and padded with zeroes. -- Keys same as blocksize are used as is. -- Keys shorter than blocksize are padding with zeroes. key_from_user :: HashMethod -> [Octet] -> [Octet] key_from_user h uk = case (compare (bitcount uk) (input_blocksize h)) of GT -> fill_key ((digest h) uk) LT -> fill_key uk EQ -> uk where fill_key kd = kd ++ (take (((input_blocksize h) - (bitcount kd)) `div` 8) (repeat 0x0)) -- Create the inner/outer pad values by XOR'ing with the key. process_pads :: [Octet] -- Key -> [Octet] -- opad -> [Octet] -- ipad -> ([Octet], [Octet]) -- new opad, new ipad process_pads ks os is = unzip $ zipWith3 (\k o i -> (k `xor` o, k `xor` i)) ks os is -- Create padding values for a hash of a given bit size. make_start_pad :: Int -> Octet -> [Octet] make_start_pad size pad = take (size `div` (bitSize pad)) $ repeat pad -- Padding constants, per the spec. opad_pattern = 0x5c :: Octet ipad_pattern = 0x36 :: Octet -- Bit count of byte array. bitcount :: [Octet] -> Int bitcount k = (length k) * (bitSize (head k)) Crypto-4.2.5.1/Data/LargeWord.hs0000755156011600244210000001127112062104420016150 0ustar 1312888Domain Users----------------------------------------------------------------------------- -- | -- Module : Data.LargeWord -- Copyright : (c) Dominic Steinitz 2004 -- License : BSD-style (see the file ReadMe.tex) -- -- Maintainer : dominic.steinitz@blueyonder.co.uk -- Stability : experimental -- Portability : portable -- -- Provides Word128, Word192 and Word256 and a way of producing other -- large words if required. -- ----------------------------------------------------------------------------- module Data.LargeWord (LargeKey,Word96,Word128,Word160,Word192,Word224,Word256) where import Data.Word import Data.Bits import Numeric import Data.Char -- Keys have certain capabilities. class (Num a) => LargeWord a where largeWordToInteger :: a -> Integer integerToLargeWord :: Integer -> a largeWordPlus :: a -> a -> a largeWordAnd :: a -> a -> a largeWordOr :: a -> a -> a largeWordShift :: a -> Int -> a largeWordXor :: a -> a -> a largeBitSize :: a -> Int -- Word32 is a key in the obvious way. instance LargeWord Word32 where largeWordToInteger = toInteger integerToLargeWord = fromInteger largeWordPlus = (+) largeWordAnd = (.&.) largeWordOr = (.|.) largeWordShift = shift largeWordXor = xor largeBitSize = bitSize -- Word64 is a key in the obvious way. instance LargeWord Word64 where largeWordToInteger = toInteger integerToLargeWord = fromInteger largeWordPlus = (+) largeWordAnd = (.&.) largeWordOr = (.|.) largeWordShift = shift largeWordXor = xor largeBitSize = bitSize -- Define larger keys from smaller ones. data LargeKey a b = LargeKey a b deriving (Eq, Ord) instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => LargeWord (LargeKey a b) where largeWordToInteger (LargeKey lo hi) = largeWordToInteger lo + (2^(bitSize lo)) * largeWordToInteger hi integerToLargeWord x = let (h,l) = x `quotRem` (2^(bitSize lo)) (lo,hi) = (integerToLargeWord l, integerToLargeWord h) in LargeKey lo hi largeWordPlus (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo + blo hi' = ahi + bhi + if lo' < alo then 1 else 0 largeWordAnd (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo .&. blo hi' = ahi .&. bhi largeWordOr (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo .|. blo hi' = ahi .|. bhi largeWordXor (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo `xor` blo hi' = ahi `xor` bhi largeWordShift w 0 = w largeWordShift (LargeKey lo hi) x = if bitSize lo < bitSize hi then LargeKey (shift lo x) (shift hi x .|. (shift (conv lo) (x - (bitSize lo)))) else LargeKey (shift lo x) (shift hi x .|. (conv $ shift lo (x - (bitSize lo)))) where conv = integerToLargeWord . largeWordToInteger largeBitSize ~(LargeKey lo hi) = largeBitSize lo + largeBitSize hi instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Show (LargeKey a b) where showsPrec p = showInt . largeWordToInteger instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Num (LargeKey a b) where (+) = largeWordPlus fromInteger = integerToLargeWord -- Larger keys are instances of Bits provided their constituents are keys. instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Bits (LargeKey a b) where (.&.) = largeWordAnd (.|.) = largeWordOr xor = largeWordXor shift = largeWordShift bitSize = largeBitSize instance (Ord a, Bits a, Bounded a, Integral a, LargeWord a, Bits b, Bounded b, Integral b, LargeWord b) => Bounded (LargeKey a b) where minBound = 0 maxBound = result where result = fromIntegral $ (1 + fromIntegral (maxBound `asTypeOf` (boflk result)))* (1 + fromIntegral (maxBound `asTypeOf` (aoflk result))) - 1 aoflk :: (LargeKey a b) -> a aoflk = undefined boflk :: (LargeKey a b) -> b boflk = undefined instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) => Integral (LargeKey a b) where toInteger = largeWordToInteger instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) => Real (LargeKey a b) instance Enum (LargeKey a b) type Word96 = LargeKey Word32 Word64 type Word128 = LargeKey Word64 Word64 type Word160 = LargeKey Word32 Word128 type Word192 = LargeKey Word64 Word128 type Word224 = LargeKey Word32 Word192 type Word256 = LargeKey Word64 Word192 Crypto-4.2.5.1/HMACTest.hs0000755156011600244210000001146612062104420014767 0ustar 1312888Domain Usersmodule Main(main) where import Data.HMAC import Test.HUnit import Codec.Utils (Octet) import Data.Char(ord) -- HMAC-SHA1 tests from -- -- HMAC-MD5 tests from -- -- Test #1: SHA-1 64-byte key (single block) hmacTest1 = TestCase ( assertEqual "Test HMAC-SHA1 #1 with 64-byte key" hmac_1 (hmac_sha1 key_1 message_1) ) message_1 = string2words "Sample #1" key_1 :: [Octet] key_1 = [0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f] hmac_1 :: [Octet] hmac_1 = [0x4f, 0x4c, 0xa3, 0xd5, 0xd6, 0x8b, 0xa7, 0xcc, 0x0a, 0x12, 0x08, 0xc9, 0xc6, 0x1e, 0x9c, 0x5d, 0xa0, 0x40, 0x3c, 0x0a] -- Test #2: SHA 20-byte key (short block) hmacTest2 = TestCase ( assertEqual "Test HMAC-SHA1 #2 with 20-byte key" hmac_2 (hmac_sha1 key_2 message_2) ) message_2 = string2words "Sample #2" key_2 :: [Octet] key_2 = [0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40, 0x41, 0x42, 0x43] hmac_2 :: [Octet] hmac_2 = [0x09, 0x22, 0xd3, 0x40, 0x5f, 0xaa, 0x3d, 0x19, 0x4f, 0x82, 0xa4, 0x58, 0x30, 0x73, 0x7d, 0x5c, 0xc6, 0xc7, 0x5d, 0x24] -- Test #3: SHA 100-byte key (multi-block) hmacTest3 = TestCase ( assertEqual "Test HMAC-SHA1 #3 with 100-byte key" hmac_3 (hmac_sha1 key_3 message_3) ) message_3 = string2words "Sample #3" key_3 :: [Octet] key_3 = [0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f, 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f, 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f, 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f, 0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, 0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf, 0xb0, 0xb1, 0xb2, 0xb3] hmac_3 :: [Octet] hmac_3 = [0xbc, 0xf4, 0x1e, 0xab, 0x8b, 0xb2, 0xd8, 0x02, 0xf3, 0xd0, 0x5c, 0xaf, 0x7c, 0xb0, 0x92, 0xec, 0xf8, 0xd1, 0xa3, 0xaa] -- Test #4: SHA 49-byte key (truncated to 12-byte HMAC) hmacTest4 = TestCase ( assertEqual "Test HMAC-SHA1 #4 with 49-byte key, truncated to 12-bytes" hmac_4 (take 12 (hmac_sha1 key_4 message_4)) ) message_4 = string2words "Sample #4" key_4 :: [Octet] key_4 = [0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f, 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f, 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f, 0xa0] hmac_4 :: [Octet] hmac_4 = [0x9e, 0xa8, 0x86, 0xef, 0xe2, 0x68, 0xdb, 0xec, 0xce, 0x42, 0x0c, 0x75] -- Test #5: MD5 Test from rfc 2104 (16-byte key) hmacTest5 = TestCase ( assertEqual "Test HMAC-MD5 with 16-byte key" hmac_5 (hmac_md5 key_5 message_5) ) message_5 = string2words "Hi There" key_5 :: [Octet] key_5 = take 16 (repeat 0xb) hmac_5 :: [Octet] hmac_5 = [0x92, 0x94, 0x72, 0x7a, 0x36, 0x38, 0xbb, 0x1c, 0x13, 0xf4, 0x8e, 0xf8, 0x15, 0x8b, 0xfc, 0x9d] -- Test #6: MD5 Test from rfc 2104 (28-byte key) hmacTest6 = TestCase ( assertEqual "Test HMAC-MD5 with 28-byte key" hmac_6 (hmac_md5 key_6 message_6) ) message_6 = string2words "what do ya want for nothing?" key_6 :: [Octet] key_6 = string2words "Jefe" hmac_6 :: [Octet] hmac_6 = [0x75, 0x0c, 0x78, 0x3e, 0x6a, 0xb0, 0xb5, 0x03, 0xea, 0xa8, 0x6e, 0x31, 0x0a, 0x5d, 0xb7, 0x38] -- Test #7: MD5 Test from rfc 2104 (16-byte key) hmacTest7 = TestCase ( assertEqual "Test HMAC-MD5 with 16-byte key" hmac_7 (hmac_md5 key_7 message_7) ) message_7 = take 50 (repeat 0xdd) key_7 :: [Octet] key_7 = take 16 (repeat 0xaa) hmac_7 :: [Octet] hmac_7 = [0x56, 0xbe, 0x34, 0x52, 0x1d, 0x14, 0x4c, 0x88, 0xdb, 0xb8, 0xc7, 0x33, 0xf0, 0xe8, 0xb3, 0xf6] string2words :: String -> [Octet] string2words = map (fromIntegral . ord) -- Run the tests tests = TestList [hmacTest1, hmacTest2, hmacTest3, hmacTest4, hmacTest5, hmacTest6, hmacTest7] main = runTestTT tests Crypto-4.2.5.1/QuickTest.hs0000755156011600244210000000353512062104420015331 0ustar 1312888Domain Users{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Main where import Codec.Utils import Codec.Encryption.Blowfish as Blowfish import Codec.Encryption.AES as AES import Codec.Encryption.Modes import Codec.Encryption.Padding import Data.LargeWord import Data.Word import Data.Bits import Numeric import Data.Char import Test.QuickCheck instance Arbitrary Word128 where arbitrary = do n <- choose ((fromIntegral (minBound::Word128))::Integer, (fromIntegral (maxBound::Word128))::Integer) return (fromIntegral n) prop_decryptEncrypt k b = b == Blowfish.decrypt k (Blowfish.encrypt k b) where types = (k :: Word8, b :: Word64) prop_AESIdempotent k b = b == AES.decrypt k (AES.encrypt k b) where types = (k :: Word128, b :: Word128) prop_unCbcCbc iv k bs = bs == (unPkcs5 $ unCbc Blowfish.decrypt iv k $ cbc Blowfish.encrypt iv k $ pkcs5 bs) where types =(k :: Word8, iv :: Word64, bs :: [Octet]) prop_unPkcs5Pkcs5 os = os == (unPkcs5 $ ((pkcs5 os)::[Word64])) where types = (os :: [Octet]) prop_unNullsNulls os = all (/=0) os ==> os == (unPadNulls $ ((padNulls os)::[Word64])) where types = (os :: [Octet]) prop_fromOctetsToOctets k n = k >= 0 && n > 1 ==> k == (fromOctets n $ toOctets n k) where types = (k :: Int, n :: Word8) prop_unTwosCompTwosComp n = n < (0) ==> collect n $ forAll g $ \n -> n == (fromTwosComp $ toTwosComp n) where types = (n::Int) g = do n <- choose (minBound::Int,maxBound::Int) return (13*n) main = do quickCheck prop_decryptEncrypt quickCheck prop_AESIdempotent quickCheck prop_unCbcCbc quickCheck prop_unPkcs5Pkcs5 quickCheck prop_unNullsNulls quickCheck prop_fromOctetsToOctets quickCheck prop_unTwosCompTwosComp Crypto-4.2.5.1/ReadMe.tex0000755156011600244210000002512712062104420014741 0ustar 1312888Domain Users\documentclass{article} \usepackage{listings} \usepackage{a4} \usepackage{courier} \usepackage{hyperref} \usepackage{html} \lstdefinelanguage{ASN1} { morekeywords={}, sensitive=false, morecomment=[s]{(--}{--)} } \lstdefinelanguage{shell} { sensitive=true } \setlength{\parskip}{\medskipamount} \setlength{\parindent}{0pt} \title{Haskell Cryptographic Library 4.2.0} \author{Dominic Steinitz} \begin{document} \maketitle The \htmladdnormallinkfoot {Haskell Cryptographic Library 4.2.0} {http://www.haskell.org/crypto} collects together existing Haskell cryptographic functions into one cabalized package, together with HUnit tests, QuickCheck property tests and examples. It is a significant change from previous versions and now only contains cryptographic functions; the functions for dealing with ASN.1, X.509 certificates and PKCS\#8 will be provided by an entirely separate library reducing the number of dependencies. This release contains: \begin{itemize} \item DES \item Blowfish \item AES \item TEA \item Cipher Block Chaining (CBC) \item PKCS\#5 and nulls padding \item SHA-1 \item MD5 \item RSA \end{itemize} Haddock documentation for the library is available \htmladdnormallinkfoot {here} {http://www.haskell.org/crypto/doc/html} . \section{System Requirements} \begin{itemize} \item The code has been tested on GHC 6.6 and Hugs Version September 2006. It does not currently work with YHC because of the lack of {\tt Data.Word} and {\tt Data.Bits}. \item It {\em no longer} requires the use of {\tt NewBinary.Binary}. \end{itemize} \section{Installation Instructions} Get the sources: \lstset{language=shell,basicstyle=\ttfamily\small} \begin{lstlisting}[frame=single] darcs get --tag "4.2.0" http://code.haskell.org/crypto \end{lstlisting} Build and install ready for testing: \begin{lstlisting}[frame=single] ghc -o Setup Setup.hs -package Cabal ./Setup configure --prefix=/my/chosen/dir ./Setup build ./Setup install --user \end{lstlisting} Run the tests. \begin{lstlisting}[frame=single] cd /my/chosen/dir/bin ./RSATest ./SymmetricTest ./QuickTest \end{lstlisting} You can now run the examples to confirm further that everything is working satisfactorily. When you are happy, build and install them in their final destination: \begin{lstlisting}[frame=single] ./Setup unregister --user ./Setup clean ./Setup configure ./Setup build ./Setup install \end{lstlisting} \section{To Do} In no particular order: \begin{itemize} \item Incorporate other symmetric key algorithms already coded in Haskell. \item Performance analysis as Blowfish ought to run more quickly than DES. \item Other modes / padding schemes. \item Extend typechecking to ensure that only the appropriate key sizes are used for a given algorithm. \item Improve performance, for example, for SHA1. This \htmladdnormallinkfoot {code} {http://www.abridgegame.org/repos/darcs-unstable} runs an order of magnitude faster but, with respect to the authors, doesn't feel that functional. \item Get rid of the GPL code. \end{itemize} \section{Contact} All questions, comments, bug reports, flames, requests for updates / changes and suggestions should be directed to Dominic Steinitz and logged \htmladdnormallinkfoot {here} {http://hackage.haskell.org/trac/crypto} . \section{Licensing} The modules in the library come from different authors and have been released under different licences. \subsection{Contributors} \subsubsection{Codec.Binary} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Codec.Binary.BubbleBabble & John Meacham & Copyright \copyright\ 2008, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsubsection{Codec.Text} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Codec.Text.Raw & Dominic Steinitz & Copyright \copyright\ 2006, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsubsection{Codec.Encryption} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Codec.Encryption.AES & Lukasz Anforowicz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.AESAux & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.Blowfish & Doug Hoyte & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.BlowfishAux & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.TEA & John Meacham & Copyright \copyright\ 2008, All rights reserved & BSD \\ \hline Codec.Encryption.DES & Ian Lynagh & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.DESAux & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.Modes & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.Padding & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.RSA & David Sankel & Copyright \copyright\ 2005, All rights reserved & GPL \\ \hline Codec.Encryption.RSA.EMEOAEP & David Sankel & Copyright \copyright\ 2005, All rights reserved & GPL \\ \hline Codec.Encryption.RSA.MGF & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Codec.Encryption.RSA.NumberTheory & David Sankel & Copyright \copyright\ 2005, All rights reserved & GPL \\ \hline\hline \end{tabular} \subsubsection{Codec} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Codec.Utils & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsubsection{Data.Digest} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Data.Digest.MD5 & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Data.Digest.MD5Aux & Ian Lynagh & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline Data.Digest.SHA1 & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsubsection{Data} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline Data.LargeWord & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsubsection{Tests and Examples} \begin{tabular}{|p{6cm}|p{3cm}|p{3cm}|p{1cm}|} \hline\hline RSATest & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline QuickTest & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline SymmetricTest & Dominic Steinitz & Copyright \copyright\ 2005, All rights reserved & BSD \\ \hline\hline \end{tabular} \subsection{The BSD License} This license is based on \htmladdnormallinkfoot {The BSD License} {http://www.opensource.org/licenses/bsd-license.php}. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: \begin{itemize} \item Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. \item Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. \item The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission. \end{itemize} \begin{sc} This software is provided by the copyright holders and contributors ``AS IS'' and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the copyright onwers or contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. \end{sc} \subsection{The GNU General Public License (GPL)} This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You can find a copy of the GNU General Public License \htmladdnormallinkfoot {here} {http://www.opensource.org/licenses/gpl-license.php} ; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA \section{Disclaimer} Cryptography is a notoriously easy area in which to make mistakes, not necessarily with the algorithms but with how they are implemented (for example not protecting keys, using weak keys and so on). For a readable account of some of the pitfalls, see \htmladdnormallinkfoot {Ross Anderson} {http://www.cl.cam.ac.uk/users/rja14/} 's book. \begin{sc} This software is provided by the copyright holders and contributors ``AS IS'' and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the copyright onwers or contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. \end{sc} \section{Acknowledgements} \begin{itemize} \item Doug Hoyte (HardCore SoftWare) \item Anatoly Zaretsky \item \htmladdnormallinkfoot {Ian Lynagh} {http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh} \item \htmladdnormallinkfoot {David Sankel} {http://www.electronconsulting.com/whois.html} \item \htmladdnormallinkfoot {Ross Paterson} {http://www.soi.city.ac.uk/~ross} \item Lukasz Anforowicz \item \htmladdnormallinkfoot {Warrick Gray} {http://homepages.paradise.net.nz/warrickg/haskell/http/} \item \htmladdnormallinkfoot {Russell O'Connor} {http://r6.ca} \item Spencer Janssen \end{itemize} This document was last updated on 7th December 2008. \copyright\ 2006--2008 Dominic Steinitz. \end{document} Crypto-4.2.5.1/RSATest.hs0000755156011600244210000001145612062104420014703 0ustar 1312888Domain Usersmodule Main(main) where import Codec.Utils import Data.Digest.SHA1(hash,Word160(Word160)) import Codec.Encryption.RSA.MGF import Codec.Encryption.RSA.EMEOAEP import Codec.Encryption.RSA import Test.HUnit n :: [Octet] n = [0xbb, 0xf8, 0x2f, 0x09, 0x06, 0x82, 0xce, 0x9c, 0x23, 0x38, 0xac, 0x2b, 0x9d, 0xa8, 0x71, 0xf7, 0x36, 0x8d, 0x07, 0xee, 0xd4, 0x10, 0x43, 0xa4, 0x40, 0xd6, 0xb6, 0xf0, 0x74, 0x54, 0xf5, 0x1f, 0xb8, 0xdf, 0xba, 0xaf, 0x03, 0x5c, 0x02, 0xab, 0x61, 0xea, 0x48, 0xce, 0xeb, 0x6f, 0xcd, 0x48, 0x76, 0xed, 0x52, 0x0d, 0x60, 0xe1, 0xec, 0x46, 0x19, 0x71, 0x9d, 0x8a, 0x5b, 0x8b, 0x80, 0x7f, 0xaf, 0xb8, 0xe0, 0xa3, 0xdf, 0xc7, 0x37, 0x72, 0x3e, 0xe6, 0xb4, 0xb7, 0xd9, 0x3a, 0x25, 0x84, 0xee, 0x6a, 0x64, 0x9d, 0x06, 0x09, 0x53, 0x74, 0x88, 0x34, 0xb2, 0x45, 0x45, 0x98, 0x39, 0x4e, 0xe0, 0xaa, 0xb1, 0x2d, 0x7b, 0x61, 0xa5, 0x1f, 0x52, 0x7a, 0x9a, 0x41, 0xf6, 0xc1, 0x68, 0x7f, 0xe2, 0x53, 0x72, 0x98, 0xca, 0x2a, 0x8f, 0x59, 0x46, 0xf8, 0xe5, 0xfd, 0x09, 0x1d, 0xbd, 0xcb] p :: [Octet] p = [0xee, 0xcf, 0xae, 0x81, 0xb1, 0xb9, 0xb3, 0xc9, 0x08, 0x81, 0x0b, 0x10, 0xa1, 0xb5, 0x60, 0x01, 0x99, 0xeb, 0x9f, 0x44, 0xae, 0xf4, 0xfd, 0xa4, 0x93, 0xb8, 0x1a, 0x9e, 0x3d, 0x84, 0xf6, 0x32, 0x12, 0x4e, 0xf0, 0x23, 0x6e, 0x5d, 0x1e, 0x3b, 0x7e, 0x28, 0xfa, 0xe7, 0xaa, 0x04, 0x0a, 0x2d, 0x5b, 0x25, 0x21, 0x76, 0x45, 0x9d, 0x1f, 0x39, 0x75, 0x41, 0xba, 0x2a, 0x58, 0xfb, 0x65, 0x99] q :: [Octet] q = [0xc9, 0x7f, 0xb1, 0xf0, 0x27, 0xf4, 0x53, 0xf6, 0x34, 0x12, 0x33, 0xea, 0xaa, 0xd1, 0xd9, 0x35, 0x3f, 0x6c, 0x42, 0xd0, 0x88, 0x66, 0xb1, 0xd0, 0x5a, 0x0f, 0x20, 0x35, 0x02, 0x8b, 0x9d, 0x86, 0x98, 0x40, 0xb4, 0x16, 0x66, 0xb4, 0x2e, 0x92, 0xea, 0x0d, 0xa3, 0xb4, 0x32, 0x04, 0xb5, 0xcf, 0xce, 0x33, 0x52, 0x52, 0x4d, 0x04, 0x16, 0xa5, 0xa4, 0x41, 0xe7, 0x00, 0xaf, 0x46, 0x15, 0x03] popTest = TestCase ( assertEqual "Product of Primes" (fromOctets 256 n) ((fromOctets 256 p)*(fromOctets 256 q)) ) d :: [Octet] d = [0xa5, 0xda, 0xfc, 0x53, 0x41, 0xfa, 0xf2, 0x89, 0xc4, 0xb9, 0x88, 0xdb, 0x30, 0xc1, 0xcd, 0xf8, 0x3f, 0x31, 0x25, 0x1e, 0x06, 0x68, 0xb4, 0x27, 0x84, 0x81, 0x38, 0x01, 0x57, 0x96, 0x41, 0xb2, 0x94, 0x10, 0xb3, 0xc7, 0x99, 0x8d, 0x6b, 0xc4, 0x65, 0x74, 0x5e, 0x5c, 0x39, 0x26, 0x69, 0xd6, 0x87, 0x0d, 0xa2, 0xc0, 0x82, 0xa9, 0x39, 0xe3, 0x7f, 0xdc, 0xb8, 0x2e, 0xc9, 0x3e, 0xda, 0xc9, 0x7f, 0xf3, 0xad, 0x59, 0x50, 0xac, 0xcf, 0xbc, 0x11, 0x1c, 0x76, 0xf1, 0xa9, 0x52, 0x94, 0x44, 0xe5, 0x6a, 0xaf, 0x68, 0xc5, 0x6c, 0x09, 0x2c, 0xd3, 0x8d, 0xc3, 0xbe, 0xf5, 0xd2, 0x0a, 0x93, 0x99, 0x26, 0xed, 0x4f, 0x74, 0xa1, 0x3e, 0xdd, 0xfb, 0xe1, 0xa1, 0xce, 0xcc, 0x48, 0x94, 0xaf, 0x94, 0x28, 0xc2, 0xb7, 0xb8, 0x88, 0x3f, 0xe4, 0x46, 0x3a, 0x4b, 0xc8, 0x5b, 0x1c, 0xb3, 0xc1] dP :: [Octet] dP = [0x54, 0x49, 0x4c, 0xa6, 0x3e, 0xba, 0x03, 0x37, 0xe4, 0xe2, 0x40, 0x23, 0xfc, 0xd6, 0x9a, 0x5a, 0xeb, 0x07, 0xdd, 0xdc, 0x01, 0x83, 0xa4, 0xd0, 0xac, 0x9b, 0x54, 0xb0, 0x51, 0xf2, 0xb1, 0x3e, 0xd9, 0x49, 0x09, 0x75, 0xea, 0xb7, 0x74, 0x14, 0xff, 0x59, 0xc1, 0xf7, 0x69, 0x2e, 0x9a, 0x2e, 0x20, 0x2b, 0x38, 0xfc, 0x91, 0x0a, 0x47, 0x41, 0x74, 0xad, 0xc9, 0x3c, 0x1f, 0x67, 0xc9, 0x81] exponent1 = toOctets 256 $ (fromOctets 256 d) `mod` ((fromOctets 256 p) - 1) e1Test = TestCase ( assertEqual "Exponent" dP exponent1 ) dQ :: [Octet] dQ = [0x47, 0x1e, 0x02, 0x90, 0xff, 0x0a, 0xf0, 0x75, 0x03, 0x51, 0xb7, 0xf8, 0x78, 0x86, 0x4c, 0xa9, 0x61, 0xad, 0xbd, 0x3a, 0x8a, 0x7e, 0x99, 0x1c, 0x5c, 0x05, 0x56, 0xa9, 0x4c, 0x31, 0x46, 0xa7, 0xf9, 0x80, 0x3f, 0x8f, 0x6f, 0x8a, 0xe3, 0x42, 0xe9, 0x31, 0xfd, 0x8a, 0xe4, 0x7a, 0x22, 0x0d, 0x1b, 0x99, 0xa4, 0x95, 0x84, 0x98, 0x07, 0xfe, 0x39, 0xf9, 0x24, 0x5a, 0x98, 0x36, 0xda, 0x3d] m :: [Octet] m = [0xd4, 0x36, 0xe9, 0x95, 0x69, 0xfd, 0x32, 0xa7, 0xc8, 0xa0, 0x5b, 0xbc, 0x90, 0xd3, 0x2c, 0x49] seed :: [Octet] seed = [0xaa, 0xfd, 0x12, 0xf6, 0x59, 0xca, 0xe6, 0x34, 0x89, 0xb4, 0x79, 0xe5, 0x07, 0x6d, 0xde, 0xc2, 0xf0, 0x6c, 0xb5, 0x8f] e :: [Octet] e = [0x11] hash' xs = let (Word160 a b c d e) = hash xs in concatMap (toOctets 256) [a,b,c,d,e] encodedText = encode mgf hash' [] seed n m decodedText = decode mgf hash' [] encodedText encodingTest = TestCase ( assertEqual "Encoding / Decoding" m decodedText ) cipherText = encrypt (n,e) encodedText plainText = decrypt (n,d) cipherText decodedText' = decode mgf hash' [] plainText encryptionTest = TestCase ( assertEqual "Encrypting / Decrypting" m decodedText ) tests = TestList [popTest, e1Test, encodingTest, encryptionTest] main = runTestTT tests Crypto-4.2.5.1/Setup.hs0000755156011600244210000000011712062104420014506 0ustar 1312888Domain Usersmodule Main where import Distribution.Simple main :: IO () main = defaultMain Crypto-4.2.5.1/SHA1Test.hs0000755156011600244210000002111312062104420014741 0ustar 1312888Domain Usersimport Test.HUnit import Codec.Text.Raw (hexdumpBy) import Data.Digest.SHA1 (hash,Word160(Word160)) import Text.PrettyPrint import Data.Char (ord) import Codec.Utils (toOctets) testCases = [ ("Hello" , "f7ff9e8b7bb2e09b70935a5d785e0cc5d9d0abf0") , ("haskell" , "f0234175f95a989496bf7f5ba03dea4dbc773e58") , ("Cryptography" , "b804ec5a0d83d19d8db908572f51196505d09f98") , ("Message Digest", "d52066b0fa1d68ef07eeab73031c3a3671298417") ] testCases' = [ ([] , "da39a3ee5e6b4b0d3255bfef95601890afd80709") , ([0xa8] , "99f2aa95e36f95c2acb0eaf23998f030638f3f15") , (toOctets 256 0x7e3a4c325cb9c52b88387f93d01ae86d42098f5efa7f9457388b5e74b6d28b2438d42d8b64703324d4aa25ab6aad153ae30cd2b2af4d5e5c00a8a2d0220c6116, "a3054427cdb13f164a610b348702724c808a0dcc") , (toOctets 256 0xec29561244ede706b6eb30a1c371d74450a105c3f9735f7fa9fe38cf67f304a5736a106e92e17139a6813b1c81a4f3d3fb9546ab4296fa9f722826c066869edacd73b2548035185813e22634a9da44000d95a281ff9f264ecce0a931222162d021cca28db5f3c2aa24945ab1e31cb413ae29810fd794cad5dfaf29ec43cb38d198fe4ae1da2359780221405bd6712a5305da4b1b737fce7cd21c0eb7728d08235a9011, "970111c4e77bcc88cc20459c02b69b4aa8f58217") , (toOctets 256 0x4893f1c763625f2c6ce53aacf28026f14b3cd8687e1a1d3b60a81e80fcd1e2b038f9145ab64a0718f948f7c3c9ac92e3d86fb669a5257da1a18c776291653688338210a3242120f101788e8acc9110db9258b1554bf3d26602516ea93606a25a7f566c0c758fb39ecd9d876bc5d8abc1c3205095382c2474cb1f8bbdb45c2c0e659cb0fc703ec607a5de6bcc7a28687db1ee1c8f34797bb2441d5706d210df8c2d7d65dbded36414d063c117b52a51f7a4eb9cac0782e008b47459ed5acac0bc1f20121087f992ad985511b33c866d18e63f585478ee5a5e654b19d81231d98683ae3f0533565aba43dce408d7e3c4c6be11d8f05165f29c9dcb2030c4ee31d3a04e7421aa92c3231a1fc07e50e95fea7389a5e65891afaba51cf55e36a9d089bf293accb356d5d06547307d6e41456d4ed146a056179971c56521c83109bf922866186e184a99a96c7bb96df8937e35970e438412a2b8d744cf2ad87cb605d4232e976f9f15169776e4e5b6b786132c966b25fc56d815c56c819af5e159aa39f8a93d38115f5580cda93bc073c30b39920e726fe861b72483a3f886269ab7a8eefe952f35d25c4eb7f443f4f3f26e43d51fb54591e6a6dad25fcdf5142033084e5624bdd51435e77dea86b8, "dc5859dd5163c4354d5d577b855fa98e37f04384") , (toOctets 256 0xcf494c18a4e17bf03910631471bca5ba7edea8b9a63381e3463517961749848eb03abefd4ce676dece3740860255f57c261a558aa9c7f11432f549a9e4ce31d8e17c79450ce2ccfc148ad904aedfb138219d7052088520495355dadd90f72e6f69f9c6176d3d45f113f275b7fbc2a295784d41384cd7d629b23d1459a22e45fd5097ec9bf65fa965d3555ec77367903c32141065fc24da5c56963d46a2da3c279e4035fb2fb1c0025d9dda5b9e3443d457d92401a0d3f58b48469ecb1862dc975cdbe75ca099526db8b0329b03928206f084c633c04eef5e8e377f118d30edf592504be9d2802651ec78aeb02aea167a03fc3e23e5fc907c324f283f89ab37e84687a9c74ccf055402db95c29ba2c8d79b2bd4fa96459f8e3b78e07e923b81198267492196ecb71e01c331f8df245ec5bdf8d0e05c91e63bb299f0f6324895304dda721d39410458f117c87b7dd6a0ee734b79fcbe482b2c9e9aa0cef03a39d4b0c86de3bc34b4aadabfa373fd2258f7c40c187744d237080762382f547a36adb117839ca72f8ebbc5a20a07e86f4c8bb923f5787698d278f6db0040e76e54645bb0f97083995b34b9aa445fc424455058795828dd00c32471ec402a307f5aa1b37b1a86d6dae3bcbfbe9ba41cab0beeabf489af0073d4b3837d3f14b815120bc3602d072b5aeefcdec655fe756b660eba7dcf34675acbce317746270599424b9248791a0780449c1eabbb9459cc1e588bfd74df9b1b711c85c09d8aa171b309281947e8f4b6ac438753158f4f36fa, "4c17926feb6e87f5bca7890d8a5cde744f231dab") , (toOctets 256 0xe79701ff44ecfe5a7e97306a9c93791a2b4a6948e0aa06797f7cc8cbfbf1e82bdf7edbc7ecea19c604a62237475cc3487bca95b9b1d1c89025c91e0d67183ae0b8031b9ab7c4e4623ddcdee985aabfa0903d2d28c7677e09e312c2a80ad703733acdcb5feb9fe794f0e26b669fa5f6883149377c6c93b04e7fffba822d57ca4b2d85f2fed1a6abc5e75fd198dd74ef692896bd9fe57de7c6c137108517c017d059d2995eb1feb75ee8fc1966864032ac3bcdc6787d4eaad97363cc981239736a865dc769d3d293c5bc614ab7e43048b733965bef7b2e82ef5b2af4a264ea64817bce84067e48c8642b356c753d6db8f4d79883ec2644f6704335928d56fc747d01ccd81dfc88dda2fc208887da1e0ac9f17c4657c8b98ec4f12cad4030972bc6e0ffcc9793bb5ae6f9cca4d5036cc7a047e9ac18a7b4d2542db54ea33ae210c4e010675a8c09c89ae8decb47ff7f76e0a388be180b5e4b86c17b7c9ebc06abe0c8a7b24f2f99ad25920102c5187e9ff1cb01833d3edf80c373243f19fd2b8480626bb35ec39494efbfdb53379491cb3b87fb0370875ef9740d599ffc4677240e74057470922102603614c585bce28026a11f479a2d033fff55c1a52fdf1512f0c71cfd6be26981e0c1556097d896491adf1456a179f8d9ce1405589a102bd69023595439fc9498d726462d5530d8ab7f0b82396fb3624f4711ccc12621e2f954506483c028c9d0ad2e8e33a80bce30bdeb13f6ea236c2ad416bfe6b9596102a615e492eaad30afcaa1d57b76b3a05f3c486d97fc103bf1dce986d13c01d179ed3b82879dd5f2bf9647c50ba96e77c064e938238cc4fa2cc753c88a986159e6908be56cc3e637887ae804ed27857bdc9e981da38185cf64fc1c2d17b3c122d2f9cab54843292691dc4b3a29da40d33a501bc31ec59ce21fe50c5f82776953c58fc39c2405e6e862253910c5a8e6a863e43bd49c3f515ce8e9eb03d3cba01545ba3d4007f165a483be7a2dcb7bc121ddc0c0f526d7eb65447080c41096b090dce2ff49f9efed837d0dd63b423a1767324e72d0c275b424bde2944743c2dfeb116fd26003e7c7add67c15df33cd31a1e9f4190d7b01f2c2daa8ef377336764f6cc97e2d2bc13c491972fec3a51b57f88b1c7c545663ee672328593aa9dabce37659cb577b659280cb575a8fa00ed0949f2d644b5d84f03921cb9af8ec96fbd0b6858187fbbb11797692f1eb2d8de69cad8f999d974a3f635bf9791b4452793db5b66764b2ac035da18d8b7d5281df383ea9e3f00c9e250b5a1bc048b9f68053f9554697a81eae53d5aff0f019d00492d9e50aedc569e85aa4973529546a56390cc8e6c7e5fa5c849960e7ea8a639dcf06aad53bc991d177c3d7a1661c96431876790f9d7229531775083a13ac22f21a4d610d822000288a3f41cba71a639118bdce89c05692db35f10faf1587f54a9937707a6cd39c35bd9e3f7d9354b786606b311bda991c3e0696de0f9523c5ef744b40e49fe94f3f366a387dd2d47c6c1907098f9044b1c2b1ebdb213e897827d4113913c36aff901d2a94940da298896a1abeab8c5d38b15f796fafb5c0f83be112c3cf815f966e9b67ba8aecc4f5267c2bb83876ef985137c6027fa5d02b73c2d547df81cffb22d8a814271644798a77c25efdf5ffbbeb625cfd5bb4c2fb16a0e32b0c6ac216f4fb75093334290eff82681ac4b29788c607c3c6098a9d4f6ea2c2d91ee440cf2b2c560175ed7c9bcbc5a3535355bee72c4f81c751d0690ec1f1fcb7dd99520e1195d464b6ea44073769fe7273857dc063622067fd2e2e2258b4192f102effbbec5b769bbed2893c8b96feddeceadbfbb467280dd34bf5727b149fa8814e50be05a9c50c554e54210f732dfd862de08167861f239dd0c5e67139188af69f4bffa4a548204306ac9e0b29123a09f69438c4e98f102164a766844a0b3c38c9fa671177873f4fa1999bc6df35fd3cec000913b5ff3c28b0a2dafa6f01280f7565dc93480ad243c8230089be1face8b82bdc9b15f80f795cbe2a1cd281b5424b934773405a3fe52253b59cee57b1d5021d9aa52f01f1de0f033f3298134b9bf28c91fa86fef0fe5830a347966572cb71df29792ba24a1d717aff84ec3f52e01358a06d437e4b5511c2b0d2dfd25992ad78735f326382ff2b2a5359f48e32da55005e179e63bab4f612c584f025ccf15ff05f9f6ccd014ce51c23fbd8875451618bb23fc033a4e1ae27cba6f2e635b22f50d48000672fcc465658b0c1b31e0dde01832cd07971a5e20aa8800c9efb9bc49fbc4b16b97546f7e2d8c1d798f9d5756abb27f7ba88c83ac1465a67d48675c7e5fe49d84c3984a0c88d7641c04e72cecf41785d8053125d568b7c2a103e07df2a82bf6ca7e44ce80e5e1628b383ad9037fd672952394bf4d0612d7eda8b1bb57730f8fa53df6777be32ebb3f7024c63abd73c84b9a23aa638afb78bbbd577f0d3f03babd6919df6dff33b0b163117f132b73e953cf6a81c955d60783a84e43947aacfa6ba61b50d7a884f57987ad8dfd485b685639e5dfeef52716ee0002a38da46fd1486b9796396d96fc0034455d89929ec7bb60021f34f78319433b1119494ac0d1dc300afa13bcee26ee1f657828a8b28a0be85bca3bcb6ea13bd0061f67dc447e8f89d206e714ff288b9faa685ae94b21b0295f5b73ef4e2120653e1059e77f29eadfa94734144e53614b70a8a0e2ad1150a9995d7dd1a63ba94135a6afeab58666b7ed358b29504a279954b39b036cfb65ff765aaa211b332f1a995cca549bf69b891a4c4cd2a97f170fc30399ea1f22588192ad994bf1aa3a57b57d49c3a70cf1f9bd05f99ebe64e81548333e051838b0d65af0bbb0de23536f36b2aea64b3bf250420d21ec138df35050ace7c30c90f7745bbe920e3510f2e78987597b1d061543559c56492d7cc13778eb37c250eda4d20151bca2ab15a1571a55dac080ede339446df7448093ea413d689e7179813175e8648c1c8483d71485b8c3050b65e4a8aaec955c9175d6e3facf9c6f0b1e35e66d6180ea75fe1cc6482a72b7310082280582b0fff4950fb64d6ab20979f72a8a2cd35b8ad3d6ead2de259a658640542dc0dababd0e640d3eb1d46fdf4aae780793244c7c42c0b9d0b4247a7e7fa7d320795f4302638547c3a497366ef1c6b6b53cff044d372e023666b1c390819977b6ab8aca6e885b580bb22d961703b25f3986ade36c25816c7a6267e61a30b7ba46c3e7c15fe168a67d56f21f95f513e9fb1ccb9a57926d51133391629a016523574ee0b864f33fcb7effaf233a4a4ddf704bd279adf24448a766c8b98e78344b7ec910200c52333fa7389f519277c2b84fa05d01bde9a8cb9d58985b6619a78b13bef088c473056b7c8e5d1b2d12350cdfc6b5e335dcfd426b956ae8cf4a217abc9d0c631bea08d7756d62f0688e0735b70b876e7450c455a8b9dab2189e5482dfefce3f710bc02c18524b71e35fabcb4bfb4c2417c9907dcb124277e09a934c0423a08e626ccda1dbd961001c1ba54625227ea48ebbe413495b4c8a95a3702ebfd54dd07, "0eb8d69f6661b8124ddf76a635dc2821cbac32d7") ] genTests' cases = "SHA1" ~: map f cases where f (val, dgst) = dgst ~=? hexHash' val hexHash' x = let (Word160 a b c d e) = hash x in render . (hexdumpBy "" 20) . concatMap (toOctets 256) $ [a,b,c,d,e] main = runTestTT $ genTests' testCases' Crypto-4.2.5.1/SymmetricTest.hs0000755156011600244210000001506712062104420016234 0ustar 1312888Domain Usersmodule Main(main) where import Codec.Utils import Codec.Encryption.Blowfish as Blowfish import Codec.Encryption.Modes import Codec.Encryption.Padding import Codec.Encryption.DES as DES import Codec.Encryption.AES as AES import Data.Word import Data.Bits import Data.Char import Data.LargeWord import Test.HUnit import Numeric -- AES Tests. -- Comparision with resuts from -- http://www.cs.ucsd.edu/~fritz/rijndael_test.html ad = 0xF0E1D2C3B4A5968778695A4B3C2D1E0F :: Word128 ak16 = 0xF0E1D2C3B4A5968778695A4B3C2D1E0F :: Word128 ae16 = 0x6e94fffbb861b2c1769cd4629f3d724b :: Word128 ae16' = AES.encrypt ak16 ad aesTest1 = TestCase ( assertEqual "AES Key Length 128" ae16 ae16' ) ak24 = 0xF0E1D2C3B4A5968778695A4B3C2D1E0FF0E1D2C3B4A59687 :: Word192 ae24' = AES.encrypt ak24 ad ae24 = 0x07d806bb62ebb4399354594ea6586ec6 :: Word128 aesTest2 = TestCase ( assertEqual "AES Key Length 192" ae24 ae24' ) ak32 = 0xF0E1D2C3B4A5968778695A4B3C2D1E0FF0E1D2C3B4A5968778695A4B3C2D1E0F :: Word256 ae32' = AES.encrypt ak32 ad ae32 = 0x28e88482d9b146fdde7e080fcbae1b98 :: Word128 aes3 = ae32 == ae32' aesTest3 = TestCase ( assertEqual "AES Key Length 256" ae32 ae32' ) -- Comparision with resuts from -- http://www.zvon.org/tmRFC/RFC3602/Output/chapter4.html aeskey16 = 0x06a9214036b8a15b512e03d534120006 :: Word128 aesiv16 = 0x3dafba429d9eb430b422da802c9fac41 :: Word128 aesplaintext = "Single block msg" aesciphertext = [0xe353779c1079aeb82708942dbe77181a] :: [Word128] aesciphertext' = cbc AES.encrypt aesiv16 aeskey16 $ pkcs5 $ map (fromIntegral . ord) aesplaintext -- aescbc1 = aesciphertext == take 1 aesciphertext' aescbcTest1 = TestCase ( assertEqual "AES CBC PKCS5 Key Length 128" aesciphertext (take 1 aesciphertext') ) aesplaintext' = map (chr . fromIntegral) $ unPkcs5 $ unCbc AES.decrypt aesiv16 aeskey16 aesciphertext' aescbcTest2 = TestCase ( assertEqual "AES CBC PKCS5 Decryption Key Length 128" aesplaintext aesplaintext' ) aes2key16 = 0x6c3ea0477630ce21a2ce334aa746c2cd :: Word128 aes2iv16 = 0xc782dc4c098c66cbd9cd27d825682c81 :: Word128 aes2plaintext = "This is a 48-byte message (exactly 3 AES blocks)" aes2ciphertext = [0xd0a02b3836451753d493665d33f0e886, 0x2dea54cdb293abc7506939276772f8d5, 0x021c19216bad525c8579695d83ba2684] :: [Word128] aes2ciphertext' = cbc AES.encrypt aes2iv16 aes2key16 $ pkcs5 $ map (fromIntegral . ord) aes2plaintext aescbcTest3 = TestCase ( assertEqual "AES CBC PKCS5 3 Blocks Key Length 128" aes2ciphertext (take 3 aes2ciphertext') ) -- Comparision with resuts from -- http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf aes3key24 = 0x8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b :: Word192 aes3iv16 = 0x000102030405060708090a0b0c0d0e0f :: Word128 aes3plaintext = [0x6bc1bee22e409f96e93d7e117393172a, 0xae2d8a571e03ac9c9eb76fac45af8e51, 0x30c81c46a35ce411e5fbc1191a0a52ef, 0xf69f2445df4f9b17ad2b417be66c3710] :: [Word128] aes3ciphertext' = cbc AES.encrypt aes3iv16 aes3key24 $ pkcs5 $ concat $ map (toOctets 256) aes3plaintext aes3ciphertext = [0x4f021db243bc633d7178183a9fa071e8, 0xb4d9ada9ad7dedf4e5e738763f69145a, 0x571b242012fb7ae07fa9baac3df102e0, 0x08b0e27988598881d920a9e64f5615cd] :: [Word128] aescbcTest4 = TestCase ( assertEqual "AES CBC PKCS5 4 Blocks Key Length 192" aes3ciphertext (take 4 aes3ciphertext') ) aes4key32 = 0x603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4 :: Word256 aes4iv16 = 0x000102030405060708090a0b0c0d0e0f :: Word128 aes4plaintext = [0x6bc1bee22e409f96e93d7e117393172a, 0xae2d8a571e03ac9c9eb76fac45af8e51, 0x30c81c46a35ce411e5fbc1191a0a52ef, 0xf69f2445df4f9b17ad2b417be66c3710] :: [Word128] aes4ciphertext' = cbc AES.encrypt aes4iv16 aes4key32 $ pkcs5 $ concat $ map (toOctets 256) aes3plaintext aes4ciphertext = [0xf58c4c04d6e5f1ba779eabfb5f7bfbd6, 0x9cfc4e967edb808d679f777bc6702c7d, 0x39f23369a9d9bacfa530e26304231461, 0xb2eb05e2c39be9fcda6c19078c6a9d1b] :: [Word128] aescbcTest5 = TestCase ( assertEqual "AES CBC PKCS5 4 Blocks Key Length 256" aes4ciphertext (take 4 aes4ciphertext') ) -- Blowfish Tests. -- Tests from http://www.counterpane.com/vectors.txt. d = 0xFEDCBA9876543210 :: Word64 k = 0xF0 :: Word8 e = 0xF9AD597C49DB005E :: Word64 e' = Blowfish.encrypt k d bfTest1 = TestCase ( assertEqual "Blowfish Key Length 8" e e' ) k2 = 0xF0E1 :: Word16 e2 = 0xE91D21C1D961A6D6 :: Word64 e2' = Blowfish.encrypt k2 d bfTest2 = TestCase ( assertEqual "Blowfish Key Length 16" e2 e2' ) e8 = 0xE87A244E2CC85E82 :: Word64 k8 = 0xF0E1D2C3B4A59687 :: Word64 e8' = Blowfish.encrypt k8 d bfTest3 = TestCase ( assertEqual "Blowfish Key Length 64" e8 e8' ) e16 = 0x93142887EE3BE15C :: Word64 k16= 0xF0E1D2C3B4A5968778695A4B3C2D1E0F :: Word128 e16' = Blowfish.encrypt k16 d bfTest4 = TestCase ( assertEqual "Blowfish Key Length 128" e16 e16' ) -- Blowfish test with Cipher Block Chaining. -- Set up the published key, initialization vector and data. key16 = 0x0123456789ABCDEFF0E1D2C3B4A59687 :: Word128 iv8 = 0xFEDCBA9876543210 :: Word64 data29 = "7654321 Now is the time for \NUL" -- Pad with nulls as in the example. e29' = cbc Blowfish.encrypt iv8 key16 $ padNulls $ map (fromIntegral . ord) data29 e29 = [0x6B,0x77,0xB4,0xD6,0x30,0x06,0xDE,0xE6, 0x05,0xB1,0x56,0xE2,0x74,0x03,0x97,0x93, 0x58,0xDE,0xB9,0xE7,0x15,0x46,0x16,0xD9, 0x59,0xF1,0x65,0x2B,0xD5,0xFF,0x92,0xCC] :: [Octet] bfTest5 = TestCase ( assertEqual "AES CBC Nulls Key Length 128" e29 (concat $ map (toOctets 256) e29') ) -- DES Tests -- Test from http://www.itl.nist.gov/fipspubs/fip81.htm key = 0x0123456789abcdef :: Word64 iv = 0x1234567890abcdef :: Word64 expectedDES = [0xe5c7cdde872bf27c, 0x43e934008c389c0f, 0x683788499a7c05f6] :: [Word64] plainText = "Now is the time for all " -- Pad using PKCS#5 so only take the first 3 blocks of the ciphertext. cipherText = cbc DES.encrypt iv key $ pkcs5 $ map (fromIntegral . ord) plainText descbcTest1 = TestCase ( assertEqual "DES CBC PKCS5 3 Blocks" expectedDES (take 3 cipherText) ) tests = TestList [ aesTest1, aesTest2, aesTest3, aescbcTest1, aescbcTest2, aescbcTest3, aescbcTest4, aescbcTest5, bfTest1, bfTest2, bfTest3, bfTest4, bfTest5, descbcTest1 ] main = runTestTT tests Crypto-4.2.5.1/WordListTest.hs0000755156011600244210000000277112062104420016025 0ustar 1312888Domain Users{-# LANGUAGE ScopedTypeVariables, PatternSignatures, FlexibleInstances, UndecidableInstances, TypeSynonymInstances #-} import Data.LargeWord (Word128, Word192, Word256, LargeKey) import Codec.Utils (listFromOctets, listToOctets) import Data.Word (Word8, Word32, Word64) import Test.QuickCheck main :: IO () main = sequence_ $ map test checks where test :: (String, IO ()) -> IO () test (s, t) = do putStrLn $ "Checking " ++ s putStr " " t checks :: [(String, IO ())] checks = [ ("Word32", quickCheck (\(w :: [Word32]) -> (listFromOctets . listToOctets) w == w)), ("Word64", quickCheck (\(w :: [Word64]) -> (listFromOctets . listToOctets) w == w)), ("Word128", quickCheck (\(w :: [Word128]) -> (listFromOctets . listToOctets) w == w)), ("Word192", quickCheck (\(w :: [Word192]) -> (listFromOctets . listToOctets) w == w)), ("Word256", quickCheck (\(w :: [Word256]) -> (listFromOctets . listToOctets) w == w))] instance Arbitrary Word128 where arbitrary = do x <- vector (128 `div` 8) :: Gen [Word8] return $ head $ listFromOctets x instance Arbitrary Word192 where arbitrary = do x <- vector (192 `div` 8) :: Gen [Word8] return $ head $ listFromOctets x instance Arbitrary Word256 where arbitrary = do x <- vector (256 `div` 8) :: Gen [Word8] return $ head $ listFromOctets x