Crypto 4.2.5.1 → 4.2.5.2
raw patch · 69 files changed
+4599/−4531 lines, 69 filesdep +Cryptodep ~HUnitdep ~QuickCheckdep ~arraysetup-changednew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: Crypto
Dependency ranges changed: HUnit, QuickCheck, array, base, pretty, random
API changes (from Hackage documentation)
- Codec.Encryption.AES: instance AESKey Word128
- Codec.Encryption.AES: instance AESKey Word192
- Codec.Encryption.AES: instance AESKey Word256
- Codec.Encryption.AES: instance AESKeyIndirection Word128
- Codec.Encryption.AES: instance AESKeyIndirection Word192
- Codec.Encryption.AES: instance AESKeyIndirection Word256
- Data.Digest.SHA1: instance Eq Word160
- Data.Digest.SHA1: instance Show Word160
- Data.Digest.SHA2: instance (Integral a, Show a) => Show (Hash8 a)
- Data.Digest.SHA2: instance (Integral h, Bits h, Show h) => Hash (Hash8 h)
- Data.Digest.SHA2: instance Eq Hash224
- Data.Digest.SHA2: instance Eq Hash384
- Data.Digest.SHA2: instance Eq w => Eq (Hash8 w)
- Data.Digest.SHA2: instance Hash Hash224
- Data.Digest.SHA2: instance Hash Hash384
- Data.Digest.SHA2: instance Ord Hash224
- Data.Digest.SHA2: instance Ord Hash384
- Data.Digest.SHA2: instance Ord w => Ord (Hash8 w)
- Data.Digest.SHA2: instance ShaData Word32
- Data.Digest.SHA2: instance ShaData Word64
- Data.Digest.SHA2: instance Show Hash224
- Data.Digest.SHA2: instance Show Hash384
- Data.HMAC: digest :: HashMethod -> [Octet] -> [Octet]
- Data.HMAC: input_blocksize :: HashMethod -> Int
- Data.LargeWord: instance (Eq a, Eq b) => Eq (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, Bounded a, Integral a, LargeWord a, Bits b, Bounded b, Integral b, LargeWord b) => Bounded (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Bits (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => LargeWord (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Num (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Show (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) => Integral (LargeKey a b)
- Data.LargeWord: instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) => Real (LargeKey a b)
- Data.LargeWord: instance (Ord a, Ord b) => Ord (LargeKey a b)
- Data.LargeWord: instance Enum (LargeKey a b)
- Data.LargeWord: instance LargeWord Word32
- Data.LargeWord: instance LargeWord Word64
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKey Data.LargeWord.Word128
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKey Data.LargeWord.Word192
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKey Data.LargeWord.Word256
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKeyIndirection Data.LargeWord.Word128
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKeyIndirection Data.LargeWord.Word192
+ Codec.Encryption.AES: instance Codec.Encryption.AES.AESKeyIndirection Data.LargeWord.Word256
+ Data.Digest.SHA1: instance GHC.Classes.Eq Data.Digest.SHA1.Word160
+ Data.Digest.SHA1: instance GHC.Show.Show Data.Digest.SHA1.Word160
+ Data.Digest.SHA2: instance (GHC.Real.Integral a, GHC.Show.Show a) => GHC.Show.Show (Data.Digest.SHA2.Hash8 a)
+ Data.Digest.SHA2: instance (GHC.Real.Integral h, GHC.Bits.Bits h, GHC.Show.Show h) => Data.Digest.SHA2.Hash (Data.Digest.SHA2.Hash8 h)
+ Data.Digest.SHA2: instance Data.Digest.SHA2.Hash Data.Digest.SHA2.Hash224
+ Data.Digest.SHA2: instance Data.Digest.SHA2.Hash Data.Digest.SHA2.Hash384
+ Data.Digest.SHA2: instance Data.Digest.SHA2.ShaData GHC.Word.Word32
+ Data.Digest.SHA2: instance Data.Digest.SHA2.ShaData GHC.Word.Word64
+ Data.Digest.SHA2: instance GHC.Classes.Eq Data.Digest.SHA2.Hash224
+ Data.Digest.SHA2: instance GHC.Classes.Eq Data.Digest.SHA2.Hash384
+ Data.Digest.SHA2: instance GHC.Classes.Eq w => GHC.Classes.Eq (Data.Digest.SHA2.Hash8 w)
+ Data.Digest.SHA2: instance GHC.Classes.Ord Data.Digest.SHA2.Hash224
+ Data.Digest.SHA2: instance GHC.Classes.Ord Data.Digest.SHA2.Hash384
+ Data.Digest.SHA2: instance GHC.Classes.Ord w => GHC.Classes.Ord (Data.Digest.SHA2.Hash8 w)
+ Data.Digest.SHA2: instance GHC.Show.Show Data.Digest.SHA2.Hash224
+ Data.Digest.SHA2: instance GHC.Show.Show Data.Digest.SHA2.Hash384
+ Data.HMAC: [digest] :: HashMethod -> [Octet] -> [Octet]
+ Data.HMAC: [input_blocksize] :: HashMethod -> Int
+ Data.LargeWord: instance (GHC.Classes.Eq a, GHC.Classes.Eq b) => GHC.Classes.Eq (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => Data.LargeWord.LargeWord (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => GHC.Bits.Bits (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => GHC.Num.Num (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => GHC.Show.Show (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Classes.Ord b, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => GHC.Real.Integral (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, Data.LargeWord.LargeWord a, GHC.Classes.Ord b, GHC.Bits.Bits b, Data.LargeWord.LargeWord b) => GHC.Real.Real (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Bits.Bits a, GHC.Enum.Bounded a, GHC.Real.Integral a, Data.LargeWord.LargeWord a, GHC.Bits.Bits b, GHC.Enum.Bounded b, GHC.Real.Integral b, Data.LargeWord.LargeWord b) => GHC.Enum.Bounded (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance (GHC.Classes.Ord a, GHC.Classes.Ord b) => GHC.Classes.Ord (Data.LargeWord.LargeKey a b)
+ Data.LargeWord: instance Data.LargeWord.LargeWord GHC.Word.Word32
+ Data.LargeWord: instance Data.LargeWord.LargeWord GHC.Word.Word64
+ Data.LargeWord: instance GHC.Enum.Enum (Data.LargeWord.LargeKey a b)
- Codec.Encryption.RSA.NumberTheory: pg :: Integer -> Integer -> Integer -> IO (Integer)
+ Codec.Encryption.RSA.NumberTheory: pg :: Integer -> Integer -> Integer -> IO Integer
- Codec.Encryption.RSA.NumberTheory: randomOctet :: Int -> IO (String)
+ Codec.Encryption.RSA.NumberTheory: randomOctet :: Int -> IO String
Files
- ChangeLog.md +18/−0
- Codec/Binary/BubbleBabble.hs +0/−41
- Codec/Encryption/AES.hs +0/−62
- Codec/Encryption/AESAux.hs +0/−1008
- Codec/Encryption/Blowfish.hs +0/−58
- Codec/Encryption/BlowfishAux.hs +0/−282
- Codec/Encryption/DES.hs +0/−35
- Codec/Encryption/DESAux.hs +0/−179
- Codec/Encryption/Modes.hs +0/−61
- Codec/Encryption/Padding.hs +0/−108
- Codec/Encryption/RSA.hs +0/−79
- Codec/Encryption/RSA/EMEOAEP.hs +0/−95
- Codec/Encryption/RSA/MGF.hs +0/−32
- Codec/Encryption/RSA/NumberTheory.hs +0/−203
- Codec/Encryption/TEA.hs +0/−85
- Codec/Text/Raw.hs +0/−49
- Codec/Utils.hs +0/−138
- Crypto.cabal +144/−96
- CryptoHomePage.html +0/−51
- Data/Digest/MD5.hs +0/−41
- Data/Digest/MD5Aux.hs +0/−355
- Data/Digest/SHA1.hs +0/−120
- Data/Digest/SHA2.hs +0/−285
- Data/Digest/SHA224.hs +0/−26
- Data/Digest/SHA256.hs +0/−26
- Data/Digest/SHA384.hs +0/−26
- Data/Digest/SHA512.hs +0/−26
- Data/HMAC.hs +0/−118
- Data/LargeWord.hs +0/−147
- HMACTest.hs +0/−183
- QuickTest.hs +0/−62
- RSATest.hs +0/−139
- SHA1Test.hs +0/−35
- Setup.hs +0/−5
- SymmetricTest.hs +0/−232
- WordListTest.hs +0/−43
- src-test/HMACTest.hs +183/−0
- src-test/QuickTest.hs +75/−0
- src-test/RSATest.hs +140/−0
- src-test/SHA1Test.hs +38/−0
- src-test/SHA2Test.hs +58/−0
- src-test/SymmetricTest.hs +233/−0
- src-test/WordListTest.hs +60/−0
- src/Codec/Binary/BubbleBabble.hs +40/−0
- src/Codec/Encryption/AES.hs +62/−0
- src/Codec/Encryption/AESAux.hs +1008/−0
- src/Codec/Encryption/Blowfish.hs +57/−0
- src/Codec/Encryption/BlowfishAux.hs +282/−0
- src/Codec/Encryption/DES.hs +34/−0
- src/Codec/Encryption/DESAux.hs +179/−0
- src/Codec/Encryption/Modes.hs +60/−0
- src/Codec/Encryption/Padding.hs +107/−0
- src/Codec/Encryption/RSA.hs +78/−0
- src/Codec/Encryption/RSA/EMEOAEP.hs +94/−0
- src/Codec/Encryption/RSA/MGF.hs +31/−0
- src/Codec/Encryption/RSA/NumberTheory.hs +203/−0
- src/Codec/Encryption/TEA.hs +84/−0
- src/Codec/Text/Raw.hs +48/−0
- src/Codec/Utils.hs +132/−0
- src/Data/Digest/MD5.hs +40/−0
- src/Data/Digest/MD5Aux.hs +355/−0
- src/Data/Digest/SHA1.hs +136/−0
- src/Data/Digest/SHA2.hs +252/−0
- src/Data/Digest/SHA224.hs +26/−0
- src/Data/Digest/SHA256.hs +26/−0
- src/Data/Digest/SHA384.hs +26/−0
- src/Data/Digest/SHA512.hs +26/−0
- src/Data/HMAC.hs +118/−0
- src/Data/LargeWord.hs +146/−0
+ ChangeLog.md view
@@ -0,0 +1,18 @@+See also http://pvp.haskell.org/faq++### 4.2.5.2++- Compatibility fix for `base-4.12` which made `accumArray` stricter causing SHA-1's implementation to hang+- Modernize package description from the ancient cabal spec version 1.2 to version 2.2 and declare test executables as actual test-unit executables (and make them pass)+- Drop support for `base < 4.3` (i.e. GHC < 7.0)+- Reduce dependency footprint of main library by dropping the dependecies on the test specific `HUnit` and `QuickCheck` libraries; these are now only depended upon by the actual test suites+- Reduce compile warnings++### 4.2.5.1++- Compatibility fix for `base-4.6` (`Bits` class not implying `Num` anymore)++## 4.2.5++- Compatibility fix for `base-4.5` (`Num` class not implying `Show` anymore)+
− Codec/Binary/BubbleBabble.hs
@@ -1,41 +0,0 @@-module 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-
− Codec/Encryption/AES.hs
@@ -1,62 +0,0 @@-{-# 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-
− Codec/Encryption/AESAux.hs
@@ -1,1008 +0,0 @@--- | 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 - ] --} -
− Codec/Encryption/Blowfish.hs
@@ -1,58 +0,0 @@--------------------------------------------------------------------------------- |--- 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 --- <http://www.counterpane.com/vectors.txt>.--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
− Codec/Encryption/BlowfishAux.hs
@@ -1,282 +0,0 @@--- 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])
− Codec/Encryption/DES.hs
@@ -1,35 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>.-----------------------------------------------------------------------------------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
− Codec/Encryption/DESAux.hs
@@ -1,179 +0,0 @@-{-# 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-
− Codec/Encryption/Modes.hs
@@ -1,61 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://www.itl.nist.gov/fipspubs/fip81.htm> 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
− Codec/Encryption/Padding.hs
@@ -1,108 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://www.rsasecurity.com/rsalabs/pkcs/pkcs-5>)--- 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
− Codec/Encryption/RSA.hs
@@ -1,79 +0,0 @@--------------------------------------------------------------------------------- |--- 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--- (<http://www.electronconsulting.com/rsa-haskell>).------ 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 --- <http://www.rsasecurity.com/rsalabs/pkcs/pkcs-1/index.html> 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
− Codec/Encryption/RSA/EMEOAEP.hs
@@ -1,95 +0,0 @@--------------------------------------------------------------------------------- |--- 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--- (<http://www.electronconsulting.com/rsa-haskell>).------ 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 --- <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf> 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'
− Codec/Encryption/RSA/MGF.hs
@@ -1,32 +0,0 @@--------------------------------------------------------------------------------- |--- 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:--- <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf>-----------------------------------------------------------------------------------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)
− Codec/Encryption/RSA/NumberTheory.hs
@@ -1,203 +0,0 @@---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 (<it) primes))- where it = min 2000 a----returns greatest z where x^z | y-largestPower :: Integer -> 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 ) ) ]
− Codec/Encryption/TEA.hs
@@ -1,85 +0,0 @@--------------------------------------------------------------------------------- |--- 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;-}---}
− Codec/Text/Raw.hs
@@ -1,49 +0,0 @@--------------------------------------------------------------------------------- |--- 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
− Codec/Utils.hs
@@ -1,138 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf>--- 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.cabal view
@@ -1,106 +1,154 @@-Name: Crypto-Version: 4.2.5.1-License: OtherLicense-License-File: ReadMe.tex-Author: Dominic Steinitz-Maintainer: Caylee Hogg <caylee.hogg@gmail.com>-Copyright: Dominic Steinitz 2003 - 2007+cabal-version: 2.2+name: Crypto+version: 4.2.5.2+build-type: Simple -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+Copyright: © 2003-2007 Dominic Steinitz et al.+license: BSD-3-Clause AND GPL-2.0-or-later+license-file: ReadMe.tex -Build-Type: Simple-Cabal-Version: >= 1.2-Tested-With: GHC==6.8.2 GHC==6.10.1+author: Dominic Steinitz+maintainer: hvr@gnu.org -flag small_base- description: choose the new smaller, split-up base package.+category: Cryptography, Codec+synopsis: Common Cryptographic Algorithms in Pure Haskell+description:+ This packages provides many of the commonly used cryptographic algorithms, such as+ .+ * DES+ * Blowfish+ * AES+ * TEA+ * SHA-1+ * SHA-2 (SHA-224, SHA-256, SHA-384, SHA-512)+ * MD5+ * RSA+ * PKCS#5 Padding+ * HMAC+ * Ciper Block Chaining (CBC) mode+ .+ Moreover, this package also provides an implementation of the /Bubble Babble Binary Data Encoding/ <http://web.mit.edu/kenta/www/one/bubblebabble/spec/jrtrjwzi/draft-huima-01.txt specification> and miscellaneous utilties.+ .+ The library in this package is implemented in pure <https://www.haskell.org/onlinereport/haskell2010/ Haskell2010> (plus currently the @FlexibleInstances@ and @TypeSynonymInstances@ extensions) and thus should be fairly portable. However, it shouldn't be expected to be the most performant possible Haskell cryptographic library; for instance, for optimized implementations of Hash algorithms, see the <https://hackage.haskell.org/package/cryptohash-sha512 cryptohash-* family>. -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+extra-source-files: ChangeLog.md -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+tested-with: GHC ==7.0.1, GHC ==7.0.4, GHC ==7.2.2, GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC ==8.4.4, GHC ==8.6.5, GHC ==8.8.4, GHC ==8.10.4, GHC ==9.0.2, GHC ==9.2.2, GHC ==9.4.4 -Executable SHA1Test- Main-Is: SHA1Test.hs- Ghc-options: -fregs-graph- Other-modules: Codec.Text.Raw- Data.Digest.SHA1+------------------+-- main library --+------------------ -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+common defaults+ default-language: Haskell2010+ other-extensions: FlexibleInstances, TypeSynonymInstances -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+ -- NB: 'pretty' is needed by the "Codec.Text.Raw" API+ build-depends:+ , base >= 4.3 && < 4.18+ , pretty ^>= 1.0.1 || ^>= 1.1.0 -Executable HMACTest- Main-Is: HMACTest.hs- Other-modules: Codec.Utils- Data.HMAC+ ghc-options: -fregs-graph -Executable WordListTest- Main-Is: WordListTest.hs- Other-modules: Data.LargeWord+ -- silence deprecation warnings for Haskell2010 compliant 'bitSize' method+ -- as well as all the missing typeclass methods warnings+ ghc-options: -fno-warn-deprecations -fno-warn-missing-methods++library+ import: defaults++ hs-source-dirs: src++ 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++ other-modules:+ Codec.Encryption.BlowfishAux+ Codec.Encryption.DESAux+ Codec.Encryption.AESAux+ Data.Digest.MD5Aux++ -- NB: 'random' is currently /only/ used by the 'getPrime' operation+ build-depends:+ , array ^>= 0.3.0 || ^>= 0.4.0 || ^>= 0.5.0+ , random ^>= 1.0 || ^>= 1.1 || ^>= 1.2++-----------------+-- test suites --+-----------------++common test-defaults+ import: defaults++ hs-source-dirs: src-test++ -- depend on main library+ build-depends: Crypto++ build-depends:+ , QuickCheck ^>= 2.14.2+ , HUnit ^>= 1.6.2+++test-suite SymmetricTest+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: SymmetricTest.hs++test-suite SHA1Test+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: SHA1Test.hs++test-suite SHA2Test+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: SHA2Test.hs++test-suite RSATest+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: RSATest.hs++test-suite QuickTest+ import: test-defaults+ type: exitcode-stdio-1.0++ main-is: QuickTest.hs++test-suite HMACTest+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: HMACTest.hs++test-suite WordListTest+ import: test-defaults+ type: exitcode-stdio-1.0++ Main-Is: WordListTest.hs
− CryptoHomePage.html
@@ -1,51 +0,0 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">-<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">-<head>-<meta http-equiv="Content-Type" content="text/html;charset=us-ascii" />-<title>The Haskell Cryptographic Library</title>-</head>-<body>- <h2>The Haskell Cryptographic Library</h2>-- <p>The Haskell Cryptographic Library collects together existing Haskell- cryptographic functions into one cabalized package, with- <a href="http://hunit.sourceforge.net/">HUnit</a> tests,- <a href="http://haskell.org/haskellwiki/Quickcheck">QuickCheck</a>- properties, examples showing how to interwork with- other cryptographic implementations and examples showing how to- handle other- <a href="http://en.wikipedia.org/wiki/Abstract_syntax_notation_one">ASN.1</a>- definitions.</p>-- <h2>Downloading</h2>- <p>Stable releases of Crypto can be found in the Hackage package database:</p>-- <ul><li><a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Crypto">Hackage download</a></li></ul>-- <p>For the latest version, you can use the development repository. You can download it:<br/></p>-- <ul><li>darcs get- <a href="http://darcs.haskell.org/crypto">http://darcs.haskell.org/crypto</a></li></ul>-- <h2>Resources</h2>- <ul>- <li><a href="http://www.haskell.org/crypto/ReadMe.pdf">User guide</a></li>- <li><a href="http://www.haskell.org/crypto/doc/html">Haddock documentation</a></li>- </ul>-- <h2>Contact</h2>-- <p>All questions, comments, bug reports, flames,- requests for updates / changes- and suggestions should be directed to - <script language="JavaScript">- <!--- var name = "dominic.steinitz"- var domain = "blueyonder.co.uk"- document.write("<a href='mailto:" + name + "@" + domain + "'>")- document.write(name + "@" + domain)- document.write("</a>")- //-->- </script>.</p>-</body> </html>
− Data/Digest/MD5.hs
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>--- and <http://www.ietf.org/rfc/rfc1321.txt>.-----------------------------------------------------------------------------------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:[])
− Data/Digest/MD5Aux.hs
@@ -1,355 +0,0 @@-module 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-
− Data/Digest/SHA1.hs
@@ -1,120 +0,0 @@-{-# 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 <http://www.itl.nist.gov/fipspubs/fip180-1.htm> 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
− Data/Digest/SHA2.hs
@@ -1,285 +0,0 @@-{-# 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--- <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.-----------------------------------------------------------------------------------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_sha2
− Data/Digest/SHA224.hs
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.-----------------------------------------------------------------------------------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.sha224
− Data/Digest/SHA256.hs
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.-----------------------------------------------------------------------------------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.sha256
− Data/Digest/SHA384.hs
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.-----------------------------------------------------------------------------------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.sha384
− Data/Digest/SHA512.hs
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.-----------------------------------------------------------------------------------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.sha512
− Data/HMAC.hs
@@ -1,118 +0,0 @@--------------------------------------------------------------------------------- |--- 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--- <http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>.-----------------------------------------------------------------------------------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))
− Data/LargeWord.hs
@@ -1,147 +0,0 @@--------------------------------------------------------------------------------- |--- 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
− HMACTest.hs
@@ -1,183 +0,0 @@-module Main(main) where--import Data.HMAC-import Test.HUnit-import Codec.Utils (Octet)-import Data.Char(ord)---- HMAC-SHA1 tests from--- <http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>---- HMAC-MD5 tests from--- <http://www.ietf.org/rfc/rfc2104.txt>---- 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-
− QuickTest.hs
@@ -1,62 +0,0 @@-{-# 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
− RSATest.hs
@@ -1,139 +0,0 @@-module 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
− SHA1Test.hs
@@ -1,35 +0,0 @@-import 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'--
− Setup.hs
@@ -1,5 +0,0 @@-module Main where-import Distribution.Simple--main :: IO ()-main = defaultMain
− SymmetricTest.hs
@@ -1,232 +0,0 @@-module 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
− WordListTest.hs
@@ -1,43 +0,0 @@-{-# 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
+ src-test/HMACTest.hs view
@@ -0,0 +1,183 @@+module Main(main) where++import Data.HMAC+import Test.HUnit+import Codec.Utils (Octet)+import Data.Char(ord)++-- HMAC-SHA1 tests from+-- <http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>++-- HMAC-MD5 tests from+-- <http://www.ietf.org/rfc/rfc2104.txt>++-- 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 :: IO ()+main = runTestTTAndExit tests
+ src-test/QuickTest.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Main(main) where++import Codec.Encryption.AES as AES+import Codec.Encryption.Blowfish as Blowfish+import Codec.Encryption.Modes+import Codec.Encryption.Padding+import Codec.Utils+import Control.Monad (unless)+import Data.Bits+import Data.Char+import Data.LargeWord+import Data.Word+import Numeric+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 :: IO ()+main = do+ results <- sequence+ [ quickCheckWithResult args prop_decryptEncrypt+ , quickCheckWithResult args prop_AESIdempotent+ , quickCheckWithResult args prop_unCbcCbc+ , quickCheckWithResult args prop_unPkcs5Pkcs5+ , quickCheckWithResult args prop_unNullsNulls+ , quickCheckWithResult args prop_fromOctetsToOctets+ , quickCheckWithResult args prop_unTwosCompTwosComp+ ]++ unless (all isSuccess results) $ do+ fail "SOME TESTS FAILED!"++ putStrLn "=> all tests passed!"+ where+ args = stdArgs { maxSuccess = 500 }
+ src-test/RSATest.hs view
@@ -0,0 +1,140 @@+module 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 :: IO ()+main = runTestTTAndExit tests
+ src-test/SHA1Test.hs view
@@ -0,0 +1,38 @@+module Main(main) where++import Codec.Text.Raw (hexdumpBy)+import Codec.Utils (toOctets)+import Data.Char (ord)+import Data.Digest.SHA1 (Word160 (Word160), hash)+import Test.HUnit (runTestTTAndExit, (~:), (~=?))+import Text.PrettyPrint (render)++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' :: [([Word8], String)] -> Test+genTests' cases =+ "SHA1" ~: map f cases+ where f (val, dgst) = dgst ~=? hexHash' val++-- hexHash' :: [Word8] -> String+hexHash' x =+ let (Word160 a b c d e) = hash x in+ render . (hexdumpBy "" 20) . concatMap (toOctets 256) $ [a,b,c,d,e]++main :: IO ()+main = runTestTTAndExit $ genTests' testCases'
+ src-test/SHA2Test.hs view
@@ -0,0 +1,58 @@+-- Copyright : (c) Russell O'Connor 2006+-- License : BSD-style (see the file ReadMe.tex)++module Main(main) where++import Data.Digest.SHA2+import Test.HUnit (runTestTTAndExit, test, (~:), (~?=))++-----------------------------------------------------------------------------+-- ** 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+ [toOctets (sha256Ascii "abc") ~?=+ [0xba,0x78,0x16,0xbf,0x8f,0x01,0xcf,0xea,0x41,0x41,0x40,0xde,0x5d,0xae,0x22,0x23,0xb0,0x03,0x61,0xa3,0x96,0x17,0x7a,0x9c,0xb4,0x10,0xff,0x61,0xf2,0x00,0x15,0xad]+ ,toOctets (sha256Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") ~?=+ [0x24,0x8d,0x6a,0x61,0xd2,0x06,0x38,0xb8,0xe5,0xc0,0x26,0x93,0x0c,0x3e,0x60,0x39,0xa3,0x3c,0xe4,0x59,0x64,0xff,0x21,0x67,0xf6,0xec,0xed,0xd4,0x19,0xdb,0x06,0xc1]+ ,toOctets (sha256Ascii (replicate 1000000 'a')) ~?=+ [0xcd,0xc7,0x6e,0x5c,0x99,0x14,0xfb,0x92,0x81,0xa1,0xc7,0xe2,0x84,0xd7,0x3e,0x67,0xf1,0x80,0x9a,0x48,0xa4,0x97,0x20,0x0e,0x04,0x6d,0x39,0xcc,0xc7,0x11,0x2c,0xd0]+ ]++test_sha512 = "SHA-512" ~: test+ [toOctets (sha512Ascii "abc") ~?=+ [0xdd,0xaf,0x35,0xa1,0x93,0x61,0x7a,0xba,0xcc,0x41,0x73,0x49,0xae,0x20,0x41,0x31,0x12,0xe6,0xfa,0x4e,0x89,0xa9,0x7e,0xa2,0x0a,0x9e,0xee,0xe6,0x4b,0x55,0xd3,0x9a,0x21,0x92,0x99,0x2a,0x27,0x4f,0xc1,0xa8,0x36,0xba,0x3c,0x23,0xa3,0xfe,0xeb,0xbd,0x45,0x4d,0x44,0x23,0x64,0x3c,0xe8,0x0e,0x2a,0x9a,0xc9,0x4f,0xa5,0x4c,0xa4,0x9f]+ ,toOctets (sha512Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"+++ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu")) ~?=+ [0x8e,0x95,0x9b,0x75,0xda,0xe3,0x13,0xda,0x8c,0xf4,0xf7,0x28,0x14,0xfc,0x14,0x3f,0x8f,0x77,0x79,0xc6,0xeb,0x9f,0x7f,0xa1,0x72,0x99,0xae,0xad,0xb6,0x88,0x90,0x18,0x50,0x1d,0x28,0x9e,0x49,0x00,0xf7,0xe4,0x33,0x1b,0x99,0xde,0xc4,0xb5,0x43,0x3a,0xc7,0xd3,0x29,0xee,0xb6,0xdd,0x26,0x54,0x5e,0x96,0xe5,0x5b,0x87,0x4b,0xe9,0x09]+ ,toOctets (sha512Ascii (replicate 1000000 'a')) ~?=+ [0xe7,0x18,0x48,0x3d,0x0c,0xe7,0x69,0x64,0x4e,0x2e,0x42,0xc7,0xbc,0x15,0xb4,0x63,0x8e,0x1f,0x98,0xb1,0x3b,0x20,0x44,0x28,0x56,0x32,0xa8,0x03,0xaf,0xa9,0x73,0xeb,0xde,0x0f,0xf2,0x44,0x87,0x7e,0xa6,0x0a,0x4c,0xb0,0x43,0x2c,0xe5,0x77,0xc3,0x1b,0xeb,0x00,0x9c,0x5c,0x2c,0x49,0xaa,0x2e,0x4e,0xad,0xb2,0x17,0xad,0x8c,0xc0,0x9b]+ ]++test_sha384 = "SHA-384" ~: test+ [toOctets (sha384Ascii "abc") ~?=+ [0xcb,0x00,0x75,0x3f,0x45,0xa3,0x5e,0x8b,0xb5,0xa0,0x3d,0x69,0x9a,0xc6,0x50,0x07,0x27,0x2c,0x32,0xab,0x0e,0xde,0xd1,0x63,0x1a,0x8b,0x60,0x5a,0x43,0xff,0x5b,0xed,0x80,0x86,0x07,0x2b,0xa1,0xe7,0xcc,0x23,0x58,0xba,0xec,0xa1,0x34,0xc8,0x25,0xa7]+ ,toOctets (sha384Ascii ("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"+++ "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu")) ~?=+ [0x09,0x33,0x0c,0x33,0xf7,0x11,0x47,0xe8,0x3d,0x19,0x2f,0xc7,0x82,0xcd,0x1b,0x47,0x53,0x11,0x1b,0x17,0x3b,0x3b,0x05,0xd2,0x2f,0xa0,0x80,0x86,0xe3,0xb0,0xf7,0x12,0xfc,0xc7,0xc7,0x1a,0x55,0x7e,0x2d,0xb9,0x66,0xc3,0xe9,0xfa,0x91,0x74,0x60,0x39]+ ,toOctets (sha384Ascii (replicate 1000000 'a')) ~?=+ [0x9d,0x0e,0x18,0x09,0x71,0x64,0x74,0xcb,0x08,0x6e,0x83,0x4e,0x31,0x0a,0x4a,0x1c,0xed,0x14,0x9e,0x9c,0x00,0xf2,0x48,0x52,0x79,0x72,0xce,0xc5,0x70,0x4c,0x2a,0x5b,0x07,0xb8,0xb3,0xdc,0x38,0xec,0xc4,0xeb,0xae,0x97,0xdd,0xd8,0x7f,0x3d,0x89,0x85]+ ]++test_sha224 = "SHA-224" ~: test+ [toOctets (sha224Ascii "abc") ~?=+ [0x23,0x09,0x7d,0x22,0x34,0x05,0xd8,0x22,0x86,0x42,0xa4,0x77,0xbd,0xa2,0x55,0xb3,0x2a,0xad,0xbc,0xe4,0xbd,0xa0,0xb3,0xf7,0xe3,0x6c,0x9d,0xa7]+ ,toOctets (sha224Ascii "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") ~?=+ [0x75,0x38,0x8b,0x16,0x51,0x27,0x76,0xcc,0x5d,0xba,0x5d,0xa1,0xfd,0x89,0x01,0x50,0xb0,0xc6,0x45,0x5c,0xb4,0xf5,0x8b,0x19,0x52,0x52,0x25,0x25]+ ,toOctets (sha224Ascii (replicate 1000000 'a')) ~?=+ [0x20,0x79,0x46,0x55,0x98,0x0c,0x91,0xd8,0xbb,0xb4,0xc1,0xea,0x97,0x61,0x8a,0x4b,0xf0,0x3f,0x42,0x58,0x19,0x48,0xb2,0xee,0x4e,0xe7,0xad,0x67]+ ]+++test_sha2 = "SHA-2" ~: test [test_sha256, test_sha512, test_sha384, test_sha224]++main :: IO ()+main = runTestTTAndExit test_sha2 >> return ()
+ src-test/SymmetricTest.hs view
@@ -0,0 +1,233 @@+module 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 :: IO ()+main = runTestTTAndExit tests
+ src-test/WordListTest.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Main(main) where++import Codec.Utils (listFromOctets, listToOctets)+import Control.Monad (unless)+import Data.Bits (Bits, bitSize)+import Data.LargeWord (Word128, Word160, Word192, Word224, Word256, Word96)+import Data.Word (Word32, Word64, Word8)+import Test.QuickCheck++newtype WordsX a = WordsX [a]++instance Show a => Show (WordsX a) where+ show (WordsX x) = show x++instance (Bounded a, Integral a, Bits a) => Arbitrary (WordsX a) where+ arbitrary = fmap WordsX (liftArbitrary $ chooseBoundedIntegral (minBound,maxBound))++checks :: [(String, IO Result)]+checks =+ [ ("Word32", quickCheckWithResult args $+ \w -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word32]))+ , ("Word64", quickCheckWithResult args $+ \w -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word64]))+ , ("Word96", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word96]))+ , ("Word128", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word128]))+ , ("Word160", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word160]))+ , ("Word192", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word192]))+ , ("Word224", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word224]))+ , ("Word256", quickCheckWithResult args $+ \(WordsX w) -> not (hasTrailingZero w) ==> (listFromOctets . listToOctets) w === (w :: [Word256]))+ ]+ where+ args = stdArgs { maxSuccess = 1000 }++ -- (listFromOctets . listToOctets) isn't a proper identity due to 'trimNulls'+ hasTrailingZero :: (Eq x, Num x) => [x] -> Bool+ hasTrailingZero [] = False+ hasTrailingZero xs = last xs == 0++main :: IO ()+main = do+ results <- mapM test checks++ unless (all isSuccess results) $+ fail "SOME TESTS FAILED!"++ putStrLn "=> all tests passed!"+ where+ test :: (String, IO a) -> IO a+ test (s, t) = do putStrLn $ "Checking " ++ s+ putStr " "+ t
+ src/Codec/Binary/BubbleBabble.hs view
@@ -0,0 +1,40 @@+module 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 also <http://web.mit.edu/kenta/www/one/bubblebabble/spec/jrtrjwzi/draft-huima-01.txt "The Bubble Babble Binary Data Encoding" specification> for more details.++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+
+ src/Codec/Encryption/AES.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.AES+-- Copyright : (c) Dominic Steinitz 2004+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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 Codec.Utils+import Data.Bits+import Data.LargeWord+import Data.Word++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
+ src/Codec/Encryption/AESAux.hs view
@@ -0,0 +1,1008 @@+-- | 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+ ]+-}+
+ src/Codec/Encryption/Blowfish.hs view
@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+-- |+-- Module : Coded.Encryption.Blowfish+-- Copyright : (c) Dominic Steinitz 2003+-- License : BSD-style (see the file ReadMe.tex)+-- +-- 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 +-- <http://www.counterpane.com/vectors.txt>.++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
+ src/Codec/Encryption/BlowfishAux.hs view
@@ -0,0 +1,282 @@+-- 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])
+ src/Codec/Encryption/DES.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.DES+-- Copyright : (c) Dominic Steinitz 2003+-- License : BSD-style (see the file ReadMe.tex)+-- +-- Stability : experimental+-- Portability : portable+--+-- Takes the DES module supplied by Ian Lynagh and wraps it so it can+-- used with the standard modes.+--+-- See <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>.+--+-----------------------------------------------------------------------------++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
+ src/Codec/Encryption/DESAux.hs view
@@ -0,0 +1,179 @@+{-# 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+
+ src/Codec/Encryption/Modes.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.Modes+-- Copyright : (c) Dominic Steinitz 2001-2003+-- License : BSD-style (see the file ReadMe.tex)+--+-- Stability : experimental+-- Portability : portable+--+-- This module currently supports Cipher Block Chaining (CBC) mode.+-- See <http://www.itl.nist.gov/fipspubs/fip81.htm> 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
+ src/Codec/Encryption/Padding.hs view
@@ -0,0 +1,107 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.Padding+-- Copyright : (c) Dominic Steinitz 2003+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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 <http://www.rsasecurity.com/rsalabs/pkcs/pkcs-5>)+-- 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
+ src/Codec/Encryption/RSA.hs view
@@ -0,0 +1,78 @@+-----------------------------------------------------------------------------+-- |+-- Module : Coded.Encryption.RSA+-- Copyright : (c) David J. Sankel 2003, Dominic Steinitz 2003+-- License : GPL (see the file ReadMe.tex)+--+-- Stability : experimental+-- Portability : non-portable+--+-- A modified version of the RSA module supplied by David J. Sankel+-- (<http://www.electronconsulting.com/rsa-haskell>).+--+-- 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 +-- <http://www.rsasecurity.com/rsalabs/pkcs/pkcs-1/index.html> 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
+ src/Codec/Encryption/RSA/EMEOAEP.hs view
@@ -0,0 +1,94 @@+-----------------------------------------------------------------------------+-- |+-- Module : Coded.Encryption.RSA.EMEOAEP+-- Copyright : (c) David J. Sankel 2003, Dominic Steinitz 2003+-- License : GPL (see the file ReadMe.tex)+--+-- Stability : experimental+-- Portability : non-portable+--+-- A modified version of the EMEOAEP module supplied by David J. Sankel+-- (<http://www.electronconsulting.com/rsa-haskell>).+--+-- 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+-- <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf> 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'
+ src/Codec/Encryption/RSA/MGF.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.RSA.MGF+-- Copyright : (c) Dominic Steinitz 2003+-- License : BSD-style (see the file libraries/base/LICENSE)+--+-- Stability : experimental+-- Portability : portable+--+-- Implements the mask generation function as specified in:+-- <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf>+--+-----------------------------------------------------------------------------++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)
+ src/Codec/Encryption/RSA/NumberTheory.hs view
@@ -0,0 +1,203 @@+--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 (<it) primes))+ where it = min 2000 a++--returns greatest z where x^z | y+largestPower :: Integer -> 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 ) ) ]
+ src/Codec/Encryption/TEA.hs view
@@ -0,0 +1,84 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Encryption.TEA+-- Copyright : (c) John Meacham 2008+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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;+}++-}
+ src/Codec/Text/Raw.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module : Coded.Text.Raw+-- Copyright : (c) Dominic Steinitz 2006+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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
+ src/Codec/Utils.hs view
@@ -0,0 +1,132 @@+-----------------------------------------------------------------------------+-- |+-- Module : Codec.Utils+-- Copyright : (c) Dominic Steinitz 2003+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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 @x@ 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 8-bit 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 <ftp://ftp.rsasecurity.com/pub/pkcs/pkcs-1/pkcs-1v2-1.pdf>+-- 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
+ src/Data/Digest/MD5.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Digest.MD5+-- Copyright : (c) Dominic Steinitz 2004+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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 <http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/>+-- and <http://www.ietf.org/rfc/rfc1321.txt>.+--+-----------------------------------------------------------------------------++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:[])
+ src/Data/Digest/MD5Aux.hs view
@@ -0,0 +1,355 @@+module 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+
+ src/Data/Digest/SHA1.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -funbox-strict-fields #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Digest.SHA1+-- Copyright : (c) Dominic Steinitz 2007+-- License : BSD-style (see the file ReadMe.tex)+--+-- Stability : experimental+-- Portability : portable+--+-- Take [Word8] and return Word160.+-- See <http://www.itl.nist.gov/fipspubs/fip180-1.htm> 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 (Array, array, elems, (!))+import Codec.Utils (i2osp)+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' as defined in FIPS 180-4 section 4.1.1 "SHA-1 Functions"+f :: Int -> Word32 -> Word32 -> Word32 -> Word32+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' as defined in FIPS 180-4 section 4.2.1 "SHA-1 Constants"+k :: Int -> Word32+k n+ | n <= 19 = 0x5a827999+ | n <= 39 = 0x6ed9eba1+ | n <= 59 = 0x8f1bbcdc+ | n <= 79 = 0xca62c1d6++data AccAndWord160 = AccAndWord160 !Int !Word160++-- FIPS-180-4 section 6.1.2 "SHA-1 Hash Computation"+oneBlock :: Word160 -> [Word32] {- Word512 -} -> Word160+oneBlock ss xs = tt+ where+ -- message schedule $W_t$+ w :: Array Int Word32+ w = array (0,79) $ zip [0..15] xs ++ [(i, rotL 1 (xxor i)) | i <- [16..79] ]+ where+ xxor i = w ! (i-3) `xor` w ! (i-8) `xor` w ! (i-14) `xor` w ! (i-16)++ -- step 3+ g (AccAndWord160 n (Word160 a b c d e)) w =+ AccAndWord160 (n+1) $ Word160 {- a' = -} ((rotL 5 a) + (f n b c d) + e + w + (k n))+ {- b' = -} a+ {- c' = -} (rotL 30 b)+ {- d' = -} c+ {- e' = -} d++ (AccAndWord160 _ tt) = foldl' g (AccAndWord160 0 ss) (elems w)++-- initial hash value $H^{(0)}$ as defined in FIPS-180-4 section 5.3.1+ss :: Word160+ss = Word160 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0++-- FIPS-180-4 section 5.1.1+pad :: [Word8] -> [Word8]+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++-- step 4 of FIPS-180-4 section 6.1.2 SHA-1 Hash Computation+hashOnce :: Word160 -> [Word32] -> Word160+hashOnce ss a = lift2 (+) ss (oneBlock ss a)++hash :: [Word8] -> Word160+hash = foldl' hashOnce ss . blockWord32sIn512
+ src/Data/Digest/SHA2.hs view
@@ -0,0 +1,252 @@+{-# 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+-- <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.+--+-----------------------------------------------------------------------------++module Data.Digest.SHA2+ ( -- * SHA-224+ sha224, sha224Ascii, Hash224+ -- * SHA-256+ , sha256, sha256Ascii, Hash256+ -- * SHA-384+ , sha384, sha384Ascii, Hash384+ -- * SHA-512+ , sha512, sha512Ascii, Hash512+ -- * Utilities+ , toOctets+ ) where++import Data.Word+import Data.Bits+import Data.List+import Numeric++ch :: Bits a => a -> a -> a -> a+ch x y z = (x .&. y) `xor` (complement x .&. z)++maj :: Bits a => a -> a -> a -> a+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++-----------------------------------------------------------------------------+-- | 'sha256Ascii' 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' assumes that all characters of the strings are+-- ISO-latin-1 characters. ie. each characters fits in one octet.+-----------------------------------------------------------------------------+sha384Ascii :: String -> Hash384+sha384Ascii = sha384 . stringToOctets++-----------------------------------------------------------------------------+-- | 'sha512Ascii' assumes that all characters of the strings are+-- ISO-latin-1 characters. ie. each characters fits in one octet.+-----------------------------------------------------------------------------+sha512Ascii :: String -> Hash512+sha512Ascii = sha512 . stringToOctets++-----------------------------------------------------------------------------+-- | 'sha224Ascii' assumes that all characters of the strings are+-- ISO-latin-1 characters. ie. each characters fits in one octet.+-----------------------------------------------------------------------------+sha224Ascii :: String -> Hash224+sha224Ascii = sha224 . stringToOctets
+ src/Data/Digest/SHA224.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.+--+-----------------------------------------------------------------------------++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.sha224
+ src/Data/Digest/SHA256.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.+--+-----------------------------------------------------------------------------++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.sha256
+ src/Data/Digest/SHA384.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.+--+-----------------------------------------------------------------------------++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.sha384
+ src/Data/Digest/SHA512.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- 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 <http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>.+--+-----------------------------------------------------------------------------++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.sha512
+ src/Data/HMAC.hs view
@@ -0,0 +1,118 @@+-----------------------------------------------------------------------------+-- |+-- 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+-- <http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>.+--+-----------------------------------------------------------------------------++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))
+ src/Data/LargeWord.hs view
@@ -0,0 +1,146 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.LargeWord+-- Copyright : (c) Dominic Steinitz 2004+-- License : BSD-style (see the file ReadMe.tex)+--+-- 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