crypton 1.0.1 → 1.0.2

raw patch · 200 files changed

+20248/−11758 lines, 200 filesdep ~basesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• Crypto/Cipher/AES.hs +17/−17
• Crypto/Cipher/AES/Primitive.hs +349/−237
• Crypto/Cipher/AESGCMSIV.hs +48/−42
• Crypto/Cipher/Blowfish.hs +14/−14
• Crypto/Cipher/Blowfish/Box.hs +282/−275
• Crypto/Cipher/Blowfish/Primitive.hs +150/−124
• Crypto/Cipher/CAST5.hs +12/−13
• Crypto/Cipher/CAST5/Primitive.hs +81/−64
• Crypto/Cipher/Camellia.hs +5/−6
• Crypto/Cipher/Camellia/Primitive.hs +177/−149
• Crypto/Cipher/ChaCha.hs +103/−71
• Crypto/Cipher/ChaChaPoly1305.hs +121/−82
• Crypto/Cipher/DES.hs +15/−15
• Crypto/Cipher/DES/Primitive.hs +450/−103
• Crypto/Cipher/RC4.hs +58/−37
• Crypto/Cipher/Salsa.hs +59/−40
• Crypto/Cipher/TripleDES.hs +32/−28
• Crypto/Cipher/Twofish.hs +17/−14
• Crypto/Cipher/Twofish/Primitive.hs +398/−185
• Crypto/Cipher/Types.hs +23/−21
• Crypto/Cipher/Types/AEAD.hs +45/−32
• Crypto/Cipher/Types/Base.hs +34/−28
• Crypto/Cipher/Types/Block.hs +148/−108
• Crypto/Cipher/Types/GF.hs +23/−22
• Crypto/Cipher/Types/Stream.hs +3/−4
• Crypto/Cipher/Types/Utils.hs +7/−6
• Crypto/Cipher/Utils.hs +16/−13
• Crypto/Cipher/XSalsa.hs +48/−34
• Crypto/ConstructHash/MiyaguchiPreneel.hs +38/−30
• Crypto/Data/AFIS.hs +107/−86
• Crypto/Data/Padding.hs +33/−31
• Crypto/ECC.hs +165/−104
• Crypto/ECC/Edwards25519.hs +133/−113
• Crypto/ECC/Simple/Prim.hs +68/−60
• Crypto/ECC/Simple/Types.hs +559/−382
• Crypto/Error.hs +3/−4
• Crypto/Error/Types.hs +34/−35
• Crypto/Hash.hs +89/−67
• Crypto/Hash/Algorithms.hs +72/−70
• Crypto/Hash/Blake2.hs +124/−83
• Crypto/Hash/Blake2b.hs +56/−54
• Crypto/Hash/Blake2bp.hs +20/−22
• Crypto/Hash/Blake2s.hs +38/−38
• Crypto/Hash/Blake2sp.hs +29/−30
• Crypto/Hash/IO.hs +32/−23
• Crypto/Hash/Keccak.hs +47/−46
• Crypto/Hash/MD2.hs +19/−19
• Crypto/Hash/MD4.hs +19/−19
• Crypto/Hash/MD5.hs +21/−20
• Crypto/Hash/RIPEMD160.hs +19/−19
• Crypto/Hash/SHA1.hs +21/−20
• Crypto/Hash/SHA224.hs +21/−20
• Crypto/Hash/SHA256.hs +21/−20
• Crypto/Hash/SHA3.hs +47/−46
• Crypto/Hash/SHA384.hs +21/−20
• Crypto/Hash/SHA512.hs +21/−20
• Crypto/Hash/SHA512t.hs +29/−30
• Crypto/Hash/SHAKE.hs +50/−45
• Crypto/Hash/Skein256.hs +29/−30
• Crypto/Hash/Skein512.hs +47/−46
• Crypto/Hash/Tiger.hs +19/−19
• Crypto/Hash/Types.hs +56/−45
• Crypto/Hash/Whirlpool.hs +19/−19
• Crypto/Internal/Builder.hs +18/−17
• Crypto/Internal/ByteArray.hs +12/−12
• Crypto/Internal/Compat.hs +9/−9
• Crypto/Internal/CompatPrim.hs +18/−14
• Crypto/Internal/DeepSeq.hs +5/−5
• Crypto/Internal/Imports.hs +9/−9
• Crypto/Internal/WordArray.hs +46/−46
• Crypto/Internal/Words.hs +6/−7
• Crypto/KDF/Argon2.hs +85/−72
• Crypto/KDF/BCrypt.hs +112/−65
• Crypto/KDF/BCryptPBKDF.hs +133/−123
• Crypto/KDF/HKDF.hs +60/−39
• Crypto/KDF/PBKDF2.hs +133/−102
• Crypto/KDF/Scrypt.hs +49/−33
• Crypto/MAC/CMAC.hs +83/−56
• Crypto/MAC/HMAC.hs +95/−73
• Crypto/MAC/KMAC.hs +56/−44
• Crypto/MAC/KeyedBlake2.hs +39/−35
• Crypto/MAC/Poly1305.hs +48/−38
• Crypto/Number/Basic.hs +86/−65
• Crypto/Number/Compat.hs +29/−27
• Crypto/Number/F2m.hs +142/−81
• Crypto/Number/Generate.hs +102/−68
• Crypto/Number/ModArithmetic.hs +90/−70
• Crypto/Number/Nat.hs +24/−20
• Crypto/Number/Prime.hs +506/−117
• Crypto/Number/Serialize.hs +19/−17
• Crypto/Number/Serialize/Internal.hs +27/−26
• Crypto/Number/Serialize/Internal/LE.hs +27/−25
• Crypto/Number/Serialize/LE.hs +19/−17
• Crypto/OTP.hs +43/−39
• Crypto/PubKey/Curve25519.hs +71/−54
• Crypto/PubKey/Curve448.hs +64/−46
• Crypto/PubKey/DH.hs +28/−23
• Crypto/PubKey/DSA.hs +90/−62
• Crypto/PubKey/ECC/DH.hs +24/−16
• Crypto/PubKey/ECC/ECDSA.hs +163/−63
• Crypto/PubKey/ECC/Generate.hs +15/−11
• Crypto/PubKey/ECC/P256.hs +122/−91
• Crypto/PubKey/ECC/Prim.hs +95/−57
• Crypto/PubKey/ECC/Types.hs +536/−335
• Crypto/PubKey/ECDSA.hs +155/−112
• Crypto/PubKey/ECIES.hs +23/−17
• Crypto/PubKey/Ed25519.hs +76/−64
• Crypto/PubKey/Ed448.hs +82/−70
• Crypto/PubKey/EdDSA.hs +276/−199
• Crypto/PubKey/ElGamal.hs +99/−73
• Crypto/PubKey/Internal.hs +14/−13
• Crypto/PubKey/MaskGenFunction.hs +25/−20
• Crypto/PubKey/RSA.hs +58/−44
• Crypto/PubKey/RSA/OAEP.hs +132/−100
• Crypto/PubKey/RSA/PKCS15.hs +313/−86
• Crypto/PubKey/RSA/PSS.hs +182/−133
• Crypto/PubKey/RSA/Prim.hs +26/−23
• Crypto/PubKey/RSA/Types.hs +64/−41
• Crypto/PubKey/Rabin/Basic.hs +183/−126
• Crypto/PubKey/Rabin/Modified.hs +84/−59
• Crypto/PubKey/Rabin/OAEP.hs +88/−71
• Crypto/PubKey/Rabin/RW.hs +131/−95
• Crypto/PubKey/Rabin/Types.hs +34/−25
• Crypto/Random.hs +33/−28
• Crypto/Random/ChaChaDRG.hs +27/−17
• Crypto/Random/Entropy.hs +6/−7
• Crypto/Random/Entropy/RDRand.hs +15/−14
• Crypto/Random/Entropy/Source.hs +5/−4
• Crypto/Random/Entropy/Unix.hs +30/−27
• Crypto/Random/Entropy/Unsafe.hs +15/−14
• Crypto/Random/EntropyPool.hs +26/−26
• Crypto/Random/HmacDRG.hs +51/−0
• Crypto/Random/Probabilistic.hs +7/−8
• Crypto/Random/SystemDRG.hs +29/−28
• Crypto/Random/Types.hs +9/−11
• Crypto/System/CPU.hs +19/−16
• Crypto/Tutorial.hs +10/−10
• Setup.hs +1/−0
• benchs/Bench.hs +224/−170
• benchs/Number/F2m.hs +10/−10
• crypton.cabal +5/−9
• tests/BCrypt.hs +67/−38
• tests/BCryptPBKDF.hs +192/−55
• tests/BlockCipher.hs +330/−228
• tests/ChaCha.hs +77/−68
• tests/ChaChaPoly1305.hs +113/−69
• tests/ECC.hs +173/−117
• tests/ECC/Edwards25519.hs +160/−112
• tests/ECDSA.hs +104/−33
• tests/Hash.hs +434/−218
• tests/Imports.hs +10/−8
• tests/KAT_AES.hs +102/−71
• tests/KAT_AES/KATCBC.hs +434/−81
• tests/KAT_AES/KATCCM.hs +196/−146
• tests/KAT_AES/KATECB.hs +696/−124
• tests/KAT_AES/KATGCM.hs +84/−58
• tests/KAT_AES/KATOCB3.hs +56/−33
• tests/KAT_AES/KATXTS.hs +14/−5
• tests/KAT_AESGCMSIV.hs +486/−307
• tests/KAT_AFIS.hs +32/−21
• tests/KAT_Argon2.hs +30/−20
• tests/KAT_Blake2.hs +96/−59
• tests/KAT_Blowfish.hs +141/−37
• tests/KAT_CAST5.hs +16/−5
• tests/KAT_CMAC.hs +114/−107
• tests/KAT_Camellia.hs +226/−13
• tests/KAT_Curve25519.hs +39/−14
• tests/KAT_Curve448.hs +39/−14
• tests/KAT_DES.hs +144/−39
• tests/KAT_Ed25519.hs +56/−37
• tests/KAT_Ed448.hs +76/−47
• tests/KAT_EdDSA.hs +81/−48
• tests/KAT_HKDF.hs +359/−23
• tests/KAT_HMAC.hs +95/−44
• tests/KAT_KMAC.hs +73/−46
• tests/KAT_MiyaguchiPreneel.hs +31/−25
• tests/KAT_OTP.hs +58/−29
• tests/KAT_PBKDF2.hs +66/−41
• tests/KAT_PubKey.hs +29/−22
• tests/KAT_PubKey/DSA.hs +163/−91
• tests/KAT_PubKey/ECC.hs +154/−131
• tests/KAT_PubKey/ECDSA.hs +1636/−521
• tests/KAT_PubKey/OAEP.hs +107/−62
• tests/KAT_PubKey/P256.hs +139/−126
• tests/KAT_PubKey/PSS.hs +384/−241
• tests/KAT_PubKey/RSA.hs +93/−65
• tests/KAT_PubKey/Rabin.hs +172/−75
• tests/KAT_RC4.hs +25/−17
• tests/KAT_Scrypt.hs +17/−9
• tests/KAT_TripleDES.hs +5/−3
• tests/KAT_Twofish.hs +374/−31
• tests/Number.hs +100/−70
• tests/Number/F2m.hs +115/−99
• tests/Padding.hs +20/−12
• tests/Poly1305.hs +29/−17
• tests/Salsa.hs +110/−76
• tests/Tests.hs +78/−67
• tests/Utils.hs +69/−60
• tests/XSalsa.hs +150/−105

@@ -1,3 +1,16 @@+## 1.0.2++* Deterministic Nonce Generation for ECDSA+  [#46](https://github.com/kazu-yamamoto/crypton/pull/46)+* ECDSA Signature Normalization.+  [#45](https://github.com/kazu-yamamoto/crypton/pull/45)+* Add Full Test Suite from RFC 6979.+  [#44](https://github.com/kazu-yamamoto/crypton/pull/44)+* ECDSA with Public Key Recovery.+  [#43](https://github.com/kazu-yamamoto/crypton/pull/43)+* Providing necessary features for HPKE.+  [#42](https://github.com/kazu-yamamoto/crypton/pull/42)+ ## 1.0.1  * Update decaf library.

@@ -1,22 +1,23 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.AES -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good-{-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.AES-    ( AES128-    , AES192-    , AES256-    ) where+module Crypto.Cipher.AES (+    AES128,+    AES192,+    AES256,+) where -import Crypto.Error+import Crypto.Cipher.AES.Primitive import Crypto.Cipher.Types-import Crypto.Cipher.Utils import Crypto.Cipher.Types.Block-import Crypto.Cipher.AES.Primitive+import Crypto.Cipher.Utils+import Crypto.Error import Crypto.Internal.Imports  -- | AES with 128 bit key@@ -32,20 +33,19 @@     deriving (NFData)  instance Cipher AES128 where-    cipherName    _ = "AES128"+    cipherName _ = "AES128"     cipherKeySize _ = KeySizeFixed 16-    cipherInit k    = AES128 <$> (initAES =<< validateKeySize (undefined :: AES128) k)+    cipherInit k = AES128 <$> (initAES =<< validateKeySize (undefined :: AES128) k)  instance Cipher AES192 where-    cipherName    _ = "AES192"+    cipherName _ = "AES192"     cipherKeySize _ = KeySizeFixed 24-    cipherInit k    = AES192 <$> (initAES =<< validateKeySize (undefined :: AES192) k)+    cipherInit k = AES192 <$> (initAES =<< validateKeySize (undefined :: AES192) k)  instance Cipher AES256 where-    cipherName    _ = "AES256"+    cipherName _ = "AES256"     cipherKeySize _ = KeySizeFixed 32-    cipherInit k    = AES256 <$> (initAES =<< validateKeySize (undefined :: AES256) k)-+    cipherInit k = AES256 <$> (initAES =<< validateKeySize (undefined :: AES256) k)  #define INSTANCE_BLOCKCIPHER(CSTR) \ instance BlockCipher CSTR where \

@@ -1,75 +1,79 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ViewPatterns #-}+ -- | -- Module      : Crypto.Cipher.AES.Primitive -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good----module Crypto.Cipher.AES.Primitive-    (+module Crypto.Cipher.AES.Primitive (     -- * Block cipher data types-      AES+    AES,      -- * Authenticated encryption block cipher types-    , AESGCM-    , AESOCB+    AESGCM,+    AESOCB,      -- * Creation-    , initAES+    initAES,      -- * Miscellanea-    , genCTR-    , genCounter+    genCTR,+    genCounter,      -- * Encryption-    , encryptECB-    , encryptCBC-    , encryptCTR-    , encryptXTS+    encryptECB,+    encryptCBC,+    encryptCTR,+    encryptXTS,      -- * Decryption-    , decryptECB-    , decryptCBC-    , decryptCTR-    , decryptXTS+    decryptECB,+    decryptCBC,+    decryptCTR,+    decryptXTS,      -- * CTR with 32-bit wrapping-    , combineC32+    combineC32,      -- * Incremental GCM-    , gcmMode-    , gcmInit+    gcmMode,+    gcmInit,      -- * Incremental OCB-    , ocbMode-    , ocbInit+    ocbMode,+    ocbInit,      -- * CCM-    , ccmMode-    , ccmInit-    ) where+    ccmMode,+    ccmInit,+) where -import           Data.Word-import           Foreign.Ptr-import           Foreign.C.Types-import           Foreign.C.String+import Data.Word+import Foreign.C.String+import Foreign.C.Types+import Foreign.Ptr -import           Crypto.Error-import           Crypto.Cipher.Types-import           Crypto.Cipher.Types.Block (IV(..))-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes, withByteArray)+import Crypto.Cipher.Types+import Crypto.Cipher.Types.Block (IV (..))+import Crypto.Error+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    ScrubbedBytes,+    withByteArray,+ ) import qualified Crypto.Internal.ByteArray as B+import Crypto.Internal.Compat+import Crypto.Internal.Imports  instance Cipher AES where-    cipherName    _ = "AES"-    cipherKeySize _ = KeySizeEnum [16,24,32]-    cipherInit k    = initAES k+    cipherName _ = "AES"+    cipherKeySize _ = KeySizeEnum [16, 24, 32]+    cipherInit k = initAES k  instance BlockCipher AES where     blockSize _ = 16@@ -81,38 +85,40 @@     aeadInit AEAD_GCM aes iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv)     aeadInit AEAD_OCB aes iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv)     aeadInit (AEAD_CCM n m l) aes iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l-    aeadInit _        _   _  = CryptoFailed CryptoError_AEADModeNotSupported+    aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported instance BlockCipher128 AES where     xtsEncrypt = encryptXTS     xtsDecrypt = decryptXTS  -- | Create an AES AEAD implementation for GCM gcmMode :: AES -> AEADModeImpl AESGCM-gcmMode aes = AEADModeImpl-    { aeadImplAppendHeader = gcmAppendAAD-    , aeadImplEncrypt      = gcmAppendEncrypt aes-    , aeadImplDecrypt      = gcmAppendDecrypt aes-    , aeadImplFinalize     = gcmFinish aes-    }+gcmMode aes =+    AEADModeImpl+        { aeadImplAppendHeader = gcmAppendAAD+        , aeadImplEncrypt = gcmAppendEncrypt aes+        , aeadImplDecrypt = gcmAppendDecrypt aes+        , aeadImplFinalize = gcmFinish aes+        }  -- | Create an AES AEAD implementation for OCB ocbMode :: AES -> AEADModeImpl AESOCB-ocbMode aes = AEADModeImpl-    { aeadImplAppendHeader = ocbAppendAAD aes-    , aeadImplEncrypt      = ocbAppendEncrypt aes-    , aeadImplDecrypt      = ocbAppendDecrypt aes-    , aeadImplFinalize     = ocbFinish aes-    }+ocbMode aes =+    AEADModeImpl+        { aeadImplAppendHeader = ocbAppendAAD aes+        , aeadImplEncrypt = ocbAppendEncrypt aes+        , aeadImplDecrypt = ocbAppendDecrypt aes+        , aeadImplFinalize = ocbFinish aes+        }  -- | Create an AES AEAD implementation for CCM ccmMode :: AES -> AEADModeImpl AESCCM-ccmMode aes = AEADModeImpl-    { aeadImplAppendHeader = ccmAppendAAD aes-    , aeadImplEncrypt      = ccmEncrypt aes-    , aeadImplDecrypt      = ccmDecrypt aes-    , aeadImplFinalize     = ccmFinish aes-    }-+ccmMode aes =+    AEADModeImpl+        { aeadImplAppendHeader = ccmAppendAAD aes+        , aeadImplEncrypt = ccmEncrypt aes+        , aeadImplDecrypt = ccmDecrypt aes+        , aeadImplFinalize = ccmFinish aes+        }  -- | AES Context (pre-processed key) newtype AES = AES ScrubbedBytes@@ -145,42 +151,47 @@ ivToPtr :: ByteArrayAccess iv => iv -> (Ptr Word8 -> IO a) -> IO a ivToPtr iv f = withByteArray iv (f . castPtr) - ivCopyPtr :: IV AES -> (Ptr Word8 -> IO a) -> IO (a, IV AES)-ivCopyPtr (IV iv) f = (\(x,y) -> (x, IV y)) `fmap` copyAndModify iv f+ivCopyPtr (IV iv) f = (\(x, y) -> (x, IV y)) `fmap` copyAndModify iv f   where     copyAndModify :: ByteArray ba => ba -> (Ptr Word8 -> IO a) -> IO (a, ba)     copyAndModify ba f' = B.copyRet ba f' -withKeyAndIV :: ByteArrayAccess iv => AES -> iv -> (Ptr AES -> Ptr Word8 -> IO a) -> IO a+withKeyAndIV+    :: ByteArrayAccess iv => AES -> iv -> (Ptr AES -> Ptr Word8 -> IO a) -> IO a withKeyAndIV ctx iv f = keyToPtr ctx $ \kptr -> ivToPtr iv $ \ivp -> f kptr ivp -withKey2AndIV :: ByteArrayAccess iv => AES -> AES -> iv -> (Ptr AES -> Ptr AES -> Ptr Word8 -> IO a) -> IO a+withKey2AndIV+    :: ByteArrayAccess iv+    => AES -> AES -> iv -> (Ptr AES -> Ptr AES -> Ptr Word8 -> IO a) -> IO a withKey2AndIV key1 key2 iv f =     keyToPtr key1 $ \kptr1 -> keyToPtr key2 $ \kptr2 -> ivToPtr iv $ \ivp -> f kptr1 kptr2 ivp -withGCMKeyAndCopySt :: AES -> AESGCM -> (Ptr AESGCM -> Ptr AES -> IO a) -> IO (a, AESGCM)+withGCMKeyAndCopySt+    :: AES -> AESGCM -> (Ptr AESGCM -> Ptr AES -> IO a) -> IO (a, AESGCM) withGCMKeyAndCopySt aes (AESGCM gcmSt) f =     keyToPtr aes $ \aesPtr -> do         newSt <- B.copy gcmSt (\_ -> return ())-        a     <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr+        a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr         return (a, AESGCM newSt)  withNewGCMSt :: AESGCM -> (Ptr AESGCM -> IO ()) -> IO AESGCM withNewGCMSt (AESGCM gcmSt) f = B.copy gcmSt (f . castPtr) >>= \sm2 -> return (AESGCM sm2) -withOCBKeyAndCopySt :: AES -> AESOCB -> (Ptr AESOCB -> Ptr AES -> IO a) -> IO (a, AESOCB)+withOCBKeyAndCopySt+    :: AES -> AESOCB -> (Ptr AESOCB -> Ptr AES -> IO a) -> IO (a, AESOCB) withOCBKeyAndCopySt aes (AESOCB gcmSt) f =     keyToPtr aes $ \aesPtr -> do         newSt <- B.copy gcmSt (\_ -> return ())-        a     <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr+        a <- withByteArray newSt $ \gcmStPtr -> f (castPtr gcmStPtr) aesPtr         return (a, AESOCB newSt) -withCCMKeyAndCopySt :: AES -> AESCCM -> (Ptr AESCCM -> Ptr AES -> IO a) -> IO (a, AESCCM)+withCCMKeyAndCopySt+    :: AES -> AESCCM -> (Ptr AESCCM -> Ptr AES -> IO a) -> IO (a, AESCCM) withCCMKeyAndCopySt aes (AESCCM ccmSt) f =     keyToPtr aes $ \aesPtr -> do         newSt <- B.copy ccmSt (\_ -> return ())-        a     <- withByteArray newSt $ \ccmStPtr -> f (castPtr ccmStPtr) aesPtr+        a <- withByteArray newSt $ \ccmStPtr -> f (castPtr ccmStPtr) aesPtr         return (a, AESCCM newSt)  -- | Initialize a new context with a key@@ -192,10 +203,11 @@     | len == 24 = CryptoPassed $ initWithRounds 12     | len == 32 = CryptoPassed $ initWithRounds 14     | otherwise = CryptoFailed CryptoError_KeySizeInvalid-  where len = B.length k-        initWithRounds nbR = AES $ B.allocAndFreeze (16+2*2*16*nbR) aesInit-        aesInit ptr = withByteArray k $ \ikey ->-            c_aes_init (castPtr ptr) (castPtr ikey) (fromIntegral len)+  where+    len = B.length k+    initWithRounds nbR = AES $ B.allocAndFreeze (16 + 2 * 2 * 16 * nbR) aesInit+    aesInit ptr = withByteArray k $ \ikey ->+        c_aes_init (castPtr ptr) (castPtr ikey) (fromIntegral len)  -- | encrypt using Electronic Code Book (ECB) {-# NOINLINE encryptECB #-}@@ -204,11 +216,16 @@  -- | encrypt using Cipher Block Chaining (CBC) {-# NOINLINE encryptCBC #-}-encryptCBC :: ByteArray ba-           => AES        -- ^ AES Context-           -> IV AES     -- ^ Initial vector of AES block size-           -> ba         -- ^ plaintext-           -> ba         -- ^ ciphertext+encryptCBC+    :: ByteArray ba+    => AES+    -- ^ AES Context+    -> IV AES+    -- ^ Initial vector of AES block size+    -> ba+    -- ^ plaintext+    -> ba+    -- ^ ciphertext encryptCBC = doCBC c_aes_encrypt_cbc  -- | generate a counter mode pad. this is generally xor-ed to an input@@ -218,17 +235,22 @@ -- more data will be returned, so that the returned bytearray is -- a multiple of the block cipher size. {-# NOINLINE genCTR #-}-genCTR :: ByteArray ba-       => AES    -- ^ Cipher Key.-       -> IV AES -- ^ usually a 128 bit integer.-       -> Int    -- ^ length of bytes required.-       -> ba+genCTR+    :: ByteArray ba+    => AES+    -- ^ Cipher Key.+    -> IV AES+    -- ^ usually a 128 bit integer.+    -> Int+    -- ^ length of bytes required.+    -> ba genCTR ctx (IV iv) len-    | len <= 0  = B.empty+    | len <= 0 = B.empty     | otherwise = B.allocAndFreeze (nbBlocks * 16) generate-  where generate o = withKeyAndIV ctx iv $ \k i -> c_aes_gen_ctr (castPtr o) k i (fromIntegral nbBlocks)-        (nbBlocks',r) = len `quotRem` 16-        nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1+  where+    generate o = withKeyAndIV ctx iv $ \k i -> c_aes_gen_ctr (castPtr o) k i (fromIntegral nbBlocks)+    (nbBlocks', r) = len `quotRem` 16+    nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1  -- | generate a counter mode pad. this is generally xor-ed to an input -- to make the standard counter mode block operations.@@ -239,22 +261,23 @@ -- -- Similiar to 'genCTR' but also return the next IV for continuation {-# NOINLINE genCounter #-}-genCounter :: ByteArray ba-           => AES-           -> IV AES-           -> Int-           -> (ba, IV AES)+genCounter+    :: ByteArray ba+    => AES+    -> IV AES+    -> Int+    -> (ba, IV AES) genCounter ctx iv len-    | len <= 0  = (B.empty, iv)+    | len <= 0 = (B.empty, iv)     | otherwise = unsafeDoIO $         keyToPtr ctx $ \k ->-        ivCopyPtr iv $ \i ->-        B.alloc outputLength $ \o -> do-            c_aes_gen_ctr_cont (castPtr o) k i (fromIntegral nbBlocks)+            ivCopyPtr iv $ \i ->+                B.alloc outputLength $ \o -> do+                    c_aes_gen_ctr_cont (castPtr o) k i (fromIntegral nbBlocks)   where-        (nbBlocks',r) = len `quotRem` 16-        nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1-        outputLength = nbBlocks * 16+    (nbBlocks', r) = len `quotRem` 16+    nbBlocks = if r == 0 then nbBlocks' else nbBlocks' + 1+    outputLength = nbBlocks * 16  {- TODO: when genCTR has same AESIV requirements for IV, add the following rules:  - RULES "snd . genCounter" forall ctx iv len .  snd (genCounter ctx iv len) = genCTR ctx iv len@@ -264,30 +287,45 @@ -- -- in CTR mode encryption and decryption is the same operation. {-# NOINLINE encryptCTR #-}-encryptCTR :: ByteArray ba-           => AES        -- ^ AES Context-           -> IV AES     -- ^ initial vector of AES block size (usually representing a 128 bit integer)-           -> ba         -- ^ plaintext input-           -> ba         -- ^ ciphertext output+encryptCTR+    :: ByteArray ba+    => AES+    -- ^ AES Context+    -> IV AES+    -- ^ initial vector of AES block size (usually representing a 128 bit integer)+    -> ba+    -- ^ plaintext input+    -> ba+    -- ^ ciphertext output encryptCTR ctx iv input-    | len <= 0          = B.empty-    | B.length iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ (show $ B.length iv)+    | len <= 0 = B.empty+    | B.length iv /= 16 =+        error $+            "AES error: IV length must be block size (16). Its length is: "+                ++ (show $ B.length iv)     | otherwise = B.allocAndFreeze len doEncrypt-  where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->-                      c_aes_encrypt_ctr (castPtr o) k v i (fromIntegral len)-        len = B.length input+  where+    doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->+        c_aes_encrypt_ctr (castPtr o) k v i (fromIntegral len)+    len = B.length input  -- | encrypt using XTS -- -- the first key is the normal block encryption key -- the second key is used for the initial block tweak {-# NOINLINE encryptXTS #-}-encryptXTS :: ByteArray ba-           => (AES,AES)  -- ^ AES cipher and tweak context-           -> IV AES     -- ^ a 128 bits IV, typically a sector or a block offset in XTS-           -> Word32     -- ^ number of rounds to skip, also seen a 16 byte offset in the sector or block.-           -> ba         -- ^ input to encrypt-           -> ba         -- ^ output encrypted+encryptXTS+    :: ByteArray ba+    => (AES, AES)+    -- ^ AES cipher and tweak context+    -> IV AES+    -- ^ a 128 bits IV, typically a sector or a block offset in XTS+    -> Word32+    -- ^ number of rounds to skip, also seen a 16 byte offset in the sector or block.+    -> ba+    -- ^ input to encrypt+    -> ba+    -- ^ output encrypted encryptXTS = doXTS c_aes_encrypt_xts  -- | decrypt using Electronic Code Book (ECB)@@ -303,82 +341,122 @@ -- | decrypt using Counter mode (CTR). -- -- in CTR mode encryption and decryption is the same operation.-decryptCTR :: ByteArray ba-           => AES        -- ^ AES Context-           -> IV AES     -- ^ initial vector, usually representing a 128 bit integer-           -> ba         -- ^ ciphertext input-           -> ba         -- ^ plaintext output+decryptCTR+    :: ByteArray ba+    => AES+    -- ^ AES Context+    -> IV AES+    -- ^ initial vector, usually representing a 128 bit integer+    -> ba+    -- ^ ciphertext input+    -> ba+    -- ^ plaintext output decryptCTR = encryptCTR  -- | decrypt using XTS {-# NOINLINE decryptXTS #-}-decryptXTS :: ByteArray ba-           => (AES,AES)  -- ^ AES cipher and tweak context-           -> IV AES     -- ^ a 128 bits IV, typically a sector or a block offset in XTS-           -> Word32     -- ^ number of rounds to skip, also seen a 16 byte offset in the sector or block.-           -> ba         -- ^ input to decrypt-           -> ba         -- ^ output decrypted+decryptXTS+    :: ByteArray ba+    => (AES, AES)+    -- ^ AES cipher and tweak context+    -> IV AES+    -- ^ a 128 bits IV, typically a sector or a block offset in XTS+    -> Word32+    -- ^ number of rounds to skip, also seen a 16 byte offset in the sector or block.+    -> ba+    -- ^ input to decrypt+    -> ba+    -- ^ output decrypted decryptXTS = doXTS c_aes_decrypt_xts  -- | encrypt/decrypt using Counter mode (32-bit wrapping used in AES-GCM-SIV) {-# NOINLINE combineC32 #-}-combineC32 :: ByteArray ba-           => AES        -- ^ AES Context-           -> IV AES     -- ^ initial vector of AES block size (usually representing a 128 bit integer)-           -> ba         -- ^ plaintext input-           -> ba         -- ^ ciphertext output+combineC32+    :: ByteArray ba+    => AES+    -- ^ AES Context+    -> IV AES+    -- ^ initial vector of AES block size (usually representing a 128 bit integer)+    -> ba+    -- ^ plaintext input+    -> ba+    -- ^ ciphertext output combineC32 ctx iv input-    | len <= 0          = B.empty-    | B.length iv /= 16 = error $ "AES error: IV length must be block size (16). Its length is: " ++ show (B.length iv)+    | len <= 0 = B.empty+    | B.length iv /= 16 =+        error $+            "AES error: IV length must be block size (16). Its length is: "+                ++ show (B.length iv)     | otherwise = B.allocAndFreeze len doEncrypt-  where doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->-                      c_aes_encrypt_c32 (castPtr o) k v i (fromIntegral len)-        len = B.length input+  where+    doEncrypt o = withKeyAndIV ctx iv $ \k v -> withByteArray input $ \i ->+        c_aes_encrypt_c32 (castPtr o) k v i (fromIntegral len)+    len = B.length input  {-# INLINE doECB #-}-doECB :: ByteArray ba-      => (Ptr b -> Ptr AES -> CString -> CUInt -> IO ())-      -> AES -> ba -> ba+doECB+    :: ByteArray ba+    => (Ptr b -> Ptr AES -> CString -> CUInt -> IO ())+    -> AES+    -> ba+    -> ba doECB f ctx input-    | len == 0     = B.empty-    | r /= 0       = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len)-    | otherwise    =+    | len == 0 = B.empty+    | r /= 0 =+        error $+            "Encryption error: input length must be a multiple of block size (16). Its length is: "+                ++ (show len)+    | otherwise =         B.allocAndFreeze len $ \o ->-        keyToPtr ctx         $ \k ->-        withByteArray input  $ \i ->-            f (castPtr o) k i (fromIntegral nbBlocks)-  where (nbBlocks, r) = len `quotRem` 16-        len           = B.length input+            keyToPtr ctx $ \k ->+                withByteArray input $ \i ->+                    f (castPtr o) k i (fromIntegral nbBlocks)+  where+    (nbBlocks, r) = len `quotRem` 16+    len = B.length input  {-# INLINE doCBC #-}-doCBC :: ByteArray ba-      => (Ptr b -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ())-      -> AES -> IV AES -> ba -> ba+doCBC+    :: ByteArray ba+    => (Ptr b -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ())+    -> AES+    -> IV AES+    -> ba+    -> ba doCBC f ctx (IV iv) input-    | len == 0  = B.empty-    | r /= 0    = error $ "Encryption error: input length must be a multiple of block size (16). Its length is: " ++ (show len)+    | len == 0 = B.empty+    | r /= 0 =+        error $+            "Encryption error: input length must be a multiple of block size (16). Its length is: "+                ++ (show len)     | otherwise = B.allocAndFreeze len $ \o ->-                  withKeyAndIV ctx iv $ \k v ->-                  withByteArray input $ \i ->-                  f (castPtr o) k v i (fromIntegral nbBlocks)-  where (nbBlocks, r) = len `quotRem` 16-        len           = B.length input+        withKeyAndIV ctx iv $ \k v ->+            withByteArray input $ \i ->+                f (castPtr o) k v i (fromIntegral nbBlocks)+  where+    (nbBlocks, r) = len `quotRem` 16+    len = B.length input  {-# INLINE doXTS #-}-doXTS :: ByteArray ba-      => (Ptr b -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ())-      -> (AES, AES)-      -> IV AES-      -> Word32-      -> ba-      -> ba-doXTS f (key1,key2) iv spoint input-    | len == 0  = B.empty-    | r /= 0    = error $ "Encryption error: input length must be a multiple of block size (16) for now. Its length is: " ++ (show len)+doXTS+    :: ByteArray ba+    => (Ptr b -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ())+    -> (AES, AES)+    -> IV AES+    -> Word32+    -> ba+    -> ba+doXTS f (key1, key2) iv spoint input+    | len == 0 = B.empty+    | r /= 0 =+        error $+            "Encryption error: input length must be a multiple of block size (16) for now. Its length is: "+                ++ (show len)     | otherwise = B.allocAndFreeze len $ \o -> withKey2AndIV key1 key2 iv $ \k1 k2 v -> withByteArray input $ \i ->-            f (castPtr o) k1 k2 v (fromIntegral spoint) i (fromIntegral nbBlocks)-  where (nbBlocks, r) = len `quotRem` 16-        len           = B.length input+        f (castPtr o) k1 k2 v (fromIntegral spoint) i (fromIntegral nbBlocks)+  where+    (nbBlocks, r) = len `quotRem` 16+    len = B.length input  ------------------------------------------------------------------------ -- GCM@@ -389,7 +467,7 @@ gcmInit :: ByteArrayAccess iv => AES -> iv -> AESGCM gcmInit ctx iv = unsafeDoIO $ do     sm <- B.alloc sizeGCM $ \gcmStPtr ->-            withKeyAndIV ctx iv $ \k v ->+        withKeyAndIV ctx iv $ \k v ->             c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ B.length iv)     return $ AESGCM sm @@ -399,10 +477,11 @@ {-# NOINLINE gcmAppendAAD #-} gcmAppendAAD :: ByteArrayAccess aad => AESGCM -> aad -> AESGCM gcmAppendAAD gcmSt input = unsafeDoIO doAppend-  where doAppend =-            withNewGCMSt gcmSt $ \gcmStPtr ->+  where+    doAppend =+        withNewGCMSt gcmSt $ \gcmStPtr ->             withByteArray input $ \i ->-            c_aes_gcm_aad gcmStPtr i (fromIntegral $ B.length input)+                c_aes_gcm_aad gcmStPtr i (fromIntegral $ B.length input)  -- | append data to encrypt and append to the GCM context --@@ -411,11 +490,12 @@ {-# NOINLINE gcmAppendEncrypt #-} gcmAppendEncrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc-  where len = B.length input-        doEnc gcmStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    doEnc gcmStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_gcm_encrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)+                c_aes_gcm_encrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)  -- | append data to decrypt and append to the GCM context --@@ -424,18 +504,20 @@ {-# NOINLINE gcmAppendDecrypt #-} gcmAppendDecrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) gcmAppendDecrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec-  where len = B.length input-        doDec gcmStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    doDec gcmStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_gcm_decrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)+                c_aes_gcm_decrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)  -- | Generate the Tag from GCM context {-# NOINLINE gcmFinish #-} gcmFinish :: AES -> AESGCM -> Int -> AuthTag gcmFinish ctx gcm taglen = AuthTag $ B.take taglen computeTag-  where computeTag = B.allocAndFreeze 16 $ \t ->-                        withGCMKeyAndCopySt ctx gcm (c_aes_gcm_finish (castPtr t)) >> return ()+  where+    computeTag = B.allocAndFreeze 16 $ \t ->+        withGCMKeyAndCopySt ctx gcm (c_aes_gcm_finish (castPtr t)) >> return ()  ------------------------------------------------------------------------ -- OCB v3@@ -446,7 +528,7 @@ ocbInit :: ByteArrayAccess iv => AES -> iv -> AESOCB ocbInit ctx iv = unsafeDoIO $ do     sm <- B.alloc sizeOCB $ \ocbStPtr ->-            withKeyAndIV ctx iv $ \k v ->+        withKeyAndIV ctx iv $ \k v ->             c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ B.length iv)     return $ AESOCB sm @@ -456,8 +538,9 @@ {-# NOINLINE ocbAppendAAD #-} ocbAppendAAD :: ByteArrayAccess aad => AES -> AESOCB -> aad -> AESOCB ocbAppendAAD ctx ocb input = unsafeDoIO (snd `fmap` withOCBKeyAndCopySt ctx ocb doAppend)-  where doAppend ocbStPtr aesPtr =-            withByteArray input $ \i ->+  where+    doAppend ocbStPtr aesPtr =+        withByteArray input $ \i ->             c_aes_ocb_aad ocbStPtr aesPtr i (fromIntegral $ B.length input)  -- | append data to encrypt and append to the OCB context@@ -467,11 +550,12 @@ {-# NOINLINE ocbAppendEncrypt #-} ocbAppendEncrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) ocbAppendEncrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doEnc-  where len = B.length input-        doEnc ocbStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    doEnc ocbStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_ocb_encrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)+                c_aes_ocb_encrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)  -- | append data to decrypt and append to the OCB context --@@ -480,45 +564,56 @@ {-# NOINLINE ocbAppendDecrypt #-} ocbAppendDecrypt :: ByteArray ba => AES -> AESOCB -> ba -> (ba, AESOCB) ocbAppendDecrypt ctx ocb input = unsafeDoIO $ withOCBKeyAndCopySt ctx ocb doDec-  where len = B.length input-        doDec ocbStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    doDec ocbStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_ocb_decrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)+                c_aes_ocb_decrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)  -- | Generate the Tag from OCB context {-# NOINLINE ocbFinish #-} ocbFinish :: AES -> AESOCB -> Int -> AuthTag ocbFinish ctx ocb taglen = AuthTag $ B.take taglen computeTag-  where computeTag = B.allocAndFreeze 16 $ \t ->-                        withOCBKeyAndCopySt ctx ocb (c_aes_ocb_finish (castPtr t)) >> return ()+  where+    computeTag = B.allocAndFreeze 16 $ \t ->+        withOCBKeyAndCopySt ctx ocb (c_aes_ocb_finish (castPtr t)) >> return ()  ccmGetM :: CCM_M -> Int ccmGetL :: CCM_L -> Int ccmGetM m = case m of-  CCM_M4 -> 4-  CCM_M6 -> 6-  CCM_M8 -> 8-  CCM_M10 -> 10-  CCM_M12 -> 12-  CCM_M14 -> 14-  CCM_M16 -> 16+    CCM_M4 -> 4+    CCM_M6 -> 6+    CCM_M8 -> 8+    CCM_M10 -> 10+    CCM_M12 -> 12+    CCM_M14 -> 14+    CCM_M16 -> 16  ccmGetL l = case l of-  CCM_L2 -> 2-  CCM_L3 -> 3-  CCM_L4 -> 4+    CCM_L2 -> 2+    CCM_L3 -> 3+    CCM_L4 -> 4  -- | initialize a ccm context {-# NOINLINE ccmInit #-}-ccmInit :: ByteArrayAccess iv => AES -> iv -> Int -> CCM_M -> CCM_L -> CryptoFailable AESCCM+ccmInit+    :: ByteArrayAccess iv+    => AES -> iv -> Int -> CCM_M -> CCM_L -> CryptoFailable AESCCM ccmInit ctx iv n m l     | 15 - li /= B.length iv = CryptoFailed CryptoError_IvSizeInvalid     | otherwise = unsafeDoIO $ do-          sm <- B.alloc sizeCCM $ \ccmStPtr ->+        sm <- B.alloc sizeCCM $ \ccmStPtr ->             withKeyAndIV ctx iv $ \k v ->-            c_aes_ccm_init (castPtr ccmStPtr) k v (fromIntegral $ B.length iv) (fromIntegral n) (fromIntegral mi) (fromIntegral li)-          return $ CryptoPassed (AESCCM sm)+                c_aes_ccm_init+                    (castPtr ccmStPtr)+                    k+                    v+                    (fromIntegral $ B.length iv)+                    (fromIntegral n)+                    (fromIntegral mi)+                    (fromIntegral li)+        return $ CryptoPassed (AESCCM sm)   where     mi = ccmGetM m     li = ccmGetL l@@ -529,8 +624,9 @@ {-# NOINLINE ccmAppendAAD #-} ccmAppendAAD :: ByteArrayAccess aad => AES -> AESCCM -> aad -> AESCCM ccmAppendAAD ctx ccm input = unsafeDoIO $ snd <$> withCCMKeyAndCopySt ctx ccm doAppend-  where doAppend ccmStPtr aesPtr =-            withByteArray input $ \i -> c_aes_ccm_aad ccmStPtr aesPtr i (fromIntegral $ B.length input)+  where+    doAppend ccmStPtr aesPtr =+        withByteArray input $ \i -> c_aes_ccm_aad ccmStPtr aesPtr i (fromIntegral $ B.length input)  -- | append data to encrypt and append to the CCM context --@@ -539,11 +635,12 @@ {-# NOINLINE ccmEncrypt #-} ccmEncrypt :: ByteArray ba => AES -> AESCCM -> ba -> (ba, AESCCM) ccmEncrypt ctx ccm input = unsafeDoIO $ withCCMKeyAndCopySt ctx ccm cbcmacAndIv-  where len = B.length input-        cbcmacAndIv ccmStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    cbcmacAndIv ccmStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_ccm_encrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)+                c_aes_ccm_encrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)  -- | append data to decrypt and append to the CCM context --@@ -552,18 +649,20 @@ {-# NOINLINE ccmDecrypt #-} ccmDecrypt :: ByteArray ba => AES -> AESCCM -> ba -> (ba, AESCCM) ccmDecrypt ctx ccm input = unsafeDoIO $ withCCMKeyAndCopySt ctx ccm cbcmacAndIv-  where len = B.length input-        cbcmacAndIv ccmStPtr aesPtr =-            B.alloc len $ \o ->+  where+    len = B.length input+    cbcmacAndIv ccmStPtr aesPtr =+        B.alloc len $ \o ->             withByteArray input $ \i ->-            c_aes_ccm_decrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)+                c_aes_ccm_decrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)  -- | Generate the Tag from CCM context {-# NOINLINE ccmFinish #-} ccmFinish :: AES -> AESCCM -> Int -> AuthTag ccmFinish ctx ccm taglen = AuthTag $ B.take taglen computeTag-  where computeTag = B.allocAndFreeze 16 $ \t ->-                        withCCMKeyAndCopySt ctx ccm (c_aes_ccm_finish (castPtr t)) >> return ()+  where+    computeTag = B.allocAndFreeze 16 $ \t ->+        withCCMKeyAndCopySt ctx ccm (c_aes_ccm_finish (castPtr t)) >> return ()  ------------------------------------------------------------------------ foreign import ccall "crypton_aes.h crypton_aes_initkey"@@ -576,16 +675,20 @@     c_aes_decrypt_ecb :: CString -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_encrypt_cbc"-    c_aes_encrypt_cbc :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()+    c_aes_encrypt_cbc+        :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_decrypt_cbc"-    c_aes_decrypt_cbc :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()+    c_aes_decrypt_cbc+        :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_encrypt_xts"-    c_aes_encrypt_xts :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()+    c_aes_encrypt_xts+        :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_decrypt_xts"-    c_aes_decrypt_xts :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()+    c_aes_decrypt_xts+        :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gen_ctr"     c_aes_gen_ctr :: CString -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()@@ -594,10 +697,12 @@     c_aes_gen_ctr_cont :: CString -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_encrypt_ctr"-    c_aes_encrypt_ctr :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()+    c_aes_encrypt_ctr+        :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_encrypt_c32"-    c_aes_encrypt_c32 :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()+    c_aes_encrypt_c32+        :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gcm_init"     c_aes_gcm_init :: Ptr AESGCM -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()@@ -606,10 +711,12 @@     c_aes_gcm_aad :: Ptr AESGCM -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gcm_encrypt"-    c_aes_gcm_encrypt :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_gcm_encrypt+        :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gcm_decrypt"-    c_aes_gcm_decrypt :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_gcm_decrypt+        :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_gcm_finish"     c_aes_gcm_finish :: CString -> Ptr AESGCM -> Ptr AES -> IO ()@@ -621,25 +728,30 @@     c_aes_ocb_aad :: Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ocb_encrypt"-    c_aes_ocb_encrypt :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_ocb_encrypt+        :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ocb_decrypt"-    c_aes_ocb_decrypt :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_ocb_decrypt+        :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ocb_finish"     c_aes_ocb_finish :: CString -> Ptr AESOCB -> Ptr AES -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ccm_init"-    c_aes_ccm_init :: Ptr AESCCM -> Ptr AES -> Ptr Word8 -> CUInt -> CUInt -> CInt -> CInt -> IO ()+    c_aes_ccm_init+        :: Ptr AESCCM -> Ptr AES -> Ptr Word8 -> CUInt -> CUInt -> CInt -> CInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ccm_aad"     c_aes_ccm_aad :: Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ccm_encrypt"-    c_aes_ccm_encrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_ccm_encrypt+        :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ccm_decrypt"-    c_aes_ccm_decrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()+    c_aes_ccm_decrypt+        :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()  foreign import ccall "crypton_aes.h crypton_aes_ccm_finish"     c_aes_ccm_finish :: CString -> Ptr AESCCM -> Ptr AES -> IO ()

@@ -1,3 +1,6 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.AESGCMSIV -- License     : BSD-style@@ -16,28 +19,27 @@ -- -- The specification allows inputs up to 2^36 bytes but this implementation -- requires AAD and plaintext/ciphertext to be both smaller than 2^32 bytes.-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.AESGCMSIV-    ( Nonce-    , nonce-    , generateNonce-    , encrypt-    , decrypt-    ) where+module Crypto.Cipher.AESGCMSIV (+    Nonce,+    nonce,+    generateNonce,+    encrypt,+    decrypt,+) where  import Data.Bits+import Data.Maybe import Data.Word -import Foreign.C.Types import Foreign.C.String+import Foreign.C.Types import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (peekElemOff, poke, pokeElemOff) -import           Data.ByteArray+import Data.ByteArray import qualified Data.ByteArray as B-import           Data.Memory.Endian (toLE)-import           Data.Memory.PtrMethods (memXor)+import Data.Memory.Endian (toLE)+import Data.Memory.PtrMethods (memXor)  import Crypto.Cipher.AES.Primitive import Crypto.Cipher.Types@@ -45,7 +47,6 @@ import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Random - -- 12-byte nonces  -- | Nonce value for AES-GCM-SIV, always 12 bytes.@@ -55,26 +56,27 @@ nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce nonce iv     | B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv)-    | otherwise         = CryptoFailed CryptoError_IvSizeInvalid+    | otherwise = CryptoFailed CryptoError_IvSizeInvalid  -- | Generate a random nonce for use with AES-GCM-SIV. generateNonce :: MonadRandom m => m Nonce generateNonce = Nonce <$> getRandomBytes 12 - -- POLYVAL (mutable context)  newtype Polyval = Polyval Bytes  polyvalInit :: ScrubbedBytes -> IO Polyval polyvalInit h = Polyval <$> doInit-  where doInit = B.alloc 272 $ \pctx -> B.withByteArray h $ \ph ->-            c_aes_polyval_init pctx ph+  where+    doInit = B.alloc 272 $ \pctx -> B.withByteArray h $ \ph ->+        c_aes_polyval_init pctx ph  polyvalUpdate :: ByteArrayAccess ba => Polyval -> ba -> IO () polyvalUpdate (Polyval ctx) bs = B.withByteArray ctx $ \pctx ->     B.withByteArray bs $ \pbs -> c_aes_polyval_update pctx pbs sz-  where sz = fromIntegral (B.length bs)+  where+    sz = fromIntegral (B.length bs)  polyvalFinalize :: Polyval -> IO ScrubbedBytes polyvalFinalize (Polyval ctx) = B.alloc 16 $ \dst ->@@ -89,7 +91,6 @@ foreign import ccall unsafe "crypton_aes.h crypton_aes_polyval_finalize"     c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO () - -- Key Generation  le32iv :: Word32 -> Nonce -> Bytes@@ -100,24 +101,25 @@ deriveKeys :: BlockCipher128 aes => aes -> Nonce -> (ScrubbedBytes, AES) deriveKeys aes iv =     case cipherKeySize aes of-        KeySizeFixed sz | sz `mod` 8 == 0 ->-            let mak = buildKey [0 .. 1]-                key = buildKey [2 .. fromIntegral (sz `div` 8) + 1]-                mek = throwCryptoError (cipherInit key)-             in (mak, mek)+        KeySizeFixed sz+            | sz `mod` 8 == 0 ->+                let mak = buildKey [0 .. 1]+                    key = buildKey [2 .. fromIntegral (sz `div` 8) + 1]+                    mek = throwCryptoError (cipherInit key)+                 in (mak, mek)         _ -> error "AESGCMSIV: invalid cipher"   where     idx n = ecbEncrypt aes (le32iv n iv) `takeView` 8     buildKey = B.concat . map idx - -- Encryption and decryption  lengthInvalid :: ByteArrayAccess ba => ba -> Bool lengthInvalid bs     | finiteBitSize len > 32 = len >= 1 `unsafeShiftL` 32-    | otherwise              = False-  where len = B.length bs+    | otherwise = False+  where+    len = B.length bs  -- | AEAD encryption with the specified key and nonce.  The key must be given -- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'@@ -125,8 +127,9 @@ -- -- Lengths of additional data and plaintext must be less than 2^32 bytes, -- otherwise an exception is thrown.-encrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)-        => aes -> Nonce -> aad -> ba -> (AuthTag, ba)+encrypt+    :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)+    => aes -> Nonce -> aad -> ba -> (AuthTag, ba) encrypt aes iv aad plaintext     | lengthInvalid aad = error "AESGCMSIV: aad is too large"     | lengthInvalid plaintext = error "AESGCMSIV: plaintext is too large"@@ -143,8 +146,9 @@ -- -- Lengths of additional data and ciphertext must be less than 2^32 bytes, -- otherwise an exception is thrown.-decrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)-        => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba+decrypt+    :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba)+    => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba decrypt aes iv aad ciphertext (AuthTag tag)     | lengthInvalid aad = error "AESGCMSIV: aad is too large"     | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large"@@ -156,18 +160,19 @@     plaintext = combineC32 mek (transformTag tag) ciphertext  -- Calculate S_s = POLYVAL(mak, X_1, X_2, ...).-getSs :: (ByteArrayAccess aad, ByteArrayAccess ba)-      => ScrubbedBytes -> aad -> ba -> ScrubbedBytes+getSs+    :: (ByteArrayAccess aad, ByteArrayAccess ba)+    => ScrubbedBytes -> aad -> ba -> ScrubbedBytes getSs mak aad plaintext = unsafeDoIO $ do     ctx <- polyvalInit mak     polyvalUpdate ctx aad     polyvalUpdate ctx plaintext-    polyvalUpdate ctx (lb :: Bytes)  -- the "length block"+    polyvalUpdate ctx (lb :: Bytes) -- the "length block"     polyvalFinalize ctx   where     lb = B.allocAndFreeze 16 $ \ptr -> do-            pokeElemOff ptr 0 (toLE64 $ B.length aad)-            pokeElemOff ptr 1 (toLE64 $ B.length plaintext)+        pokeElemOff ptr 0 (toLE64 $ B.length aad)+        pokeElemOff ptr 1 (toLE64 $ B.length plaintext)     toLE64 x = toLE (fromIntegral x * 8 :: Word64)  -- XOR the first 12 bytes of S_s with the nonce and clear the most significant@@ -175,10 +180,10 @@ tagInput :: ScrubbedBytes -> Nonce -> Bytes tagInput ss (Nonce iv) =     B.copyAndFreeze ss $ \ptr ->-    B.withByteArray iv $ \ivPtr -> do-        memXor ptr ptr ivPtr 12-        b <- peekElemOff ptr 15-        pokeElemOff ptr 15 (b .&. (0x7f :: Word8))+        B.withByteArray iv $ \ivPtr -> do+            memXor ptr ptr ivPtr 12+            b <- peekElemOff ptr 15+            pokeElemOff ptr 15 (b .&. (0x7f :: Word8))  -- Encrypt the result with AES using the message-encryption key to produce the -- tag.@@ -190,4 +195,5 @@ transformTag :: Bytes -> IV AES transformTag tag = toIV $ B.copyAndFreeze tag $ \ptr ->     peekElemOff ptr 15 >>= pokeElemOff ptr 15 . (.|. (0x80 :: Word8))-  where toIV bs = let Just iv = makeIV (bs :: Bytes) in iv+  where+    toIV bs = fromJust $ makeIV (bs :: Bytes)

@@ -1,23 +1,23 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.Blowfish -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good----{-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.Blowfish-    ( Blowfish-    , Blowfish64-    , Blowfish128-    , Blowfish256-    , Blowfish448-    ) where+module Crypto.Cipher.Blowfish (+    Blowfish,+    Blowfish64,+    Blowfish128,+    Blowfish256,+    Blowfish448,+) where -import Crypto.Internal.Imports-import Crypto.Cipher.Types import Crypto.Cipher.Blowfish.Primitive+import Crypto.Cipher.Types+import Crypto.Internal.Imports  -- | variable keyed blowfish state newtype Blowfish = Blowfish Context@@ -40,9 +40,9 @@     deriving (NFData)  instance Cipher Blowfish where-    cipherName _    = "blowfish"+    cipherName _ = "blowfish"     cipherKeySize _ = KeySizeRange 6 56-    cipherInit k    = Blowfish `fmap` initBlowfish k+    cipherInit k = Blowfish `fmap` initBlowfish k  instance BlockCipher Blowfish where     blockSize _ = 8

@@ -1,19 +1,22 @@+{-# LANGUAGE MagicHash #-}+ -- | -- Module      : Crypto.Cipher.Blowfish.Box -- License     : BSD-style -- Stability   : experimental -- Portability : Good-{-# LANGUAGE MagicHash #-}-module Crypto.Cipher.Blowfish.Box-    (   KeySchedule(..)-    ,   createKeySchedule-    ,   copyKeySchedule-    ) where+module Crypto.Cipher.Blowfish.Box (+    KeySchedule (..),+    createKeySchedule,+    copyKeySchedule,+) where -import           Crypto.Internal.WordArray (MutableArray32,-                                            mutableArray32FromAddrBE,-                                            mutableArrayRead32,-                                            mutableArrayWrite32)+import Crypto.Internal.WordArray (+    MutableArray32,+    mutableArray32FromAddrBE,+    mutableArrayRead32,+    mutableArrayWrite32,+ )  newtype KeySchedule = KeySchedule MutableArray32 @@ -23,274 +26,278 @@ copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0   where     loop 1042 = return ()-    loop i    = do-        w32 <-mutableArrayRead32 src i+    loop i = do+        w32 <- mutableArrayRead32 src i         mutableArrayWrite32 dst i w32         loop (i + 1)  -- | Create a key schedule mutable array of the pbox followed by -- all the sboxes. createKeySchedule :: IO KeySchedule-createKeySchedule = KeySchedule `fmap` mutableArray32FromAddrBE 1042 "\-    \\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\-    \\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\-    \\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\-    \\xc0\xac\x29\xb7\xc9\x7c\x50\xdd\x3f\x84\xd5\xb5\xb5\x47\x09\x17\-    \\x92\x16\xd5\xd9\x89\x79\xfb\x1b\-    \\xd1\x31\x0b\xa6\x98\xdf\xb5\xac\x2f\xfd\x72\xdb\xd0\x1a\xdf\xb7\-    \\xb8\xe1\xaf\xed\x6a\x26\x7e\x96\xba\x7c\x90\x45\xf1\x2c\x7f\x99\-    \\x24\xa1\x99\x47\xb3\x91\x6c\xf7\x08\x01\xf2\xe2\x85\x8e\xfc\x16\-    \\x63\x69\x20\xd8\x71\x57\x4e\x69\xa4\x58\xfe\xa3\xf4\x93\x3d\x7e\-    \\x0d\x95\x74\x8f\x72\x8e\xb6\x58\x71\x8b\xcd\x58\x82\x15\x4a\xee\-    \\x7b\x54\xa4\x1d\xc2\x5a\x59\xb5\x9c\x30\xd5\x39\x2a\xf2\x60\x13\-    \\xc5\xd1\xb0\x23\x28\x60\x85\xf0\xca\x41\x79\x18\xb8\xdb\x38\xef\-    \\x8e\x79\xdc\xb0\x60\x3a\x18\x0e\x6c\x9e\x0e\x8b\xb0\x1e\x8a\x3e\-    \\xd7\x15\x77\xc1\xbd\x31\x4b\x27\x78\xaf\x2f\xda\x55\x60\x5c\x60\-    \\xe6\x55\x25\xf3\xaa\x55\xab\x94\x57\x48\x98\x62\x63\xe8\x14\x40\-    \\x55\xca\x39\x6a\x2a\xab\x10\xb6\xb4\xcc\x5c\x34\x11\x41\xe8\xce\-    \\xa1\x54\x86\xaf\x7c\x72\xe9\x93\xb3\xee\x14\x11\x63\x6f\xbc\x2a\-    \\x2b\xa9\xc5\x5d\x74\x18\x31\xf6\xce\x5c\x3e\x16\x9b\x87\x93\x1e\-    \\xaf\xd6\xba\x33\x6c\x24\xcf\x5c\x7a\x32\x53\x81\x28\x95\x86\x77\-    \\x3b\x8f\x48\x98\x6b\x4b\xb9\xaf\xc4\xbf\xe8\x1b\x66\x28\x21\x93\-    \\x61\xd8\x09\xcc\xfb\x21\xa9\x91\x48\x7c\xac\x60\x5d\xec\x80\x32\-    \\xef\x84\x5d\x5d\xe9\x85\x75\xb1\xdc\x26\x23\x02\xeb\x65\x1b\x88\-    \\x23\x89\x3e\x81\xd3\x96\xac\xc5\x0f\x6d\x6f\xf3\x83\xf4\x42\x39\-    \\x2e\x0b\x44\x82\xa4\x84\x20\x04\x69\xc8\xf0\x4a\x9e\x1f\x9b\x5e\-    \\x21\xc6\x68\x42\xf6\xe9\x6c\x9a\x67\x0c\x9c\x61\xab\xd3\x88\xf0\-    \\x6a\x51\xa0\xd2\xd8\x54\x2f\x68\x96\x0f\xa7\x28\xab\x51\x33\xa3\-    \\x6e\xef\x0b\x6c\x13\x7a\x3b\xe4\xba\x3b\xf0\x50\x7e\xfb\x2a\x98\-    \\xa1\xf1\x65\x1d\x39\xaf\x01\x76\x66\xca\x59\x3e\x82\x43\x0e\x88\-    \\x8c\xee\x86\x19\x45\x6f\x9f\xb4\x7d\x84\xa5\xc3\x3b\x8b\x5e\xbe\-    \\xe0\x6f\x75\xd8\x85\xc1\x20\x73\x40\x1a\x44\x9f\x56\xc1\x6a\xa6\-    \\x4e\xd3\xaa\x62\x36\x3f\x77\x06\x1b\xfe\xdf\x72\x42\x9b\x02\x3d\-    \\x37\xd0\xd7\x24\xd0\x0a\x12\x48\xdb\x0f\xea\xd3\x49\xf1\xc0\x9b\-    \\x07\x53\x72\xc9\x80\x99\x1b\x7b\x25\xd4\x79\xd8\xf6\xe8\xde\xf7\-    \\xe3\xfe\x50\x1a\xb6\x79\x4c\x3b\x97\x6c\xe0\xbd\x04\xc0\x06\xba\-    \\xc1\xa9\x4f\xb6\x40\x9f\x60\xc4\x5e\x5c\x9e\xc2\x19\x6a\x24\x63\-    \\x68\xfb\x6f\xaf\x3e\x6c\x53\xb5\x13\x39\xb2\xeb\x3b\x52\xec\x6f\-    \\x6d\xfc\x51\x1f\x9b\x30\x95\x2c\xcc\x81\x45\x44\xaf\x5e\xbd\x09\-    \\xbe\xe3\xd0\x04\xde\x33\x4a\xfd\x66\x0f\x28\x07\x19\x2e\x4b\xb3\-    \\xc0\xcb\xa8\x57\x45\xc8\x74\x0f\xd2\x0b\x5f\x39\xb9\xd3\xfb\xdb\-    \\x55\x79\xc0\xbd\x1a\x60\x32\x0a\xd6\xa1\x00\xc6\x40\x2c\x72\x79\-    \\x67\x9f\x25\xfe\xfb\x1f\xa3\xcc\x8e\xa5\xe9\xf8\xdb\x32\x22\xf8\-    \\x3c\x75\x16\xdf\xfd\x61\x6b\x15\x2f\x50\x1e\xc8\xad\x05\x52\xab\-    \\x32\x3d\xb5\xfa\xfd\x23\x87\x60\x53\x31\x7b\x48\x3e\x00\xdf\x82\-    \\x9e\x5c\x57\xbb\xca\x6f\x8c\xa0\x1a\x87\x56\x2e\xdf\x17\x69\xdb\-    \\xd5\x42\xa8\xf6\x28\x7e\xff\xc3\xac\x67\x32\xc6\x8c\x4f\x55\x73\-    \\x69\x5b\x27\xb0\xbb\xca\x58\xc8\xe1\xff\xa3\x5d\xb8\xf0\x11\xa0\-    \\x10\xfa\x3d\x98\xfd\x21\x83\xb8\x4a\xfc\xb5\x6c\x2d\xd1\xd3\x5b\-    \\x9a\x53\xe4\x79\xb6\xf8\x45\x65\xd2\x8e\x49\xbc\x4b\xfb\x97\x90\-    \\xe1\xdd\xf2\xda\xa4\xcb\x7e\x33\x62\xfb\x13\x41\xce\xe4\xc6\xe8\-    \\xef\x20\xca\xda\x36\x77\x4c\x01\xd0\x7e\x9e\xfe\x2b\xf1\x1f\xb4\-    \\x95\xdb\xda\x4d\xae\x90\x91\x98\xea\xad\x8e\x71\x6b\x93\xd5\xa0\-    \\xd0\x8e\xd1\xd0\xaf\xc7\x25\xe0\x8e\x3c\x5b\x2f\x8e\x75\x94\xb7\-    \\x8f\xf6\xe2\xfb\xf2\x12\x2b\x64\x88\x88\xb8\x12\x90\x0d\xf0\x1c\-    \\x4f\xad\x5e\xa0\x68\x8f\xc3\x1c\xd1\xcf\xf1\x91\xb3\xa8\xc1\xad\-    \\x2f\x2f\x22\x18\xbe\x0e\x17\x77\xea\x75\x2d\xfe\x8b\x02\x1f\xa1\-    \\xe5\xa0\xcc\x0f\xb5\x6f\x74\xe8\x18\xac\xf3\xd6\xce\x89\xe2\x99\-    \\xb4\xa8\x4f\xe0\xfd\x13\xe0\xb7\x7c\xc4\x3b\x81\xd2\xad\xa8\xd9\-    \\x16\x5f\xa2\x66\x80\x95\x77\x05\x93\xcc\x73\x14\x21\x1a\x14\x77\-    \\xe6\xad\x20\x65\x77\xb5\xfa\x86\xc7\x54\x42\xf5\xfb\x9d\x35\xcf\-    \\xeb\xcd\xaf\x0c\x7b\x3e\x89\xa0\xd6\x41\x1b\xd3\xae\x1e\x7e\x49\-    \\x00\x25\x0e\x2d\x20\x71\xb3\x5e\x22\x68\x00\xbb\x57\xb8\xe0\xaf\-    \\x24\x64\x36\x9b\xf0\x09\xb9\x1e\x55\x63\x91\x1d\x59\xdf\xa6\xaa\-    \\x78\xc1\x43\x89\xd9\x5a\x53\x7f\x20\x7d\x5b\xa2\x02\xe5\xb9\xc5\-    \\x83\x26\x03\x76\x62\x95\xcf\xa9\x11\xc8\x19\x68\x4e\x73\x4a\x41\-    \\xb3\x47\x2d\xca\x7b\x14\xa9\x4a\x1b\x51\x00\x52\x9a\x53\x29\x15\-    \\xd6\x0f\x57\x3f\xbc\x9b\xc6\xe4\x2b\x60\xa4\x76\x81\xe6\x74\x00\-    \\x08\xba\x6f\xb5\x57\x1b\xe9\x1f\xf2\x96\xec\x6b\x2a\x0d\xd9\x15\-    \\xb6\x63\x65\x21\xe7\xb9\xf9\xb6\xff\x34\x05\x2e\xc5\x85\x56\x64\-    \\x53\xb0\x2d\x5d\xa9\x9f\x8f\xa1\x08\xba\x47\x99\x6e\x85\x07\x6a\-    \\x4b\x7a\x70\xe9\xb5\xb3\x29\x44\xdb\x75\x09\x2e\xc4\x19\x26\x23\-    \\xad\x6e\xa6\xb0\x49\xa7\xdf\x7d\x9c\xee\x60\xb8\x8f\xed\xb2\x66\-    \\xec\xaa\x8c\x71\x69\x9a\x17\xff\x56\x64\x52\x6c\xc2\xb1\x9e\xe1\-    \\x19\x36\x02\xa5\x75\x09\x4c\x29\xa0\x59\x13\x40\xe4\x18\x3a\x3e\-    \\x3f\x54\x98\x9a\x5b\x42\x9d\x65\x6b\x8f\xe4\xd6\x99\xf7\x3f\xd6\-    \\xa1\xd2\x9c\x07\xef\xe8\x30\xf5\x4d\x2d\x38\xe6\xf0\x25\x5d\xc1\-    \\x4c\xdd\x20\x86\x84\x70\xeb\x26\x63\x82\xe9\xc6\x02\x1e\xcc\x5e\-    \\x09\x68\x6b\x3f\x3e\xba\xef\xc9\x3c\x97\x18\x14\x6b\x6a\x70\xa1\-    \\x68\x7f\x35\x84\x52\xa0\xe2\x86\xb7\x9c\x53\x05\xaa\x50\x07\x37\-    \\x3e\x07\x84\x1c\x7f\xde\xae\x5c\x8e\x7d\x44\xec\x57\x16\xf2\xb8\-    \\xb0\x3a\xda\x37\xf0\x50\x0c\x0d\xf0\x1c\x1f\x04\x02\x00\xb3\xff\-    \\xae\x0c\xf5\x1a\x3c\xb5\x74\xb2\x25\x83\x7a\x58\xdc\x09\x21\xbd\-    \\xd1\x91\x13\xf9\x7c\xa9\x2f\xf6\x94\x32\x47\x73\x22\xf5\x47\x01\-    \\x3a\xe5\xe5\x81\x37\xc2\xda\xdc\xc8\xb5\x76\x34\x9a\xf3\xdd\xa7\-    \\xa9\x44\x61\x46\x0f\xd0\x03\x0e\xec\xc8\xc7\x3e\xa4\x75\x1e\x41\-    \\xe2\x38\xcd\x99\x3b\xea\x0e\x2f\x32\x80\xbb\xa1\x18\x3e\xb3\x31\-    \\x4e\x54\x8b\x38\x4f\x6d\xb9\x08\x6f\x42\x0d\x03\xf6\x0a\x04\xbf\-    \\x2c\xb8\x12\x90\x24\x97\x7c\x79\x56\x79\xb0\x72\xbc\xaf\x89\xaf\-    \\xde\x9a\x77\x1f\xd9\x93\x08\x10\xb3\x8b\xae\x12\xdc\xcf\x3f\x2e\-    \\x55\x12\x72\x1f\x2e\x6b\x71\x24\x50\x1a\xdd\xe6\x9f\x84\xcd\x87\-    \\x7a\x58\x47\x18\x74\x08\xda\x17\xbc\x9f\x9a\xbc\xe9\x4b\x7d\x8c\-    \\xec\x7a\xec\x3a\xdb\x85\x1d\xfa\x63\x09\x43\x66\xc4\x64\xc3\xd2\-    \\xef\x1c\x18\x47\x32\x15\xd9\x08\xdd\x43\x3b\x37\x24\xc2\xba\x16\-    \\x12\xa1\x4d\x43\x2a\x65\xc4\x51\x50\x94\x00\x02\x13\x3a\xe4\xdd\-    \\x71\xdf\xf8\x9e\x10\x31\x4e\x55\x81\xac\x77\xd6\x5f\x11\x19\x9b\-    \\x04\x35\x56\xf1\xd7\xa3\xc7\x6b\x3c\x11\x18\x3b\x59\x24\xa5\x09\-    \\xf2\x8f\xe6\xed\x97\xf1\xfb\xfa\x9e\xba\xbf\x2c\x1e\x15\x3c\x6e\-    \\x86\xe3\x45\x70\xea\xe9\x6f\xb1\x86\x0e\x5e\x0a\x5a\x3e\x2a\xb3\-    \\x77\x1f\xe7\x1c\x4e\x3d\x06\xfa\x29\x65\xdc\xb9\x99\xe7\x1d\x0f\-    \\x80\x3e\x89\xd6\x52\x66\xc8\x25\x2e\x4c\xc9\x78\x9c\x10\xb3\x6a\-    \\xc6\x15\x0e\xba\x94\xe2\xea\x78\xa5\xfc\x3c\x53\x1e\x0a\x2d\xf4\-    \\xf2\xf7\x4e\xa7\x36\x1d\x2b\x3d\x19\x39\x26\x0f\x19\xc2\x79\x60\-    \\x52\x23\xa7\x08\xf7\x13\x12\xb6\xeb\xad\xfe\x6e\xea\xc3\x1f\x66\-    \\xe3\xbc\x45\x95\xa6\x7b\xc8\x83\xb1\x7f\x37\xd1\x01\x8c\xff\x28\-    \\xc3\x32\xdd\xef\xbe\x6c\x5a\xa5\x65\x58\x21\x85\x68\xab\x98\x02\-    \\xee\xce\xa5\x0f\xdb\x2f\x95\x3b\x2a\xef\x7d\xad\x5b\x6e\x2f\x84\-    \\x15\x21\xb6\x28\x29\x07\x61\x70\xec\xdd\x47\x75\x61\x9f\x15\x10\-    \\x13\xcc\xa8\x30\xeb\x61\xbd\x96\x03\x34\xfe\x1e\xaa\x03\x63\xcf\-    \\xb5\x73\x5c\x90\x4c\x70\xa2\x39\xd5\x9e\x9e\x0b\xcb\xaa\xde\x14\-    \\xee\xcc\x86\xbc\x60\x62\x2c\xa7\x9c\xab\x5c\xab\xb2\xf3\x84\x6e\-    \\x64\x8b\x1e\xaf\x19\xbd\xf0\xca\xa0\x23\x69\xb9\x65\x5a\xbb\x50\-    \\x40\x68\x5a\x32\x3c\x2a\xb4\xb3\x31\x9e\xe9\xd5\xc0\x21\xb8\xf7\-    \\x9b\x54\x0b\x19\x87\x5f\xa0\x99\x95\xf7\x99\x7e\x62\x3d\x7d\xa8\-    \\xf8\x37\x88\x9a\x97\xe3\x2d\x77\x11\xed\x93\x5f\x16\x68\x12\x81\-    \\x0e\x35\x88\x29\xc7\xe6\x1f\xd6\x96\xde\xdf\xa1\x78\x58\xba\x99\-    \\x57\xf5\x84\xa5\x1b\x22\x72\x63\x9b\x83\xc3\xff\x1a\xc2\x46\x96\-    \\xcd\xb3\x0a\xeb\x53\x2e\x30\x54\x8f\xd9\x48\xe4\x6d\xbc\x31\x28\-    \\x58\xeb\xf2\xef\x34\xc6\xff\xea\xfe\x28\xed\x61\xee\x7c\x3c\x73\-    \\x5d\x4a\x14\xd9\xe8\x64\xb7\xe3\x42\x10\x5d\x14\x20\x3e\x13\xe0\-    \\x45\xee\xe2\xb6\xa3\xaa\xab\xea\xdb\x6c\x4f\x15\xfa\xcb\x4f\xd0\-    \\xc7\x42\xf4\x42\xef\x6a\xbb\xb5\x65\x4f\x3b\x1d\x41\xcd\x21\x05\-    \\xd8\x1e\x79\x9e\x86\x85\x4d\xc7\xe4\x4b\x47\x6a\x3d\x81\x62\x50\-    \\xcf\x62\xa1\xf2\x5b\x8d\x26\x46\xfc\x88\x83\xa0\xc1\xc7\xb6\xa3\-    \\x7f\x15\x24\xc3\x69\xcb\x74\x92\x47\x84\x8a\x0b\x56\x92\xb2\x85\-    \\x09\x5b\xbf\x00\xad\x19\x48\x9d\x14\x62\xb1\x74\x23\x82\x0e\x00\-    \\x58\x42\x8d\x2a\x0c\x55\xf5\xea\x1d\xad\xf4\x3e\x23\x3f\x70\x61\-    \\x33\x72\xf0\x92\x8d\x93\x7e\x41\xd6\x5f\xec\xf1\x6c\x22\x3b\xdb\-    \\x7c\xde\x37\x59\xcb\xee\x74\x60\x40\x85\xf2\xa7\xce\x77\x32\x6e\-    \\xa6\x07\x80\x84\x19\xf8\x50\x9e\xe8\xef\xd8\x55\x61\xd9\x97\x35\-    \\xa9\x69\xa7\xaa\xc5\x0c\x06\xc2\x5a\x04\xab\xfc\x80\x0b\xca\xdc\-    \\x9e\x44\x7a\x2e\xc3\x45\x34\x84\xfd\xd5\x67\x05\x0e\x1e\x9e\xc9\-    \\xdb\x73\xdb\xd3\x10\x55\x88\xcd\x67\x5f\xda\x79\xe3\x67\x43\x40\-    \\xc5\xc4\x34\x65\x71\x3e\x38\xd8\x3d\x28\xf8\x9e\xf1\x6d\xff\x20\-    \\x15\x3e\x21\xe7\x8f\xb0\x3d\x4a\xe6\xe3\x9f\x2b\xdb\x83\xad\xf7\-    \\xe9\x3d\x5a\x68\x94\x81\x40\xf7\xf6\x4c\x26\x1c\x94\x69\x29\x34\-    \\x41\x15\x20\xf7\x76\x02\xd4\xf7\xbc\xf4\x6b\x2e\xd4\xa2\x00\x68\-    \\xd4\x08\x24\x71\x33\x20\xf4\x6a\x43\xb7\xd4\xb7\x50\x00\x61\xaf\-    \\x1e\x39\xf6\x2e\x97\x24\x45\x46\x14\x21\x4f\x74\xbf\x8b\x88\x40\-    \\x4d\x95\xfc\x1d\x96\xb5\x91\xaf\x70\xf4\xdd\xd3\x66\xa0\x2f\x45\-    \\xbf\xbc\x09\xec\x03\xbd\x97\x85\x7f\xac\x6d\xd0\x31\xcb\x85\x04\-    \\x96\xeb\x27\xb3\x55\xfd\x39\x41\xda\x25\x47\xe6\xab\xca\x0a\x9a\-    \\x28\x50\x78\x25\x53\x04\x29\xf4\x0a\x2c\x86\xda\xe9\xb6\x6d\xfb\-    \\x68\xdc\x14\x62\xd7\x48\x69\x00\x68\x0e\xc0\xa4\x27\xa1\x8d\xee\-    \\x4f\x3f\xfe\xa2\xe8\x87\xad\x8c\xb5\x8c\xe0\x06\x7a\xf4\xd6\xb6\-    \\xaa\xce\x1e\x7c\xd3\x37\x5f\xec\xce\x78\xa3\x99\x40\x6b\x2a\x42\-    \\x20\xfe\x9e\x35\xd9\xf3\x85\xb9\xee\x39\xd7\xab\x3b\x12\x4e\x8b\-    \\x1d\xc9\xfa\xf7\x4b\x6d\x18\x56\x26\xa3\x66\x31\xea\xe3\x97\xb2\-    \\x3a\x6e\xfa\x74\xdd\x5b\x43\x32\x68\x41\xe7\xf7\xca\x78\x20\xfb\-    \\xfb\x0a\xf5\x4e\xd8\xfe\xb3\x97\x45\x40\x56\xac\xba\x48\x95\x27\-    \\x55\x53\x3a\x3a\x20\x83\x8d\x87\xfe\x6b\xa9\xb7\xd0\x96\x95\x4b\-    \\x55\xa8\x67\xbc\xa1\x15\x9a\x58\xcc\xa9\x29\x63\x99\xe1\xdb\x33\-    \\xa6\x2a\x4a\x56\x3f\x31\x25\xf9\x5e\xf4\x7e\x1c\x90\x29\x31\x7c\-    \\xfd\xf8\xe8\x02\x04\x27\x2f\x70\x80\xbb\x15\x5c\x05\x28\x2c\xe3\-    \\x95\xc1\x15\x48\xe4\xc6\x6d\x22\x48\xc1\x13\x3f\xc7\x0f\x86\xdc\-    \\x07\xf9\xc9\xee\x41\x04\x1f\x0f\x40\x47\x79\xa4\x5d\x88\x6e\x17\-    \\x32\x5f\x51\xeb\xd5\x9b\xc0\xd1\xf2\xbc\xc1\x8f\x41\x11\x35\x64\-    \\x25\x7b\x78\x34\x60\x2a\x9c\x60\xdf\xf8\xe8\xa3\x1f\x63\x6c\x1b\-    \\x0e\x12\xb4\xc2\x02\xe1\x32\x9e\xaf\x66\x4f\xd1\xca\xd1\x81\x15\-    \\x6b\x23\x95\xe0\x33\x3e\x92\xe1\x3b\x24\x0b\x62\xee\xbe\xb9\x22\-    \\x85\xb2\xa2\x0e\xe6\xba\x0d\x99\xde\x72\x0c\x8c\x2d\xa2\xf7\x28\-    \\xd0\x12\x78\x45\x95\xb7\x94\xfd\x64\x7d\x08\x62\xe7\xcc\xf5\xf0\-    \\x54\x49\xa3\x6f\x87\x7d\x48\xfa\xc3\x9d\xfd\x27\xf3\x3e\x8d\x1e\-    \\x0a\x47\x63\x41\x99\x2e\xff\x74\x3a\x6f\x6e\xab\xf4\xf8\xfd\x37\-    \\xa8\x12\xdc\x60\xa1\xeb\xdd\xf8\x99\x1b\xe1\x4c\xdb\x6e\x6b\x0d\-    \\xc6\x7b\x55\x10\x6d\x67\x2c\x37\x27\x65\xd4\x3b\xdc\xd0\xe8\x04\-    \\xf1\x29\x0d\xc7\xcc\x00\xff\xa3\xb5\x39\x0f\x92\x69\x0f\xed\x0b\-    \\x66\x7b\x9f\xfb\xce\xdb\x7d\x9c\xa0\x91\xcf\x0b\xd9\x15\x5e\xa3\-    \\xbb\x13\x2f\x88\x51\x5b\xad\x24\x7b\x94\x79\xbf\x76\x3b\xd6\xeb\-    \\x37\x39\x2e\xb3\xcc\x11\x59\x79\x80\x26\xe2\x97\xf4\x2e\x31\x2d\-    \\x68\x42\xad\xa7\xc6\x6a\x2b\x3b\x12\x75\x4c\xcc\x78\x2e\xf1\x1c\-    \\x6a\x12\x42\x37\xb7\x92\x51\xe7\x06\xa1\xbb\xe6\x4b\xfb\x63\x50\-    \\x1a\x6b\x10\x18\x11\xca\xed\xfa\x3d\x25\xbd\xd8\xe2\xe1\xc3\xc9\-    \\x44\x42\x16\x59\x0a\x12\x13\x86\xd9\x0c\xec\x6e\xd5\xab\xea\x2a\-    \\x64\xaf\x67\x4e\xda\x86\xa8\x5f\xbe\xbf\xe9\x88\x64\xe4\xc3\xfe\-    \\x9d\xbc\x80\x57\xf0\xf7\xc0\x86\x60\x78\x7b\xf8\x60\x03\x60\x4d\-    \\xd1\xfd\x83\x46\xf6\x38\x1f\xb0\x77\x45\xae\x04\xd7\x36\xfc\xcc\-    \\x83\x42\x6b\x33\xf0\x1e\xab\x71\xb0\x80\x41\x87\x3c\x00\x5e\x5f\-    \\x77\xa0\x57\xbe\xbd\xe8\xae\x24\x55\x46\x42\x99\xbf\x58\x2e\x61\-    \\x4e\x58\xf4\x8f\xf2\xdd\xfd\xa2\xf4\x74\xef\x38\x87\x89\xbd\xc2\-    \\x53\x66\xf9\xc3\xc8\xb3\x8e\x74\xb4\x75\xf2\x55\x46\xfc\xd9\xb9\-    \\x7a\xeb\x26\x61\x8b\x1d\xdf\x84\x84\x6a\x0e\x79\x91\x5f\x95\xe2\-    \\x46\x6e\x59\x8e\x20\xb4\x57\x70\x8c\xd5\x55\x91\xc9\x02\xde\x4c\-    \\xb9\x0b\xac\xe1\xbb\x82\x05\xd0\x11\xa8\x62\x48\x75\x74\xa9\x9e\-    \\xb7\x7f\x19\xb6\xe0\xa9\xdc\x09\x66\x2d\x09\xa1\xc4\x32\x46\x33\-    \\xe8\x5a\x1f\x02\x09\xf0\xbe\x8c\x4a\x99\xa0\x25\x1d\x6e\xfe\x10\-    \\x1a\xb9\x3d\x1d\x0b\xa5\xa4\xdf\xa1\x86\xf2\x0f\x28\x68\xf1\x69\-    \\xdc\xb7\xda\x83\x57\x39\x06\xfe\xa1\xe2\xce\x9b\x4f\xcd\x7f\x52\-    \\x50\x11\x5e\x01\xa7\x06\x83\xfa\xa0\x02\xb5\xc4\x0d\xe6\xd0\x27\-    \\x9a\xf8\x8c\x27\x77\x3f\x86\x41\xc3\x60\x4c\x06\x61\xa8\x06\xb5\-    \\xf0\x17\x7a\x28\xc0\xf5\x86\xe0\x00\x60\x58\xaa\x30\xdc\x7d\x62\-    \\x11\xe6\x9e\xd7\x23\x38\xea\x63\x53\xc2\xdd\x94\xc2\xc2\x16\x34\-    \\xbb\xcb\xee\x56\x90\xbc\xb6\xde\xeb\xfc\x7d\xa1\xce\x59\x1d\x76\-    \\x6f\x05\xe4\x09\x4b\x7c\x01\x88\x39\x72\x0a\x3d\x7c\x92\x7c\x24\-    \\x86\xe3\x72\x5f\x72\x4d\x9d\xb9\x1a\xc1\x5b\xb4\xd3\x9e\xb8\xfc\-    \\xed\x54\x55\x78\x08\xfc\xa5\xb5\xd8\x3d\x7c\xd3\x4d\xad\x0f\xc4\-    \\x1e\x50\xef\x5e\xb1\x61\xe6\xf8\xa2\x85\x14\xd9\x6c\x51\x13\x3c\-    \\x6f\xd5\xc7\xe7\x56\xe1\x4e\xc4\x36\x2a\xbf\xce\xdd\xc6\xc8\x37\-    \\xd7\x9a\x32\x34\x92\x63\x82\x12\x67\x0e\xfa\x8e\x40\x60\x00\xe0\-    \\x3a\x39\xce\x37\xd3\xfa\xf5\xcf\xab\xc2\x77\x37\x5a\xc5\x2d\x1b\-    \\x5c\xb0\x67\x9e\x4f\xa3\x37\x42\xd3\x82\x27\x40\x99\xbc\x9b\xbe\-    \\xd5\x11\x8e\x9d\xbf\x0f\x73\x15\xd6\x2d\x1c\x7e\xc7\x00\xc4\x7b\-    \\xb7\x8c\x1b\x6b\x21\xa1\x90\x45\xb2\x6e\xb1\xbe\x6a\x36\x6e\xb4\-    \\x57\x48\xab\x2f\xbc\x94\x6e\x79\xc6\xa3\x76\xd2\x65\x49\xc2\xc8\-    \\x53\x0f\xf8\xee\x46\x8d\xde\x7d\xd5\x73\x0a\x1d\x4c\xd0\x4d\xc6\-    \\x29\x39\xbb\xdb\xa9\xba\x46\x50\xac\x95\x26\xe8\xbe\x5e\xe3\x04\-    \\xa1\xfa\xd5\xf0\x6a\x2d\x51\x9a\x63\xef\x8c\xe2\x9a\x86\xee\x22\-    \\xc0\x89\xc2\xb8\x43\x24\x2e\xf6\xa5\x1e\x03\xaa\x9c\xf2\xd0\xa4\-    \\x83\xc0\x61\xba\x9b\xe9\x6a\x4d\x8f\xe5\x15\x50\xba\x64\x5b\xd6\-    \\x28\x26\xa2\xf9\xa7\x3a\x3a\xe1\x4b\xa9\x95\x86\xef\x55\x62\xe9\-    \\xc7\x2f\xef\xd3\xf7\x52\xf7\xda\x3f\x04\x6f\x69\x77\xfa\x0a\x59\-    \\x80\xe4\xa9\x15\x87\xb0\x86\x01\x9b\x09\xe6\xad\x3b\x3e\xe5\x93\-    \\xe9\x90\xfd\x5a\x9e\x34\xd7\x97\x2c\xf0\xb7\xd9\x02\x2b\x8b\x51\-    \\x96\xd5\xac\x3a\x01\x7d\xa6\x7d\xd1\xcf\x3e\xd6\x7c\x7d\x2d\x28\-    \\x1f\x9f\x25\xcf\xad\xf2\xb8\x9b\x5a\xd6\xb4\x72\x5a\x88\xf5\x4c\-    \\xe0\x29\xac\x71\xe0\x19\xa5\xe6\x47\xb0\xac\xfd\xed\x93\xfa\x9b\-    \\xe8\xd3\xc4\x8d\x28\x3b\x57\xcc\xf8\xd5\x66\x29\x79\x13\x2e\x28\-    \\x78\x5f\x01\x91\xed\x75\x60\x55\xf7\x96\x0e\x44\xe3\xd3\x5e\x8c\-    \\x15\x05\x6d\xd4\x88\xf4\x6d\xba\x03\xa1\x61\x25\x05\x64\xf0\xbd\-    \\xc3\xeb\x9e\x15\x3c\x90\x57\xa2\x97\x27\x1a\xec\xa9\x3a\x07\x2a\-    \\x1b\x3f\x6d\x9b\x1e\x63\x21\xf5\xf5\x9c\x66\xfb\x26\xdc\xf3\x19\-    \\x75\x33\xd9\x28\xb1\x55\xfd\xf5\x03\x56\x34\x82\x8a\xba\x3c\xbb\-    \\x28\x51\x77\x11\xc2\x0a\xd9\xf8\xab\xcc\x51\x67\xcc\xad\x92\x5f\-    \\x4d\xe8\x17\x51\x38\x30\xdc\x8e\x37\x9d\x58\x62\x93\x20\xf9\x91\-    \\xea\x7a\x90\xc2\xfb\x3e\x7b\xce\x51\x21\xce\x64\x77\x4f\xbe\x32\-    \\xa8\xb6\xe3\x7e\xc3\x29\x3d\x46\x48\xde\x53\x69\x64\x13\xe6\x80\-    \\xa2\xae\x08\x10\xdd\x6d\xb2\x24\x69\x85\x2d\xfd\x09\x07\x21\x66\-    \\xb3\x9a\x46\x0a\x64\x45\xc0\xdd\x58\x6c\xde\xcf\x1c\x20\xc8\xae\-    \\x5b\xbe\xf7\xdd\x1b\x58\x8d\x40\xcc\xd2\x01\x7f\x6b\xb4\xe3\xbb\-    \\xdd\xa2\x6a\x7e\x3a\x59\xff\x45\x3e\x35\x0a\x44\xbc\xb4\xcd\xd5\-    \\x72\xea\xce\xa8\xfa\x64\x84\xbb\x8d\x66\x12\xae\xbf\x3c\x6f\x47\-    \\xd2\x9b\xe4\x63\x54\x2f\x5d\x9e\xae\xc2\x77\x1b\xf6\x4e\x63\x70\-    \\x74\x0e\x0d\x8d\xe7\x5b\x13\x57\xf8\x72\x16\x71\xaf\x53\x7d\x5d\-    \\x40\x40\xcb\x08\x4e\xb4\xe2\xcc\x34\xd2\x46\x6a\x01\x15\xaf\x84\-    \\xe1\xb0\x04\x28\x95\x98\x3a\x1d\x06\xb8\x9f\xb4\xce\x6e\xa0\x48\-    \\x6f\x3f\x3b\x82\x35\x20\xab\x82\x01\x1a\x1d\x4b\x27\x72\x27\xf8\-    \\x61\x15\x60\xb1\xe7\x93\x3f\xdc\xbb\x3a\x79\x2b\x34\x45\x25\xbd\-    \\xa0\x88\x39\xe1\x51\xce\x79\x4b\x2f\x32\xc9\xb7\xa0\x1f\xba\xc9\-    \\xe0\x1c\xc8\x7e\xbc\xc7\xd1\xf6\xcf\x01\x11\xc3\xa1\xe8\xaa\xc7\-    \\x1a\x90\x87\x49\xd4\x4f\xbd\x9a\xd0\xda\xde\xcb\xd5\x0a\xda\x38\-    \\x03\x39\xc3\x2a\xc6\x91\x36\x67\x8d\xf9\x31\x7c\xe0\xb1\x2b\x4f\-    \\xf7\x9e\x59\xb7\x43\xf5\xbb\x3a\xf2\xd5\x19\xff\x27\xd9\x45\x9c\-    \\xbf\x97\x22\x2c\x15\xe6\xfc\x2a\x0f\x91\xfc\x71\x9b\x94\x15\x25\-    \\xfa\xe5\x93\x61\xce\xb6\x9c\xeb\xc2\xa8\x64\x59\x12\xba\xa8\xd1\-    \\xb6\xc1\x07\x5e\xe3\x05\x6a\x0c\x10\xd2\x50\x65\xcb\x03\xa4\x42\-    \\xe0\xec\x6e\x0e\x16\x98\xdb\x3b\x4c\x98\xa0\xbe\x32\x78\xe9\x64\-    \\x9f\x1f\x95\x32\xe0\xd3\x92\xdf\xd3\xa0\x34\x2b\x89\x71\xf2\x1e\-    \\x1b\x0a\x74\x41\x4b\xa3\x34\x8c\xc5\xbe\x71\x20\xc3\x76\x32\xd8\-    \\xdf\x35\x9f\x8d\x9b\x99\x2f\x2e\xe6\x0b\x6f\x47\x0f\xe3\xf1\x1d\-    \\xe5\x4c\xda\x54\x1e\xda\xd8\x91\xce\x62\x79\xcf\xcd\x3e\x7e\x6f\-    \\x16\x18\xb1\x66\xfd\x2c\x1d\x05\x84\x8f\xd2\xc5\xf6\xfb\x22\x99\-    \\xf5\x23\xf3\x57\xa6\x32\x76\x23\x93\xa8\x35\x31\x56\xcc\xcd\x02\-    \\xac\xf0\x81\x62\x5a\x75\xeb\xb5\x6e\x16\x36\x97\x88\xd2\x73\xcc\-    \\xde\x96\x62\x92\x81\xb9\x49\xd0\x4c\x50\x90\x1b\x71\xc6\x56\x14\-    \\xe6\xc6\xc7\xbd\x32\x7a\x14\x0a\x45\xe1\xd0\x06\xc3\xf2\x7b\x9a\-    \\xc9\xaa\x53\xfd\x62\xa8\x0f\x00\xbb\x25\xbf\xe2\x35\xbd\xd2\xf6\-    \\x71\x12\x69\x05\xb2\x04\x02\x22\xb6\xcb\xcf\x7c\xcd\x76\x9c\x2b\-    \\x53\x11\x3e\xc0\x16\x40\xe3\xd3\x38\xab\xbd\x60\x25\x47\xad\xf0\-    \\xba\x38\x20\x9c\xf7\x46\xce\x76\x77\xaf\xa1\xc5\x20\x75\x60\x60\-    \\x85\xcb\xfe\x4e\x8a\xe8\x8d\xd8\x7a\xaa\xf9\xb0\x4c\xf9\xaa\x7e\-    \\x19\x48\xc2\x5c\x02\xfb\x8a\x8c\x01\xc3\x6a\xe4\xd6\xeb\xe1\xf9\-    \\x90\xd4\xf8\x69\xa6\x5c\xde\xa0\x3f\x09\x25\x2d\xc2\x08\xe6\x9f\-    \\xb7\x4e\x61\x32\xce\x77\xe2\x5b\x57\x8f\xdf\xe3\x3a\xc3\x72\xe6\-    \"#+createKeySchedule =+    KeySchedule+        `fmap` mutableArray32FromAddrBE+            1042+            "\+            \\x24\x3f\x6a\x88\x85\xa3\x08\xd3\x13\x19\x8a\x2e\x03\x70\x73\x44\+            \\xa4\x09\x38\x22\x29\x9f\x31\xd0\x08\x2e\xfa\x98\xec\x4e\x6c\x89\+            \\x45\x28\x21\xe6\x38\xd0\x13\x77\xbe\x54\x66\xcf\x34\xe9\x0c\x6c\+            \\xc0\xac\x29\xb7\xc9\x7c\x50\xdd\x3f\x84\xd5\xb5\xb5\x47\x09\x17\+            \\x92\x16\xd5\xd9\x89\x79\xfb\x1b\+            \\xd1\x31\x0b\xa6\x98\xdf\xb5\xac\x2f\xfd\x72\xdb\xd0\x1a\xdf\xb7\+            \\xb8\xe1\xaf\xed\x6a\x26\x7e\x96\xba\x7c\x90\x45\xf1\x2c\x7f\x99\+            \\x24\xa1\x99\x47\xb3\x91\x6c\xf7\x08\x01\xf2\xe2\x85\x8e\xfc\x16\+            \\x63\x69\x20\xd8\x71\x57\x4e\x69\xa4\x58\xfe\xa3\xf4\x93\x3d\x7e\+            \\x0d\x95\x74\x8f\x72\x8e\xb6\x58\x71\x8b\xcd\x58\x82\x15\x4a\xee\+            \\x7b\x54\xa4\x1d\xc2\x5a\x59\xb5\x9c\x30\xd5\x39\x2a\xf2\x60\x13\+            \\xc5\xd1\xb0\x23\x28\x60\x85\xf0\xca\x41\x79\x18\xb8\xdb\x38\xef\+            \\x8e\x79\xdc\xb0\x60\x3a\x18\x0e\x6c\x9e\x0e\x8b\xb0\x1e\x8a\x3e\+            \\xd7\x15\x77\xc1\xbd\x31\x4b\x27\x78\xaf\x2f\xda\x55\x60\x5c\x60\+            \\xe6\x55\x25\xf3\xaa\x55\xab\x94\x57\x48\x98\x62\x63\xe8\x14\x40\+            \\x55\xca\x39\x6a\x2a\xab\x10\xb6\xb4\xcc\x5c\x34\x11\x41\xe8\xce\+            \\xa1\x54\x86\xaf\x7c\x72\xe9\x93\xb3\xee\x14\x11\x63\x6f\xbc\x2a\+            \\x2b\xa9\xc5\x5d\x74\x18\x31\xf6\xce\x5c\x3e\x16\x9b\x87\x93\x1e\+            \\xaf\xd6\xba\x33\x6c\x24\xcf\x5c\x7a\x32\x53\x81\x28\x95\x86\x77\+            \\x3b\x8f\x48\x98\x6b\x4b\xb9\xaf\xc4\xbf\xe8\x1b\x66\x28\x21\x93\+            \\x61\xd8\x09\xcc\xfb\x21\xa9\x91\x48\x7c\xac\x60\x5d\xec\x80\x32\+            \\xef\x84\x5d\x5d\xe9\x85\x75\xb1\xdc\x26\x23\x02\xeb\x65\x1b\x88\+            \\x23\x89\x3e\x81\xd3\x96\xac\xc5\x0f\x6d\x6f\xf3\x83\xf4\x42\x39\+            \\x2e\x0b\x44\x82\xa4\x84\x20\x04\x69\xc8\xf0\x4a\x9e\x1f\x9b\x5e\+            \\x21\xc6\x68\x42\xf6\xe9\x6c\x9a\x67\x0c\x9c\x61\xab\xd3\x88\xf0\+            \\x6a\x51\xa0\xd2\xd8\x54\x2f\x68\x96\x0f\xa7\x28\xab\x51\x33\xa3\+            \\x6e\xef\x0b\x6c\x13\x7a\x3b\xe4\xba\x3b\xf0\x50\x7e\xfb\x2a\x98\+            \\xa1\xf1\x65\x1d\x39\xaf\x01\x76\x66\xca\x59\x3e\x82\x43\x0e\x88\+            \\x8c\xee\x86\x19\x45\x6f\x9f\xb4\x7d\x84\xa5\xc3\x3b\x8b\x5e\xbe\+            \\xe0\x6f\x75\xd8\x85\xc1\x20\x73\x40\x1a\x44\x9f\x56\xc1\x6a\xa6\+            \\x4e\xd3\xaa\x62\x36\x3f\x77\x06\x1b\xfe\xdf\x72\x42\x9b\x02\x3d\+            \\x37\xd0\xd7\x24\xd0\x0a\x12\x48\xdb\x0f\xea\xd3\x49\xf1\xc0\x9b\+            \\x07\x53\x72\xc9\x80\x99\x1b\x7b\x25\xd4\x79\xd8\xf6\xe8\xde\xf7\+            \\xe3\xfe\x50\x1a\xb6\x79\x4c\x3b\x97\x6c\xe0\xbd\x04\xc0\x06\xba\+            \\xc1\xa9\x4f\xb6\x40\x9f\x60\xc4\x5e\x5c\x9e\xc2\x19\x6a\x24\x63\+            \\x68\xfb\x6f\xaf\x3e\x6c\x53\xb5\x13\x39\xb2\xeb\x3b\x52\xec\x6f\+            \\x6d\xfc\x51\x1f\x9b\x30\x95\x2c\xcc\x81\x45\x44\xaf\x5e\xbd\x09\+            \\xbe\xe3\xd0\x04\xde\x33\x4a\xfd\x66\x0f\x28\x07\x19\x2e\x4b\xb3\+            \\xc0\xcb\xa8\x57\x45\xc8\x74\x0f\xd2\x0b\x5f\x39\xb9\xd3\xfb\xdb\+            \\x55\x79\xc0\xbd\x1a\x60\x32\x0a\xd6\xa1\x00\xc6\x40\x2c\x72\x79\+            \\x67\x9f\x25\xfe\xfb\x1f\xa3\xcc\x8e\xa5\xe9\xf8\xdb\x32\x22\xf8\+            \\x3c\x75\x16\xdf\xfd\x61\x6b\x15\x2f\x50\x1e\xc8\xad\x05\x52\xab\+            \\x32\x3d\xb5\xfa\xfd\x23\x87\x60\x53\x31\x7b\x48\x3e\x00\xdf\x82\+            \\x9e\x5c\x57\xbb\xca\x6f\x8c\xa0\x1a\x87\x56\x2e\xdf\x17\x69\xdb\+            \\xd5\x42\xa8\xf6\x28\x7e\xff\xc3\xac\x67\x32\xc6\x8c\x4f\x55\x73\+            \\x69\x5b\x27\xb0\xbb\xca\x58\xc8\xe1\xff\xa3\x5d\xb8\xf0\x11\xa0\+            \\x10\xfa\x3d\x98\xfd\x21\x83\xb8\x4a\xfc\xb5\x6c\x2d\xd1\xd3\x5b\+            \\x9a\x53\xe4\x79\xb6\xf8\x45\x65\xd2\x8e\x49\xbc\x4b\xfb\x97\x90\+            \\xe1\xdd\xf2\xda\xa4\xcb\x7e\x33\x62\xfb\x13\x41\xce\xe4\xc6\xe8\+            \\xef\x20\xca\xda\x36\x77\x4c\x01\xd0\x7e\x9e\xfe\x2b\xf1\x1f\xb4\+            \\x95\xdb\xda\x4d\xae\x90\x91\x98\xea\xad\x8e\x71\x6b\x93\xd5\xa0\+            \\xd0\x8e\xd1\xd0\xaf\xc7\x25\xe0\x8e\x3c\x5b\x2f\x8e\x75\x94\xb7\+            \\x8f\xf6\xe2\xfb\xf2\x12\x2b\x64\x88\x88\xb8\x12\x90\x0d\xf0\x1c\+            \\x4f\xad\x5e\xa0\x68\x8f\xc3\x1c\xd1\xcf\xf1\x91\xb3\xa8\xc1\xad\+            \\x2f\x2f\x22\x18\xbe\x0e\x17\x77\xea\x75\x2d\xfe\x8b\x02\x1f\xa1\+            \\xe5\xa0\xcc\x0f\xb5\x6f\x74\xe8\x18\xac\xf3\xd6\xce\x89\xe2\x99\+            \\xb4\xa8\x4f\xe0\xfd\x13\xe0\xb7\x7c\xc4\x3b\x81\xd2\xad\xa8\xd9\+            \\x16\x5f\xa2\x66\x80\x95\x77\x05\x93\xcc\x73\x14\x21\x1a\x14\x77\+            \\xe6\xad\x20\x65\x77\xb5\xfa\x86\xc7\x54\x42\xf5\xfb\x9d\x35\xcf\+            \\xeb\xcd\xaf\x0c\x7b\x3e\x89\xa0\xd6\x41\x1b\xd3\xae\x1e\x7e\x49\+            \\x00\x25\x0e\x2d\x20\x71\xb3\x5e\x22\x68\x00\xbb\x57\xb8\xe0\xaf\+            \\x24\x64\x36\x9b\xf0\x09\xb9\x1e\x55\x63\x91\x1d\x59\xdf\xa6\xaa\+            \\x78\xc1\x43\x89\xd9\x5a\x53\x7f\x20\x7d\x5b\xa2\x02\xe5\xb9\xc5\+            \\x83\x26\x03\x76\x62\x95\xcf\xa9\x11\xc8\x19\x68\x4e\x73\x4a\x41\+            \\xb3\x47\x2d\xca\x7b\x14\xa9\x4a\x1b\x51\x00\x52\x9a\x53\x29\x15\+            \\xd6\x0f\x57\x3f\xbc\x9b\xc6\xe4\x2b\x60\xa4\x76\x81\xe6\x74\x00\+            \\x08\xba\x6f\xb5\x57\x1b\xe9\x1f\xf2\x96\xec\x6b\x2a\x0d\xd9\x15\+            \\xb6\x63\x65\x21\xe7\xb9\xf9\xb6\xff\x34\x05\x2e\xc5\x85\x56\x64\+            \\x53\xb0\x2d\x5d\xa9\x9f\x8f\xa1\x08\xba\x47\x99\x6e\x85\x07\x6a\+            \\x4b\x7a\x70\xe9\xb5\xb3\x29\x44\xdb\x75\x09\x2e\xc4\x19\x26\x23\+            \\xad\x6e\xa6\xb0\x49\xa7\xdf\x7d\x9c\xee\x60\xb8\x8f\xed\xb2\x66\+            \\xec\xaa\x8c\x71\x69\x9a\x17\xff\x56\x64\x52\x6c\xc2\xb1\x9e\xe1\+            \\x19\x36\x02\xa5\x75\x09\x4c\x29\xa0\x59\x13\x40\xe4\x18\x3a\x3e\+            \\x3f\x54\x98\x9a\x5b\x42\x9d\x65\x6b\x8f\xe4\xd6\x99\xf7\x3f\xd6\+            \\xa1\xd2\x9c\x07\xef\xe8\x30\xf5\x4d\x2d\x38\xe6\xf0\x25\x5d\xc1\+            \\x4c\xdd\x20\x86\x84\x70\xeb\x26\x63\x82\xe9\xc6\x02\x1e\xcc\x5e\+            \\x09\x68\x6b\x3f\x3e\xba\xef\xc9\x3c\x97\x18\x14\x6b\x6a\x70\xa1\+            \\x68\x7f\x35\x84\x52\xa0\xe2\x86\xb7\x9c\x53\x05\xaa\x50\x07\x37\+            \\x3e\x07\x84\x1c\x7f\xde\xae\x5c\x8e\x7d\x44\xec\x57\x16\xf2\xb8\+            \\xb0\x3a\xda\x37\xf0\x50\x0c\x0d\xf0\x1c\x1f\x04\x02\x00\xb3\xff\+            \\xae\x0c\xf5\x1a\x3c\xb5\x74\xb2\x25\x83\x7a\x58\xdc\x09\x21\xbd\+            \\xd1\x91\x13\xf9\x7c\xa9\x2f\xf6\x94\x32\x47\x73\x22\xf5\x47\x01\+            \\x3a\xe5\xe5\x81\x37\xc2\xda\xdc\xc8\xb5\x76\x34\x9a\xf3\xdd\xa7\+            \\xa9\x44\x61\x46\x0f\xd0\x03\x0e\xec\xc8\xc7\x3e\xa4\x75\x1e\x41\+            \\xe2\x38\xcd\x99\x3b\xea\x0e\x2f\x32\x80\xbb\xa1\x18\x3e\xb3\x31\+            \\x4e\x54\x8b\x38\x4f\x6d\xb9\x08\x6f\x42\x0d\x03\xf6\x0a\x04\xbf\+            \\x2c\xb8\x12\x90\x24\x97\x7c\x79\x56\x79\xb0\x72\xbc\xaf\x89\xaf\+            \\xde\x9a\x77\x1f\xd9\x93\x08\x10\xb3\x8b\xae\x12\xdc\xcf\x3f\x2e\+            \\x55\x12\x72\x1f\x2e\x6b\x71\x24\x50\x1a\xdd\xe6\x9f\x84\xcd\x87\+            \\x7a\x58\x47\x18\x74\x08\xda\x17\xbc\x9f\x9a\xbc\xe9\x4b\x7d\x8c\+            \\xec\x7a\xec\x3a\xdb\x85\x1d\xfa\x63\x09\x43\x66\xc4\x64\xc3\xd2\+            \\xef\x1c\x18\x47\x32\x15\xd9\x08\xdd\x43\x3b\x37\x24\xc2\xba\x16\+            \\x12\xa1\x4d\x43\x2a\x65\xc4\x51\x50\x94\x00\x02\x13\x3a\xe4\xdd\+            \\x71\xdf\xf8\x9e\x10\x31\x4e\x55\x81\xac\x77\xd6\x5f\x11\x19\x9b\+            \\x04\x35\x56\xf1\xd7\xa3\xc7\x6b\x3c\x11\x18\x3b\x59\x24\xa5\x09\+            \\xf2\x8f\xe6\xed\x97\xf1\xfb\xfa\x9e\xba\xbf\x2c\x1e\x15\x3c\x6e\+            \\x86\xe3\x45\x70\xea\xe9\x6f\xb1\x86\x0e\x5e\x0a\x5a\x3e\x2a\xb3\+            \\x77\x1f\xe7\x1c\x4e\x3d\x06\xfa\x29\x65\xdc\xb9\x99\xe7\x1d\x0f\+            \\x80\x3e\x89\xd6\x52\x66\xc8\x25\x2e\x4c\xc9\x78\x9c\x10\xb3\x6a\+            \\xc6\x15\x0e\xba\x94\xe2\xea\x78\xa5\xfc\x3c\x53\x1e\x0a\x2d\xf4\+            \\xf2\xf7\x4e\xa7\x36\x1d\x2b\x3d\x19\x39\x26\x0f\x19\xc2\x79\x60\+            \\x52\x23\xa7\x08\xf7\x13\x12\xb6\xeb\xad\xfe\x6e\xea\xc3\x1f\x66\+            \\xe3\xbc\x45\x95\xa6\x7b\xc8\x83\xb1\x7f\x37\xd1\x01\x8c\xff\x28\+            \\xc3\x32\xdd\xef\xbe\x6c\x5a\xa5\x65\x58\x21\x85\x68\xab\x98\x02\+            \\xee\xce\xa5\x0f\xdb\x2f\x95\x3b\x2a\xef\x7d\xad\x5b\x6e\x2f\x84\+            \\x15\x21\xb6\x28\x29\x07\x61\x70\xec\xdd\x47\x75\x61\x9f\x15\x10\+            \\x13\xcc\xa8\x30\xeb\x61\xbd\x96\x03\x34\xfe\x1e\xaa\x03\x63\xcf\+            \\xb5\x73\x5c\x90\x4c\x70\xa2\x39\xd5\x9e\x9e\x0b\xcb\xaa\xde\x14\+            \\xee\xcc\x86\xbc\x60\x62\x2c\xa7\x9c\xab\x5c\xab\xb2\xf3\x84\x6e\+            \\x64\x8b\x1e\xaf\x19\xbd\xf0\xca\xa0\x23\x69\xb9\x65\x5a\xbb\x50\+            \\x40\x68\x5a\x32\x3c\x2a\xb4\xb3\x31\x9e\xe9\xd5\xc0\x21\xb8\xf7\+            \\x9b\x54\x0b\x19\x87\x5f\xa0\x99\x95\xf7\x99\x7e\x62\x3d\x7d\xa8\+            \\xf8\x37\x88\x9a\x97\xe3\x2d\x77\x11\xed\x93\x5f\x16\x68\x12\x81\+            \\x0e\x35\x88\x29\xc7\xe6\x1f\xd6\x96\xde\xdf\xa1\x78\x58\xba\x99\+            \\x57\xf5\x84\xa5\x1b\x22\x72\x63\x9b\x83\xc3\xff\x1a\xc2\x46\x96\+            \\xcd\xb3\x0a\xeb\x53\x2e\x30\x54\x8f\xd9\x48\xe4\x6d\xbc\x31\x28\+            \\x58\xeb\xf2\xef\x34\xc6\xff\xea\xfe\x28\xed\x61\xee\x7c\x3c\x73\+            \\x5d\x4a\x14\xd9\xe8\x64\xb7\xe3\x42\x10\x5d\x14\x20\x3e\x13\xe0\+            \\x45\xee\xe2\xb6\xa3\xaa\xab\xea\xdb\x6c\x4f\x15\xfa\xcb\x4f\xd0\+            \\xc7\x42\xf4\x42\xef\x6a\xbb\xb5\x65\x4f\x3b\x1d\x41\xcd\x21\x05\+            \\xd8\x1e\x79\x9e\x86\x85\x4d\xc7\xe4\x4b\x47\x6a\x3d\x81\x62\x50\+            \\xcf\x62\xa1\xf2\x5b\x8d\x26\x46\xfc\x88\x83\xa0\xc1\xc7\xb6\xa3\+            \\x7f\x15\x24\xc3\x69\xcb\x74\x92\x47\x84\x8a\x0b\x56\x92\xb2\x85\+            \\x09\x5b\xbf\x00\xad\x19\x48\x9d\x14\x62\xb1\x74\x23\x82\x0e\x00\+            \\x58\x42\x8d\x2a\x0c\x55\xf5\xea\x1d\xad\xf4\x3e\x23\x3f\x70\x61\+            \\x33\x72\xf0\x92\x8d\x93\x7e\x41\xd6\x5f\xec\xf1\x6c\x22\x3b\xdb\+            \\x7c\xde\x37\x59\xcb\xee\x74\x60\x40\x85\xf2\xa7\xce\x77\x32\x6e\+            \\xa6\x07\x80\x84\x19\xf8\x50\x9e\xe8\xef\xd8\x55\x61\xd9\x97\x35\+            \\xa9\x69\xa7\xaa\xc5\x0c\x06\xc2\x5a\x04\xab\xfc\x80\x0b\xca\xdc\+            \\x9e\x44\x7a\x2e\xc3\x45\x34\x84\xfd\xd5\x67\x05\x0e\x1e\x9e\xc9\+            \\xdb\x73\xdb\xd3\x10\x55\x88\xcd\x67\x5f\xda\x79\xe3\x67\x43\x40\+            \\xc5\xc4\x34\x65\x71\x3e\x38\xd8\x3d\x28\xf8\x9e\xf1\x6d\xff\x20\+            \\x15\x3e\x21\xe7\x8f\xb0\x3d\x4a\xe6\xe3\x9f\x2b\xdb\x83\xad\xf7\+            \\xe9\x3d\x5a\x68\x94\x81\x40\xf7\xf6\x4c\x26\x1c\x94\x69\x29\x34\+            \\x41\x15\x20\xf7\x76\x02\xd4\xf7\xbc\xf4\x6b\x2e\xd4\xa2\x00\x68\+            \\xd4\x08\x24\x71\x33\x20\xf4\x6a\x43\xb7\xd4\xb7\x50\x00\x61\xaf\+            \\x1e\x39\xf6\x2e\x97\x24\x45\x46\x14\x21\x4f\x74\xbf\x8b\x88\x40\+            \\x4d\x95\xfc\x1d\x96\xb5\x91\xaf\x70\xf4\xdd\xd3\x66\xa0\x2f\x45\+            \\xbf\xbc\x09\xec\x03\xbd\x97\x85\x7f\xac\x6d\xd0\x31\xcb\x85\x04\+            \\x96\xeb\x27\xb3\x55\xfd\x39\x41\xda\x25\x47\xe6\xab\xca\x0a\x9a\+            \\x28\x50\x78\x25\x53\x04\x29\xf4\x0a\x2c\x86\xda\xe9\xb6\x6d\xfb\+            \\x68\xdc\x14\x62\xd7\x48\x69\x00\x68\x0e\xc0\xa4\x27\xa1\x8d\xee\+            \\x4f\x3f\xfe\xa2\xe8\x87\xad\x8c\xb5\x8c\xe0\x06\x7a\xf4\xd6\xb6\+            \\xaa\xce\x1e\x7c\xd3\x37\x5f\xec\xce\x78\xa3\x99\x40\x6b\x2a\x42\+            \\x20\xfe\x9e\x35\xd9\xf3\x85\xb9\xee\x39\xd7\xab\x3b\x12\x4e\x8b\+            \\x1d\xc9\xfa\xf7\x4b\x6d\x18\x56\x26\xa3\x66\x31\xea\xe3\x97\xb2\+            \\x3a\x6e\xfa\x74\xdd\x5b\x43\x32\x68\x41\xe7\xf7\xca\x78\x20\xfb\+            \\xfb\x0a\xf5\x4e\xd8\xfe\xb3\x97\x45\x40\x56\xac\xba\x48\x95\x27\+            \\x55\x53\x3a\x3a\x20\x83\x8d\x87\xfe\x6b\xa9\xb7\xd0\x96\x95\x4b\+            \\x55\xa8\x67\xbc\xa1\x15\x9a\x58\xcc\xa9\x29\x63\x99\xe1\xdb\x33\+            \\xa6\x2a\x4a\x56\x3f\x31\x25\xf9\x5e\xf4\x7e\x1c\x90\x29\x31\x7c\+            \\xfd\xf8\xe8\x02\x04\x27\x2f\x70\x80\xbb\x15\x5c\x05\x28\x2c\xe3\+            \\x95\xc1\x15\x48\xe4\xc6\x6d\x22\x48\xc1\x13\x3f\xc7\x0f\x86\xdc\+            \\x07\xf9\xc9\xee\x41\x04\x1f\x0f\x40\x47\x79\xa4\x5d\x88\x6e\x17\+            \\x32\x5f\x51\xeb\xd5\x9b\xc0\xd1\xf2\xbc\xc1\x8f\x41\x11\x35\x64\+            \\x25\x7b\x78\x34\x60\x2a\x9c\x60\xdf\xf8\xe8\xa3\x1f\x63\x6c\x1b\+            \\x0e\x12\xb4\xc2\x02\xe1\x32\x9e\xaf\x66\x4f\xd1\xca\xd1\x81\x15\+            \\x6b\x23\x95\xe0\x33\x3e\x92\xe1\x3b\x24\x0b\x62\xee\xbe\xb9\x22\+            \\x85\xb2\xa2\x0e\xe6\xba\x0d\x99\xde\x72\x0c\x8c\x2d\xa2\xf7\x28\+            \\xd0\x12\x78\x45\x95\xb7\x94\xfd\x64\x7d\x08\x62\xe7\xcc\xf5\xf0\+            \\x54\x49\xa3\x6f\x87\x7d\x48\xfa\xc3\x9d\xfd\x27\xf3\x3e\x8d\x1e\+            \\x0a\x47\x63\x41\x99\x2e\xff\x74\x3a\x6f\x6e\xab\xf4\xf8\xfd\x37\+            \\xa8\x12\xdc\x60\xa1\xeb\xdd\xf8\x99\x1b\xe1\x4c\xdb\x6e\x6b\x0d\+            \\xc6\x7b\x55\x10\x6d\x67\x2c\x37\x27\x65\xd4\x3b\xdc\xd0\xe8\x04\+            \\xf1\x29\x0d\xc7\xcc\x00\xff\xa3\xb5\x39\x0f\x92\x69\x0f\xed\x0b\+            \\x66\x7b\x9f\xfb\xce\xdb\x7d\x9c\xa0\x91\xcf\x0b\xd9\x15\x5e\xa3\+            \\xbb\x13\x2f\x88\x51\x5b\xad\x24\x7b\x94\x79\xbf\x76\x3b\xd6\xeb\+            \\x37\x39\x2e\xb3\xcc\x11\x59\x79\x80\x26\xe2\x97\xf4\x2e\x31\x2d\+            \\x68\x42\xad\xa7\xc6\x6a\x2b\x3b\x12\x75\x4c\xcc\x78\x2e\xf1\x1c\+            \\x6a\x12\x42\x37\xb7\x92\x51\xe7\x06\xa1\xbb\xe6\x4b\xfb\x63\x50\+            \\x1a\x6b\x10\x18\x11\xca\xed\xfa\x3d\x25\xbd\xd8\xe2\xe1\xc3\xc9\+            \\x44\x42\x16\x59\x0a\x12\x13\x86\xd9\x0c\xec\x6e\xd5\xab\xea\x2a\+            \\x64\xaf\x67\x4e\xda\x86\xa8\x5f\xbe\xbf\xe9\x88\x64\xe4\xc3\xfe\+            \\x9d\xbc\x80\x57\xf0\xf7\xc0\x86\x60\x78\x7b\xf8\x60\x03\x60\x4d\+            \\xd1\xfd\x83\x46\xf6\x38\x1f\xb0\x77\x45\xae\x04\xd7\x36\xfc\xcc\+            \\x83\x42\x6b\x33\xf0\x1e\xab\x71\xb0\x80\x41\x87\x3c\x00\x5e\x5f\+            \\x77\xa0\x57\xbe\xbd\xe8\xae\x24\x55\x46\x42\x99\xbf\x58\x2e\x61\+            \\x4e\x58\xf4\x8f\xf2\xdd\xfd\xa2\xf4\x74\xef\x38\x87\x89\xbd\xc2\+            \\x53\x66\xf9\xc3\xc8\xb3\x8e\x74\xb4\x75\xf2\x55\x46\xfc\xd9\xb9\+            \\x7a\xeb\x26\x61\x8b\x1d\xdf\x84\x84\x6a\x0e\x79\x91\x5f\x95\xe2\+            \\x46\x6e\x59\x8e\x20\xb4\x57\x70\x8c\xd5\x55\x91\xc9\x02\xde\x4c\+            \\xb9\x0b\xac\xe1\xbb\x82\x05\xd0\x11\xa8\x62\x48\x75\x74\xa9\x9e\+            \\xb7\x7f\x19\xb6\xe0\xa9\xdc\x09\x66\x2d\x09\xa1\xc4\x32\x46\x33\+            \\xe8\x5a\x1f\x02\x09\xf0\xbe\x8c\x4a\x99\xa0\x25\x1d\x6e\xfe\x10\+            \\x1a\xb9\x3d\x1d\x0b\xa5\xa4\xdf\xa1\x86\xf2\x0f\x28\x68\xf1\x69\+            \\xdc\xb7\xda\x83\x57\x39\x06\xfe\xa1\xe2\xce\x9b\x4f\xcd\x7f\x52\+            \\x50\x11\x5e\x01\xa7\x06\x83\xfa\xa0\x02\xb5\xc4\x0d\xe6\xd0\x27\+            \\x9a\xf8\x8c\x27\x77\x3f\x86\x41\xc3\x60\x4c\x06\x61\xa8\x06\xb5\+            \\xf0\x17\x7a\x28\xc0\xf5\x86\xe0\x00\x60\x58\xaa\x30\xdc\x7d\x62\+            \\x11\xe6\x9e\xd7\x23\x38\xea\x63\x53\xc2\xdd\x94\xc2\xc2\x16\x34\+            \\xbb\xcb\xee\x56\x90\xbc\xb6\xde\xeb\xfc\x7d\xa1\xce\x59\x1d\x76\+            \\x6f\x05\xe4\x09\x4b\x7c\x01\x88\x39\x72\x0a\x3d\x7c\x92\x7c\x24\+            \\x86\xe3\x72\x5f\x72\x4d\x9d\xb9\x1a\xc1\x5b\xb4\xd3\x9e\xb8\xfc\+            \\xed\x54\x55\x78\x08\xfc\xa5\xb5\xd8\x3d\x7c\xd3\x4d\xad\x0f\xc4\+            \\x1e\x50\xef\x5e\xb1\x61\xe6\xf8\xa2\x85\x14\xd9\x6c\x51\x13\x3c\+            \\x6f\xd5\xc7\xe7\x56\xe1\x4e\xc4\x36\x2a\xbf\xce\xdd\xc6\xc8\x37\+            \\xd7\x9a\x32\x34\x92\x63\x82\x12\x67\x0e\xfa\x8e\x40\x60\x00\xe0\+            \\x3a\x39\xce\x37\xd3\xfa\xf5\xcf\xab\xc2\x77\x37\x5a\xc5\x2d\x1b\+            \\x5c\xb0\x67\x9e\x4f\xa3\x37\x42\xd3\x82\x27\x40\x99\xbc\x9b\xbe\+            \\xd5\x11\x8e\x9d\xbf\x0f\x73\x15\xd6\x2d\x1c\x7e\xc7\x00\xc4\x7b\+            \\xb7\x8c\x1b\x6b\x21\xa1\x90\x45\xb2\x6e\xb1\xbe\x6a\x36\x6e\xb4\+            \\x57\x48\xab\x2f\xbc\x94\x6e\x79\xc6\xa3\x76\xd2\x65\x49\xc2\xc8\+            \\x53\x0f\xf8\xee\x46\x8d\xde\x7d\xd5\x73\x0a\x1d\x4c\xd0\x4d\xc6\+            \\x29\x39\xbb\xdb\xa9\xba\x46\x50\xac\x95\x26\xe8\xbe\x5e\xe3\x04\+            \\xa1\xfa\xd5\xf0\x6a\x2d\x51\x9a\x63\xef\x8c\xe2\x9a\x86\xee\x22\+            \\xc0\x89\xc2\xb8\x43\x24\x2e\xf6\xa5\x1e\x03\xaa\x9c\xf2\xd0\xa4\+            \\x83\xc0\x61\xba\x9b\xe9\x6a\x4d\x8f\xe5\x15\x50\xba\x64\x5b\xd6\+            \\x28\x26\xa2\xf9\xa7\x3a\x3a\xe1\x4b\xa9\x95\x86\xef\x55\x62\xe9\+            \\xc7\x2f\xef\xd3\xf7\x52\xf7\xda\x3f\x04\x6f\x69\x77\xfa\x0a\x59\+            \\x80\xe4\xa9\x15\x87\xb0\x86\x01\x9b\x09\xe6\xad\x3b\x3e\xe5\x93\+            \\xe9\x90\xfd\x5a\x9e\x34\xd7\x97\x2c\xf0\xb7\xd9\x02\x2b\x8b\x51\+            \\x96\xd5\xac\x3a\x01\x7d\xa6\x7d\xd1\xcf\x3e\xd6\x7c\x7d\x2d\x28\+            \\x1f\x9f\x25\xcf\xad\xf2\xb8\x9b\x5a\xd6\xb4\x72\x5a\x88\xf5\x4c\+            \\xe0\x29\xac\x71\xe0\x19\xa5\xe6\x47\xb0\xac\xfd\xed\x93\xfa\x9b\+            \\xe8\xd3\xc4\x8d\x28\x3b\x57\xcc\xf8\xd5\x66\x29\x79\x13\x2e\x28\+            \\x78\x5f\x01\x91\xed\x75\x60\x55\xf7\x96\x0e\x44\xe3\xd3\x5e\x8c\+            \\x15\x05\x6d\xd4\x88\xf4\x6d\xba\x03\xa1\x61\x25\x05\x64\xf0\xbd\+            \\xc3\xeb\x9e\x15\x3c\x90\x57\xa2\x97\x27\x1a\xec\xa9\x3a\x07\x2a\+            \\x1b\x3f\x6d\x9b\x1e\x63\x21\xf5\xf5\x9c\x66\xfb\x26\xdc\xf3\x19\+            \\x75\x33\xd9\x28\xb1\x55\xfd\xf5\x03\x56\x34\x82\x8a\xba\x3c\xbb\+            \\x28\x51\x77\x11\xc2\x0a\xd9\xf8\xab\xcc\x51\x67\xcc\xad\x92\x5f\+            \\x4d\xe8\x17\x51\x38\x30\xdc\x8e\x37\x9d\x58\x62\x93\x20\xf9\x91\+            \\xea\x7a\x90\xc2\xfb\x3e\x7b\xce\x51\x21\xce\x64\x77\x4f\xbe\x32\+            \\xa8\xb6\xe3\x7e\xc3\x29\x3d\x46\x48\xde\x53\x69\x64\x13\xe6\x80\+            \\xa2\xae\x08\x10\xdd\x6d\xb2\x24\x69\x85\x2d\xfd\x09\x07\x21\x66\+            \\xb3\x9a\x46\x0a\x64\x45\xc0\xdd\x58\x6c\xde\xcf\x1c\x20\xc8\xae\+            \\x5b\xbe\xf7\xdd\x1b\x58\x8d\x40\xcc\xd2\x01\x7f\x6b\xb4\xe3\xbb\+            \\xdd\xa2\x6a\x7e\x3a\x59\xff\x45\x3e\x35\x0a\x44\xbc\xb4\xcd\xd5\+            \\x72\xea\xce\xa8\xfa\x64\x84\xbb\x8d\x66\x12\xae\xbf\x3c\x6f\x47\+            \\xd2\x9b\xe4\x63\x54\x2f\x5d\x9e\xae\xc2\x77\x1b\xf6\x4e\x63\x70\+            \\x74\x0e\x0d\x8d\xe7\x5b\x13\x57\xf8\x72\x16\x71\xaf\x53\x7d\x5d\+            \\x40\x40\xcb\x08\x4e\xb4\xe2\xcc\x34\xd2\x46\x6a\x01\x15\xaf\x84\+            \\xe1\xb0\x04\x28\x95\x98\x3a\x1d\x06\xb8\x9f\xb4\xce\x6e\xa0\x48\+            \\x6f\x3f\x3b\x82\x35\x20\xab\x82\x01\x1a\x1d\x4b\x27\x72\x27\xf8\+            \\x61\x15\x60\xb1\xe7\x93\x3f\xdc\xbb\x3a\x79\x2b\x34\x45\x25\xbd\+            \\xa0\x88\x39\xe1\x51\xce\x79\x4b\x2f\x32\xc9\xb7\xa0\x1f\xba\xc9\+            \\xe0\x1c\xc8\x7e\xbc\xc7\xd1\xf6\xcf\x01\x11\xc3\xa1\xe8\xaa\xc7\+            \\x1a\x90\x87\x49\xd4\x4f\xbd\x9a\xd0\xda\xde\xcb\xd5\x0a\xda\x38\+            \\x03\x39\xc3\x2a\xc6\x91\x36\x67\x8d\xf9\x31\x7c\xe0\xb1\x2b\x4f\+            \\xf7\x9e\x59\xb7\x43\xf5\xbb\x3a\xf2\xd5\x19\xff\x27\xd9\x45\x9c\+            \\xbf\x97\x22\x2c\x15\xe6\xfc\x2a\x0f\x91\xfc\x71\x9b\x94\x15\x25\+            \\xfa\xe5\x93\x61\xce\xb6\x9c\xeb\xc2\xa8\x64\x59\x12\xba\xa8\xd1\+            \\xb6\xc1\x07\x5e\xe3\x05\x6a\x0c\x10\xd2\x50\x65\xcb\x03\xa4\x42\+            \\xe0\xec\x6e\x0e\x16\x98\xdb\x3b\x4c\x98\xa0\xbe\x32\x78\xe9\x64\+            \\x9f\x1f\x95\x32\xe0\xd3\x92\xdf\xd3\xa0\x34\x2b\x89\x71\xf2\x1e\+            \\x1b\x0a\x74\x41\x4b\xa3\x34\x8c\xc5\xbe\x71\x20\xc3\x76\x32\xd8\+            \\xdf\x35\x9f\x8d\x9b\x99\x2f\x2e\xe6\x0b\x6f\x47\x0f\xe3\xf1\x1d\+            \\xe5\x4c\xda\x54\x1e\xda\xd8\x91\xce\x62\x79\xcf\xcd\x3e\x7e\x6f\+            \\x16\x18\xb1\x66\xfd\x2c\x1d\x05\x84\x8f\xd2\xc5\xf6\xfb\x22\x99\+            \\xf5\x23\xf3\x57\xa6\x32\x76\x23\x93\xa8\x35\x31\x56\xcc\xcd\x02\+            \\xac\xf0\x81\x62\x5a\x75\xeb\xb5\x6e\x16\x36\x97\x88\xd2\x73\xcc\+            \\xde\x96\x62\x92\x81\xb9\x49\xd0\x4c\x50\x90\x1b\x71\xc6\x56\x14\+            \\xe6\xc6\xc7\xbd\x32\x7a\x14\x0a\x45\xe1\xd0\x06\xc3\xf2\x7b\x9a\+            \\xc9\xaa\x53\xfd\x62\xa8\x0f\x00\xbb\x25\xbf\xe2\x35\xbd\xd2\xf6\+            \\x71\x12\x69\x05\xb2\x04\x02\x22\xb6\xcb\xcf\x7c\xcd\x76\x9c\x2b\+            \\x53\x11\x3e\xc0\x16\x40\xe3\xd3\x38\xab\xbd\x60\x25\x47\xad\xf0\+            \\xba\x38\x20\x9c\xf7\x46\xce\x76\x77\xaf\xa1\xc5\x20\x75\x60\x60\+            \\x85\xcb\xfe\x4e\x8a\xe8\x8d\xd8\x7a\xaa\xf9\xb0\x4c\xf9\xaa\x7e\+            \\x19\x48\xc2\x5c\x02\xfb\x8a\x8c\x01\xc3\x6a\xe4\xd6\xeb\xe1\xf9\+            \\x90\xd4\xf8\x69\xa6\x5c\xde\xa0\x3f\x09\x25\x2d\xc2\x08\xe6\x9f\+            \\xb7\x4e\x61\x32\xce\x77\xe2\x5b\x57\x8f\xdf\xe3\x3a\xc3\x72\xe6\+            \"#

@@ -1,9 +1,3 @@--- |--- Module      : Crypto.Cipher.Blowfish.Primitive--- License     : BSD-style--- Stability   : experimental--- Portability : Good- -- Rewritten by Vincent Hanquez (c) 2015 --              Lars Petersen (c) 2018 --@@ -12,32 +6,38 @@ --      based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte --           (as found in Crypto-4.2.4) {-# LANGUAGE BangPatterns #-}-module Crypto.Cipher.Blowfish.Primitive-    ( Context-    , initBlowfish-    , encrypt-    , decrypt-    , KeySchedule-    , createKeySchedule-    , freezeKeySchedule-    , expandKey-    , expandKeyWithSalt-    , cipherBlockMutable-    ) where -import           Control.Monad              (when)-import           Data.Bits-import           Data.Memory.Endian-import           Data.Word+-- |+-- Module      : Crypto.Cipher.Blowfish.Primitive+-- License     : BSD-style+-- Stability   : experimental+-- Portability : Good+module Crypto.Cipher.Blowfish.Primitive (+    Context,+    initBlowfish,+    encrypt,+    decrypt,+    KeySchedule,+    createKeySchedule,+    freezeKeySchedule,+    expandKey,+    expandKeyWithSalt,+    cipherBlockMutable,+) where -import           Crypto.Cipher.Blowfish.Box-import           Crypto.Error-import           Crypto.Internal.ByteArray  (ByteArray, ByteArrayAccess)-import qualified Crypto.Internal.ByteArray  as B-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Crypto.Internal.WordArray+import Control.Monad (when)+import Data.Bits+import Data.Memory.Endian+import Data.Word +import Crypto.Cipher.Blowfish.Box+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)+import qualified Crypto.Internal.ByteArray as B+import Crypto.Internal.Compat+import Crypto.Internal.Imports+import Crypto.Internal.WordArray+ newtype Context = Context Array32  instance NFData Context where@@ -49,7 +49,7 @@ initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context initBlowfish key     | B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid-    | otherwise                    = CryptoPassed $ unsafeDoIO $ do+    | otherwise = CryptoPassed $ unsafeDoIO $ do         ks <- createKeySchedule         expandKey ks key         freezeKeySchedule ks@@ -58,43 +58,53 @@ freezeKeySchedule :: KeySchedule -> IO Context freezeKeySchedule (KeySchedule ma) = Context `fmap` mutableArray32Freeze ma -expandKey :: (ByteArrayAccess key) => KeySchedule -> key -> IO ()+expandKey :: ByteArrayAccess key => KeySchedule -> key -> IO () expandKey ks@(KeySchedule ma) key = do-    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont -> do         mutableArrayWriteXor32 ma i l         mutableArrayWriteXor32 ma (i + 1) r         when (i + 2 < 18) (cont a0 a1)     loop 0 0 0-    where-        loop i l r = do-            n <- cipherBlockMutable ks (fromIntegral l `shiftL` 32 .|. fromIntegral r)-            let nl = fromIntegral (n `shiftR` 32)-                nr = fromIntegral (n .&. 0xffffffff)-            mutableArrayWrite32 ma i nl-            mutableArrayWrite32 ma (i + 1) nr-            when (i < 18 + 1024) (loop (i + 2) nl nr)+  where+    loop i l r = do+        n <- cipherBlockMutable ks (fromIntegral l `shiftL` 32 .|. fromIntegral r)+        let nl = fromIntegral (n `shiftR` 32)+            nr = fromIntegral (n .&. 0xffffffff)+        mutableArrayWrite32 ma i nl+        mutableArrayWrite32 ma (i + 1) nr+        when (i < 18 + 1024) (loop (i + 2) nl nr) -expandKeyWithSalt :: (ByteArrayAccess key, ByteArrayAccess salt)+expandKeyWithSalt+    :: (ByteArrayAccess key, ByteArrayAccess salt)     => KeySchedule     -> key     -> salt     -> IO () expandKeyWithSalt ks key salt-    | B.length salt == 16 = expandKeyWithSalt128 ks key (fromBE $ B.toW64BE salt 0) (fromBE $ B.toW64BE salt 8)-    | otherwise           = expandKeyWithSaltAny ks key salt+    | B.length salt == 16 =+        expandKeyWithSalt128+            ks+            key+            (fromBE $ B.toW64BE salt 0)+            (fromBE $ B.toW64BE salt 8)+    | otherwise = expandKeyWithSaltAny ks key salt -expandKeyWithSaltAny :: (ByteArrayAccess key, ByteArrayAccess salt)-    => KeySchedule         -- ^ The key schedule-    -> key                 -- ^ The key-    -> salt                -- ^ The salt+expandKeyWithSaltAny+    :: (ByteArrayAccess key, ByteArrayAccess salt)+    => KeySchedule+    -- ^ The key schedule+    -> key+    -- ^ The key+    -> salt+    -- ^ The salt     -> IO () expandKeyWithSaltAny ks@(KeySchedule ma) key salt = do-    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont -> do         mutableArrayWriteXor32 ma i l         mutableArrayWriteXor32 ma (i + 1) r         when (i + 2 < 18) (cont a0 a1)     -- Go through the entire key schedule overwriting the P-Array and S-Boxes-    when (B.length salt > 0) $ iterKeyStream salt 0 0 $ \i l r a0 a1 cont-> do+    when (B.length salt > 0) $ iterKeyStream salt 0 0 $ \i l r a0 a1 cont -> do         let l' = xor l a0         let r' = xor r a1         n <- cipherBlockMutable ks (fromIntegral l' `shiftL` 32 .|. fromIntegral r')@@ -104,112 +114,119 @@         mutableArrayWrite32 ma (i + 1) nr         when (i + 2 < 18 + 1024) (cont nl nr) -expandKeyWithSalt128 :: ByteArrayAccess ba-    => KeySchedule         -- ^ The key schedule-    -> ba                  -- ^ The key-    -> Word64              -- ^ First word of the salt-    -> Word64              -- ^ Second word of the salt+expandKeyWithSalt128+    :: ByteArrayAccess ba+    => KeySchedule+    -- ^ The key schedule+    -> ba+    -- ^ The key+    -> Word64+    -- ^ First word of the salt+    -> Word64+    -- ^ Second word of the salt     -> IO () expandKeyWithSalt128 ks@(KeySchedule ma) key salt1 salt2 = do-    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do+    when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont -> do         mutableArrayWriteXor32 ma i l         mutableArrayWriteXor32 ma (i + 1) r         when (i + 2 < 18) (cont a0 a1)     -- Go through the entire key schedule overwriting the P-Array and S-Boxes     loop 0 salt1 salt1 salt2-    where-        loop i input slt1 slt2-            | i == 1042   = return ()-            | otherwise = do-                n <- cipherBlockMutable ks input-                let nl = fromIntegral (n `shiftR` 32)-                    nr = fromIntegral (n .&. 0xffffffff)-                mutableArrayWrite32 ma i     nl-                mutableArrayWrite32 ma (i+1) nr-                loop (i+2) (n `xor` slt2) slt2 slt1+  where+    loop i input slt1 slt2+        | i == 1042 = return ()+        | otherwise = do+            n <- cipherBlockMutable ks input+            let nl = fromIntegral (n `shiftR` 32)+                nr = fromIntegral (n .&. 0xffffffff)+            mutableArrayWrite32 ma i nl+            mutableArrayWrite32 ma (i + 1) nr+            loop (i + 2) (n `xor` slt2) slt2 slt1  -- | Encrypt blocks -- -- Input need to be a multiple of 8 bytes encrypt :: ByteArray ba => Context -> ba -> ba encrypt ctx ba-    | B.length ba == 0         = B.empty+    | B.length ba == 0 = B.empty     | B.length ba `mod` 8 /= 0 = error "invalid data length"-    | otherwise                = B.mapAsWord64 (cipherBlock ctx False) ba+    | otherwise = B.mapAsWord64 (cipherBlock ctx False) ba  -- | Decrypt blocks -- -- Input need to be a multiple of 8 bytes decrypt :: ByteArray ba => Context -> ba -> ba decrypt ctx ba-    | B.length ba == 0         = B.empty+    | B.length ba == 0 = B.empty     | B.length ba `mod` 8 /= 0 = error "invalid data length"-    | otherwise                = B.mapAsWord64 (cipherBlock ctx True) ba+    | otherwise = B.mapAsWord64 (cipherBlock ctx True) ba  -- | Encrypt or decrypt a single block of 64 bits. -- -- The inverse argument decides whether to encrypt or decrypt. cipherBlock :: Context -> Bool -> Word64 -> Word64 cipherBlock (Context ar) inverse input = doRound input 0-    where-    -- | Transform the input over 16 rounds+  where+    -- \| Transform the input over 16 rounds     doRound :: Word64 -> Int -> Word64     doRound !i roundIndex         | roundIndex == 16 =             let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)              in rotateL (i `xor` final) 32-        | otherwise     =+        | otherwise =             let newr = fromIntegral (i `shiftR` 32) `xor` p roundIndex                 newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr-             in doRound newi (roundIndex+1)+             in doRound newi (roundIndex + 1) -    -- | The Blowfish Feistel function F-    f   :: Word32 -> Word64-    f t = let a = s0 (0xff .&. (t `shiftR` 24))-              b = s1 (0xff .&. (t `shiftR` 16))-              c = s2 (0xff .&. (t `shiftR` 8))-              d = s3 (0xff .&.  t)-           in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32+    -- \| The Blowfish Feistel function F+    f :: Word32 -> Word64+    f t =+        let a = s0 (0xff .&. (t `shiftR` 24))+            b = s1 (0xff .&. (t `shiftR` 16))+            c = s2 (0xff .&. (t `shiftR` 8))+            d = s3 (0xff .&. t)+         in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32 -    -- | S-Box arrays, each containing 256 32-bit words+    -- \| S-Box arrays, each containing 256 32-bit words     --   The first 18 words contain the P-Array of subkeys     s0, s1, s2, s3 :: Word32 -> Word32-    s0 i            = arrayRead32 ar (fromIntegral i + 18)-    s1 i            = arrayRead32 ar (fromIntegral i + 274)-    s2 i            = arrayRead32 ar (fromIntegral i + 530)-    s3 i            = arrayRead32 ar (fromIntegral i + 786)-    p              :: Int -> Word32-    p i | inverse   = arrayRead32 ar (17 - i)+    s0 i = arrayRead32 ar (fromIntegral i + 18)+    s1 i = arrayRead32 ar (fromIntegral i + 274)+    s2 i = arrayRead32 ar (fromIntegral i + 530)+    s3 i = arrayRead32 ar (fromIntegral i + 786)+    p :: Int -> Word32+    p i+        | inverse = arrayRead32 ar (17 - i)         | otherwise = arrayRead32 ar i  -- | Blowfish encrypt a Word using the current state of the key schedule cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64 cipherBlockMutable (KeySchedule ma) input = doRound input 0-    where-    -- | Transform the input over 16 rounds+  where+    -- \| Transform the input over 16 rounds     doRound !i roundIndex         | roundIndex == 16 = do             pVal1 <- mutableArrayRead32 ma 16             pVal2 <- mutableArrayRead32 ma 17             let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2             return $ rotateL (i `xor` final) 32-        | otherwise     = do+        | otherwise = do             pVal <- mutableArrayRead32 ma roundIndex             let newr = fromIntegral (i `shiftR` 32) `xor` pVal             newr' <- f newr             let newi = ((i `shiftL` 32) `xor` newr') .|. fromIntegral newr-            doRound newi (roundIndex+1)+            doRound newi (roundIndex + 1) -    -- | The Blowfish Feistel function F-    f   :: Word32 -> IO Word64+    -- \| The Blowfish Feistel function F+    f :: Word32 -> IO Word64     f t = do         a <- s0 (0xff .&. (t `shiftR` 24))         b <- s1 (0xff .&. (t `shiftR` 16))         c <- s2 (0xff .&. (t `shiftR` 8))-        d <- s3 (0xff .&.  t)+        d <- s3 (0xff .&. t)         return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32) -    -- | S-Box arrays, each containing 256 32-bit words+    -- \| S-Box arrays, each containing 256 32-bit words     --   The first 18 words contain the P-Array of subkeys     s0, s1, s2, s3 :: Word32 -> IO Word32     s0 i = mutableArrayRead32 ma (fromIntegral i + 18)@@ -217,41 +234,50 @@     s2 i = mutableArrayRead32 ma (fromIntegral i + 530)     s3 i = mutableArrayRead32 ma (fromIntegral i + 786) -iterKeyStream :: (ByteArrayAccess x)+iterKeyStream+    :: ByteArrayAccess x     => x     -> Word32     -> Word32-    -> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ())+    -> ( Int+         -> Word32+         -> Word32+         -> Word32+         -> Word32+         -> (Word32 -> Word32 -> IO ())+         -> IO ()+       )     -> IO () iterKeyStream x a0 a1 g = f 0 0 a0 a1-    where-        len          = B.length x-        -- Avoiding the modulo operation when interating over the ring-        -- buffer is assumed to be more efficient here. All other-        -- implementations do this, too. The branch prediction shall prefer-        -- the branch with the increment.-        n j          = if j + 1 >= len then 0 else j + 1-        f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8)-            where-                j1 = n j0-                j2 = n j1-                j3 = n j2-                j4 = n j3-                j5 = n j4-                j6 = n j5-                j7 = n j6-                j8 = n j7-                x0 = fromIntegral (B.index x j0)-                x1 = fromIntegral (B.index x j1)-                x2 = fromIntegral (B.index x j2)-                x3 = fromIntegral (B.index x j3)-                x4 = fromIntegral (B.index x j4)-                x5 = fromIntegral (B.index x j5)-                x6 = fromIntegral (B.index x j6)-                x7 = fromIntegral (B.index x j7)-                l  = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3-                r  = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7+  where+    len = B.length x+    -- Avoiding the modulo operation when interating over the ring+    -- buffer is assumed to be more efficient here. All other+    -- implementations do this, too. The branch prediction shall prefer+    -- the branch with the increment.+    n j = if j + 1 >= len then 0 else j + 1+    f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8)+      where+        j1 = n j0+        j2 = n j1+        j3 = n j2+        j4 = n j3+        j5 = n j4+        j6 = n j5+        j7 = n j6+        j8 = n j7+        x0 = fromIntegral (B.index x j0)+        x1 = fromIntegral (B.index x j1)+        x2 = fromIntegral (B.index x j2)+        x3 = fromIntegral (B.index x j3)+        x4 = fromIntegral (B.index x j4)+        x5 = fromIntegral (B.index x j5)+        x6 = fromIntegral (B.index x j6)+        x7 = fromIntegral (B.index x j7)+        l = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3+        r = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7 {-# INLINE iterKeyStream #-}+ -- Benchmarking shows that GHC considers this function too big to inline -- although forcing inlining causes an actual improvement. -- It is assumed that all function calls (especially the continuation)

@@ -4,15 +4,14 @@ -- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com> -- Stability   : stable -- Portability : good----module Crypto.Cipher.CAST5-    ( CAST5-    ) where+module Crypto.Cipher.CAST5 (+    CAST5,+) where -import           Crypto.Error-import           Crypto.Cipher.Types-import           Crypto.Cipher.CAST5.Primitive-import           Crypto.Internal.ByteArray (ByteArrayAccess)+import Crypto.Cipher.CAST5.Primitive+import Crypto.Cipher.Types+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B  -- | CAST5 block cipher (also known as CAST-128).  Key is between@@ -20,9 +19,9 @@ newtype CAST5 = CAST5 Key  instance Cipher CAST5 where-    cipherName    _ = "CAST5"+    cipherName _ = "CAST5"     cipherKeySize _ = KeySizeRange 5 16-    cipherInit      = initCAST5+    cipherInit = initCAST5  instance BlockCipher CAST5 where     blockSize _ = 8@@ -31,12 +30,12 @@  initCAST5 :: ByteArrayAccess key => key -> CryptoFailable CAST5 initCAST5 bs-    | len <   5 = CryptoFailed CryptoError_KeySizeInvalid-    | len <  16 = CryptoPassed (CAST5 $ buildKey short padded)+    | len < 5 = CryptoFailed CryptoError_KeySizeInvalid+    | len < 16 = CryptoPassed (CAST5 $ buildKey short padded)     | len == 16 = CryptoPassed (CAST5 $ buildKey False bs)     | otherwise = CryptoFailed CryptoError_KeySizeInvalid   where-    len   = B.length bs+    len = B.length bs     short = len <= 10      padded :: B.Bytes

@@ -1,21 +1,20 @@ {-# LANGUAGE MagicHash #-}  -----------------------------------------------------------------------------++-----------------------------------------------------------------------------+ -- | -- Module      :  Crypto.Cipher.CAST5.Primitive -- License     :  BSD-style -- -- Haskell implementation of the CAST-128 Encryption Algorithm------------------------------------------------------------------------------------module Crypto.Cipher.CAST5.Primitive-    ( encrypt-    , decrypt-    , Key()-    , buildKey-    ) where+module Crypto.Cipher.CAST5.Primitive (+    encrypt,+    decrypt,+    Key (),+    buildKey,+) where  import Control.Monad (void, (>=>)) @@ -23,23 +22,28 @@ import Data.Memory.Endian import Data.Word -import           Crypto.Internal.ByteArray (ByteArrayAccess)+import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.WordArray-+import Crypto.Internal.WordArray  -- Data Types -data P = P {-# UNPACK #-} !Word32 -- left word-           {-# UNPACK #-} !Word32 -- right word+data P+    = P+        {-# UNPACK #-} !Word32 -- left word+        {-# UNPACK #-} !Word32 -- right word -data Q = Q {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32-           {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32+data Q+    = Q+        {-# UNPACK #-} !Word32+        {-# UNPACK #-} !Word32+        {-# UNPACK #-} !Word32+        {-# UNPACK #-} !Word32  -- | All subkeys for 12 or 16 rounds-data Key = K12 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km12, kr12 ]-         | K16 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km16, kr16 ]-+data Key+    = K12 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km12, kr12 ]+    | K16 {-# UNPACK #-} !Array32 -- [ km1, kr1, km2, kr2, ..., km16, kr16 ]  -- Big-endian Transformations @@ -53,10 +57,9 @@ decomp32 x =     let a = fromIntegral (x `shiftR` 24)         b = fromIntegral (x `shiftR` 16)-        c = fromIntegral (x `shiftR`  8)+        c = fromIntegral (x `shiftR` 8)         d = fromIntegral x-    in (a, b, c, d)-+     in (a, b, c, d)  -- Encryption @@ -67,19 +70,18 @@ cast_enc :: Key -> P -> P cast_enc (K12 a) (P l0 r0) = P r12 r11   where-    r1  = type1 a 0  l0  r0-    r2  = type2 a 2  r0  r1-    r3  = type3 a 4  r1  r2-    r4  = type1 a 6  r2  r3-    r5  = type2 a 8  r3  r4-    r6  = type3 a 10 r4  r5-    r7  = type1 a 12 r5  r6-    r8  = type2 a 14 r6  r7-    r9  = type3 a 16 r7  r8-    r10 = type1 a 18 r8  r9-    r11 = type2 a 20 r9  r10+    r1 = type1 a 0 l0 r0+    r2 = type2 a 2 r0 r1+    r3 = type3 a 4 r1 r2+    r4 = type1 a 6 r2 r3+    r5 = type2 a 8 r3 r4+    r6 = type3 a 10 r4 r5+    r7 = type1 a 12 r5 r6+    r8 = type2 a 14 r6 r7+    r9 = type3 a 16 r7 r8+    r10 = type1 a 18 r8 r9+    r11 = type2 a 20 r9 r10     r12 = type3 a 22 r10 r11- cast_enc (K16 a) p = P r16 r15   where     P r12 r11 = cast_enc (K12 a) p@@ -99,18 +101,17 @@ cast_dec (K12 a) (P r12 r11) = P l0 r0   where     r10 = type3 a 22 r12 r11-    r9  = type2 a 20 r11 r10-    r8  = type1 a 18 r10 r9-    r7  = type3 a 16 r9  r8-    r6  = type2 a 14 r8  r7-    r5  = type1 a 12 r7  r6-    r4  = type3 a 10 r6  r5-    r3  = type2 a 8  r5  r4-    r2  = type1 a 6  r4  r3-    r1  = type3 a 4  r3  r2-    r0  = type2 a 2  r2  r1-    l0  = type1 a 0  r1  r0-+    r9 = type2 a 20 r11 r10+    r8 = type1 a 18 r10 r9+    r7 = type3 a 16 r9 r8+    r6 = type2 a 14 r8 r7+    r5 = type1 a 12 r7 r6+    r4 = type3 a 10 r6 r5+    r3 = type2 a 8 r5 r4+    r2 = type1 a 6 r4 r3+    r1 = type3 a 4 r3 r2+    r0 = type2 a 2 r2 r1+    l0 = type1 a 0 r1 r0 cast_dec (K16 a) (P r16 r15) = cast_dec (K12 a) (P r12 r11)   where     r14 = type1 a 30 r16 r15@@ -118,7 +119,6 @@     r12 = type2 a 26 r14 r13     r11 = type1 a 24 r13 r12 - -- Non-Identical Rounds  type1 :: Array32 -> Int -> Word32 -> Word32 -> Word32@@ -145,14 +145,17 @@         (ja, jb, jc, jd) = decomp32 j      in l `xor` (((sbox_s1 ja + sbox_s2 jb) `xor` sbox_s3 jc) - sbox_s4 jd) - -- Key Schedule  -- | Precompute "masking" and "rotation" subkeys-buildKey :: ByteArrayAccess key-         => Bool -- ^ @True@ for short keys that only need 12 rounds-         -> key  -- ^ Input key padded to 16 bytes-         -> Key  -- ^ Output data structure+buildKey+    :: ByteArrayAccess key+    => Bool+    -- ^ @True@ for short keys that only need 12 rounds+    -> key+    -- ^ Input key padded to 16 bytes+    -> Key+    -- ^ Output data structure buildKey isShort key =     let P x0123 x4567 = decomp64 (fromBE $ B.toW64BE key 0)         P x89AB xCDEF = decomp64 (fromBE $ B.toW64BE key 8)@@ -160,12 +163,10 @@  keySchedule :: Bool -> Q -> Key keySchedule isShort x-    | isShort   = K12 $ allocArray32AndFreeze 24 $ \ma ->+    | isShort = K12 $ allocArray32AndFreeze 24 $ \ma ->         void (steps123 ma 0 x >>= skip4 >>= steps123 ma 1)-     | otherwise = K16 $ allocArray32AndFreeze 32 $ \ma ->         void (steps123 ma 0 x >>= step4 ma 24 >>= steps123 ma 1 >>= step4 ma 25)-   where     sbox_s56785 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s5 e     sbox_s56786 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s6 e@@ -279,7 +280,9 @@ sbox_s1 :: Word8 -> Word32 sbox_s1 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x30\xfb\x40\xd4\x9f\xa0\xff\x0b\x6b\xec\xcd\x2f\x3f\x25\x8c\x7a\x1e\x21\x3f\x2f\x9c\x00\x4d\xd3\x60\x03\xe5\x40\xcf\x9f\xc9\x49\             \\xbf\xd4\xaf\x27\x88\xbb\xbd\xb5\xe2\x03\x40\x90\x98\xd0\x96\x75\x6e\x63\xa0\xe0\x15\xc3\x61\xd2\xc2\xe7\x66\x1d\x22\xd4\xff\x8e\             \\x28\x68\x3b\x6f\xc0\x7f\xd0\x59\xff\x23\x79\xc8\x77\x5f\x50\xe2\x43\xc3\x40\xd3\xdf\x2f\x86\x56\x88\x7c\xa4\x1a\xa2\xd2\xbd\x2d\@@ -316,7 +319,9 @@ sbox_s2 :: Word8 -> Word32 sbox_s2 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x1f\x20\x10\x94\xef\x0b\xa7\x5b\x69\xe3\xcf\x7e\x39\x3f\x43\x80\xfe\x61\xcf\x7a\xee\xc5\x20\x7a\x55\x88\x9c\x94\x72\xfc\x06\x51\             \\xad\xa7\xef\x79\x4e\x1d\x72\x35\xd5\x5a\x63\xce\xde\x04\x36\xba\x99\xc4\x30\xef\x5f\x0c\x07\x94\x18\xdc\xdb\x7d\xa1\xd6\xef\xf3\             \\xa0\xb5\x2f\x7b\x59\xe8\x36\x05\xee\x15\xb0\x94\xe9\xff\xd9\x09\xdc\x44\x00\x86\xef\x94\x44\x59\xba\x83\xcc\xb3\xe0\xc3\xcd\xfb\@@ -353,7 +358,9 @@ sbox_s3 :: Word8 -> Word32 sbox_s3 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x8d\xef\xc2\x40\x25\xfa\x5d\x9f\xeb\x90\x3d\xbf\xe8\x10\xc9\x07\x47\x60\x7f\xff\x36\x9f\xe4\x4b\x8c\x1f\xc6\x44\xae\xce\xca\x90\             \\xbe\xb1\xf9\xbf\xee\xfb\xca\xea\xe8\xcf\x19\x50\x51\xdf\x07\xae\x92\x0e\x88\x06\xf0\xad\x05\x48\xe1\x3c\x8d\x83\x92\x70\x10\xd5\             \\x11\x10\x7d\x9f\x07\x64\x7d\xb9\xb2\xe3\xe4\xd4\x3d\x4f\x28\x5e\xb9\xaf\xa8\x20\xfa\xde\x82\xe0\xa0\x67\x26\x8b\x82\x72\x79\x2e\@@ -390,7 +397,9 @@ sbox_s4 :: Word8 -> Word32 sbox_s4 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x9d\xb3\x04\x20\x1f\xb6\xe9\xde\xa7\xbe\x7b\xef\xd2\x73\xa2\x98\x4a\x4f\x7b\xdb\x64\xad\x8c\x57\x85\x51\x04\x43\xfa\x02\x0e\xd1\             \\x7e\x28\x7a\xff\xe6\x0f\xb6\x63\x09\x5f\x35\xa1\x79\xeb\xf1\x20\xfd\x05\x9d\x43\x64\x97\xb7\xb1\xf3\x64\x1f\x63\x24\x1e\x4a\xdf\             \\x28\x14\x7f\x5f\x4f\xa2\xb8\xcd\xc9\x43\x00\x40\x0c\xc3\x22\x20\xfd\xd3\x0b\x30\xc0\xa5\x37\x4f\x1d\x2d\x00\xd9\x24\x14\x7b\x15\@@ -427,7 +436,9 @@ sbox_s5 :: Word8 -> Word32 sbox_s5 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x7e\xc9\x0c\x04\x2c\x6e\x74\xb9\x9b\x0e\x66\xdf\xa6\x33\x79\x11\xb8\x6a\x7f\xff\x1d\xd3\x58\xf5\x44\xdd\x9d\x44\x17\x31\x16\x7f\             \\x08\xfb\xf1\xfa\xe7\xf5\x11\xcc\xd2\x05\x1b\x00\x73\x5a\xba\x00\x2a\xb7\x22\xd8\x38\x63\x81\xcb\xac\xf6\x24\x3a\x69\xbe\xfd\x7a\             \\xe6\xa2\xe7\x7f\xf0\xc7\x20\xcd\xc4\x49\x48\x16\xcc\xf5\xc1\x80\x38\x85\x16\x40\x15\xb0\xa8\x48\xe6\x8b\x18\xcb\x4c\xaa\xde\xff\@@ -464,7 +475,9 @@ sbox_s6 :: Word8 -> Word32 sbox_s6 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\xf6\xfa\x8f\x9d\x2c\xac\x6c\xe1\x4c\xa3\x48\x67\xe2\x33\x7f\x7c\x95\xdb\x08\xe7\x01\x68\x43\xb4\xec\xed\x5c\xbc\x32\x55\x53\xac\             \\xbf\x9f\x09\x60\xdf\xa1\xe2\xed\x83\xf0\x57\x9d\x63\xed\x86\xb9\x1a\xb6\xa6\xb8\xde\x5e\xbe\x39\xf3\x8f\xf7\x32\x89\x89\xb1\x38\             \\x33\xf1\x49\x61\xc0\x19\x37\xbd\xf5\x06\xc6\xda\xe4\x62\x5e\x7e\xa3\x08\xea\x99\x4e\x23\xe3\x3c\x79\xcb\xd7\xcc\x48\xa1\x43\x67\@@ -501,7 +514,9 @@ sbox_s7 :: Word8 -> Word32 sbox_s7 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\x85\xe0\x40\x19\x33\x2b\xf5\x67\x66\x2d\xbf\xff\xcf\xc6\x56\x93\x2a\x8d\x7f\x6f\xab\x9b\xc9\x12\xde\x60\x08\xa1\x20\x28\xda\x1f\             \\x02\x27\xbc\xe7\x4d\x64\x29\x16\x18\xfa\xc3\x00\x50\xf1\x8b\x82\x2c\xb2\xcb\x11\xb2\x32\xe7\x5c\x4b\x36\x95\xf2\xb2\x87\x07\xde\             \\xa0\x5f\xbc\xf6\xcd\x41\x81\xe9\xe1\x50\x21\x0c\xe2\x4e\xf1\xbd\xb1\x68\xc3\x81\xfd\xe4\xe7\x89\x5c\x79\xb0\xd8\x1e\x8b\xfd\x43\@@ -538,7 +553,9 @@ sbox_s8 :: Word8 -> Word32 sbox_s8 i = arrayRead32 t (fromIntegral i)   where-    t = array32FromAddrBE 256+    t =+        array32FromAddrBE+            256             "\xe2\x16\x30\x0d\xbb\xdd\xff\xfc\xa7\xeb\xda\xbd\x35\x64\x80\x95\x77\x89\xf8\xb7\xe6\xc1\x12\x1b\x0e\x24\x16\x00\x05\x2c\xe8\xb5\             \\x11\xa9\xcf\xb0\xe5\x95\x2f\x11\xec\xe7\x99\x0a\x93\x86\xd1\x74\x2a\x42\x93\x1c\x76\xe3\x81\x11\xb1\x2d\xef\x3a\x37\xdd\xdd\xfc\             \\xde\x9a\xde\xb1\x0a\x0c\xc3\x2c\xbe\x19\x70\x29\x84\xa0\x09\x40\xbb\x24\x3a\x0f\xb4\xd1\x37\xcf\xb4\x4e\x79\xf0\x04\x9e\xed\xfd\

@@ -6,10 +6,9 @@ -- Portability : Good -- -- Camellia support. only 128 bit variant available for now.--module Crypto.Cipher.Camellia-    ( Camellia128-    ) where+module Crypto.Cipher.Camellia (+    Camellia128,+) where  import Crypto.Cipher.Camellia.Primitive import Crypto.Cipher.Types@@ -18,9 +17,9 @@ newtype Camellia128 = Camellia128 Camellia  instance Cipher Camellia128 where-    cipherName    _ = "Camellia128"+    cipherName _ = "Camellia128"     cipherKeySize _ = KeySizeFixed 16-    cipherInit k    = Camellia128 `fmap` initCamellia k+    cipherInit k = Camellia128 `fmap` initCamellia k  instance BlockCipher Camellia128 where     blockSize _ = 16

@@ -1,3 +1,4 @@+{-# LANGUAGE MagicHash #-}  -- | -- Module      : Crypto.Cipher.Camellia.Primitive@@ -8,23 +9,22 @@ -- -- This only cover Camellia 128 bits for now. The API will change once -- 192 and 256 mode are implemented too.-{-# LANGUAGE MagicHash #-}-module Crypto.Cipher.Camellia.Primitive-    ( Camellia-    , initCamellia-    , encrypt-    , decrypt-    ) where+module Crypto.Cipher.Camellia.Primitive (+    Camellia,+    initCamellia,+    encrypt,+    decrypt,+) where -import           Data.Word-import           Data.Bits+import Data.Bits+import Data.Word -import           Crypto.Error-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Words-import           Crypto.Internal.WordArray-import           Data.Memory.Endian+import Crypto.Internal.WordArray+import Crypto.Internal.Words+import Data.Memory.Endian  data Mode = Decrypt | Encrypt @@ -33,30 +33,32 @@  w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) w64tow8 x = (t1, t2, t3, t4, t5, t6, t7, t8)-    where-        t1 = fromIntegral (x `shiftR` 56)-        t2 = fromIntegral (x `shiftR` 48)-        t3 = fromIntegral (x `shiftR` 40)-        t4 = fromIntegral (x `shiftR` 32)-        t5 = fromIntegral (x `shiftR` 24)-        t6 = fromIntegral (x `shiftR` 16)-        t7 = fromIntegral (x `shiftR` 8)-        t8 = fromIntegral (x)+  where+    t1 = fromIntegral (x `shiftR` 56)+    t2 = fromIntegral (x `shiftR` 48)+    t3 = fromIntegral (x `shiftR` 40)+    t4 = fromIntegral (x `shiftR` 32)+    t5 = fromIntegral (x `shiftR` 24)+    t6 = fromIntegral (x `shiftR` 16)+    t7 = fromIntegral (x `shiftR` 8)+    t8 = fromIntegral (x)  w8tow64 :: (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) -> Word64-w8tow64 (t1,t2,t3,t4,t5,t6,t7,t8) =-    (fromIntegral t1 `shiftL` 56) .|.-    (fromIntegral t2 `shiftL` 48) .|.-    (fromIntegral t3 `shiftL` 40) .|.-    (fromIntegral t4 `shiftL` 32) .|.-    (fromIntegral t5 `shiftL` 24) .|.-    (fromIntegral t6 `shiftL` 16) .|.-    (fromIntegral t7 `shiftL` 8)  .|.-    (fromIntegral t8)+w8tow64 (t1, t2, t3, t4, t5, t6, t7, t8) =+    (fromIntegral t1 `shiftL` 56)+        .|. (fromIntegral t2 `shiftL` 48)+        .|. (fromIntegral t3 `shiftL` 40)+        .|. (fromIntegral t4 `shiftL` 32)+        .|. (fromIntegral t5 `shiftL` 24)+        .|. (fromIntegral t6 `shiftL` 16)+        .|. (fromIntegral t7 `shiftL` 8)+        .|. (fromIntegral t8)  sbox :: Int -> Word8 sbox = arrayRead8 t-  where t = array8+  where+    t =+        array8             "\x70\x82\x2c\xec\xb3\x27\xc0\xe5\xe4\x85\x57\x35\xea\x0c\xae\x41\             \\x23\xef\x6b\x93\x45\x19\xa5\x21\xed\x0e\x4f\x4e\x1d\x65\x92\xbd\             \\x86\xb8\xaf\x8f\x7c\xeb\x1f\xce\x3e\x30\xdc\x5f\x5e\xc5\x0b\x1a\@@ -95,116 +97,142 @@ sigma6 = 0xB05688C2B3E6C1FD  rotl128 :: Word128 -> Int -> Word128-rotl128 v               0  = v+rotl128 v 0 = v rotl128 (Word128 x1 x2) 64 = Word128 x2 x1- rotl128 v@(Word128 x1 x2) w-    | w > 64    = (v `rotl128` 64) `rotl128` (w - 64)+    | w > 64 = (v `rotl128` 64) `rotl128` (w - 64)     | otherwise = Word128 (x1high .|. x2low) (x2high .|. x1low)-        where-            splitBits i = (i .&. complement x, i .&. x)-                where x = 2 ^ w - 1-            (x1high, x1low) = splitBits (x1 `rotateL` w)-            (x2high, x2low) = splitBits (x2 `rotateL` w)+  where+    splitBits i = (i .&. complement x, i .&. x)+      where+        x = 2 ^ w - 1+    (x1high, x1low) = splitBits (x1 `rotateL` w)+    (x2high, x2low) = splitBits (x2 `rotateL` w)  -- | Camellia context data Camellia = Camellia-    { k  :: Array64+    { k :: Array64     , kw :: Array64     , ke :: Array64     } -setKeyInterim :: ByteArrayAccess key => key -> (Word128, Word128, Word128, Word128)+setKeyInterim+    :: ByteArrayAccess key => key -> (Word128, Word128, Word128, Word128) setKeyInterim keyseed = (w64tow128 kL, w64tow128 kR, w64tow128 kA, w64tow128 kB)-  where kL = (fromBE $ B.toW64BE keyseed 0, fromBE $ B.toW64BE keyseed 8)-        kR = (0, 0)+  where+    kL = (fromBE $ B.toW64BE keyseed 0, fromBE $ B.toW64BE keyseed 8)+    kR = (0, 0) -        kA = let d1 = (fst kL `xor` fst kR)-                 d2 = (snd kL `xor` snd kR)-                 d3 = d2 `xor` feistel d1 sigma1-                 d4 = d1 `xor` feistel d3 sigma2-                 d5 = d4 `xor` (fst kL)-                 d6 = d3 `xor` (snd kL)-                 d7 = d6 `xor` feistel d5 sigma3-                 d8 = d5 `xor` feistel d7 sigma4-              in (d8, d7)+    kA =+        let d1 = (fst kL `xor` fst kR)+            d2 = (snd kL `xor` snd kR)+            d3 = d2 `xor` feistel d1 sigma1+            d4 = d1 `xor` feistel d3 sigma2+            d5 = d4 `xor` (fst kL)+            d6 = d3 `xor` (snd kL)+            d7 = d6 `xor` feistel d5 sigma3+            d8 = d5 `xor` feistel d7 sigma4+         in (d8, d7) -        kB = let d1 = (fst kA `xor` fst kR)-                 d2 = (snd kA `xor` snd kR)-                 d3 = d2 `xor` feistel d1 sigma5-                 d4 = d1 `xor` feistel d3 sigma6-              in (d4, d3)+    kB =+        let d1 = (fst kA `xor` fst kR)+            d2 = (snd kA `xor` snd kR)+            d3 = d2 `xor` feistel d1 sigma5+            d4 = d1 `xor` feistel d3 sigma6+         in (d4, d3)  -- | Initialize a 128-bit key ----- Return the initialized key or a error message if the given +-- Return the initialized key or a error message if the given -- keyseed was not 16-bytes in length.-initCamellia :: ByteArray key-             => key -- ^ The key to create the camellia context-             -> CryptoFailable Camellia+initCamellia+    :: ByteArray key+    => key+    -- ^ The key to create the camellia context+    -> CryptoFailable Camellia initCamellia key     | B.length key /= 16 = CryptoFailed $ CryptoError_KeySizeInvalid-    | otherwise          =-        let (kL, _, kA, _) = setKeyInterim key in--        let (Word128 kw1 kw2) = (kL `rotl128` 0) in-        let (Word128 k1 k2)   = (kA `rotl128` 0) in-        let (Word128 k3 k4)   = (kL `rotl128` 15) in-        let (Word128 k5 k6)   = (kA `rotl128` 15) in-        let (Word128 ke1 ke2) = (kA `rotl128` 30) in --ke1 = (KA <<<  30) >> 64; ke2 = (KA <<<  30) & MASK64;-        let (Word128 k7 k8)   = (kL `rotl128` 45) in --k7  = (KL <<<  45) >> 64; k8  = (KL <<<  45) & MASK64;-        let (Word128 k9 _)    = (kA `rotl128` 45) in --k9  = (KA <<<  45) >> 64;-        let (Word128 _ k10)   = (kL `rotl128` 60) in-        let (Word128 k11 k12) = (kA `rotl128` 60) in-        let (Word128 ke3 ke4) = (kL `rotl128` 77) in-        let (Word128 k13 k14) = (kL `rotl128` 94) in-        let (Word128 k15 k16) = (kA `rotl128` 94) in-        let (Word128 k17 k18) = (kL `rotl128` 111) in-        let (Word128 kw3 kw4) = (kA `rotl128` 111) in--        CryptoPassed $ Camellia-            { kw = array64 4 [ kw1, kw2, kw3, kw4 ]-            , ke = array64 4 [ ke1, ke2, ke3, ke4 ]-            , k  = array64 18 [ k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12, k13, k14, k15, k16, k17, k18 ]-            }+    | otherwise =+        let (kL, _, kA, _) = setKeyInterim key+         in let (Word128 kw1 kw2) = (kL `rotl128` 0)+             in let (Word128 k1 k2) = (kA `rotl128` 0)+                 in let (Word128 k3 k4) = (kL `rotl128` 15)+                     in let (Word128 k5 k6) = (kA `rotl128` 15)+                         in let (Word128 ke1 ke2) = (kA `rotl128` 30) -- ke1 = (KA <<<  30) >> 64; ke2 = (KA <<<  30) & MASK64;+                             in let (Word128 k7 k8) = (kL `rotl128` 45) -- k7  = (KL <<<  45) >> 64; k8  = (KL <<<  45) & MASK64;+                                 in let (Word128 k9 _) = (kA `rotl128` 45) -- k9  = (KA <<<  45) >> 64;+                                     in let (Word128 _ k10) = (kL `rotl128` 60)+                                         in let (Word128 k11 k12) = (kA `rotl128` 60)+                                             in let (Word128 ke3 ke4) = (kL `rotl128` 77)+                                                 in let (Word128 k13 k14) = (kL `rotl128` 94)+                                                     in let (Word128 k15 k16) = (kA `rotl128` 94)+                                                         in let (Word128 k17 k18) = (kL `rotl128` 111)+                                                             in let (Word128 kw3 kw4) = (kA `rotl128` 111)+                                                                 in CryptoPassed $+                                                                        Camellia+                                                                            { kw = array64 4 [kw1, kw2, kw3, kw4]+                                                                            , ke = array64 4 [ke1, ke2, ke3, ke4]+                                                                            , k =+                                                                                array64+                                                                                    18+                                                                                    [ k1+                                                                                    , k2+                                                                                    , k3+                                                                                    , k4+                                                                                    , k5+                                                                                    , k6+                                                                                    , k7+                                                                                    , k8+                                                                                    , k9+                                                                                    , k10+                                                                                    , k11+                                                                                    , k12+                                                                                    , k13+                                                                                    , k14+                                                                                    , k15+                                                                                    , k16+                                                                                    , k17+                                                                                    , k18+                                                                                    ]+                                                                            }  feistel :: Word64 -> Word64 -> Word64-feistel fin sk = -    let x = fin `xor` sk in-    let (t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x in-    let t1' = sbox1 t1 in-    let t2' = sbox2 t2 in-    let t3' = sbox3 t3 in-    let t4' = sbox4 t4 in-    let t5' = sbox2 t5 in-    let t6' = sbox3 t6 in-    let t7' = sbox4 t7 in-    let t8' = sbox1 t8 in-    let y1 = t1' `xor` t3' `xor` t4' `xor` t6' `xor` t7' `xor` t8' in-    let y2 = t1' `xor` t2' `xor` t4' `xor` t5' `xor` t7' `xor` t8' in-    let y3 = t1' `xor` t2' `xor` t3' `xor` t5' `xor` t6' `xor` t8' in-    let y4 = t2' `xor` t3' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in-    let y5 = t1' `xor` t2' `xor` t6' `xor` t7' `xor` t8' in-    let y6 = t2' `xor` t3' `xor` t5' `xor` t7' `xor` t8' in-    let y7 = t3' `xor` t4' `xor` t5' `xor` t6' `xor` t8' in-    let y8 = t1' `xor` t4' `xor` t5' `xor` t6' `xor` t7' in-    w8tow64 (y1, y2, y3, y4, y5, y6, y7, y8)+feistel fin sk =+    let x = fin `xor` sk+     in let (t1, t2, t3, t4, t5, t6, t7, t8) = w64tow8 x+         in let t1' = sbox1 t1+             in let t2' = sbox2 t2+                 in let t3' = sbox3 t3+                     in let t4' = sbox4 t4+                         in let t5' = sbox2 t5+                             in let t6' = sbox3 t6+                                 in let t7' = sbox4 t7+                                     in let t8' = sbox1 t8+                                         in let y1 = t1' `xor` t3' `xor` t4' `xor` t6' `xor` t7' `xor` t8'+                                             in let y2 = t1' `xor` t2' `xor` t4' `xor` t5' `xor` t7' `xor` t8'+                                                 in let y3 = t1' `xor` t2' `xor` t3' `xor` t5' `xor` t6' `xor` t8'+                                                     in let y4 = t2' `xor` t3' `xor` t4' `xor` t5' `xor` t6' `xor` t7'+                                                         in let y5 = t1' `xor` t2' `xor` t6' `xor` t7' `xor` t8'+                                                             in let y6 = t2' `xor` t3' `xor` t5' `xor` t7' `xor` t8'+                                                                 in let y7 = t3' `xor` t4' `xor` t5' `xor` t6' `xor` t8'+                                                                     in let y8 = t1' `xor` t4' `xor` t5' `xor` t6' `xor` t7'+                                                                         in w8tow64 (y1, y2, y3, y4, y5, y6, y7, y8)  fl :: Word64 -> Word64 -> Word64 fl fin sk =-    let (x1, x2) = w64to32 fin in-    let (k1, k2) = w64to32 sk in-    let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in-    let y1 = x1 `xor` (y2 .|. k2) in-    w32to64 (y1, y2)+    let (x1, x2) = w64to32 fin+     in let (k1, k2) = w64to32 sk+         in let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1)+             in let y1 = x1 `xor` (y2 .|. k2)+                 in w32to64 (y1, y2)  flinv :: Word64 -> Word64 -> Word64 flinv fin sk =-    let (y1, y2) = w64to32 fin in-    let (k1, k2) = w64to32 sk in-    let x1 = y1 `xor` (y2 .|. k2) in-    let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1) in-    w32to64 (x1, x2)+    let (y1, y2) = w64to32 fin+     in let (k1, k2) = w64to32 sk+         in let x1 = y1 `xor` (y2 .|. k2)+             in let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1)+                 in w32to64 (x1, x2)  {- in decrypt mode 0->17 1->16 ... -} getKeyK :: Mode -> Camellia -> Int -> Word64@@ -231,34 +259,28 @@  -} doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64) doBlockRound mode key d1 d2 i =-    let r1 = d2 `xor` feistel d1 (getKeyK mode key (0+i)) in     {- Round 1+i -}-    let r2 = d1 `xor` feistel r1 (getKeyK mode key (1+i)) in     {- Round 2+i -}-    let r3 = r1 `xor` feistel r2 (getKeyK mode key (2+i)) in     {- Round 3+i -}-    let r4 = r2 `xor` feistel r3 (getKeyK mode key (3+i)) in     {- Round 4+i -}-    let r5 = r3 `xor` feistel r4 (getKeyK mode key (4+i)) in     {- Round 5+i -}-    let r6 = r4 `xor` feistel r5 (getKeyK mode key (5+i)) in     {- Round 6+i -}-    (r6, r5)+    let r1 = d2 `xor` feistel d1 (getKeyK mode key (0 + i {- Round 1+i -}))+     in let r2 = d1 `xor` feistel r1 (getKeyK mode key (1 + i {- Round 2+i -}))+         in let r3 = r1 `xor` feistel r2 (getKeyK mode key (2 + i {- Round 3+i -}))+             in let r4 = r2 `xor` feistel r3 (getKeyK mode key (3 + i {- Round 4+i -}))+                 in let r5 = r3 `xor` feistel r4 (getKeyK mode key (4 + i {- Round 5+i -}))+                     in let r6 = r4 `xor` feistel r5 (getKeyK mode key (5 + i {- Round 6+i -}))+                         in (r6, r5)  doBlock :: Mode -> Camellia -> Word128 -> Word128 doBlock mode key (Word128 d1 d2) =-    let d1a = d1 `xor` (getKeyKw mode key 0) in {- Prewhitening -}-    let d2a = d2 `xor` (getKeyKw mode key 1) in--    let (d1b, d2b) = doBlockRound mode key d1a d2a 0 in--    let d1c = fl    d1b (getKeyKe mode key 0) in {- FL -}-    let d2c = flinv d2b (getKeyKe mode key 1) in {- FLINV -}--    let (d1d, d2d) = doBlockRound mode key d1c d2c 6 in--    let d1e = fl    d1d (getKeyKe mode key 2) in {- FL -}-    let d2e = flinv d2d (getKeyKe mode key 3) in {- FLINV -}--    let (d1f, d2f) = doBlockRound mode key d1e d2e 12 in--    let d2g = d2f `xor` (getKeyKw mode key 2) in {- Postwhitening -}-    let d1g = d1f `xor` (getKeyKw mode key 3) in-    w64tow128 (d2g, d1g)+    let d1a = d1 `xor` (getKeyKw mode key 0 {- Prewhitening -})+     in let d2a = d2 `xor` (getKeyKw mode key 1)+         in let (d1b, d2b) = doBlockRound mode key d1a d2a 0+             in let d1c = fl d1b (getKeyKe mode key 0 {- FL -})+                 in let d2c = flinv d2b (getKeyKe mode key 1 {- FLINV -})+                     in let (d1d, d2d) = doBlockRound mode key d1c d2c 6+                         in let d1e = fl d1d (getKeyKe mode key 2 {- FL -})+                             in let d2e = flinv d2d (getKeyKe mode key 3 {- FLINV -})+                                 in let (d1f, d2f) = doBlockRound mode key d1e d2e 12+                                     in let d2g = d2f `xor` (getKeyKw mode key 2 {- Postwhitening -})+                                         in let d1g = d1f `xor` (getKeyKw mode key 3)+                                             in w64tow128 (d2g, d1g)  {- encryption for 128 bits blocks -} encryptBlock :: Camellia -> Word128 -> Word128@@ -269,15 +291,21 @@ decryptBlock = doBlock Decrypt  -- | Encrypts the given ByteString using the given Key-encrypt :: ByteArray ba-        => Camellia     -- ^ The key to use-        -> ba           -- ^ The data to encrypt-        -> ba+encrypt+    :: ByteArray ba+    => Camellia+    -- ^ The key to use+    -> ba+    -- ^ The data to encrypt+    -> ba encrypt key = B.mapAsWord128 (encryptBlock key)  -- | Decrypts the given ByteString using the given Key-decrypt :: ByteArray ba-        => Camellia     -- ^ The key to use-        -> ba           -- ^ The data to decrypt-        -> ba+decrypt+    :: ByteArray ba+    => Camellia+    -- ^ The key to use+    -> ba+    -- ^ The data to decrypt+    -> ba decrypt key = B.mapAsWord128 (decryptBlock key)

@@ -1,30 +1,35 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.ChaCha -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good----{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.ChaCha-    ( initialize-    , initializeX-    , combine-    , generate-    , State+module Crypto.Cipher.ChaCha (+    initialize,+    initializeX,+    combine,+    generate,+    State,+     -- * Simple interface for DRG purpose-    , initializeSimple-    , generateSimple-    , StateSimple-    ) where+    initializeSimple,+    generateSimple,+    StateSimple,+) where -import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    ScrubbedBytes,+ ) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Foreign.Ptr-import           Foreign.C.Types+import Crypto.Internal.Compat+import Crypto.Internal.Imports+import Foreign.C.Types+import Foreign.Ptr  -- | ChaCha context newtype State = State ScrubbedBytes@@ -36,84 +41,109 @@  -- | Initialize a new ChaCha context with the number of rounds, -- the key and the nonce associated.-initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)-           => Int   -- ^ number of rounds (8,12,20)-           -> key   -- ^ the key (128 or 256 bits)-           -> nonce -- ^ the nonce (64 or 96 bits)-           -> State -- ^ the initial ChaCha state+initialize+    :: (ByteArrayAccess key, ByteArrayAccess nonce)+    => Int+    -- ^ number of rounds (8,12,20)+    -> key+    -- ^ the key (128 or 256 bits)+    -> nonce+    -- ^ the nonce (64 or 96 bits)+    -> State+    -- ^ the initial ChaCha state initialize nbRounds key nonce-    | kLen `notElem` [16,32]          = error "ChaCha: key length should be 128 or 256 bits"-    | nonceLen `notElem` [8,12]       = error "ChaCha: nonce length should be 64 or 96 bits"-    | nbRounds `notElem` [8,12,20]    = error "ChaCha: rounds should be 8, 12 or 20"-    | otherwise                       = unsafeDoIO $ do+    | kLen `notElem` [16, 32] =+        error "ChaCha: key length should be 128 or 256 bits"+    | nonceLen `notElem` [8, 12] =+        error "ChaCha: nonce length should be 64 or 96 bits"+    | nbRounds `notElem` [8, 12, 20] = error "ChaCha: rounds should be 8, 12 or 20"+    | otherwise = unsafeDoIO $ do         stPtr <- B.alloc 132 $ \stPtr ->-            B.withByteArray nonce $ \noncePtr  ->-            B.withByteArray key   $ \keyPtr ->-                ccrypton_chacha_init stPtr  nbRounds kLen keyPtr nonceLen noncePtr+            B.withByteArray nonce $ \noncePtr ->+                B.withByteArray key $ \keyPtr ->+                    ccrypton_chacha_init stPtr nbRounds kLen keyPtr nonceLen noncePtr         return $ State stPtr-  where kLen     = B.length key-        nonceLen = B.length nonce+  where+    kLen = B.length key+    nonceLen = B.length nonce  -- | Initialize a new XChaCha context with the number of rounds, -- the key and the nonce associated. -- -- An XChaCha state can be used like a regular ChaCha state after initialisation.-initializeX :: (ByteArrayAccess key, ByteArrayAccess nonce)-            => Int   -- ^ number of rounds (8,12,20)-            -> key   -- ^ the key (256 bits)-            -> nonce -- ^ the nonce (192 bits)-            -> State -- ^ the initial ChaCha state+initializeX+    :: (ByteArrayAccess key, ByteArrayAccess nonce)+    => Int+    -- ^ number of rounds (8,12,20)+    -> key+    -- ^ the key (256 bits)+    -> nonce+    -- ^ the nonce (192 bits)+    -> State+    -- ^ the initial ChaCha state initializeX nbRounds key nonce-    | kLen /= 32                      = error "XChaCha: key length should be 256 bits"-    | nonceLen /= 24                  = error "XChaCha: nonce length should be 192 bits"-    | nbRounds `notElem` [8,12,20]    = error "XChaCha: rounds should be 8, 12 or 20"-    | otherwise                       = unsafeDoIO $ do+    | kLen /= 32 =+        error "XChaCha: key length should be 256 bits"+    | nonceLen /= 24 =+        error "XChaCha: nonce length should be 192 bits"+    | nbRounds `notElem` [8, 12, 20] =+        error "XChaCha: rounds should be 8, 12 or 20"+    | otherwise = unsafeDoIO $ do         stPtr <- B.alloc 132 $ \stPtr ->-            B.withByteArray nonce $ \noncePtr  ->-            B.withByteArray key   $ \keyPtr ->-                ccrypton_xchacha_init stPtr nbRounds keyPtr noncePtr+            B.withByteArray nonce $ \noncePtr ->+                B.withByteArray key $ \keyPtr ->+                    ccrypton_xchacha_init stPtr nbRounds keyPtr noncePtr         return $ State stPtr-  where kLen     = B.length key-        nonceLen = B.length nonce+  where+    kLen = B.length key+    nonceLen = B.length nonce  -- | Initialize simple ChaCha State -- -- The seed need to be at least 40 bytes long-initializeSimple :: ByteArrayAccess seed-                 => seed -- ^ a 40 bytes long seed-                 -> StateSimple+initializeSimple+    :: ByteArrayAccess seed+    => seed+    -- ^ a 40 bytes long seed+    -> StateSimple initializeSimple seed     | sLen < 40 = error "ChaCha Random: seed length should be 40 bytes"     | otherwise = unsafeDoIO $ do         stPtr <- B.alloc 64 $ \stPtr ->-                    B.withByteArray seed $ \seedPtr ->-                        ccrypton_chacha_init_core stPtr 32 seedPtr 8 (seedPtr `plusPtr` 32)+            B.withByteArray seed $ \seedPtr ->+                ccrypton_chacha_init_core stPtr 32 seedPtr 8 (seedPtr `plusPtr` 32)         return $ StateSimple stPtr   where     sLen = B.length seed  -- | Combine the chacha output and an arbitrary message with a xor, -- and return the combined output and the new state.-combine :: ByteArray ba-        => State       -- ^ the current ChaCha state-        -> ba          -- ^ the source to xor with the generator-        -> (ba, State)+combine+    :: ByteArray ba+    => State+    -- ^ the current ChaCha state+    -> ba+    -- ^ the source to xor with the generator+    -> (ba, State) combine prevSt@(State prevStMem) src     | B.null src = (B.empty, prevSt)-    | otherwise  = unsafeDoIO $ do+    | otherwise = unsafeDoIO $ do         (out, st) <- B.copyRet prevStMem $ \ctx ->             B.alloc (B.length src) $ \dstPtr ->-            B.withByteArray src    $ \srcPtr ->-                ccrypton_chacha_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)+                B.withByteArray src $ \srcPtr ->+                    ccrypton_chacha_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)         return (out, State st)  -- | Generate a number of bytes from the ChaCha output directly-generate :: ByteArray ba-         => State -- ^ the current ChaCha state-         -> Int   -- ^ the length of data to generate-         -> (ba, State)+generate+    :: ByteArray ba+    => State+    -- ^ the current ChaCha state+    -> Int+    -- ^ the length of data to generate+    -> (ba, State) generate prevSt@(State prevStMem) len-    | len <= 0  = (B.empty, prevSt)+    | len <= 0 = (B.empty, prevSt)     | otherwise = unsafeDoIO $ do         (out, st) <- B.copyRet prevStMem $ \ctx ->             B.alloc len $ \dstPtr ->@@ -121,22 +151,25 @@         return (out, State st)  -- | similar to 'generate' but assume certains values-generateSimple :: ByteArray ba-               => StateSimple-               -> Int-               -> (ba, StateSimple)+generateSimple+    :: ByteArray ba+    => StateSimple+    -> Int+    -> (ba, StateSimple) generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do-    newSt  <- B.copy prevSt (\_ -> return ())+    newSt <- B.copy prevSt (\_ -> return ())     output <- B.alloc nbBytes $ \dstPtr ->         B.withByteArray newSt $ \stPtr ->             ccrypton_chacha_random 8 dstPtr stPtr (fromIntegral nbBytes)     return (output, StateSimple newSt)  foreign import ccall "crypton_chacha_init_core"-    ccrypton_chacha_init_core :: Ptr StateSimple -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()+    ccrypton_chacha_init_core+        :: Ptr StateSimple -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()  foreign import ccall "crypton_chacha_init"-    ccrypton_chacha_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()+    ccrypton_chacha_init+        :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()  foreign import ccall "crypton_xchacha_init"     ccrypton_xchacha_init :: Ptr State -> Int -> Ptr Word8 -> Ptr Word8 -> IO ()@@ -149,4 +182,3 @@  foreign import ccall "crypton_chacha_random"     ccrypton_chacha_random :: Int -> Ptr Word8 -> Ptr StateSimple -> CUInt -> IO ()-

@@ -34,63 +34,77 @@ -- >        (out, st3) = C.encrypt plaintext st2 -- >        auth = C.finalize st3 -- >    return $ out `B.append` Data.ByteArray.convert auth----module Crypto.Cipher.ChaChaPoly1305-    ( State-    , Nonce-    , XNonce-    , nonce12-    , nonce8-    , nonce24-    , incrementNonce-    , initialize-    , initializeX-    , appendAAD-    , finalizeAAD-    , encrypt-    , decrypt-    , finalize-    ) where+module Crypto.Cipher.ChaChaPoly1305 (+    -- * AEAD+    ChaCha20Poly1305,+    aeadChacha20poly1305Init, -import           Control.Monad             (when)-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes, ScrubbedBytes)-import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Imports-import           Crypto.Error+    -- * Low level+    State,+    Nonce,+    XNonce,+    nonce12,+    nonce8,+    nonce24,+    incrementNonce,+    initialize,+    initializeX,+    appendAAD,+    finalizeAAD,+    encrypt,+    decrypt,+    finalize,+) where++import Control.Monad (when) import qualified Crypto.Cipher.ChaCha as ChaCha-import qualified Crypto.MAC.Poly1305  as Poly1305-import           Data.Memory.Endian+import Crypto.Cipher.Types+import Crypto.Error+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    Bytes,+    ScrubbedBytes,+ )+import qualified Crypto.Internal.ByteArray as B+import Crypto.Internal.Imports+import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Data.ByteArray.Pack as P-import           Foreign.Ptr-import           Foreign.Storable+import Data.Memory.Endian+import Foreign.Ptr+import Foreign.Storable  -- | A ChaChaPoly1305 State. -- -- The state is immutable, and only new state can be created-data State = State !ChaCha.State-                   !Poly1305.State-                   !Word64 -- AAD length-                   !Word64 -- ciphertext length+data State+    = State+        !ChaCha.State+        !Poly1305.State+        !Word64 -- AAD length+        !Word64 -- ciphertext length +-- | A ChaChaPoly1305 State.+type ChaCha20Poly1305 = State+ -- | Valid Nonce for ChaChaPoly1305. -- -- It can be created with 'nonce8' or 'nonce12' data Nonce = Nonce8 Bytes | Nonce12 Bytes  instance ByteArrayAccess Nonce where-  length (Nonce8  n) = B.length n-  length (Nonce12 n) = B.length n+    length (Nonce8 n) = B.length n+    length (Nonce12 n) = B.length n -  withByteArray (Nonce8  n) = B.withByteArray n-  withByteArray (Nonce12 n) = B.withByteArray n+    withByteArray (Nonce8 n) = B.withByteArray n+    withByteArray (Nonce12 n) = B.withByteArray n  -- | Extended nonce for XChaChaPoly1305. newtype XNonce = Nonce24 Bytes  instance ByteArrayAccess XNonce where-  length (Nonce24 n) = B.length n-  withByteArray (Nonce24 n) = B.withByteArray n-+    length (Nonce24 n) = B.length n+    withByteArray (Nonce24 n) = B.withByteArray n  -- Based on the following pseudo code: --@@ -108,7 +122,7 @@ pad16 :: Word64 -> Bytes pad16 n     | modLen == 0 = B.empty-    | otherwise   = B.replicate (16 - modLen) 0+    | otherwise = B.replicate (16 - modLen) 0   where     modLen = fromIntegral (n `mod` 16) @@ -116,78 +130,84 @@ nonce12 :: ByteArrayAccess iv => iv -> CryptoFailable Nonce nonce12 iv     | B.length iv /= 12 = CryptoFailed CryptoError_IvSizeInvalid-    | otherwise         = CryptoPassed . Nonce12 . B.convert $ iv+    | otherwise = CryptoPassed . Nonce12 . B.convert $ iv  -- | 8 bytes IV, nonce constructor-nonce8 :: ByteArrayAccess ba-       => ba -- ^ 4 bytes constant-       -> ba -- ^ 8 bytes IV-       -> CryptoFailable Nonce+nonce8+    :: ByteArrayAccess ba+    => ba+    -- ^ 4 bytes constant+    -> ba+    -- ^ 8 bytes IV+    -> CryptoFailable Nonce nonce8 constant iv     | B.length constant /= 4 = CryptoFailed CryptoError_IvSizeInvalid-    | B.length iv       /= 8 = CryptoFailed CryptoError_IvSizeInvalid-    | otherwise              = CryptoPassed . Nonce8 . B.concat $ [constant, iv]+    | B.length iv /= 8 = CryptoFailed CryptoError_IvSizeInvalid+    | otherwise = CryptoPassed . Nonce8 . B.concat $ [constant, iv]  -- | 24 bytes IV, extended nonce constructor-nonce24 :: ByteArrayAccess ba-        => ba -> CryptoFailable XNonce+nonce24+    :: ByteArrayAccess ba+    => ba -> CryptoFailable XNonce nonce24 iv     | B.length iv /= 24 = CryptoFailed CryptoError_IvSizeInvalid-    | otherwise         = CryptoPassed . Nonce24 . B.convert $ iv+    | otherwise = CryptoPassed . Nonce24 . B.convert $ iv  -- | Increment a nonce incrementNonce :: Nonce -> Nonce-incrementNonce (Nonce8  n) = Nonce8  $ incrementNonce' n 4+incrementNonce (Nonce8 n) = Nonce8 $ incrementNonce' n 4 incrementNonce (Nonce12 n) = Nonce12 $ incrementNonce' n 0  incrementNonce' :: Bytes -> Int -> Bytes incrementNonce' b offset = B.copyAndFreeze b $ \s ->     loop s (s `plusPtr` offset)-    where-      loop :: Ptr Word8 -> Ptr Word8 -> IO ()-      loop s p-          | s == (p `plusPtr` (B.length b - offset - 1)) = peek s >>= poke s . (+) 1-          | otherwise = do-              r <- (+) 1 <$> peek p-              poke p r-              when (r == 0) $ loop s (p `plusPtr` 1)+  where+    loop :: Ptr Word8 -> Ptr Word8 -> IO ()+    loop s p+        | s == (p `plusPtr` (B.length b - offset - 1)) = peek s >>= poke s . (+) 1+        | otherwise = do+            r <- (+) 1 <$> peek p+            poke p r+            when (r == 0) $ loop s (p `plusPtr` 1)  -- | Initialize a new ChaChaPoly1305 State -- -- The key length need to be 256 bits, and the nonce -- procured using either `nonce8` or `nonce12`-initialize :: ByteArrayAccess key-           => key -> Nonce -> CryptoFailable State-initialize key (Nonce8  nonce) = initialize' key nonce+initialize+    :: ByteArrayAccess key+    => key -> Nonce -> CryptoFailable State+initialize key (Nonce8 nonce) = initialize' key nonce initialize key (Nonce12 nonce) = initialize' key nonce --initialize' :: ByteArrayAccess key-            => key -> Bytes -> CryptoFailable State+initialize'+    :: ByteArrayAccess key+    => key -> Bytes -> CryptoFailable State initialize' key nonce     | B.length key /= 32 = CryptoFailed CryptoError_KeySizeInvalid-    | otherwise          = CryptoPassed $ initFromRootState rootState-  where rootState = ChaCha.initialize 20 key nonce-+    | otherwise = CryptoPassed $ initFromRootState rootState+  where+    rootState = ChaCha.initialize 20 key nonce  initFromRootState :: ChaCha.State -> State initFromRootState rootState = State encState polyState 0 0   where     (polyKey, encState) = ChaCha.generate rootState 64-    polyState           = throwCryptoError $ Poly1305.initialize (B.take 32 polyKey :: ScrubbedBytes)-+    polyState =+        throwCryptoError $ Poly1305.initialize (B.take 32 polyKey :: ScrubbedBytes)  -- | Initialize a new XChaChaPoly1305 State -- -- The key length needs to be 256 bits, and the nonce -- procured using `nonce24`.-initializeX :: ByteArrayAccess key-            => key -> XNonce -> CryptoFailable State+initializeX+    :: ByteArrayAccess key+    => key -> XNonce -> CryptoFailable State initializeX key (Nonce24 nonce)     | B.length key /= 32 = CryptoFailed CryptoError_KeySizeInvalid-    | otherwise          = CryptoPassed $ initFromRootState rootState-  where rootState = ChaCha.initializeX 20 key nonce-+    | otherwise = CryptoPassed $ initFromRootState rootState+  where+    rootState = ChaCha.initializeX 20 key nonce  -- | Append Authenticated Data to the State and return -- the new modified State.@@ -199,7 +219,7 @@     State encState newMacState newLength plainLength   where     newMacState = Poly1305.update macState ba-    newLength   = aadLength + fromIntegral (B.length ba)+    newLength = aadLength + fromIntegral (B.length ba)  -- | Finalize the Authenticated Data and return the finalized State finalizeAAD :: State -> State@@ -215,8 +235,8 @@     (output, State newEncState newMacState aadLength newPlainLength)   where     (output, newEncState) = ChaCha.combine encState input-    newMacState           = Poly1305.update macState output-    newPlainLength        = plainLength + fromIntegral (B.length input)+    newMacState = Poly1305.update macState output+    newPlainLength = plainLength + fromIntegral (B.length input)  -- | Decrypt a piece of data and returns the decrypted Data and the -- updated State.@@ -225,13 +245,32 @@     (output, State newEncState newMacState aadLength newPlainLength)   where     (output, newEncState) = ChaCha.combine encState input-    newMacState           = Poly1305.update macState input-    newPlainLength        = plainLength + fromIntegral (B.length input)+    newMacState = Poly1305.update macState input+    newPlainLength = plainLength + fromIntegral (B.length input)  -- | Generate an authentication tag from the State. finalize :: State -> Poly1305.Auth finalize (State _ macState aadLength plainLength) =-    Poly1305.finalize $ Poly1305.updates macState-        [ pad16 plainLength-        , either (error "finalize: internal error") id $ P.fill 16 (P.putStorable (toLE aadLength) >> P.putStorable (toLE plainLength))-        ]+    Poly1305.finalize $+        Poly1305.updates+            macState+            [ pad16 plainLength+            , either (error "finalize: internal error") id $+                P.fill 16 (P.putStorable (toLE aadLength) >> P.putStorable (toLE plainLength))+            ]++-- | Setting up AEAD for ChaCha20Poly1305.+aeadChacha20poly1305Init+    :: (ByteArrayAccess k, ByteArrayAccess n)+    => k -> n -> CryptoFailable (AEAD ChaCha20Poly1305)+aeadChacha20poly1305Init key nonce = do+    st0 <- nonce12 nonce >>= initialize key+    return $ AEAD model st0+  where+    model =+        AEADModeImpl+            { aeadImplAppendHeader = \st aad -> finalizeAAD $ appendAAD aad st+            , aeadImplEncrypt = \st plain -> encrypt plain st+            , aeadImplDecrypt = \st cipher -> decrypt cipher st+            , aeadImplFinalize = \st _ -> let Poly1305.Auth tag = finalize st in AuthTag tag+            }

@@ -4,27 +4,26 @@ -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good----module Crypto.Cipher.DES-    ( DES-    ) where+module Crypto.Cipher.DES (+    DES,+) where -import           Data.Word-import           Crypto.Error-import           Crypto.Cipher.Types-import           Crypto.Cipher.DES.Primitive-import           Crypto.Internal.ByteArray (ByteArrayAccess)+import Crypto.Cipher.DES.Primitive+import Crypto.Cipher.Types+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Data.Memory.Endian+import Data.Memory.Endian+import Data.Word  -- | DES Context data DES = DES Word64     deriving (Eq)  instance Cipher DES where-    cipherName    _ = "DES"+    cipherName _ = "DES"     cipherKeySize _ = KeySizeFixed 8-    cipherInit k    = initDES k+    cipherInit k = initDES k  instance BlockCipher DES where     blockSize _ = 8@@ -33,7 +32,8 @@  initDES :: ByteArrayAccess key => key -> CryptoFailable DES initDES k-    | len == 8  = CryptoPassed $ DES key+    | len == 8 = CryptoPassed $ DES key     | otherwise = CryptoFailed $ CryptoError_KeySizeInvalid-  where len = B.length k-        key = fromBE $ B.toW64BE k 0+  where+    len = B.length k+    key = fromBE $ B.toW64BE k 0

@@ -1,33 +1,32 @@ {-# LANGUAGE FlexibleInstances #-}  -----------------------------------------------------------------------------++-----------------------------------------------------------------------------+ -- | -- Module      :  Crypto.Cipher.DES.Primitive -- License     :  BSD-style -- -- This module is copy of DES module from Crypto package. -- http://hackage.haskell.org/package/Crypto------------------------------------------------------------------------------------module Crypto.Cipher.DES.Primitive-    ( encrypt-    , decrypt-    , Block(..)-    ) where+module Crypto.Cipher.DES.Primitive (+    encrypt,+    decrypt,+    Block (..),+) where -import Data.Word import Data.Bits+import Data.Word  -- | a DES block (64 bits)-newtype Block = Block { unBlock :: Word64 }+newtype Block = Block {unBlock :: Word64}  type Rotation = Int-type Key     = Word64+type Key = Word64 -type Bits4  = [Bool]-type Bits6  = [Bool]+type Bits4 = [Bool]+type Bits6 = [Bool] type Bits32 = [Bool] type Bits48 = [Bool] type Bits56 = [Bool]@@ -38,20 +37,84 @@  desRotate :: [Bool] -> Int -> [Bool] desRotate bits rot = drop rot' bits ++ take rot' bits-  where rot' = rot `mod` length bits+  where+    rot' = rot `mod` length bits  bitify :: Word64 -> Bits64-bitify w = map (\b -> w .&. (shiftL 1 b) /= 0) [63,62..0]+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]+  where+    i =+        [ 57+        , 49+        , 41+        , 33+        , 25+        , 17+        , 9+        , 1+        , 59+        , 51+        , 43+        , 35+        , 27+        , 19+        , 11+        , 3+        , 61+        , 53+        , 45+        , 37+        , 29+        , 21+        , 13+        , 5+        , 63+        , 55+        , 47+        , 39+        , 31+        , 23+        , 15+        , 7+        , 56+        , 48+        , 40+        , 32+        , 24+        , 16+        , 8+        , 0+        , 58+        , 50+        , 42+        , 34+        , 26+        , 18+        , 10+        , 2+        , 60+        , 52+        , 44+        , 36+        , 28+        , 20+        , 12+        , 4+        , 62+        , 54+        , 46+        , 38+        , 30+        , 22+        , 14+        , 6+        ]  {- "\x39\x31\x29\x21\x19\x11\x09\x01\x3b\x33\x2b\x23\x1b\x13\@@ -63,10 +126,66 @@  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]+  where+    i =+        [ 56+        , 48+        , 40+        , 32+        , 24+        , 16+        , 8+        , 0+        , 57+        , 49+        , 41+        , 33+        , 25+        , 17+        , 9+        , 1+        , 58+        , 50+        , 42+        , 34+        , 26+        , 18+        , 10+        , 2+        , 59+        , 51+        , 43+        , 35+        , 62+        , 54+        , 46+        , 38+        , 30+        , 22+        , 14+        , 6+        , 61+        , 53+        , 45+        , 37+        , 29+        , 21+        , 13+        , 5+        , 60+        , 52+        , 44+        , 36+        , 28+        , 20+        , 12+        , 4+        , 27+        , 19+        , 11+        , 3+        ]+ {- "\x38\x30\x28\x20\x18\x10\x08\x00\x39\x31\x29\x21\x19\x11\ \\x09\x01\x3a\x32\x2a\x22\x1a\x12\x0a\x02\x3b\x33\x2b\x23\@@ -74,143 +193,371 @@ \\x0d\x05\x3c\x34\x2c\x24\x1c\x14\x0c\x04\x1b\x13\x0b\x03" -} - des_enc :: Block -> Key -> Block-des_enc = do_des [1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28]+des_enc = do_des [1, 2, 4, 6, 8, 10, 12, 14, 15, 17, 19, 21, 23, 25, 27, 28]  des_dec :: Block -> Key -> Block-des_dec = do_des [28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1]+des_dec = do_des [28, 27, 25, 23, 21, 19, 17, 15, 14, 12, 10, 8, 6, 4, 2, 1]  do_des :: [Rotation] -> Block -> Key -> Block do_des rots (Block m) k = Block $ des_work rots (takeDrop 32 mb) kb- where kb = key_transformation $ bitify k-       mb = initial_permutation $ bitify m+  where+    kb = key_transformation $ bitify k+    mb = initial_permutation $ bitify m  des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Word64 des_work [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml)-des_work (r:rs) mb kb = des_work rs mb' kb- where mb' = do_round r mb kb+des_work (r : rs) mb kb = des_work rs mb' kb+  where+    mb' = do_round r mb kb  do_round :: Rotation -> (Bits32, Bits32) -> Bits56 -> (Bits32, Bits32) do_round r (ml, mr) kb = (mr, m')- where kb' = get_key kb r-       comp_kb = compression_permutation kb'-       expa_mr = expansion_permutation mr-       res = comp_kb `desXor` expa_mr-       res' = tail $ iterate (trans 6) ([], res)-       trans n (_, b) = (take n b, drop n b)-       res_s = concat $ zipWith (\f (x,_) -> f x) [s_box_1, s_box_2,-                                                   s_box_3, s_box_4,-                                                   s_box_5, s_box_6,-                                                   s_box_7, s_box_8] res'-       res_p = p_box res_s-       m' = res_p `desXor` ml+  where+    kb' = get_key kb r+    comp_kb = compression_permutation kb'+    expa_mr = expansion_permutation mr+    res = comp_kb `desXor` expa_mr+    res' = drop 1 $ iterate (trans 6) ([], res)+    trans n (_, b) = (take n b, drop n b)+    res_s =+        concat $+            zipWith+                (\f (x, _) -> f x)+                [ s_box_1+                , s_box_2+                , s_box_3+                , s_box_4+                , s_box_5+                , s_box_6+                , s_box_7+                , s_box_8+                ]+                res'+    res_p = p_box res_s+    m' = res_p `desXor` ml  get_key :: Bits56 -> Rotation -> Bits56 get_key kb r = kb'- where (kl, kr) = takeDrop 28 kb-       kb' = desRotate kl r ++ desRotate kr r+  where+    (kl, kr) = takeDrop 28 kb+    kb' = desRotate kl r ++ desRotate kr r  compression_permutation :: Bits56 -> Bits48 compression_permutation kb = map ((!!) kb) i- where i = [13, 16, 10, 23,  0,  4,  2, 27, 14,  5, 20,  9,-            22, 18, 11,  3, 25,  7, 15,  6, 26, 19, 12,  1,-            40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47,-            43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31]+  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]+  where+    i =+        [ 31+        , 0+        , 1+        , 2+        , 3+        , 4+        , 3+        , 4+        , 5+        , 6+        , 7+        , 8+        , 7+        , 8+        , 9+        , 10+        , 11+        , 12+        , 11+        , 12+        , 13+        , 14+        , 15+        , 16+        , 15+        , 16+        , 17+        , 18+        , 19+        , 20+        , 19+        , 20+        , 21+        , 22+        , 23+        , 24+        , 23+        , 24+        , 25+        , 26+        , 27+        , 28+        , 27+        , 28+        , 29+        , 30+        , 31+        , 0+        ]  s_box :: [[Word8]] -> Bits6 -> Bits4-s_box s [a,b,c,d,e,f] = to_bool 4 $ (s !! row) !! col- where row = sum $ zipWith numericise [a,f]     [1, 0]-       col = sum $ zipWith numericise [b,c,d,e] [3, 2, 1, 0]-       numericise :: Bool -> Int -> Int-       numericise = (\x y -> if x then 2^y else 0)+s_box s [a, b, c, d, e, f] = to_bool 4 $ (s !! row) !! col+  where+    row = sum $ zipWith numericise [a, f] [1, 0]+    col = sum $ zipWith numericise [b, c, d, e] [3, 2, 1, 0]+    numericise :: Bool -> Int -> Int+    numericise = (\x y -> if x then 2 ^ y else 0) -       to_bool :: Int -> Word8 -> [Bool]-       to_bool 0 _ = []-       to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1)-s_box _ _             = error "DES: internal error bits6 more than 6 elements"+    to_bool :: Int -> Word8 -> [Bool]+    to_bool 0 _ = []+    to_bool n i = ((i .&. 8) == 8) : to_bool (n - 1) (shiftL i 1)+s_box _ _ = error "DES: internal error bits6 more than 6 elements"  s_box_1 :: Bits6 -> Bits4 s_box_1 = s_box i- where i = [[14,  4, 13,  1,  2, 15, 11,  8,  3, 10,  6, 12,  5,  9,  0,  7],-            [ 0, 15,  7,  4, 14,  2, 13,  1, 10,  6, 12, 11,  9,  5,  3,  8],-            [ 4,  1, 14,  8, 13,  6,  2, 11, 15, 12,  9,  7,  3, 10,  5,  0],-            [15, 12,  8,  2,  4,  9,  1,  7,  5, 11,  3, 14, 10,  0,  6, 13]]+  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]]+  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]]+  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]]+  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]]+  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]]+  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]]+  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]]+  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]+  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]+  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-+takeDrop n (x : xs) = (x : ys, zs)+  where+    (ys, zs) = takeDrop (n - 1) xs  -- | Basic DES encryption which takes a key and a block of plaintext -- and returns the encrypted block of ciphertext according to the standard.

@@ -1,3 +1,6 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.RC4 -- License     : BSD-style@@ -11,23 +14,24 @@ -- Initial FFI implementation by Peter White <peter@janrain.com> -- -- Reorganized and simplified to have an opaque context.----{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.RC4-    ( initialize-    , combine-    , generate-    , State-    ) where+module Crypto.Cipher.RC4 (+    initialize,+    combine,+    generate,+    State,+) where -import           Data.Word-import           Foreign.Ptr-import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    ScrubbedBytes,+ ) import qualified Crypto.Internal.ByteArray as B+import Data.Word+import Foreign.Ptr -import           Crypto.Internal.Compat-import           Crypto.Internal.Imports+import Crypto.Internal.Compat+import Crypto.Internal.Imports  -- | The encryption state for RC4 --@@ -36,29 +40,41 @@ -- and change in future versions.  The bytearray should not be used as input to -- cryptographic algorithms. newtype State = State ScrubbedBytes-    deriving (ByteArrayAccess,NFData)+    deriving (ByteArrayAccess, NFData)  -- | C Call for initializing the encryptor foreign import ccall unsafe "crypton_rc4.h crypton_rc4_init"-    c_rc4_init :: Ptr Word8 -- ^ The rc4 key-               -> Word32    -- ^ The key length-               -> Ptr State -- ^ The context-               -> IO ()+    c_rc4_init+        :: Ptr Word8+        -- ^ The rc4 key+        -> Word32+        -- ^ The key length+        -> Ptr State+        -- ^ The context+        -> IO ()  foreign import ccall unsafe "crypton_rc4.h crypton_rc4_combine"-    c_rc4_combine :: Ptr State        -- ^ Pointer to the permutation-                  -> Ptr Word8      -- ^ Pointer to the clear text-                  -> Word32         -- ^ Length of the clear text-                  -> Ptr Word8      -- ^ Output buffer-                  -> IO ()+    c_rc4_combine+        :: Ptr State+        -- ^ Pointer to the permutation+        -> Ptr Word8+        -- ^ Pointer to the clear text+        -> Word32+        -- ^ Length of the clear text+        -> Ptr Word8+        -- ^ Output buffer+        -> IO ()  -- | RC4 context initialization. -- -- seed the context with an initial key. the key size need to be -- adequate otherwise security takes a hit.-initialize :: ByteArrayAccess key-           => key   -- ^ The key-           -> State -- ^ The RC4 context with the key mixed in+initialize+    :: ByteArrayAccess key+    => key+    -- ^ The key+    -> State+    -- ^ The RC4 context with the key mixed in initialize key = unsafeDoIO $ do     st <- B.alloc 264 $ \stPtr ->         B.withByteArray key $ \keyPtr -> c_rc4_init keyPtr (fromIntegral $ B.length key) (castPtr stPtr)@@ -70,15 +86,20 @@ generate ctx len = combine ctx (B.zero len)  -- | RC4 xor combination of the rc4 stream with an input-combine :: ByteArray ba-        => State               -- ^ rc4 context-        -> ba                  -- ^ input-        -> (State, ba)         -- ^ new rc4 context, and the output+combine+    :: ByteArray ba+    => State+    -- ^ rc4 context+    -> ba+    -- ^ input+    -> (State, ba)+    -- ^ new rc4 context, and the output combine (State prevSt) clearText = unsafeDoIO $-    B.allocRet len            $ \outptr ->-    B.withByteArray clearText $ \clearPtr -> do-        st <- B.copy prevSt $ \stPtr ->+    B.allocRet len $ \outptr ->+        B.withByteArray clearText $ \clearPtr -> do+            st <- B.copy prevSt $ \stPtr ->                 c_rc4_combine (castPtr stPtr) clearPtr (fromIntegral len) outptr-        return $! State st-    --return $! (State st, B.PS outfptr 0 len)-  where len = B.length clearText+            return $! State st+  where+    -- return $! (State st, B.PS outfptr 0 len)+    len = B.length clearText

@@ -1,25 +1,29 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.Salsa -- License     : BSD-style -- Maintainer  : Vincent Hanquez <vincent@snarc.org> -- Stability   : stable -- Portability : good----{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.Salsa-    ( initialize-    , combine-    , generate-    , State(..)-    ) where+module Crypto.Cipher.Salsa (+    initialize,+    combine,+    generate,+    State (..),+) where -import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    ScrubbedBytes,+ ) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Foreign.Ptr-import           Foreign.C.Types+import Crypto.Internal.Compat+import Crypto.Internal.Imports+import Foreign.C.Types+import Foreign.Ptr  -- | Salsa context newtype State = State ScrubbedBytes@@ -27,46 +31,60 @@  -- | Initialize a new Salsa context with the number of rounds, -- the key and the nonce associated.-initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)-           => Int    -- ^ number of rounds (8,12,20)-           -> key    -- ^ the key (128 or 256 bits)-           -> nonce  -- ^ the nonce (64 or 96 bits)-           -> State  -- ^ the initial Salsa state+initialize+    :: (ByteArrayAccess key, ByteArrayAccess nonce)+    => Int+    -- ^ number of rounds (8,12,20)+    -> key+    -- ^ the key (128 or 256 bits)+    -> nonce+    -- ^ the nonce (64 or 96 bits)+    -> State+    -- ^ the initial Salsa state initialize nbRounds key nonce-    | kLen `notElem` [16,32]          = error "Salsa: key length should be 128 or 256 bits"-    | nonceLen `notElem` [8,12]       = error "Salsa: nonce length should be 64 or 96 bits"-    | nbRounds `notElem` [8,12,20]    = error "Salsa: rounds should be 8, 12 or 20"+    | kLen `notElem` [16, 32] =+        error "Salsa: key length should be 128 or 256 bits"+    | nonceLen `notElem` [8, 12] =+        error "Salsa: nonce length should be 64 or 96 bits"+    | nbRounds `notElem` [8, 12, 20] = error "Salsa: rounds should be 8, 12 or 20"     | otherwise = unsafeDoIO $ do         stPtr <- B.alloc 132 $ \stPtr ->-            B.withByteArray nonce $ \noncePtr  ->-            B.withByteArray key   $ \keyPtr ->-                ccrypton_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr+            B.withByteArray nonce $ \noncePtr ->+                B.withByteArray key $ \keyPtr ->+                    ccrypton_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr         return $ State stPtr-  where kLen     = B.length key-        nonceLen = B.length nonce+  where+    kLen = B.length key+    nonceLen = B.length nonce  -- | Combine the salsa output and an arbitrary message with a xor, -- and return the combined output and the new state.-combine :: ByteArray ba-        => State      -- ^ the current Salsa state-        -> ba         -- ^ the source to xor with the generator-        -> (ba, State)+combine+    :: ByteArray ba+    => State+    -- ^ the current Salsa state+    -> ba+    -- ^ the source to xor with the generator+    -> (ba, State) combine prevSt@(State prevStMem) src     | B.null src = (B.empty, prevSt)-    | otherwise  = unsafeDoIO $ do+    | otherwise = unsafeDoIO $ do         (out, st) <- B.copyRet prevStMem $ \ctx ->             B.alloc (B.length src) $ \dstPtr ->-            B.withByteArray src    $ \srcPtr -> do-                ccrypton_salsa_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)+                B.withByteArray src $ \srcPtr -> do+                    ccrypton_salsa_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)         return (out, State st)  -- | Generate a number of bytes from the Salsa output directly-generate :: ByteArray ba-         => State -- ^ the current Salsa state-         -> Int   -- ^ the length of data to generate-         -> (ba, State)+generate+    :: ByteArray ba+    => State+    -- ^ the current Salsa state+    -> Int+    -- ^ the length of data to generate+    -> (ba, State) generate prevSt@(State prevStMem) len-    | len <= 0  = (B.empty, prevSt)+    | len <= 0 = (B.empty, prevSt)     | otherwise = unsafeDoIO $ do         (out, st) <- B.copyRet prevStMem $ \ctx ->             B.alloc len $ \dstPtr ->@@ -74,7 +92,8 @@         return (out, State st)  foreign import ccall "crypton_salsa_init"-    ccrypton_salsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()+    ccrypton_salsa_init+        :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()  foreign import ccall "crypton_salsa_combine"     ccrypton_salsa_combine :: Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO ()

@@ -3,28 +3,27 @@ -- License     : BSD-style -- Stability   : experimental -- Portability : ???--module Crypto.Cipher.TripleDES-    ( DES_EEE3-    , DES_EDE3-    , DES_EEE2-    , DES_EDE2-    ) where+module Crypto.Cipher.TripleDES (+    DES_EEE3,+    DES_EDE3,+    DES_EEE2,+    DES_EDE2,+) where -import           Data.Word-import           Crypto.Error-import           Crypto.Cipher.Types-import           Crypto.Cipher.DES.Primitive-import           Crypto.Internal.ByteArray (ByteArrayAccess)+import Crypto.Cipher.DES.Primitive+import Crypto.Cipher.Types+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Data.Memory.Endian+import Data.Memory.Endian+import Data.Word  -- | 3DES with 3 different keys used all in the same direction data DES_EEE3 = DES_EEE3 Word64 Word64 Word64     deriving (Eq)  -- | 3DES with 3 different keys used in alternative direction-data DES_EDE3 = DES_EDE3 Word64 Word64 Word64 +data DES_EDE3 = DES_EDE3 Word64 Word64 Word64     deriving (Eq)  -- | 3DES where the first and third keys are equal, used in the same direction@@ -36,24 +35,24 @@     deriving (Eq)  instance Cipher DES_EEE3 where-    cipherName    _ = "3DES_EEE"+    cipherName _ = "3DES_EEE"     cipherKeySize _ = KeySizeFixed 24-    cipherInit k    = init3DES DES_EEE3 k+    cipherInit k = init3DES DES_EEE3 k  instance Cipher DES_EDE3 where-    cipherName    _ = "3DES_EDE"+    cipherName _ = "3DES_EDE"     cipherKeySize _ = KeySizeFixed 24-    cipherInit k    = init3DES DES_EDE3 k+    cipherInit k = init3DES DES_EDE3 k  instance Cipher DES_EDE2 where-    cipherName    _ = "2DES_EDE"+    cipherName _ = "2DES_EDE"     cipherKeySize _ = KeySizeFixed 16-    cipherInit k    = init2DES DES_EDE2 k+    cipherInit k = init2DES DES_EDE2 k  instance Cipher DES_EEE2 where-    cipherName    _ = "2DES_EEE"+    cipherName _ = "2DES_EEE"     cipherKeySize _ = KeySizeFixed 16-    cipherInit k    = init2DES DES_EEE2 k+    cipherInit k = init2DES DES_EEE2 k  instance BlockCipher DES_EEE3 where     blockSize _ = 8@@ -75,16 +74,21 @@     ecbEncrypt (DES_EDE2 k1 k2) = B.mapAsWord64 (unBlock . (encrypt k1 . decrypt k2 . encrypt k1) . Block)     ecbDecrypt (DES_EDE2 k1 k2) = B.mapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k1) . Block) -init3DES :: ByteArrayAccess key => (Word64 -> Word64 -> Word64 -> a) -> key -> CryptoFailable a+init3DES+    :: ByteArrayAccess key+    => (Word64 -> Word64 -> Word64 -> a) -> key -> CryptoFailable a init3DES constr k     | len == 24 = CryptoPassed $ constr k1 k2 k3     | otherwise = CryptoFailed CryptoError_KeySizeInvalid-  where len = B.length k-        (k1, k2, k3) = (fromBE $ B.toW64BE k 0, fromBE $ B.toW64BE k 8, fromBE $ B.toW64BE k 16)+  where+    len = B.length k+    (k1, k2, k3) = (fromBE $ B.toW64BE k 0, fromBE $ B.toW64BE k 8, fromBE $ B.toW64BE k 16) -init2DES :: ByteArrayAccess key => (Word64 -> Word64 -> a) -> key -> CryptoFailable a+init2DES+    :: ByteArrayAccess key => (Word64 -> Word64 -> a) -> key -> CryptoFailable a init2DES constr k     | len == 16 = CryptoPassed $ constr k1 k2     | otherwise = CryptoFailed CryptoError_KeySizeInvalid-  where len = B.length k-        (k1, k2) = (fromBE $ B.toW64BE k 0, fromBE $ B.toW64BE k 8)+  where+    len = B.length k+    (k1, k2) = (fromBE $ B.toW64BE k 0, fromBE $ B.toW64BE k 8)

@@ -1,8 +1,8 @@-module Crypto.Cipher.Twofish-    ( Twofish128-    , Twofish192-    , Twofish256-    ) where+module Crypto.Cipher.Twofish (+    Twofish128,+    Twofish192,+    Twofish256,+) where  import Crypto.Cipher.Twofish.Primitive import Crypto.Cipher.Types@@ -11,35 +11,38 @@ newtype Twofish128 = Twofish128 Twofish  instance Cipher Twofish128 where-    cipherName    _ = "Twofish128"+    cipherName _ = "Twofish128"     cipherKeySize _ = KeySizeFixed 16-    cipherInit key  = Twofish128 <$> (initTwofish =<< validateKeySize (undefined :: Twofish128) key)+    cipherInit key =+        Twofish128 <$> (initTwofish =<< validateKeySize (undefined :: Twofish128) key)  instance BlockCipher Twofish128 where-    blockSize                 _ = 16+    blockSize _ = 16     ecbEncrypt (Twofish128 key) = encrypt key     ecbDecrypt (Twofish128 key) = decrypt key  newtype Twofish192 = Twofish192 Twofish  instance Cipher Twofish192 where-    cipherName    _ = "Twofish192"+    cipherName _ = "Twofish192"     cipherKeySize _ = KeySizeFixed 24-    cipherInit key  = Twofish192 <$> (initTwofish =<< validateKeySize (undefined :: Twofish192) key)+    cipherInit key =+        Twofish192 <$> (initTwofish =<< validateKeySize (undefined :: Twofish192) key)  instance BlockCipher Twofish192 where-    blockSize                 _ = 16+    blockSize _ = 16     ecbEncrypt (Twofish192 key) = encrypt key     ecbDecrypt (Twofish192 key) = decrypt key  newtype Twofish256 = Twofish256 Twofish  instance Cipher Twofish256 where-    cipherName    _ = "Twofish256"+    cipherName _ = "Twofish256"     cipherKeySize _ = KeySizeFixed 32-    cipherInit key  = Twofish256 <$> (initTwofish =<< validateKeySize (undefined :: Twofish256) key)+    cipherInit key =+        Twofish256 <$> (initTwofish =<< validateKeySize (undefined :: Twofish256) key)  instance BlockCipher Twofish256 where-    blockSize                 _ = 16+    blockSize _ = 16     ecbEncrypt (Twofish256 key) = encrypt key     ecbDecrypt (Twofish256 key) = decrypt key

@@ -1,39 +1,44 @@-{-# LANGUAGE MagicHash #-} {-# LANGUAGE BangPatterns #-}-module Crypto.Cipher.Twofish.Primitive-    ( Twofish-    , initTwofish-    , encrypt-    , decrypt-    ) where+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -import           Crypto.Error-import           Crypto.Internal.ByteArray (ByteArray)+module Crypto.Cipher.Twofish.Primitive (+    Twofish,+    initTwofish,+    encrypt,+    decrypt,+) where++import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.WordArray-import           Data.Word-import           Data.Bits-import           Data.List+import Crypto.Internal.WordArray+import Data.Bits+import Data.List (foldl')+import Data.Word  -- Based on the Golang referance implementation -- https://github.com/golang/crypto/blob/master/twofish/twofish.go - -- BlockSize is the constant block size of Twofish. blockSize :: Int blockSize = 16  mdsPolynomial, rsPolynomial :: Word32 mdsPolynomial = 0x169 -- x^8 + x^6 + x^5 + x^3 + 1, see [TWOFISH] 4.2-rsPolynomial = 0x14d  -- x^8 + x^6 + x^3 + x^2 + 1, see [TWOFISH] 4.3+rsPolynomial = 0x14d -- x^8 + x^6 + x^3 + x^2 + 1, see [TWOFISH] 4.3 -data Twofish = Twofish { s :: (Array32, Array32, Array32, Array32)-                       , k :: Array32 }+data Twofish = Twofish+    { s :: (Array32, Array32, Array32, Array32)+    , k :: Array32+    }  data ByteSize = Bytes16 | Bytes24 | Bytes32 deriving (Eq) -data KeyPackage ba = KeyPackage { rawKeyBytes :: ba-                                , byteSize :: ByteSize }+data KeyPackage ba = KeyPackage+    { rawKeyBytes :: ba+    , byteSize :: ByteSize+    }  buildPackage :: ByteArray ba => ba -> Maybe (KeyPackage ba) buildPackage key@@ -46,89 +51,159 @@ -- -- Return the initialized key or a error message if the given -- keyseed was not 16-bytes in length.-initTwofish :: ByteArray key-            => key -- ^ The key to create the twofish context-            -> CryptoFailable Twofish+initTwofish+    :: ByteArray key+    => key+    -- ^ The key to create the twofish context+    -> CryptoFailable Twofish initTwofish key =-    case buildPackage key of Nothing -> CryptoFailed CryptoError_KeySizeInvalid-                             Just keyPackage -> CryptoPassed Twofish { k = generatedK, s = generatedS }-                                  where generatedK = array32 40 $ genK keyPackage-                                        generatedS = genSboxes keyPackage $ sWords key+    case buildPackage key of+        Nothing -> CryptoFailed CryptoError_KeySizeInvalid+        Just keyPackage -> CryptoPassed Twofish{k = generatedK, s = generatedS}+          where+            generatedK = array32 40 $ genK keyPackage+            generatedS = genSboxes keyPackage $ sWords key  mapBlocks :: ByteArray ba => (ba -> ba) -> ba -> ba mapBlocks operation input     | B.null rest = blockOutput     | otherwise = blockOutput `B.append` mapBlocks operation rest-        where (block, rest) = B.splitAt blockSize input-              blockOutput = operation block+  where+    (block, rest) = B.splitAt blockSize input+    blockOutput = operation block  -- | Encrypts the given ByteString using the given Key-encrypt :: ByteArray ba-        => Twofish     -- ^ The key to use-        -> ba           -- ^ The data to encrypt-        -> ba+encrypt+    :: ByteArray ba+    => Twofish+    -- ^ The key to use+    -> ba+    -- ^ The data to encrypt+    -> ba encrypt cipher = mapBlocks (encryptBlock cipher)  encryptBlock :: ByteArray ba => Twofish -> ba -> ba-encryptBlock Twofish { s = (s1, s2, s3, s4), k = ks } message = store32ls ts-    where (a, b, c, d) = load32ls message-          a' = a `xor` arrayRead32 ks 0-          b' = b `xor` arrayRead32 ks 1-          c' = c `xor` arrayRead32 ks 2-          d' = d `xor` arrayRead32 ks 3-          (!a'', !b'', !c'', !d'') = foldl' shuffle (a', b', c', d') [0..7]-          ts = (c'' `xor` arrayRead32 ks 4, d'' `xor` arrayRead32 ks 5, a'' `xor` arrayRead32 ks 6, b'' `xor` arrayRead32 ks 7)+encryptBlock Twofish{s = (s1, s2, s3, s4), k = ks} message = store32ls ts+  where+    (a, b, c, d) = load32ls message+    a' = a `xor` arrayRead32 ks 0+    b' = b `xor` arrayRead32 ks 1+    c' = c `xor` arrayRead32 ks 2+    d' = d `xor` arrayRead32 ks 3+    (!a'', !b'', !c'', !d'') = foldl' shuffle (a', b', c', d') [0 .. 7]+    ts =+        ( c'' `xor` arrayRead32 ks 4+        , d'' `xor` arrayRead32 ks 5+        , a'' `xor` arrayRead32 ks 6+        , b'' `xor` arrayRead32 ks 7+        ) -          shuffle :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)-          shuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')-            where [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (8 + 4 * ind) + offset) [0..3]-                  t2 = byteIndex s2 retB `xor` byteIndex s3 (shiftR retB 8) `xor` byteIndex s4 (shiftR retB 16) `xor` byteIndex s1 (shiftR retB 24)-                  t1 = (byteIndex s1 retA `xor` byteIndex s2 (shiftR retA 8) `xor` byteIndex s3 (shiftR retA 16) `xor` byteIndex s4 (shiftR retA 24)) + t2-                  retC' = rotateR (retC `xor` (t1 + k0)) 1-                  retD' = rotateL retD 1 `xor` (t1 + t2 + k1)-                  t2' = byteIndex s2 retD' `xor` byteIndex s3 (shiftR retD' 8) `xor` byteIndex s4 (shiftR retD' 16) `xor` byteIndex s1 (shiftR retD' 24)-                  t1' = (byteIndex s1 retC' `xor` byteIndex s2 (shiftR retC' 8) `xor` byteIndex s3 (shiftR retC' 16) `xor` byteIndex s4 (shiftR retC' 24)) + t2'-                  retA' = rotateR (retA `xor` (t1' + k2)) 1-                  retB' = rotateL retB 1 `xor` (t1' + t2' + k3)+    shuffle+        :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)+    shuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')+      where+        [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (8 + 4 * ind) + offset) [0 .. 3]+        t2 =+            byteIndex s2 retB+                `xor` byteIndex s3 (shiftR retB 8)+                `xor` byteIndex s4 (shiftR retB 16)+                `xor` byteIndex s1 (shiftR retB 24)+        t1 =+            ( byteIndex s1 retA+                `xor` byteIndex s2 (shiftR retA 8)+                `xor` byteIndex s3 (shiftR retA 16)+                `xor` byteIndex s4 (shiftR retA 24)+            )+                + t2+        retC' = rotateR (retC `xor` (t1 + k0)) 1+        retD' = rotateL retD 1 `xor` (t1 + t2 + k1)+        t2' =+            byteIndex s2 retD'+                `xor` byteIndex s3 (shiftR retD' 8)+                `xor` byteIndex s4 (shiftR retD' 16)+                `xor` byteIndex s1 (shiftR retD' 24)+        t1' =+            ( byteIndex s1 retC'+                `xor` byteIndex s2 (shiftR retC' 8)+                `xor` byteIndex s3 (shiftR retC' 16)+                `xor` byteIndex s4 (shiftR retC' 24)+            )+                + t2'+        retA' = rotateR (retA `xor` (t1' + k2)) 1+        retB' = rotateL retB 1 `xor` (t1' + t2' + k3)  -- Unsafe, no bounds checking byteIndex :: Array32 -> Word32 -> Word32-byteIndex xs ind  = arrayRead32 xs $ fromIntegral byte-    where byte = ind `mod` 256+byteIndex xs ind = arrayRead32 xs $ fromIntegral byte+  where+    byte = ind `mod` 256  -- | Decrypts the given ByteString using the given Key-decrypt :: ByteArray ba-        => Twofish     -- ^ The key to use-        -> ba           -- ^ The data to decrypt-        -> ba+decrypt+    :: ByteArray ba+    => Twofish+    -- ^ The key to use+    -> ba+    -- ^ The data to decrypt+    -> ba decrypt cipher = mapBlocks (decryptBlock cipher)  {- decryption for 128 bits blocks -} decryptBlock :: ByteArray ba => Twofish -> ba -> ba-decryptBlock Twofish { s = (s1, s2, s3, s4), k = ks } message = store32ls ixs-    where (a, b, c, d) = load32ls message-          a' = c `xor` arrayRead32 ks 6-          b' = d `xor` arrayRead32 ks 7-          c' = a `xor` arrayRead32 ks 4-          d' = b `xor` arrayRead32 ks 5-          (!a'', !b'', !c'', !d'') = foldl' unshuffle (a', b', c', d') [8, 7..1]-          ixs = (a'' `xor` arrayRead32 ks 0, b'' `xor` arrayRead32 ks 1, c'' `xor` arrayRead32 ks 2, d'' `xor` arrayRead32 ks 3)+decryptBlock Twofish{s = (s1, s2, s3, s4), k = ks} message = store32ls ixs+  where+    (a, b, c, d) = load32ls message+    a' = c `xor` arrayRead32 ks 6+    b' = d `xor` arrayRead32 ks 7+    c' = a `xor` arrayRead32 ks 4+    d' = b `xor` arrayRead32 ks 5+    (!a'', !b'', !c'', !d'') = foldl' unshuffle (a', b', c', d') [8, 7 .. 1]+    ixs =+        ( a'' `xor` arrayRead32 ks 0+        , b'' `xor` arrayRead32 ks 1+        , c'' `xor` arrayRead32 ks 2+        , d'' `xor` arrayRead32 ks 3+        ) -          unshuffle :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)-          unshuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')-            where [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (4 + 4 * ind) + offset) [0..3]-                  t2 = byteIndex s2 retD `xor` byteIndex s3 (shiftR retD 8) `xor` byteIndex s4 (shiftR retD 16) `xor` byteIndex s1 (shiftR retD 24)-                  t1 = (byteIndex s1 retC `xor` byteIndex s2 (shiftR retC 8) `xor` byteIndex s3 (shiftR retC 16) `xor` byteIndex s4 (shiftR retC 24)) + t2-                  retA' = rotateL retA 1 `xor` (t1 + k2)-                  retB' = rotateR (retB `xor` (t2 + t1 + k3)) 1-                  t2' = byteIndex s2 retB' `xor` byteIndex s3 (shiftR retB' 8) `xor` byteIndex s4 (shiftR retB' 16) `xor` byteIndex s1 (shiftR retB' 24)-                  t1' = (byteIndex s1 retA' `xor` byteIndex s2 (shiftR retA' 8) `xor` byteIndex s3 (shiftR retA' 16) `xor` byteIndex s4 (shiftR retA' 24)) + t2'-                  retC' = rotateL retC 1 `xor` (t1' + k0)-                  retD' = rotateR (retD `xor` (t2' + t1' + k1)) 1+    unshuffle+        :: (Word32, Word32, Word32, Word32) -> Int -> (Word32, Word32, Word32, Word32)+    unshuffle (!retA, !retB, !retC, !retD) ind = (retA', retB', retC', retD')+      where+        [k0, k1, k2, k3] = fmap (\offset -> arrayRead32 ks $ (4 + 4 * ind) + offset) [0 .. 3]+        t2 =+            byteIndex s2 retD+                `xor` byteIndex s3 (shiftR retD 8)+                `xor` byteIndex s4 (shiftR retD 16)+                `xor` byteIndex s1 (shiftR retD 24)+        t1 =+            ( byteIndex s1 retC+                `xor` byteIndex s2 (shiftR retC 8)+                `xor` byteIndex s3 (shiftR retC 16)+                `xor` byteIndex s4 (shiftR retC 24)+            )+                + t2+        retA' = rotateL retA 1 `xor` (t1 + k2)+        retB' = rotateR (retB `xor` (t2 + t1 + k3)) 1+        t2' =+            byteIndex s2 retB'+                `xor` byteIndex s3 (shiftR retB' 8)+                `xor` byteIndex s4 (shiftR retB' 16)+                `xor` byteIndex s1 (shiftR retB' 24)+        t1' =+            ( byteIndex s1 retA'+                `xor` byteIndex s2 (shiftR retA' 8)+                `xor` byteIndex s3 (shiftR retA' 16)+                `xor` byteIndex s4 (shiftR retA' 24)+            )+                + t2'+        retC' = rotateL retC 1 `xor` (t1' + k0)+        retD' = rotateR (retD `xor` (t2' + t1' + k1)) 1  sbox0 :: Int -> Word8 sbox0 = arrayRead8 t-    where t = array8+  where+    t =+        array8             "\xa9\x67\xb3\xe8\x04\xfd\xa3\x76\x9a\x92\x80\x78\xe4\xdd\xd1\x38\             \\x0d\xc6\x35\x98\x18\xf7\xec\x6c\x43\x75\x37\x26\xfa\x13\x94\x48\             \\xf2\xd0\x8b\x30\x84\x54\xdf\x23\x19\x5b\x3d\x59\xf3\xae\xa2\x82\@@ -148,7 +223,9 @@  sbox1 :: Int -> Word8 sbox1 = arrayRead8 t-    where t = array8+  where+    t =+        array8             "\x75\xf3\xc6\xf4\xdb\x7b\xfb\xc8\x4a\xd3\xe6\x6b\x45\x7d\xe8\x4b\             \\xd6\x32\xd8\xfd\x37\x71\xf1\xe1\x30\x0f\xf8\x1b\x87\xfa\x06\x3f\             \\x5e\xba\xae\x5b\x8a\x00\xbc\x9d\x6d\xc1\xb1\x0e\x80\x5d\xd2\xd5\@@ -167,145 +244,281 @@             \\xd7\x61\x1e\xb4\x50\x04\xf6\xc2\x16\x25\x86\x56\x55\x09\xbe\x91"#  rs :: [[Word8]]-rs = [ [0x01, 0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E]-     , [0xA4, 0x56, 0x82, 0xF3, 0x1E, 0xC6, 0x68, 0xE5]-     , [0x02, 0xA1, 0xFC, 0xC1, 0x47, 0xAE, 0x3D, 0x19]-     , [0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E, 0x03] ]--+rs =+    [ [0x01, 0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E]+    , [0xA4, 0x56, 0x82, 0xF3, 0x1E, 0xC6, 0x68, 0xE5]+    , [0x02, 0xA1, 0xFC, 0xC1, 0x47, 0xAE, 0x3D, 0x19]+    , [0xA4, 0x55, 0x87, 0x5A, 0x58, 0xDB, 0x9E, 0x03]+    ]  load32ls :: ByteArray ba => ba -> (Word32, Word32, Word32, Word32) load32ls message = (intify q1, intify q2, intify q3, intify q4)-    where (half1, half2) = B.splitAt 8 message-          (q1, q2) = B.splitAt 4 half1-          (q3, q4) = B.splitAt 4 half2+  where+    (half1, half2) = B.splitAt 8 message+    (q1, q2) = B.splitAt 4 half1+    (q3, q4) = B.splitAt 4 half2 -          intify :: ByteArray ba => ba -> Word32-          intify bytes = foldl' (\int (!word, !ind) -> int .|. shiftL (fromIntegral word) (ind * 8) ) 0 (zip (B.unpack bytes) [0..])+    intify :: ByteArray ba => ba -> Word32+    intify bytes =+        foldl'+            (\int (!word, !ind) -> int .|. shiftL (fromIntegral word) (ind * 8))+            0+            (zip (B.unpack bytes) [0 ..])  store32ls :: ByteArray ba => (Word32, Word32, Word32, Word32) -> ba store32ls (a, b, c, d) = B.pack $ concatMap splitWordl [a, b, c, d]-    where splitWordl :: Word32 -> [Word8]-          splitWordl w = fmap (\ind -> fromIntegral $ shiftR w (8 * ind)) [0..3]-+  where+    splitWordl :: Word32 -> [Word8]+    splitWordl w = fmap (\ind -> fromIntegral $ shiftR w (8 * ind)) [0 .. 3]  -- Create S words sWords :: ByteArray ba => ba -> [Word8] sWords key = sWord-    where word64Count = B.length key `div` 2-          sWord = concatMap (\wordIndex ->-                        map (\rsRow ->-                            foldl' (\acc (!rsVal, !colIndex) ->+  where+    word64Count = B.length key `div` 2+    sWord =+        concatMap+            ( \wordIndex ->+                map+                    ( \rsRow ->+                        foldl'+                            ( \acc (!rsVal, !colIndex) ->                                 acc `xor` gfMult rsPolynomial (B.index key $ 8 * wordIndex + colIndex) rsVal-                                ) 0 (zip rsRow [0..])-                            ) rs-                    ) [0..word64Count - 1]+                            )+                            0+                            (zip rsRow [0 ..])+                    )+                    rs+            )+            [0 .. word64Count - 1]  data Column = Zero | One | Two | Three deriving (Show, Eq, Enum, Bounded)  genSboxes :: KeyPackage ba -> [Word8] -> (Array32, Array32, Array32, Array32) genSboxes keyPackage ws = (mkArray b0', mkArray b1', mkArray b2', mkArray b3')-    where range = [0..255]-          mkArray = array32 256-          [w0, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15] = take 16 ws-          (b0', b1', b2', b3') = sboxBySize $ byteSize keyPackage--          sboxBySize :: ByteSize -> ([Word32], [Word32], [Word32], [Word32])-          sboxBySize Bytes16 = (b0, b1, b2, b3)-            where !b0 = fmap mapper range-                    where mapper :: Int -> Word32-                          mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w0) `xor` w4)) Zero-                  !b1 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5)) One-                  !b2 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6)) Two-                  !b3 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7)) Three--          sboxBySize Bytes24 = (b0, b1, b2, b3)-            where !b0 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4) `xor` w8)) Zero-                  !b1 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5) `xor` w9)) One-                  !b2 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6) `xor` w10)) Two-                  !b3 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w3) `xor` w7) `xor` w11)) Three--          sboxBySize Bytes32 = (b0, b1, b2, b3)-            where !b0 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4) `xor` w8) `xor` w12)) Zero-                  !b1 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w1) `xor` w5) `xor` w9) `xor` w13)) One-                  !b2 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6) `xor` w10) `xor` w14)) Two-                  !b3 = fmap mapper range-                    where mapper byte = mdsColumnMult ((sbox0 . fromIntegral) ((sbox1 . fromIntegral) ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7) `xor` w11) `xor` w15)) Three--genK :: (ByteArray ba) => KeyPackage ba -> [Word32]-genK keyPackage = concatMap makeTuple [0..19]-    where makeTuple :: Word8 -> [Word32]-          makeTuple idx = [a + b', rotateL (2 * b' + a) 9]-            where tmp1 = replicate 4 $ 2 * idx-                  tmp2 = fmap (+1) tmp1-                  a = h tmp1 keyPackage 0-                  b = h tmp2 keyPackage 1-                  b' = rotateL b 8+  where+    range = [0 .. 255]+    mkArray = array32 256+    [w0, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15] = take 16 ws+    (b0', b1', b2', b3') = sboxBySize $ byteSize keyPackage -h :: (ByteArray ba) => [Word8] -> KeyPackage ba -> Int -> Word32-h input keyPackage offset =  foldl' xorMdsColMult 0 $ zip [y0f, y1f, y2f, y3f] $ enumFrom Zero-    where key = rawKeyBytes keyPackage-          [y0, y1, y2, y3] = take 4 input-          (!y0f, !y1f, !y2f, !y3f) = run (y0, y1, y2, y3) $ byteSize keyPackage+    sboxBySize :: ByteSize -> ([Word32], [Word32], [Word32], [Word32])+    sboxBySize Bytes16 = (b0, b1, b2, b3)+      where+        !b0 = fmap mapper range+          where+            mapper :: Int -> Word32+            mapper byte =+                mdsColumnMult+                    ((sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w0) `xor` w4))+                    Zero+        !b1 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ((sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5))+                    One+        !b2 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ((sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6))+                    Two+        !b3 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ((sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7))+                    Three+    sboxBySize Bytes24 = (b0, b1, b2, b3)+      where+        !b0 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox1 . fromIntegral)+                        ( (sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4)+                            `xor` w8+                        )+                    )+                    Zero+        !b1 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox0 . fromIntegral)+                        ( (sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w1) `xor` w5)+                            `xor` w9+                        )+                    )+                    One+        !b2 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox1 . fromIntegral)+                        ( (sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6)+                            `xor` w10+                        )+                    )+                    Two+        !b3 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox0 . fromIntegral)+                        ( (sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w3) `xor` w7)+                            `xor` w11+                        )+                    )+                    Three+    sboxBySize Bytes32 = (b0, b1, b2, b3)+      where+        !b0 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox1 . fromIntegral)+                        ( (sbox0 . fromIntegral)+                            ( (sbox0 . fromIntegral) ((sbox1 . fromIntegral $ sbox1 byte `xor` w0) `xor` w4)+                                `xor` w8+                            )+                            `xor` w12+                        )+                    )+                    Zero+        !b1 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox0 . fromIntegral)+                        ( (sbox0 . fromIntegral)+                            ( (sbox1 . fromIntegral) ((sbox1 . fromIntegral $ sbox0 byte `xor` w1) `xor` w5)+                                `xor` w9+                            )+                            `xor` w13+                        )+                    )+                    One+        !b2 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox1 . fromIntegral)+                        ( (sbox1 . fromIntegral)+                            ( (sbox0 . fromIntegral) ((sbox0 . fromIntegral $ sbox0 byte `xor` w2) `xor` w6)+                                `xor` w10+                            )+                            `xor` w14+                        )+                    )+                    Two+        !b3 = fmap mapper range+          where+            mapper byte =+                mdsColumnMult+                    ( (sbox0 . fromIntegral)+                        ( (sbox1 . fromIntegral)+                            ( (sbox1 . fromIntegral) ((sbox0 . fromIntegral $ sbox1 byte `xor` w3) `xor` w7)+                                `xor` w11+                            )+                            `xor` w15+                        )+                    )+                    Three -          run :: (Word8, Word8, Word8, Word8) -> ByteSize -> (Word8, Word8, Word8, Word8)-          run (!y0'', !y1'', !y2'', !y3'') Bytes32 = run (y0', y1', y2', y3') Bytes24-            where y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (6 + offset) + 0)-                  y1' = sbox0 (fromIntegral y1'') `xor` B.index key (4 * (6 + offset) + 1)-                  y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (6 + offset) + 2)-                  y3' = sbox1 (fromIntegral y3'') `xor` B.index key (4 * (6 + offset) + 3)+genK :: ByteArray ba => KeyPackage ba -> [Word32]+genK keyPackage = concatMap makeTuple [0 .. 19]+  where+    makeTuple :: Word8 -> [Word32]+    makeTuple idx = [a + b', rotateL (2 * b' + a) 9]+      where+        tmp1 = replicate 4 $ 2 * idx+        tmp2 = fmap (+ 1) tmp1+        a = h tmp1 keyPackage 0+        b = h tmp2 keyPackage 1+        b' = rotateL b 8 -          run (!y0'', !y1'', !y2'', !y3'') Bytes24 = run (y0', y1', y2', y3') Bytes16-            where y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (4 + offset) + 0)-                  y1' = sbox1 (fromIntegral y1'') `xor` B.index key (4 * (4 + offset) + 1)-                  y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (4 + offset) + 2)-                  y3' = sbox0 (fromIntegral y3'') `xor` B.index key (4 * (4 + offset) + 3)+h :: ByteArray ba => [Word8] -> KeyPackage ba -> Int -> Word32+h input keyPackage offset = foldl' xorMdsColMult 0 $ zip [y0f, y1f, y2f, y3f] $ enumFrom Zero+  where+    key = rawKeyBytes keyPackage+    [y0, y1, y2, y3] = take 4 input+    (!y0f, !y1f, !y2f, !y3f) = run (y0, y1, y2, y3) $ byteSize keyPackage -          run (!y0'', !y1'', !y2'', !y3'') Bytes16 = (y0', y1', y2', y3')-            where y0' = sbox1 . fromIntegral $ (sbox0 . fromIntegral $ (sbox0 (fromIntegral y0'') `xor` B.index key (4 * (2 + offset) + 0))) `xor` B.index key (4 * (0 + offset) + 0)-                  y1' = sbox0 . fromIntegral $ (sbox0 . fromIntegral $ (sbox1 (fromIntegral y1'') `xor` B.index key (4 * (2 + offset) + 1))) `xor` B.index key (4 * (0 + offset) + 1)-                  y2' = sbox1 . fromIntegral $ (sbox1 . fromIntegral $ (sbox0 (fromIntegral y2'') `xor` B.index key (4 * (2 + offset) + 2))) `xor` B.index key (4 * (0 + offset) + 2)-                  y3' = sbox0 . fromIntegral $ (sbox1 . fromIntegral $ (sbox1 (fromIntegral y3'') `xor` B.index key (4 * (2 + offset) + 3))) `xor` B.index key (4 * (0 + offset) + 3)+    run :: (Word8, Word8, Word8, Word8) -> ByteSize -> (Word8, Word8, Word8, Word8)+    run (!y0'', !y1'', !y2'', !y3'') Bytes32 = run (y0', y1', y2', y3') Bytes24+      where+        y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (6 + offset) + 0)+        y1' = sbox0 (fromIntegral y1'') `xor` B.index key (4 * (6 + offset) + 1)+        y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (6 + offset) + 2)+        y3' = sbox1 (fromIntegral y3'') `xor` B.index key (4 * (6 + offset) + 3)+    run (!y0'', !y1'', !y2'', !y3'') Bytes24 = run (y0', y1', y2', y3') Bytes16+      where+        y0' = sbox1 (fromIntegral y0'') `xor` B.index key (4 * (4 + offset) + 0)+        y1' = sbox1 (fromIntegral y1'') `xor` B.index key (4 * (4 + offset) + 1)+        y2' = sbox0 (fromIntegral y2'') `xor` B.index key (4 * (4 + offset) + 2)+        y3' = sbox0 (fromIntegral y3'') `xor` B.index key (4 * (4 + offset) + 3)+    run (!y0'', !y1'', !y2'', !y3'') Bytes16 = (y0', y1', y2', y3')+      where+        y0' =+            sbox1 . fromIntegral $+                ( sbox0 . fromIntegral $+                    (sbox0 (fromIntegral y0'') `xor` B.index key (4 * (2 + offset) + 0))+                )+                    `xor` B.index key (4 * (0 + offset) + 0)+        y1' =+            sbox0 . fromIntegral $+                ( sbox0 . fromIntegral $+                    (sbox1 (fromIntegral y1'') `xor` B.index key (4 * (2 + offset) + 1))+                )+                    `xor` B.index key (4 * (0 + offset) + 1)+        y2' =+            sbox1 . fromIntegral $+                ( sbox1 . fromIntegral $+                    (sbox0 (fromIntegral y2'') `xor` B.index key (4 * (2 + offset) + 2))+                )+                    `xor` B.index key (4 * (0 + offset) + 2)+        y3' =+            sbox0 . fromIntegral $+                ( sbox1 . fromIntegral $+                    (sbox1 (fromIntegral y3'') `xor` B.index key (4 * (2 + offset) + 3))+                )+                    `xor` B.index key (4 * (0 + offset) + 3) -          xorMdsColMult :: Word32 -> (Word8, Column) -> Word32-          xorMdsColMult acc wordAndIndex = acc `xor` uncurry mdsColumnMult wordAndIndex+    xorMdsColMult :: Word32 -> (Word8, Column) -> Word32+    xorMdsColMult acc wordAndIndex = acc `xor` uncurry mdsColumnMult wordAndIndex  mdsColumnMult :: Word8 -> Column -> Word32 mdsColumnMult !byte !col =-    case col of Zero  -> input .|. rotateL mul5B 8 .|. rotateL mulEF 16 .|. rotateL mulEF 24-                One   -> mulEF .|. rotateL mulEF 8 .|. rotateL mul5B 16 .|. rotateL input 24-                Two   -> mul5B .|. rotateL mulEF 8 .|. rotateL input 16 .|. rotateL mulEF 24-                Three -> mul5B .|. rotateL input 8 .|. rotateL mulEF 16 .|. rotateL mul5B 24-        where input = fromIntegral byte-              mul5B = fromIntegral $ gfMult mdsPolynomial byte 0x5B-              mulEF = fromIntegral $ gfMult mdsPolynomial byte 0xEF+    case col of+        Zero -> input .|. rotateL mul5B 8 .|. rotateL mulEF 16 .|. rotateL mulEF 24+        One -> mulEF .|. rotateL mulEF 8 .|. rotateL mul5B 16 .|. rotateL input 24+        Two -> mul5B .|. rotateL mulEF 8 .|. rotateL input 16 .|. rotateL mulEF 24+        Three -> mul5B .|. rotateL input 8 .|. rotateL mulEF 16 .|. rotateL mul5B 24+  where+    input = fromIntegral byte+    mul5B = fromIntegral $ gfMult mdsPolynomial byte 0x5B+    mulEF = fromIntegral $ gfMult mdsPolynomial byte 0xEF -tupInd :: (Bits b) => b -> (a, a) -> a+tupInd :: Bits b => b -> (a, a) -> a tupInd b     | testBit b 0 = snd     | otherwise = fst  gfMult :: Word32 -> Word8 -> Word8 -> Word8 gfMult p a b = fromIntegral $ run a b' p' result 0-    where b' = (0, fromIntegral b)-          p' = (0, p)-          result = 0+  where+    b' = (0, fromIntegral b)+    p' = (0, p)+    result = 0 -          run :: Word8 -> (Word32, Word32) -> (Word32, Word32) -> Word32 -> Int -> Word32-          run a' b'' p'' result' count =-            if count == 7+    run :: Word8 -> (Word32, Word32) -> (Word32, Word32) -> Word32 -> Int -> Word32+    run a' b'' p'' result' count =+        if count == 7             then result''             else run a'' b''' p'' result'' (count + 1)-                where result'' = result' `xor` tupInd (a' .&. 1) b''-                      a'' = shiftR a' 1-                      b''' = (fst b'', tupInd (shiftR (snd b'') 7) p'' `xor` shiftL (snd b'') 1)+      where+        result'' = result' `xor` tupInd (a' .&. 1) b''+        a'' = shiftR a' 1+        b''' = (fst b'', tupInd (shiftR (snd b'') 7) p'' `xor` shiftL (snd b'') 1)

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveDataTypeable #-}+ -- | -- Module      : Crypto.Cipher.Types -- License     : BSD-style@@ -6,34 +8,34 @@ -- Portability : Excellent -- -- Symmetric cipher basic types----{-# LANGUAGE DeriveDataTypeable #-}-module Crypto.Cipher.Types-    (+module Crypto.Cipher.Types (     -- * Cipher classes-      Cipher(..)-    , BlockCipher(..)-    , BlockCipher128(..)-    , StreamCipher(..)-    , DataUnitOffset-    , KeySizeSpecifier(..)+    Cipher (..),+    BlockCipher (..),+    BlockCipher128 (..),+    StreamCipher (..),+    DataUnitOffset,+    KeySizeSpecifier (..),     -- , cfb8Encrypt     -- , cfb8Decrypt+     -- * AEAD functions-    , AEADMode(..)-    , CCM_M(..)-    , CCM_L(..)-    , module Crypto.Cipher.Types.AEAD+    AEADMode (..),+    CCM_M (..),+    CCM_L (..),+    module Crypto.Cipher.Types.AEAD,+     -- * Initial Vector type and constructor-    , IV-    , makeIV-    , nullIV-    , ivAdd+    IV,+    makeIV,+    nullIV,+    ivAdd,+     -- * Authentification Tag-    , AuthTag(..)-    ) where+    AuthTag (..),+) where +import Crypto.Cipher.Types.AEAD import Crypto.Cipher.Types.Base import Crypto.Cipher.Types.Block import Crypto.Cipher.Types.Stream-import Crypto.Cipher.Types.AEAD

@@ -1,3 +1,6 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types #-}+ -- | -- Module      : Crypto.Cipher.Types.AEAD -- License     : BSD-style@@ -6,28 +9,25 @@ -- Portability : Excellent -- -- AEAD cipher basic types----{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE Rank2Types #-} module Crypto.Cipher.Types.AEAD where -import           Crypto.Cipher.Types.Base-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)+import Crypto.Cipher.Types.Base+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Imports+import Crypto.Internal.Imports  -- | AEAD Implementation data AEADModeImpl st = AEADModeImpl-    { aeadImplAppendHeader :: forall ba . ByteArrayAccess ba => st -> ba -> st-    , aeadImplEncrypt      :: forall ba . ByteArray ba => st -> ba -> (ba, st)-    , aeadImplDecrypt      :: forall ba . ByteArray ba => st -> ba -> (ba, st)-    , aeadImplFinalize     :: st -> Int -> AuthTag+    { aeadImplAppendHeader :: forall ba. ByteArrayAccess ba => st -> ba -> st+    , aeadImplEncrypt :: forall ba. ByteArray ba => st -> ba -> (ba, st)+    , aeadImplDecrypt :: forall ba. ByteArray ba => st -> ba -> (ba, st)+    , aeadImplFinalize :: st -> Int -> AuthTag     }  -- | Authenticated Encryption with Associated Data algorithms-data AEAD cipher = forall st . AEAD+data AEAD cipher = forall st. AEAD     { aeadModeImpl :: AEADModeImpl st-    , aeadState    :: !st+    , aeadState :: !st     }  -- | Append some header information to an AEAD context@@ -47,28 +47,41 @@ aeadFinalize (AEAD impl st) = aeadImplFinalize impl st  -- | Simple AEAD encryption-aeadSimpleEncrypt :: (ByteArrayAccess aad, ByteArray ba)-                  => AEAD a        -- ^ A new AEAD Context-                  -> aad           -- ^ Optional Authentication data header-                  -> ba            -- ^ Optional Plaintext-                  -> Int           -- ^ Tag length-                  -> (AuthTag, ba) -- ^ Authentication tag and ciphertext+aeadSimpleEncrypt+    :: (ByteArrayAccess aad, ByteArray ba)+    => AEAD a+    -- ^ A new AEAD Context+    -> aad+    -- ^ Optional Authentication data header+    -> ba+    -- ^ Optional Plaintext+    -> Int+    -- ^ Tag length+    -> (AuthTag, ba)+    -- ^ Authentication tag and ciphertext aeadSimpleEncrypt aeadIni header input taglen = (tag, output)-  where aead                = aeadAppendHeader aeadIni header-        (output, aeadFinal) = aeadEncrypt aead input-        tag                 = aeadFinalize aeadFinal taglen+  where+    aead = aeadAppendHeader aeadIni header+    (output, aeadFinal) = aeadEncrypt aead input+    tag = aeadFinalize aeadFinal taglen  -- | Simple AEAD decryption-aeadSimpleDecrypt :: (ByteArrayAccess aad, ByteArray ba)-                  => AEAD a        -- ^ A new AEAD Context-                  -> aad           -- ^ Optional Authentication data header-                  -> ba            -- ^ Ciphertext-                  -> AuthTag       -- ^ The authentication tag-                  -> Maybe ba      -- ^ Plaintext+aeadSimpleDecrypt+    :: (ByteArrayAccess aad, ByteArray ba)+    => AEAD a+    -- ^ A new AEAD Context+    -> aad+    -- ^ Optional Authentication data header+    -> ba+    -- ^ Ciphertext+    -> AuthTag+    -- ^ The authentication tag+    -> Maybe ba+    -- ^ Plaintext aeadSimpleDecrypt aeadIni header input authTag     | tag == authTag = Just output-    | otherwise      = Nothing-  where aead                = aeadAppendHeader aeadIni header-        (output, aeadFinal) = aeadDecrypt aead input-        tag                 = aeadFinalize aeadFinal (B.length authTag)-+    | otherwise = Nothing+  where+    aead = aeadAppendHeader aeadIni header+    (output, aeadFinal) = aeadDecrypt aead input+    tag = aeadFinalize aeadFinal (B.length authTag)

@@ -1,3 +1,6 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.Cipher.Types.Base -- License     : BSD-style@@ -6,60 +9,63 @@ -- Portability : Excellent -- -- Symmetric cipher basic types----{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.Cipher.Types.Base-    ( KeySizeSpecifier(..)-    , Cipher(..)-    , AuthTag(..)-    , AEADMode(..)-    , CCM_M(..)-    , CCM_L(..)-    , DataUnitOffset-    ) where+module Crypto.Cipher.Types.Base (+    KeySizeSpecifier (..),+    Cipher (..),+    AuthTag (..),+    AEADMode (..),+    CCM_M (..),+    CCM_L (..),+    DataUnitOffset,+) where -import           Data.Word-import           Crypto.Internal.ByteArray (Bytes, ByteArrayAccess, ByteArray)+import Crypto.Error+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.DeepSeq-import           Crypto.Error+import Crypto.Internal.DeepSeq+import Data.Word  -- | Different specifier for key size in bytes-data KeySizeSpecifier =-      KeySizeRange Int Int -- ^ in the range [min,max]-    | KeySizeEnum  [Int]   -- ^ one of the specified values-    | KeySizeFixed Int     -- ^ a specific size-    deriving (Show,Eq)+data KeySizeSpecifier+    = -- | in the range [min,max]+      KeySizeRange Int Int+    | -- | one of the specified values+      KeySizeEnum [Int]+    | -- | a specific size+      KeySizeFixed Int+    deriving (Show, Eq)  -- | Offset inside an XTS data unit, measured in block size. type DataUnitOffset = Word32  -- | Authentication Tag for AE cipher mode-newtype AuthTag = AuthTag { unAuthTag :: Bytes }+newtype AuthTag = AuthTag {unAuthTag :: Bytes}     deriving (Show, ByteArrayAccess, NFData)  instance Eq AuthTag where     (AuthTag a) == (AuthTag b) = B.constEq a b -data CCM_M = CCM_M4 | CCM_M6 | CCM_M8 | CCM_M10 | CCM_M12 | CCM_M14 | CCM_M16 deriving (Show, Eq)+data CCM_M = CCM_M4 | CCM_M6 | CCM_M8 | CCM_M10 | CCM_M12 | CCM_M14 | CCM_M16+    deriving (Show, Eq) data CCM_L = CCM_L2 | CCM_L3 | CCM_L4 deriving (Show, Eq)  -- | AEAD Mode-data AEADMode =-      AEAD_OCB -- OCB3+data AEADMode+    = AEAD_OCB -- OCB3     | AEAD_CCM Int CCM_M CCM_L     | AEAD_EAX     | AEAD_CWC     | AEAD_GCM-    deriving (Show,Eq)+    deriving (Show, Eq)  -- | Symmetric cipher class. class Cipher cipher where     -- | Initialize a cipher context from a key-    cipherInit    :: ByteArray key => key -> CryptoFailable cipher+    cipherInit :: ByteArray key => key -> CryptoFailable cipher+     -- | Cipher name-    cipherName    :: cipher -> String+    cipherName :: cipher -> String+     -- | return the size of the key required for this cipher.     -- Some cipher accept any size for key     cipherKeySize :: cipher -> KeySizeSpecifier

@@ -1,3 +1,8 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ViewPatterns #-}+ -- | -- Module      : Crypto.Cipher.Types.Block -- License     : BSD-style@@ -6,51 +11,55 @@ -- Portability : Excellent -- -- Block cipher basic types----{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE Rank2Types #-}-module Crypto.Cipher.Types.Block-    (+module Crypto.Cipher.Types.Block (     -- * BlockCipher-      BlockCipher(..)-    , BlockCipher128(..)+    BlockCipher (..),+    BlockCipher128 (..),+     -- * Initialization vector (IV)-    , IV(..)-    , makeIV-    , nullIV-    , ivAdd+    IV (..),+    makeIV,+    nullIV,+    ivAdd,+     -- * XTS-    , XTS+    XTS,+     -- * AEAD-    , AEAD(..)+    AEAD (..),     -- , AEADState(..)-    , AEADModeImpl(..)-    , aeadAppendHeader-    , aeadEncrypt-    , aeadDecrypt-    , aeadFinalize+    AEADModeImpl (..),+    aeadAppendHeader,+    aeadEncrypt,+    aeadDecrypt,+    aeadFinalize,+     -- * CFB 8 bits-    --, cfb8Encrypt-    --, cfb8Decrypt-    ) where+) where -import           Data.Word-import           Crypto.Error-import           Crypto.Cipher.Types.Base-import           Crypto.Cipher.Types.GF-import           Crypto.Cipher.Types.AEAD-import           Crypto.Cipher.Types.Utils+-- , cfb8Encrypt+-- , cfb8Decrypt -import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, withByteArray, Bytes)+import Crypto.Cipher.Types.AEAD+import Crypto.Cipher.Types.Base+import Crypto.Cipher.Types.GF+import Crypto.Cipher.Types.Utils+import Crypto.Error+import Data.Word++import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    Bytes,+    withByteArray,+ ) import qualified Crypto.Internal.ByteArray as B -import           Foreign.Ptr-import           Foreign.Storable+import Foreign.Ptr+import Foreign.Storable  -- | an IV parametrized by the cipher-data IV c = forall byteArray . ByteArray byteArray => IV !byteArray+data IV c = forall byteArray. ByteArray byteArray => IV !byteArray  instance BlockCipher c => ByteArrayAccess (IV c) where     withByteArray (IV z) f = withByteArray z f@@ -59,16 +68,21 @@     (IV a) == (IV b) = B.eq a b  -- | XTS callback-type XTS ba cipher = (cipher, cipher)-                  -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)-                  -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks-                  -> ba               -- ^ Data-                  -> ba               -- ^ Processed Data+type XTS ba cipher =+    (cipher, cipher)+    -> IV cipher+    -- ^ Usually represent the Data Unit (e.g. disk sector)+    -> DataUnitOffset+    -- ^ Offset in the data unit in number of blocks+    -> ba+    -- ^ Data+    -> ba+    -- ^ Processed Data  -- | Symmetric block cipher class class Cipher cipher => BlockCipher cipher where     -- | Return the size of block required for this block cipher-    blockSize    :: cipher -> Int+    blockSize :: cipher -> Int      -- | Encrypt blocks     --@@ -85,6 +99,7 @@     -- input need to be a multiple of the blocksize     cbcEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba     cbcEncrypt = cbcEncryptGeneric+     -- | decrypt using the CBC mode.     --     -- input need to be a multiple of the blocksize@@ -96,6 +111,7 @@     -- input need to be a multiple of the blocksize     cfbEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba     cfbEncrypt = cfbEncryptGeneric+     -- | decrypt using the CFB mode.     --     -- input need to be a multiple of the blocksize@@ -116,7 +132,8 @@     -- | Initialize a new AEAD State     --     -- When Nothing is returns, it means the mode is not handled.-    aeadInit :: ByteArrayAccess iv => AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)+    aeadInit+        :: ByteArrayAccess iv => AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)     aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported  -- | class of block cipher with a 128 bits block size@@ -125,96 +142,117 @@     --     -- input need to be a multiple of the blocksize, and the cipher     -- need to process 128 bits block only-    xtsEncrypt :: ByteArray ba-               => (cipher, cipher)-               -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)-               -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks-               -> ba               -- ^ Plaintext-               -> ba               -- ^ Ciphertext+    xtsEncrypt+        :: ByteArray ba+        => (cipher, cipher)+        -> IV cipher+        -- ^ Usually represent the Data Unit (e.g. disk sector)+        -> DataUnitOffset+        -- ^ Offset in the data unit in number of blocks+        -> ba+        -- ^ Plaintext+        -> ba+        -- ^ Ciphertext     xtsEncrypt = xtsEncryptGeneric      -- | decrypt using the XTS mode.     --     -- input need to be a multiple of the blocksize, and the cipher     -- need to process 128 bits block only-    xtsDecrypt :: ByteArray ba-               => (cipher, cipher)-               -> IV cipher        -- ^ Usually represent the Data Unit (e.g. disk sector)-               -> DataUnitOffset   -- ^ Offset in the data unit in number of blocks-               -> ba               -- ^ Ciphertext-               -> ba               -- ^ Plaintext+    xtsDecrypt+        :: ByteArray ba+        => (cipher, cipher)+        -> IV cipher+        -- ^ Usually represent the Data Unit (e.g. disk sector)+        -> DataUnitOffset+        -- ^ Offset in the data unit in number of blocks+        -> ba+        -- ^ Ciphertext+        -> ba+        -- ^ Plaintext     xtsDecrypt = xtsDecryptGeneric  -- | Create an IV for a specified block cipher makeIV :: (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c) makeIV b = toIV undefined-  where toIV :: BlockCipher c => c -> Maybe (IV c)-        toIV cipher-          | B.length b == sz = Just $ IV (B.convert b :: Bytes)-          | otherwise        = Nothing-          where sz = blockSize cipher+  where+    toIV :: BlockCipher c => c -> Maybe (IV c)+    toIV cipher+        | B.length b == sz = Just $ IV (B.convert b :: Bytes)+        | otherwise = Nothing+      where+        sz = blockSize cipher  -- | Create an IV that is effectively representing the number 0 nullIV :: BlockCipher c => IV c nullIV = toIV undefined-  where toIV :: BlockCipher c => c -> IV c-        toIV cipher = IV (B.zero (blockSize cipher) :: Bytes)+  where+    toIV :: BlockCipher c => c -> IV c+    toIV cipher = IV (B.zero (blockSize cipher) :: Bytes)  -- | Increment an IV by a number. -- -- Assume the IV is in Big Endian format. ivAdd :: IV c -> Int -> IV c ivAdd (IV b) i = IV $ copy b-  where copy :: ByteArray bs => bs -> bs-        copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1)+  where+    copy :: ByteArray bs => bs -> bs+    copy bs = B.copyAndFreeze bs $ loop i (B.length bs - 1) -        loop :: Int -> Int -> Ptr Word8 -> IO ()-        loop acc ofs p-            | ofs < 0   = return ()-            | otherwise = do-                v <- peek (p `plusPtr` ofs) :: IO Word8-                let accv    = acc + fromIntegral v-                    (hi,lo) = accv `divMod` 256-                poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)-                loop hi (ofs - 1) p+    loop :: Int -> Int -> Ptr Word8 -> IO ()+    loop acc ofs p+        | ofs < 0 = return ()+        | otherwise = do+            v <- peek (p `plusPtr` ofs) :: IO Word8+            let accv = acc + fromIntegral v+                (hi, lo) = accv `divMod` 256+            poke (p `plusPtr` ofs) (fromIntegral lo :: Word8)+            loop hi (ofs - 1) p -cbcEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba+cbcEncryptGeneric+    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cbcEncryptGeneric cipher ivini input = mconcat $ doEnc ivini $ chunk (blockSize cipher) input-  where doEnc _  []     = []-        doEnc iv (i:is) =-            let o = ecbEncrypt cipher $ B.xor iv i-             in o : doEnc (IV o) is+  where+    doEnc _ [] = []+    doEnc iv (i : is) =+        let o = ecbEncrypt cipher $ B.xor iv i+         in o : doEnc (IV o) is -cbcDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba+cbcDecryptGeneric+    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cbcDecryptGeneric cipher ivini input = mconcat $ doDec ivini $ chunk (blockSize cipher) input   where-        doDec _  []     = []-        doDec iv (i:is) =-            let o = B.xor iv $ ecbDecrypt cipher i-             in o : doDec (IV i) is+    doDec _ [] = []+    doDec iv (i : is) =+        let o = B.xor iv $ ecbDecrypt cipher i+         in o : doDec (IV i) is -cfbEncryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba+cfbEncryptGeneric+    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cfbEncryptGeneric cipher ivini input = mconcat $ doEnc ivini $ chunk (blockSize cipher) input   where-        doEnc _  []     = []-        doEnc (IV iv) (i:is) =-            let o = B.xor i $ ecbEncrypt cipher iv-             in o : doEnc (IV o) is+    doEnc _ [] = []+    doEnc (IV iv) (i : is) =+        let o = B.xor i $ ecbEncrypt cipher iv+         in o : doEnc (IV o) is -cfbDecryptGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba+cfbDecryptGeneric+    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba cfbDecryptGeneric cipher ivini input = mconcat $ doDec ivini $ chunk (blockSize cipher) input   where-        doDec _  []     = []-        doDec (IV iv) (i:is) =-            let o = B.xor i $ ecbEncrypt cipher iv-             in o : doDec (IV i) is+    doDec _ [] = []+    doDec (IV iv) (i : is) =+        let o = B.xor i $ ecbEncrypt cipher iv+         in o : doDec (IV i) is -ctrCombineGeneric :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba+ctrCombineGeneric+    :: (ByteArray ba, BlockCipher cipher) => cipher -> IV cipher -> ba -> ba ctrCombineGeneric cipher ivini input = mconcat $ doCnt ivini $ chunk (blockSize cipher) input-  where doCnt _  [] = []-        doCnt iv@(IV ivd) (i:is) =-            let ivEnc = ecbEncrypt cipher ivd-             in B.xor i ivEnc : doCnt (ivAdd iv 1) is+  where+    doCnt _ [] = []+    doCnt iv@(IV ivd) (i : is) =+        let ivEnc = ecbEncrypt cipher ivd+         in B.xor i ivEnc : doCnt (ivAdd iv 1) is  xtsEncryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher xtsEncryptGeneric = xtsGeneric ecbEncrypt@@ -222,21 +260,23 @@ xtsDecryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher xtsDecryptGeneric = xtsGeneric ecbDecrypt -xtsGeneric :: (ByteArray ba, BlockCipher128 cipher)-           => (cipher -> ba -> ba)-           -> (cipher, cipher)-           -> IV cipher-           -> DataUnitOffset-           -> ba-           -> ba+xtsGeneric+    :: (ByteArray ba, BlockCipher128 cipher)+    => (cipher -> ba -> ba)+    -> (cipher, cipher)+    -> IV cipher+    -> DataUnitOffset+    -> ba+    -> ba xtsGeneric f (cipher, tweakCipher) (IV iv) sPoint input =     mconcat $ doXts iniTweak $ chunk (blockSize cipher) input-  where encTweak = ecbEncrypt tweakCipher iv-        iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint-        doXts _     []     = []-        doXts tweak (i:is) =-            let o = B.xor (f cipher $ B.xor i tweak) tweak-             in o : doXts (xtsGFMul tweak) is+  where+    encTweak = ecbEncrypt tweakCipher iv+    iniTweak = iterate xtsGFMul encTweak !! fromIntegral sPoint+    doXts _ [] = []+    doXts tweak (i : is) =+        let o = B.xor (f cipher $ B.xor i tweak) tweak+         in o : doXts (xtsGFMul tweak) is  {- -- | Encrypt using CFB mode in 8 bit output

@@ -6,19 +6,17 @@ -- Portability : Excellent -- -- Slow Galois Field arithmetic for generic XTS and GCM implementation----module Crypto.Cipher.Types.GF-    (+module Crypto.Cipher.Types.GF (     -- * XTS support-      xtsGFMul-    ) where+    xtsGFMul,+) where -import           Crypto.Internal.Imports-import           Crypto.Internal.ByteArray (ByteArray, withByteArray)+import Crypto.Internal.ByteArray (ByteArray, withByteArray) import qualified Crypto.Internal.ByteArray as B-import           Foreign.Storable-import           Foreign.Ptr-import           Data.Bits+import Crypto.Internal.Imports+import Data.Bits+import Foreign.Ptr+import Foreign.Storable  -- | Compute the gfmul with the XTS polynomial --@@ -29,19 +27,22 @@ xtsGFMul b     | len == 16 =         B.allocAndFreeze len $ \dst ->-        withByteArray b      $ \src -> do-            (hi,lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8)-            poke (castPtr dst) lo-            poke (castPtr dst `plusPtr` 8) hi+            withByteArray b $ \src -> do+                (hi, lo) <- gf <$> peek (castPtr src) <*> peek (castPtr src `plusPtr` 8)+                poke (castPtr dst) lo+                poke (castPtr dst `plusPtr` 8) hi     | otherwise = error "unsupported block size in GF"-  where gf :: Word64 -> Word64 -> (Word64, Word64)-        gf srcLo srcHi =-            ((if carryLo then (.|. 1) else id) (srcHi `shiftL` 1)-            ,(if carryHi then xor 0x87 else id) $ (srcLo `shiftL` 1)-            )-          where carryHi = srcHi `testBit` 63 -                carryLo = srcLo `testBit` 63-        len = B.length b+  where+    gf :: Word64 -> Word64 -> (Word64, Word64)+    gf srcLo srcHi =+        ( (if carryLo then (.|. 1) else id) (srcHi `shiftL` 1)+        , (if carryHi then xor 0x87 else id) $ (srcLo `shiftL` 1)+        )+      where+        carryHi = srcHi `testBit` 63+        carryLo = srcLo `testBit` 63+    len = B.length b+ {- 	const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL); 	uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0);

@@ -6,10 +6,9 @@ -- Portability : Excellent -- -- Stream cipher basic types----module Crypto.Cipher.Types.Stream-    ( StreamCipher(..)-    ) where+module Crypto.Cipher.Types.Stream (+    StreamCipher (..),+) where  import Crypto.Cipher.Types.Base import Crypto.Internal.ByteArray (ByteArray)

@@ -6,16 +6,17 @@ -- Portability : Excellent -- -- Basic utility for cipher related stuff--- module Crypto.Cipher.Types.Utils where -import           Crypto.Internal.ByteArray (ByteArray)+import Crypto.Internal.ByteArray (ByteArray) import qualified Crypto.Internal.ByteArray as B  -- | Chunk some input byte array into @sz byte list of byte array. chunk :: ByteArray b => Int -> b -> [b] chunk sz bs = split bs-  where split b | B.length b <= sz = [b]-                | otherwise        =-                        let (b1, b2) = B.splitAt sz b-                         in b1 : split b2+  where+    split b+        | B.length b <= sz = [b]+        | otherwise =+            let (b1, b2) = B.splitAt sz b+             in b1 : split b2

@@ -1,18 +1,21 @@-module Crypto.Cipher.Utils-    ( validateKeySize-    ) where+module Crypto.Cipher.Utils (+    validateKeySize,+) where -import Crypto.Error import Crypto.Cipher.Types+import Crypto.Error  import Data.ByteArray as BA -validateKeySize :: (ByteArrayAccess key, Cipher cipher) => cipher -> key -> CryptoFailable key-validateKeySize c k = if validKeyLength-                      then CryptoPassed k-                      else CryptoFailed CryptoError_KeySizeInvalid-  where keyLength = BA.length k-        validKeyLength = case cipherKeySize c of-          KeySizeRange low high -> keyLength >= low && keyLength <= high-          KeySizeEnum lengths -> keyLength `elem` lengths-          KeySizeFixed s -> keyLength == s+validateKeySize+    :: (ByteArrayAccess key, Cipher cipher) => cipher -> key -> CryptoFailable key+validateKeySize c k =+    if validKeyLength+        then CryptoPassed k+        else CryptoFailed CryptoError_KeySizeInvalid+  where+    keyLength = BA.length k+    validKeyLength = case cipherKeySize c of+        KeySizeRange low high -> keyLength >= low && keyLength <= high+        KeySizeEnum lengths -> keyLength `elem` lengths+        KeySizeFixed s -> keyLength == s

@@ -1,3 +1,5 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ -- | -- Module      : Crypto.Cipher.XSalsa -- License     : BSD-style@@ -8,42 +10,48 @@ -- Implementation of XSalsa20 algorithm -- <https://cr.yp.to/snuffle/xsalsa-20081128.pdf> -- Based on the Salsa20 algorithm with 256 bit key extended with 192 bit nonce--{-# LANGUAGE ForeignFunctionInterface #-}-module Crypto.Cipher.XSalsa-    ( initialize-    , derive-    , combine-    , generate-    , State-    ) where+module Crypto.Cipher.XSalsa (+    initialize,+    derive,+    combine,+    generate,+    State,+) where -import           Crypto.Internal.ByteArray (ByteArrayAccess)+import Crypto.Cipher.Salsa hiding (initialize)+import Crypto.Internal.ByteArray (ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Foreign.Ptr-import           Crypto.Cipher.Salsa hiding (initialize)+import Crypto.Internal.Compat+import Crypto.Internal.Imports+import Foreign.Ptr  -- | Initialize a new XSalsa context with the number of rounds, -- the key and the nonce associated.-initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)-           => Int    -- ^ number of rounds (8,12,20)-           -> key    -- ^ the key (256 bits)-           -> nonce  -- ^ the nonce (192 bits)-           -> State  -- ^ the initial XSalsa state+initialize+    :: (ByteArrayAccess key, ByteArrayAccess nonce)+    => Int+    -- ^ number of rounds (8,12,20)+    -> key+    -- ^ the key (256 bits)+    -> nonce+    -- ^ the nonce (192 bits)+    -> State+    -- ^ the initial XSalsa state initialize nbRounds key nonce-    | kLen /= 32                      = error "XSalsa: key length should be 256 bits"-    | nonceLen /= 24                  = error "XSalsa: nonce length should be 192 bits"-    | nbRounds `notElem` [8,12,20]    = error "XSalsa: rounds should be 8, 12 or 20"+    | kLen /= 32 =+        error "XSalsa: key length should be 256 bits"+    | nonceLen /= 24 =+        error "XSalsa: nonce length should be 192 bits"+    | nbRounds `notElem` [8, 12, 20] = error "XSalsa: rounds should be 8, 12 or 20"     | otherwise = unsafeDoIO $ do         stPtr <- B.alloc 132 $ \stPtr ->-            B.withByteArray nonce $ \noncePtr  ->-            B.withByteArray key   $ \keyPtr ->-                ccrypton_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr+            B.withByteArray nonce $ \noncePtr ->+                B.withByteArray key $ \keyPtr ->+                    ccrypton_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr         return $ State stPtr-  where kLen     = B.length key-        nonceLen = B.length nonce+  where+    kLen = B.length key+    nonceLen = B.length nonce  -- | Use an already initialized context and new nonce material to derive another -- XSalsa context.@@ -55,21 +63,27 @@ -- -- The output context always uses the same number of rounds as the input -- context.-derive :: ByteArrayAccess nonce-       => State  -- ^ base XSalsa state-       -> nonce  -- ^ the remainder nonce (128 bits)-       -> State  -- ^ the new XSalsa state+derive+    :: ByteArrayAccess nonce+    => State+    -- ^ base XSalsa state+    -> nonce+    -- ^ the remainder nonce (128 bits)+    -> State+    -- ^ the new XSalsa state derive (State stPtr') nonce     | nonceLen /= 16 = error "XSalsa: nonce length should be 128 bits"     | otherwise = unsafeDoIO $ do         stPtr <- B.copy stPtr' $ \stPtr ->-            B.withByteArray nonce $ \noncePtr  ->+            B.withByteArray nonce $ \noncePtr ->                 ccrypton_xsalsa_derive stPtr nonceLen noncePtr         return $ State stPtr-  where nonceLen = B.length nonce+  where+    nonceLen = B.length nonce  foreign import ccall "crypton_xsalsa_init"-    ccrypton_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()+    ccrypton_xsalsa_init+        :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()  foreign import ccall "crypton_xsalsa_derive"     ccrypton_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()

@@ -1,3 +1,5 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.ConstructHash.MiyaguchiPreneel -- License     : BSD-style@@ -7,40 +9,42 @@ -- -- Provide the hash function construction method from block cipher -- <https://en.wikipedia.org/wiki/One-way_compression_function>----{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.ConstructHash.MiyaguchiPreneel-       ( compute, compute'-       , MiyaguchiPreneel-       ) where+module Crypto.ConstructHash.MiyaguchiPreneel (+    compute,+    compute',+    MiyaguchiPreneel,+) where -import           Data.List (foldl')+import Data.List (foldl') -import           Crypto.Data.Padding (pad, Format (ZERO))-import           Crypto.Cipher.Types-import           Crypto.Error (throwCryptoError)-import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)+import Crypto.Cipher.Types+import Crypto.Data.Padding (Format (ZERO), pad)+import Crypto.Error (throwCryptoError)+import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes) import qualified Crypto.Internal.ByteArray as B - newtype MiyaguchiPreneel a = MP Bytes     deriving (ByteArrayAccess)  instance Eq (MiyaguchiPreneel a) where-    MP b1 == MP b2  =  B.constEq b1 b2-+    MP b1 == MP b2 = B.constEq b1 b2  -- | Compute Miyaguchi-Preneel one way compress using the supplied block cipher.-compute' :: (ByteArrayAccess bin, BlockCipher cipher)-         => (Bytes -> cipher)       -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size-         -> bin                     -- ^ input message-         -> MiyaguchiPreneel cipher -- ^ output tag-compute' g = MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz) . B.convert+compute'+    :: (ByteArrayAccess bin, BlockCipher cipher)+    => (Bytes -> cipher)+    -- ^ key build function to compute Miyaguchi-Preneel. care about block-size and key-size+    -> bin+    -- ^ input message+    -> MiyaguchiPreneel cipher+    -- ^ output tag+compute' g =+    MP . foldl' (step $ g) (B.replicate bsz 0) . chunks . pad (ZERO bsz) . B.convert   where-    bsz = blockSize ( g B.empty {- dummy to get block size -} )+    bsz = blockSize (g B.empty {- dummy to get block size -})     chunks msg-      | B.null msg  =  []-      | otherwise  =   (hd :: Bytes) : chunks tl+        | B.null msg = []+        | otherwise = (hd :: Bytes) : chunks tl       where         (hd, tl) = B.splitAt bsz msg @@ -48,17 +52,21 @@ --   Only safe when KEY-SIZE equals to BLOCK-SIZE. -- --   Simple usage /mp' msg :: MiyaguchiPreneel AES128/-compute :: (ByteArrayAccess bin, BlockCipher cipher)-        => bin                     -- ^ input message-        -> MiyaguchiPreneel cipher -- ^ output tag+compute+    :: (ByteArrayAccess bin, BlockCipher cipher)+    => bin+    -- ^ input message+    -> MiyaguchiPreneel cipher+    -- ^ output tag compute = compute' $ throwCryptoError . cipherInit  -- | computation step of Miyaguchi-Preneel-step :: (ByteArray ba, BlockCipher k)-     => (ba -> k)-     -> ba-     -> ba-     -> ba+step+    :: (ByteArray ba, BlockCipher k)+    => (ba -> k)+    -> ba+    -> ba+    -> ba step g iv msg =     ecbEncrypt k msg `bxor` iv `bxor` msg   where

@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Module      : Crypto.Data.AFIS -- License     : BSD-style@@ -11,26 +13,24 @@ -- The algorithm bloats an arbitrary secret with many bits that are necessary for -- the recovery of the key (merge), and allow greater way to permanently -- destroy a key stored on disk.----{-# LANGUAGE ScopedTypeVariables #-}-module Crypto.Data.AFIS-    ( split-    , merge-    ) where+module Crypto.Data.AFIS (+    split,+    merge,+) where -import           Crypto.Hash-import           Crypto.Random.Types-import           Crypto.Internal.Compat-import           Control.Monad (forM_, foldM)-import           Data.Word-import           Data.Bits-import           Foreign.Storable-import           Foreign.Ptr+import Control.Monad (foldM, forM_)+import Crypto.Hash+import Crypto.Internal.Compat+import Crypto.Random.Types+import Data.Bits+import Data.Word+import Foreign.Ptr+import Foreign.Storable -import           Crypto.Internal.ByteArray (ByteArray, Bytes, MemView(..))+import Crypto.Internal.ByteArray (ByteArray, Bytes, MemView (..)) import qualified Crypto.Internal.ByteArray as B -import           Data.Memory.PtrMethods (memSet, memCopy)+import Data.Memory.PtrMethods (memCopy, memSet)  -- | Split data to diffused data, using a random generator and -- an hash algorithm.@@ -49,57 +49,69 @@ -- -- where acc is : --   acc(n+1) = hash (n ++ rand(n)) ^ acc(n)----split :: (ByteArray ba, HashAlgorithm hash, DRG rng)-      => hash  -- ^ Hash algorithm to use as diffuser-      -> rng   -- ^ Random generator to use-      -> Int   -- ^ Number of times to diffuse the data.-      -> ba    -- ^ original data to diffuse.-      -> (ba, rng)         -- ^ The diffused data+split+    :: (ByteArray ba, HashAlgorithm hash, DRG rng)+    => hash+    -- ^ Hash algorithm to use as diffuser+    -> rng+    -- ^ Random generator to use+    -> Int+    -- ^ Number of times to diffuse the data.+    -> ba+    -- ^ original data to diffuse.+    -> (ba, rng)+    -- ^ The diffused data {-# NOINLINE split #-} split hashAlg rng expandTimes src     | expandTimes <= 1 = error "invalid expandTimes value"-    | otherwise        = unsafeDoIO $ do+    | otherwise = unsafeDoIO $ do         (rng', bs) <- B.allocRet diffusedLen runOp         return (bs, rng')-  where diffusedLen = blockSize * expandTimes-        blockSize   = B.length src-        runOp dstPtr = do-            let lastBlock = dstPtr `plusPtr` (blockSize * (expandTimes-1))-            memSet lastBlock 0 blockSize-            let randomBlockPtrs = map (plusPtr dstPtr . (*) blockSize) [0..(expandTimes-2)]-            rng' <- foldM fillRandomBlock rng randomBlockPtrs-            mapM_ (addRandomBlock lastBlock) randomBlockPtrs-            B.withByteArray src $ \srcPtr -> xorMem srcPtr lastBlock blockSize-            return rng'-        addRandomBlock lastBlock blockPtr = do-            xorMem blockPtr lastBlock blockSize-            diffuse hashAlg lastBlock blockSize-        fillRandomBlock g blockPtr = do-            let (rand :: Bytes, g') = randomBytesGenerate blockSize g-            B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr blockSize-            return g'+  where+    diffusedLen = blockSize * expandTimes+    blockSize = B.length src+    runOp dstPtr = do+        let lastBlock = dstPtr `plusPtr` (blockSize * (expandTimes - 1))+        memSet lastBlock 0 blockSize+        let randomBlockPtrs = map (plusPtr dstPtr . (*) blockSize) [0 .. (expandTimes - 2)]+        rng' <- foldM fillRandomBlock rng randomBlockPtrs+        mapM_ (addRandomBlock lastBlock) randomBlockPtrs+        B.withByteArray src $ \srcPtr -> xorMem srcPtr lastBlock blockSize+        return rng'+    addRandomBlock lastBlock blockPtr = do+        xorMem blockPtr lastBlock blockSize+        diffuse hashAlg lastBlock blockSize+    fillRandomBlock g blockPtr = do+        let (rand :: Bytes, g') = randomBytesGenerate blockSize g+        B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr blockSize+        return g'  -- | Merge previously diffused data back to the original data.-merge :: (ByteArray ba, HashAlgorithm hash)-      => hash  -- ^ Hash algorithm used as diffuser-      -> Int   -- ^ Number of times to un-diffuse the data-      -> ba    -- ^ Diffused data-      -> ba    -- ^ Original data+merge+    :: (ByteArray ba, HashAlgorithm hash)+    => hash+    -- ^ Hash algorithm used as diffuser+    -> Int+    -- ^ Number of times to un-diffuse the data+    -> ba+    -- ^ Diffused data+    -> ba+    -- ^ Original data {-# NOINLINE merge #-} merge hashAlg expandTimes bs-    | r /= 0            = error "diffused data not a multiple of expandTimes"+    | r /= 0 = error "diffused data not a multiple of expandTimes"     | originalSize <= 0 = error "diffused data null"-    | otherwise         = B.allocAndFreeze originalSize $ \dstPtr ->+    | otherwise = B.allocAndFreeze originalSize $ \dstPtr ->         B.withByteArray bs $ \srcPtr -> do             memSet dstPtr 0 originalSize-            forM_ [0..(expandTimes-2)] $ \i -> do+            forM_ [0 .. (expandTimes - 2)] $ \i -> do                 xorMem (srcPtr `plusPtr` (i * originalSize)) dstPtr originalSize                 diffuse hashAlg dstPtr originalSize-            xorMem (srcPtr `plusPtr` ((expandTimes-1) * originalSize)) dstPtr originalSize+            xorMem (srcPtr `plusPtr` ((expandTimes - 1) * originalSize)) dstPtr originalSize             return ()-  where (originalSize,r) = len `quotRem` expandTimes-        len              = B.length bs+  where+    (originalSize, r) = len `quotRem` expandTimes+    len = B.length bs  -- | inplace Xor with an input -- dst = src `xor` dst@@ -107,42 +119,51 @@ xorMem src dst sz     | sz `mod` 64 == 0 = loop 8 (castPtr src :: Ptr Word64) (castPtr dst) sz     | sz `mod` 32 == 0 = loop 4 (castPtr src :: Ptr Word32) (castPtr dst) sz-    | otherwise        = loop 1 (src :: Ptr Word8) dst sz-  where loop _    _ _ 0 = return ()-        loop incr s d n = do a <- peek s-                             b <- peek d-                             poke d (a `xor` b)-                             loop incr (s `plusPtr` incr) (d `plusPtr` incr) (n-incr)+    | otherwise = loop 1 (src :: Ptr Word8) dst sz+  where+    loop _ _ _ 0 = return ()+    loop incr s d n = do+        a <- peek s+        b <- peek d+        poke d (a `xor` b)+        loop incr (s `plusPtr` incr) (d `plusPtr` incr) (n - incr) -diffuse :: HashAlgorithm hash-        => hash      -- ^ Hash function to use as diffuser-        -> Ptr Word8 -- ^ buffer to diffuse, modify in place-        -> Int       -- ^ length of buffer to diffuse-        -> IO ()+diffuse+    :: HashAlgorithm hash+    => hash+    -- ^ Hash function to use as diffuser+    -> Ptr Word8+    -- ^ buffer to diffuse, modify in place+    -> Int+    -- ^ length of buffer to diffuse+    -> IO () diffuse hashAlg src sz = loop src 0-  where (full,pad) = sz `quotRem` digestSize -        loop s i-            | i < full = do h <- hashBlock i s digestSize-                            B.withByteArray h $ \hPtr -> memCopy s hPtr digestSize-                            loop (s `plusPtr` digestSize) (i+1)-            | pad /= 0 = do h <- hashBlock i s pad-                            B.withByteArray h $ \hPtr -> memCopy s hPtr pad-                            return ()-            | otherwise = return ()+  where+    (full, pad) = sz `quotRem` digestSize+    loop s i+        | i < full = do+            h <- hashBlock i s digestSize+            B.withByteArray h $ \hPtr -> memCopy s hPtr digestSize+            loop (s `plusPtr` digestSize) (i + 1)+        | pad /= 0 = do+            h <- hashBlock i s pad+            B.withByteArray h $ \hPtr -> memCopy s hPtr pad+            return ()+        | otherwise = return () -        digestSize = hashDigestSize hashAlg+    digestSize = hashDigestSize hashAlg -        -- Hash [ BE32(n), (p .. p+hashSz) ]-        hashBlock n p hashSz = do-            let ctx = hashInitWith hashAlg-            return $! hashFinalize $ hashUpdate (hashUpdate ctx (be32 n)) (MemView p hashSz)+    -- Hash [ BE32(n), (p .. p+hashSz) ]+    hashBlock n p hashSz = do+        let ctx = hashInitWith hashAlg+        return $! hashFinalize $ hashUpdate (hashUpdate ctx (be32 n)) (MemView p hashSz) -        be32 :: Int -> Bytes-        be32 n = B.allocAndFreeze 4 $ \ptr -> do-            poke ptr               (f8 (n `shiftR` 24))-            poke (ptr `plusPtr` 1) (f8 (n `shiftR` 16))-            poke (ptr `plusPtr` 2) (f8 (n `shiftR` 8))-            poke (ptr `plusPtr` 3) (f8 n)-          where-                f8 :: Int -> Word8-                f8 = fromIntegral+    be32 :: Int -> Bytes+    be32 n = B.allocAndFreeze 4 $ \ptr -> do+        poke ptr (f8 (n `shiftR` 24))+        poke (ptr `plusPtr` 1) (f8 (n `shiftR` 16))+        poke (ptr `plusPtr` 2) (f8 (n `shiftR` 8))+        poke (ptr `plusPtr` 3) (f8 n)+      where+        f8 :: Int -> Word8+        f8 = fromIntegral

@@ -7,59 +7,61 @@ -- -- Various cryptographic padding commonly used for block ciphers -- or asymmetric systems.----module Crypto.Data.Padding-    ( Format(..)-    , pad-    , unpad-    ) where+module Crypto.Data.Padding (+    Format (..),+    pad,+    unpad,+) where -import           Data.ByteArray (ByteArray, Bytes)+import Data.ByteArray (ByteArray, Bytes) import qualified Data.ByteArray as B  -- | Format of padding-data Format =-      PKCS5     -- ^ PKCS5: PKCS7 with hardcoded size of 8-    | PKCS7 Int -- ^ PKCS7 with padding size between 1 and 255-    | ZERO Int  -- ^ zero padding with block size+data Format+    = -- | PKCS5: PKCS7 with hardcoded size of 8+      PKCS5+    | -- | PKCS7 with padding size between 1 and 255+      PKCS7 Int+    | -- | zero padding with block size+      ZERO Int     deriving (Show, Eq)  -- | Apply some pad to a bytearray pad :: ByteArray byteArray => Format -> byteArray -> byteArray-pad  PKCS5     bin = pad (PKCS7 8) bin+pad PKCS5 bin = pad (PKCS7 8) bin pad (PKCS7 sz) bin = bin `B.append` paddingString   where     paddingString = B.replicate paddingByte (fromIntegral paddingByte)-    paddingByte   = sz - (B.length bin `mod` sz)-pad (ZERO sz)  bin = bin `B.append` paddingString+    paddingByte = sz - (B.length bin `mod` sz)+pad (ZERO sz) bin = bin `B.append` paddingString   where     paddingString = B.replicate paddingSz 0     paddingSz-      | len == 0   =  sz-      | m == 0     =  0-      | otherwise  =  sz - m+        | len == 0 = sz+        | m == 0 = 0+        | otherwise = sz - m     m = len `mod` sz     len = B.length bin  -- | Try to remove some padding from a bytearray. unpad :: ByteArray byteArray => Format -> byteArray -> Maybe byteArray-unpad  PKCS5     bin = unpad (PKCS7 8) bin+unpad PKCS5 bin = unpad (PKCS7 8) bin unpad (PKCS7 sz) bin-    | len == 0                           = Nothing-    | (len `mod` sz) /= 0                = Nothing-    | paddingSz < 1 || paddingSz > len   = Nothing+    | len == 0 = Nothing+    | (len `mod` sz) /= 0 = Nothing+    | paddingSz < 1 || paddingSz > len = Nothing     | paddingWitness `B.constEq` padding = Just content-    | otherwise                          = Nothing+    | otherwise = Nothing   where-    len         = B.length bin+    len = B.length bin     paddingByte = B.index bin (len - 1)-    paddingSz   = fromIntegral paddingByte+    paddingSz = fromIntegral paddingByte     (content, padding) = B.splitAt (len - paddingSz) bin-    paddingWitness     = B.replicate paddingSz paddingByte :: Bytes-unpad (ZERO sz)  bin-    | len == 0                           = Nothing-    | (len `mod` sz) /= 0                = Nothing-    | B.index bin (len - 1) /= 0         = Just bin-    | otherwise                          = Nothing+    paddingWitness = B.replicate paddingSz paddingByte :: Bytes+unpad (ZERO sz) bin+    | len == 0 = Nothing+    | (len `mod` sz) /= 0 = Nothing+    | B.index bin (len - 1) /= 0 = Just bin+    | otherwise = Nothing   where-    len         = B.length bin+    len = B.length bin

@@ -1,3 +1,9 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+ -- | -- Module      : Crypto.ECC -- License     : BSD-style@@ -6,69 +12,76 @@ -- Portability : unknown -- -- Elliptic Curve Cryptography----{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Crypto.ECC-    ( Curve_P256R1(..)-    , Curve_P384R1(..)-    , Curve_P521R1(..)-    , Curve_X25519(..)-    , Curve_X448(..)-    , Curve_Edwards25519(..)-    , EllipticCurve(..)-    , EllipticCurveDH(..)-    , EllipticCurveArith(..)-    , EllipticCurveBasepointArith(..)-    , KeyPair(..)-    , SharedSecret(..)-    ) where+module Crypto.ECC (+    Curve_P256R1 (..),+    Curve_P384R1 (..),+    Curve_P521R1 (..),+    Curve_X25519 (..),+    Curve_X448 (..),+    Curve_Edwards25519 (..),+    EllipticCurve (..),+    EllipticCurveDH (..),+    EllipticCurveArith (..),+    EllipticCurveBasepointArith (..),+    KeyPair (..),+    SharedSecret (..),+) where -import qualified Crypto.PubKey.ECC.P256 as P256 import qualified Crypto.ECC.Edwards25519 as Edwards25519-import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple-import           Crypto.Random-import           Crypto.Error-import           Crypto.Internal.Imports-import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)+import qualified Crypto.ECC.Simple.Types as Simple+import Crypto.Error+import Crypto.Internal.ByteArray (+    ByteArray,+    ByteArrayAccess,+    ScrubbedBytes,+ ) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Number.Basic (numBits)-import           Crypto.Number.Serialize (i2ospOf_, os2ip)+import Crypto.Internal.Imports+import Crypto.Number.Basic (numBits)+import Crypto.Number.Serialize (i2ospOf_, os2ip) import qualified Crypto.Number.Serialize.LE as LE import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448-import           Data.ByteArray (convert)-import           Data.Data (Data())-import           Data.Kind (Type)-import           Data.Proxy+import qualified Crypto.PubKey.ECC.P256 as P256+import Crypto.Random+import Data.ByteArray (convert)+import Data.Data (Data ())+import Data.Kind (Type)+import Data.Proxy  -- | An elliptic curve key pair composed of the private part (a scalar), and -- the associated point. data KeyPair curve = KeyPair-    { keypairGetPublic  :: !(Point curve)+    { keypairGetPublic :: !(Point curve)     , keypairGetPrivate :: !(Scalar curve)     } +-- | Secret shared via key exchange newtype SharedSecret = SharedSecret ScrubbedBytes     deriving (Eq, ByteArrayAccess, NFData) +instance Semigroup SharedSecret where+    SharedSecret x <> SharedSecret y = SharedSecret (x <> y)++instance Monoid SharedSecret where+    mempty = SharedSecret mempty+ class EllipticCurve curve where     -- | Point on an Elliptic Curve-    type Point curve  :: Type+    type Point curve :: Type      -- | Scalar in the Elliptic Curve domain     type Scalar curve :: Type      -- | Generate a new random scalar on the curve.     -- The scalar will represent a number between 1 and the order of the curve non included-    curveGenerateScalar :: MonadRandom randomly => proxy curve -> randomly (Scalar curve)+    curveGenerateScalar+        :: MonadRandom randomly => proxy curve -> randomly (Scalar curve)      -- | Generate a new random keypair-    curveGenerateKeyPair :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve)+    curveGenerateKeyPair+        :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve)      -- | Get the curve size in bits     curveSizeBits :: proxy curve -> Int@@ -79,6 +92,15 @@     -- | Try to decode the binary form of an elliptic curve point     decodePoint :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Point curve) +    -- | Encode an elliptic curve scalar into big-endian form+    encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs++    -- | Try to decode the big-endian form of an elliptic curve scalar+    decodeScalar+        :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve)++    scalarToPoint :: proxy curve -> Scalar curve -> Point curve+ class EllipticCurve curve => EllipticCurveDH curve where     -- | Generate a Diffie hellman secret value.     --@@ -100,7 +122,8 @@     -- This additional test avoids risks existing with function 'ecdhRaw'.     -- Implementations always return a 'CryptoError' instead of a special     -- value or an exception.-    ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret+    ecdh+        :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret  class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where     -- | Add points on a curve@@ -115,7 +138,10 @@ --   -- | Scalar Inverse --   scalarInverse :: Scalar curve -> Scalar curve -class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where+class+    (EllipticCurveArith curve, Eq (Scalar curve)) =>+    EllipticCurveBasepointArith curve+    where     -- | Get the curve order size in bits     curveOrderBits :: proxy curve -> Int @@ -123,15 +149,10 @@     pointBaseSmul :: proxy curve -> Scalar curve -> Point curve      -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@-    pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve+    pointsSmulVarTime+        :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve     pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p) -    -- | Encode an elliptic curve scalar into big-endian form-    encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs--    -- | Try to decode the big-endian form of an elliptic curve scalar-    decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve)-     -- | Convert an elliptic curve scalar to an integer     scalarToInteger :: proxy curve -> Scalar curve -> Integer @@ -148,7 +169,7 @@ -- -- also known as P256 data Curve_P256R1 = Curve_P256R1-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_P256R1 where     type Point Curve_P256R1 = P256.Point@@ -156,7 +177,8 @@     curveSizeBits _ = 256     curveGenerateScalar _ = P256.scalarGenerate     curveGenerateKeyPair _ = toKeyPair <$> P256.scalarGenerate-      where toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar+      where+        toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar     encodePoint _ p = mxy       where         mxy :: forall bs. ByteArray bs => bs@@ -167,33 +189,34 @@             xy = P256.pointToBinary p     decodePoint _ mxy = case B.uncons mxy of         Nothing -> CryptoFailed CryptoError_PointSizeInvalid-        Just (m,xy)+        Just (m, xy)             -- uncompressed             | m == 4 -> P256.pointFromBinary xy             | otherwise -> CryptoFailed CryptoError_PointFormatInvalid+    encodeScalar _ = P256.scalarToBinary+    decodeScalar _ = P256.scalarFromBinary+    scalarToPoint _ = P256.toPoint  instance EllipticCurveArith Curve_P256R1 where-    pointAdd  _ a b = P256.pointAdd a b+    pointAdd _ a b = P256.pointAdd a b     pointNegate _ p = P256.pointNegate p     pointSmul _ s p = P256.pointMul s p  instance EllipticCurveDH Curve_P256R1 where     ecdhRaw _ s p = SharedSecret $ P256.pointDh s p-    ecdh  prx s p = checkNonZeroDH (ecdhRaw prx s p)+    ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)  instance EllipticCurveBasepointArith Curve_P256R1 where     curveOrderBits _ = 256     pointBaseSmul _ = P256.toPoint     pointsSmulVarTime _ = P256.pointsMulVarTime-    encodeScalar _ = P256.scalarToBinary-    decodeScalar _ = P256.scalarFromBinary     scalarToInteger _ = P256.scalarToInteger     scalarFromInteger _ = P256.scalarFromInteger     scalarAdd _ = P256.scalarAdd     scalarMul _ = P256.scalarMul  data Curve_P384R1 = Curve_P384R1-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_P384R1 where     type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1@@ -201,9 +224,13 @@     curveSizeBits _ = 384     curveGenerateScalar _ = Simple.scalarGenerate     curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate-      where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar+      where+        toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar     encodePoint _ point = encodeECPoint point     decodePoint _ bs = decodeECPoint bs+    encodeScalar _ = ecScalarToBinary+    decodeScalar _ = ecScalarFromBinary+    scalarToPoint _ = Simple.pointBaseMul  instance EllipticCurveArith Curve_P384R1 where     pointAdd _ a b = Simple.pointAdd a b@@ -219,15 +246,13 @@     curveOrderBits _ = 384     pointBaseSmul _ = Simple.pointBaseMul     pointsSmulVarTime _ = ecPointsMulVarTime-    encodeScalar _ = ecScalarToBinary-    decodeScalar _ = ecScalarFromBinary     scalarToInteger _ = ecScalarToInteger     scalarFromInteger _ = ecScalarFromInteger     scalarAdd _ = ecScalarAdd     scalarMul _ = ecScalarMul  data Curve_P521R1 = Curve_P521R1-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_P521R1 where     type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1@@ -235,9 +260,13 @@     curveSizeBits _ = 521     curveGenerateScalar _ = Simple.scalarGenerate     curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate-      where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar+      where+        toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar     encodePoint _ point = encodeECPoint point     decodePoint _ bs = decodeECPoint bs+    encodeScalar _ = ecScalarToBinary+    decodeScalar _ = ecScalarFromBinary+    scalarToPoint _ = Simple.pointBaseMul  instance EllipticCurveArith Curve_P521R1 where     pointAdd _ a b = Simple.pointAdd a b@@ -253,15 +282,13 @@     curveOrderBits _ = 521     pointBaseSmul _ = Simple.pointBaseMul     pointsSmulVarTime _ = ecPointsMulVarTime-    encodeScalar _ = ecScalarToBinary-    decodeScalar _ = ecScalarFromBinary     scalarToInteger _ = ecScalarToInteger     scalarFromInteger _ = ecScalarFromInteger     scalarAdd _ = ecScalarAdd     scalarMul _ = ecScalarMul  data Curve_X25519 = Curve_X25519-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_X25519 where     type Point Curve_X25519 = X25519.PublicKey@@ -273,14 +300,18 @@         return $ KeyPair (X25519.toPublic s) s     encodePoint _ p = B.convert p     decodePoint _ bs = X25519.publicKey bs+    encodeScalar _ s = convert s+    decodeScalar _ bs = X25519.secretKey bs+    scalarToPoint _ s = X25519.toPublic s  instance EllipticCurveDH Curve_X25519 where     ecdhRaw _ s p = SharedSecret $ convert secret-      where secret = X25519.dh p s+      where+        secret = X25519.dh p s     ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)  data Curve_X448 = Curve_X448-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_X448 where     type Point Curve_X448 = X448.PublicKey@@ -292,14 +323,18 @@         return $ KeyPair (X448.toPublic s) s     encodePoint _ p = B.convert p     decodePoint _ bs = X448.publicKey bs+    encodeScalar _ s = convert s+    decodeScalar _ bs = X448.secretKey bs+    scalarToPoint _ s = X448.toPublic s  instance EllipticCurveDH Curve_X448 where     ecdhRaw _ s p = SharedSecret $ convert secret-      where secret = X448.dh p s+      where+        secret = X448.dh p s     ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)  data Curve_Edwards25519 = Curve_Edwards25519-    deriving (Show,Data)+    deriving (Show, Data)  instance EllipticCurve Curve_Edwards25519 where     type Point Curve_Edwards25519 = Edwards25519.Point@@ -307,9 +342,15 @@     curveSizeBits _ = 255     curveGenerateScalar _ = Edwards25519.scalarGenerate     curveGenerateKeyPair _ = toKeyPair <$> Edwards25519.scalarGenerate-      where toKeyPair scalar = KeyPair (Edwards25519.toPoint scalar) scalar+      where+        toKeyPair scalar = KeyPair (Edwards25519.toPoint scalar) scalar     encodePoint _ point = Edwards25519.pointEncode point     decodePoint _ bs = Edwards25519.pointDecode bs+    encodeScalar _ = B.reverse . Edwards25519.scalarEncode+    decodeScalar _ bs+        | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs)+        | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid+    scalarToPoint _ = Edwards25519.toPoint  instance EllipticCurveArith Curve_Edwards25519 where     pointAdd _ a b = Edwards25519.pointAdd a b@@ -320,10 +361,6 @@     curveOrderBits _ = 253     pointBaseSmul _ = Edwards25519.toPoint     pointsSmulVarTime _ = Edwards25519.pointsMulVarTime-    encodeScalar _ = B.reverse . Edwards25519.scalarEncode-    decodeScalar _ bs-        | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs)-        | otherwise         = CryptoFailed CryptoError_SecretKeySizeInvalid     scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes)     scalarFromInteger _ i =         case LE.i2ospOf 32 i of@@ -335,15 +372,18 @@ checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b)     | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid-    | otherwise        = CryptoPassed s+    | otherwise = CryptoPassed s -encodeECShared :: Simple.Curve curve => Proxy curve -> Simple.Point curve -> CryptoFailable SharedSecret-encodeECShared _   Simple.PointO      = CryptoFailed CryptoError_ScalarMultiplicationInvalid+encodeECShared+    :: Simple.Curve curve+    => Proxy curve -> Simple.Point curve -> CryptoFailable SharedSecret+encodeECShared _ Simple.PointO = CryptoFailed CryptoError_ScalarMultiplicationInvalid encodeECShared prx (Simple.Point x _) = CryptoPassed . SharedSecret $ i2ospOf_ (Simple.curveSizeBytes prx) x -encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs-encodeECPoint Simple.PointO      = error "encodeECPoint: cannot serialize point at infinity"-encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb]+encodeECPoint+    :: forall curve bs. (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs+encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity"+encodeECPoint (Simple.Point x y) = B.concat [uncompressed, xb, yb]   where     size = Simple.curveSizeBytes (Proxy :: Proxy curve)     uncompressed, xb, yb :: bs@@ -351,58 +391,79 @@     xb = i2ospOf_ size x     yb = i2ospOf_ size y -decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve)+decodeECPoint+    :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve) decodeECPoint mxy = case B.uncons mxy of-    Nothing     -> CryptoFailed CryptoError_PointSizeInvalid-    Just (m,xy)+    Nothing -> CryptoFailed CryptoError_PointSizeInvalid+    Just (m, xy)         -- uncompressed         | m == 4 ->             let siz = B.length xy `div` 2-                (xb,yb) = B.splitAt siz xy+                (xb, yb) = B.splitAt siz xy                 x = os2ip xb                 y = os2ip yb-             in Simple.pointFromIntegers (x,y)+             in Simple.pointFromIntegers (x, y)         | otherwise -> CryptoFailed CryptoError_PointFormatInvalid -ecPointsMulVarTime :: forall curve . Simple.Curve curve-                   => Simple.Scalar curve-                   -> Simple.Scalar curve -> Simple.Point curve-                   -> Simple.Point curve+ecPointsMulVarTime+    :: forall curve+     . Simple.Curve curve+    => Simple.Scalar curve+    -> Simple.Scalar curve+    -> Simple.Point curve+    -> Simple.Point curve ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g-  where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve)+  where+    g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve) -ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs)-                   => bs -> CryptoFailable (Simple.Scalar curve)+ecScalarFromBinary+    :: forall curve bs+     . (Simple.Curve curve, ByteArrayAccess bs)+    => bs -> CryptoFailable (Simple.Scalar curve) ecScalarFromBinary ba     | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid-    | otherwise           = CryptoPassed (Simple.Scalar $ os2ip ba)-  where size = ecCurveOrderBytes (Proxy :: Proxy curve)+    | otherwise = CryptoPassed (Simple.Scalar $ os2ip ba)+  where+    size = ecCurveOrderBytes (Proxy :: Proxy curve) -ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs)-                 => Simple.Scalar curve -> bs+ecScalarToBinary+    :: forall curve bs+     . (Simple.Curve curve, ByteArray bs)+    => Simple.Scalar curve -> bs ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s-  where size = ecCurveOrderBytes (Proxy :: Proxy curve)+  where+    size = ecCurveOrderBytes (Proxy :: Proxy curve) -ecScalarFromInteger :: forall curve . Simple.Curve curve-                    => Integer -> CryptoFailable (Simple.Scalar curve)+ecScalarFromInteger+    :: forall curve+     . Simple.Curve curve+    => Integer -> CryptoFailable (Simple.Scalar curve) ecScalarFromInteger s     | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid-    | otherwise      = CryptoPassed (Simple.Scalar s)-  where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve)+    | otherwise = CryptoPassed (Simple.Scalar s)+  where+    nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve)  ecScalarToInteger :: Simple.Scalar curve -> Integer ecScalarToInteger (Simple.Scalar s) = s  ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int ecCurveOrderBytes prx = (numBits n + 7) `div` 8-  where n = Simple.curveEccN $ Simple.curveParameters prx+  where+    n = Simple.curveEccN $ Simple.curveParameters prx -ecScalarAdd :: forall curve . Simple.Curve curve-            => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve+ecScalarAdd+    :: forall curve+     . Simple.Curve curve+    => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n)-  where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve)+  where+    n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) -ecScalarMul :: forall curve . Simple.Curve curve-            => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve+ecScalarMul+    :: forall curve+     . Simple.Curve curve+    => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n)-  where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve)+  where+    n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve)

@@ -1,3 +1,5 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- | -- Module      : Crypto.ECC.Edwards25519 -- License     : BSD-style@@ -48,55 +50,55 @@ -- 3. Because of modular reduction in this implementation it is not -- possible to multiply points directly by scalars like 8.s or L. -- This has to be decomposed into several steps.----{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Crypto.ECC.Edwards25519-    ( Scalar-    , Point+module Crypto.ECC.Edwards25519 (+    Scalar,+    Point,+     -- * Scalars-    , scalarGenerate-    , scalarDecodeLong-    , scalarEncode+    scalarGenerate,+    scalarDecodeLong,+    scalarEncode,+     -- * Points-    , pointDecode-    , pointEncode-    , pointHasPrimeOrder+    pointDecode,+    pointEncode,+    pointHasPrimeOrder,+     -- * Arithmetic functions-    , toPoint-    , scalarAdd-    , scalarMul-    , pointNegate-    , pointAdd-    , pointDouble-    , pointMul-    , pointMulByCofactor-    , pointsMulVarTime-    ) where+    toPoint,+    scalarAdd,+    scalarMul,+    pointNegate,+    pointAdd,+    pointDouble,+    pointMul,+    pointMulByCofactor,+    pointsMulVarTime,+) where -import           Data.Word-import           Foreign.C.Types-import           Foreign.Ptr+import Data.Word+import Foreign.C.Types+import Foreign.Ptr -import           Crypto.Error-import           Crypto.Internal.ByteArray (Bytes, ScrubbedBytes, withByteArray)+import Crypto.Error+import Crypto.Internal.ByteArray (Bytes, ScrubbedBytes, withByteArray) import qualified Crypto.Internal.ByteArray as B-import           Crypto.Internal.Compat-import           Crypto.Internal.Imports-import           Crypto.Random-+import Crypto.Internal.Compat+import Crypto.Internal.Imports+import Crypto.Random  scalarArraySize :: Int scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}]  -- | A scalar modulo prime order of curve edwards25519. newtype Scalar = Scalar ScrubbedBytes-    deriving (Show,NFData)+    deriving (Show, NFData)  instance Eq Scalar where     (Scalar s1) == (Scalar s2) = unsafeDoIO $         withByteArray s1 $ \ps1 ->-        withByteArray s2 $ \ps2 ->-            fmap (/= 0) (ed25519_scalar_eq ps1 ps2)+            withByteArray s2 $ \ps2 ->+                fmap (/= 0) (ed25519_scalar_eq ps1 ps2)     {-# NOINLINE (==) #-}  pointArraySize :: Int@@ -104,19 +106,20 @@  -- | A point on curve edwards25519. newtype Point = Point Bytes-    deriving NFData+    deriving (NFData)  instance Show Point where     showsPrec d p =         let bs = pointEncode p :: Bytes-         in showParen (d > 10) $ showString "Point "-                               . shows (B.convertToBase B.Base16 bs :: Bytes)+         in showParen (d > 10) $+                showString "Point "+                    . shows (B.convertToBase B.Base16 bs :: Bytes)  instance Eq Point where     (Point p1) == (Point p2) = unsafeDoIO $         withByteArray p1 $ \pp1 ->-        withByteArray p2 $ \pp2 ->-            fmap (/= 0) (ed25519_point_eq pp1 pp2)+            withByteArray p2 $ \pp2 ->+                fmap (/= 0) (ed25519_point_eq pp1 pp2)     {-# NOINLINE (==) #-}  -- | Generate a random scalar.@@ -148,12 +151,12 @@ scalarDecodeLong :: B.ByteArrayAccess bs => bs -> CryptoFailable Scalar scalarDecodeLong bs     | B.length bs > 64 = CryptoFailed CryptoError_EcScalarOutOfBounds-    | otherwise        = unsafeDoIO $ withByteArray bs initialize+    | otherwise = unsafeDoIO $ withByteArray bs initialize   where     len = fromIntegral $ B.length bs     initialize inp = do         s <- B.alloc scalarArraySize $ \ps ->-                 ed25519_scalar_decode_long ps inp len+            ed25519_scalar_decode_long ps inp len         return $ CryptoPassed (Scalar s) {-# NOINLINE scalarDecodeLong #-} @@ -162,16 +165,16 @@ scalarAdd (Scalar a) (Scalar b) =     Scalar $ B.allocAndFreeze scalarArraySize $ \out ->         withByteArray a $ \pa ->-        withByteArray b $ \pb ->-             ed25519_scalar_add out pa pb+            withByteArray b $ \pb ->+                ed25519_scalar_add out pa pb  -- | Multiply two scalars. scalarMul :: Scalar -> Scalar -> Scalar scalarMul (Scalar a) (Scalar b) =     Scalar $ B.allocAndFreeze scalarArraySize $ \out ->         withByteArray a $ \pa ->-        withByteArray b $ \pb ->-             ed25519_scalar_mul out pa pb+            withByteArray b $ \pb ->+                ed25519_scalar_mul out pa pb  -- | Multiplies a scalar with the curve base point. toPoint :: Scalar -> Point@@ -188,7 +191,7 @@ pointEncode (Point p) =     B.allocAndFreeze 32 $ \out ->         withByteArray p $ \pp ->-             ed25519_point_encode out pp+            ed25519_point_encode out pp  -- | Deserialize a 32-byte array as a point, ensuring the point is -- valid on edwards25519.@@ -197,13 +200,14 @@ pointDecode :: B.ByteArrayAccess bs => bs -> CryptoFailable Point pointDecode bs     | B.length bs == 32 = unsafeDoIO $ withByteArray bs initialize-    | otherwise         = CryptoFailed CryptoError_PointSizeInvalid+    | otherwise = CryptoFailed CryptoError_PointSizeInvalid   where     initialize inp = do         (res, p) <- B.allocRet pointArraySize $ \pp ->-                        ed25519_point_decode_vartime pp inp-        if res == 0 then return $ CryptoFailed CryptoError_PointCoordinatesInvalid-                    else return $ CryptoPassed (Point p)+            ed25519_point_decode_vartime pp inp+        if res == 0+            then return $ CryptoFailed CryptoError_PointCoordinatesInvalid+            else return $ CryptoPassed (Point p) {-# NOINLINE pointDecode #-}  -- | Test whether a point belongs to the prime-order subgroup@@ -224,15 +228,15 @@ pointNegate (Point a) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray a $ \pa ->-             ed25519_point_negate out pa+            ed25519_point_negate out pa  -- | Add two points. pointAdd :: Point -> Point -> Point pointAdd (Point a) (Point b) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray a $ \pa ->-        withByteArray b $ \pb ->-             ed25519_point_add out pa pb+            withByteArray b $ \pb ->+                ed25519_point_add out pa pb  -- | Add a point to itself. --@@ -243,7 +247,7 @@ pointDouble (Point a) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray a $ \pa ->-             ed25519_point_double out pa+            ed25519_point_double out pa  -- | Multiply a point by h = 8. --@@ -254,7 +258,7 @@ pointMulByCofactor (Point a) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray a $ \pa ->-             ed25519_point_mul_by_cofactor out pa+            ed25519_point_mul_by_cofactor out pa  -- | Scalar multiplication over curve edwards25519. --@@ -265,8 +269,8 @@ pointMul (Scalar scalar) (Point base) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray scalar $ \pscalar ->-        withByteArray base   $ \pbase   ->-             ed25519_point_scalarmul out pbase pscalar+            withByteArray base $ \pbase ->+                ed25519_point_scalarmul out pbase pscalar  -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@. --@@ -279,92 +283,108 @@ pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) =     Point $ B.allocAndFreeze pointArraySize $ \out ->         withByteArray s1 $ \ps1 ->-        withByteArray s2 $ \ps2 ->-        withByteArray p  $ \pp  ->-             ed25519_base_double_scalarmul_vartime out ps1 pp ps2+            withByteArray s2 $ \ps2 ->+                withByteArray p $ \pp ->+                    ed25519_base_double_scalarmul_vartime out ps1 pp ps2  foreign import ccall unsafe "crypton_ed25519_scalar_eq"-    ed25519_scalar_eq :: Ptr Scalar-                      -> Ptr Scalar-                      -> IO CInt+    ed25519_scalar_eq+        :: Ptr Scalar+        -> Ptr Scalar+        -> IO CInt  foreign import ccall unsafe "crypton_ed25519_scalar_encode"-    ed25519_scalar_encode :: Ptr Word8-                          -> Ptr Scalar-                          -> IO ()+    ed25519_scalar_encode+        :: Ptr Word8+        -> Ptr Scalar+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_scalar_decode_long"-    ed25519_scalar_decode_long :: Ptr Scalar-                               -> Ptr Word8-                               -> CSize-                               -> IO ()+    ed25519_scalar_decode_long+        :: Ptr Scalar+        -> Ptr Word8+        -> CSize+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_scalar_add"-    ed25519_scalar_add :: Ptr Scalar -- sum-                       -> Ptr Scalar -- a-                       -> Ptr Scalar -- b-                       -> IO ()+    ed25519_scalar_add+        :: Ptr Scalar -- sum+        -> Ptr Scalar -- a+        -> Ptr Scalar -- b+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_scalar_mul"-    ed25519_scalar_mul :: Ptr Scalar -- out-                       -> Ptr Scalar -- a-                       -> Ptr Scalar -- b-                       -> IO ()+    ed25519_scalar_mul+        :: Ptr Scalar -- out+        -> Ptr Scalar -- a+        -> Ptr Scalar -- b+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_point_encode"-    ed25519_point_encode :: Ptr Word8-                         -> Ptr Point-                         -> IO ()+    ed25519_point_encode+        :: Ptr Word8+        -> Ptr Point+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_point_decode_vartime"-    ed25519_point_decode_vartime :: Ptr Point-                                 -> Ptr Word8-                                 -> IO CInt+    ed25519_point_decode_vartime+        :: Ptr Point+        -> Ptr Word8+        -> IO CInt  foreign import ccall unsafe "crypton_ed25519_point_eq"-    ed25519_point_eq :: Ptr Point-                     -> Ptr Point-                     -> IO CInt+    ed25519_point_eq+        :: Ptr Point+        -> Ptr Point+        -> IO CInt  foreign import ccall "crypton_ed25519_point_has_prime_order"-    ed25519_point_has_prime_order :: Ptr Point-                                  -> IO CInt+    ed25519_point_has_prime_order+        :: Ptr Point+        -> IO CInt  foreign import ccall unsafe "crypton_ed25519_point_negate"-    ed25519_point_negate :: Ptr Point -- minus_a-                         -> Ptr Point -- a-                         -> IO ()+    ed25519_point_negate+        :: Ptr Point -- minus_a+        -> Ptr Point -- a+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_point_add"-    ed25519_point_add :: Ptr Point -- sum-                      -> Ptr Point -- a-                      -> Ptr Point -- b-                      -> IO ()+    ed25519_point_add+        :: Ptr Point -- sum+        -> Ptr Point -- a+        -> Ptr Point -- b+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_point_double"-    ed25519_point_double :: Ptr Point -- two_a-                         -> Ptr Point -- a-                         -> IO ()+    ed25519_point_double+        :: Ptr Point -- two_a+        -> Ptr Point -- a+        -> IO ()  foreign import ccall unsafe "crypton_ed25519_point_mul_by_cofactor"-    ed25519_point_mul_by_cofactor :: Ptr Point -- eight_a-                                  -> Ptr Point -- a-                                  -> IO ()+    ed25519_point_mul_by_cofactor+        :: Ptr Point -- eight_a+        -> Ptr Point -- a+        -> IO ()  foreign import ccall "crypton_ed25519_point_base_scalarmul"-    ed25519_point_base_scalarmul :: Ptr Point  -- scaled-                                 -> Ptr Scalar -- scalar-                                 -> IO ()+    ed25519_point_base_scalarmul+        :: Ptr Point -- scaled+        -> Ptr Scalar -- scalar+        -> IO ()  foreign import ccall "crypton_ed25519_point_scalarmul"-    ed25519_point_scalarmul :: Ptr Point  -- scaled-                            -> Ptr Point  -- base-                            -> Ptr Scalar -- scalar-                            -> IO ()+    ed25519_point_scalarmul+        :: Ptr Point -- scaled+        -> Ptr Point -- base+        -> Ptr Scalar -- scalar+        -> IO ()  foreign import ccall "crypton_ed25519_base_double_scalarmul_vartime"-    ed25519_base_double_scalarmul_vartime :: Ptr Point  -- combo-                                          -> Ptr Scalar -- scalar1-                                          -> Ptr Point  -- base2-                                          -> Ptr Scalar -- scalar2-                                          -> IO ()+    ed25519_base_double_scalarmul_vartime+        :: Ptr Point -- combo+        -> Ptr Scalar -- scalar1+        -> Ptr Point -- base2+        -> Ptr Scalar -- scalar2+        -> IO ()