Initial commit

This commit is contained in:
La Ancapo 2026-01-25 02:27:22 +01:00
commit c101616e62
309 changed files with 53937 additions and 0 deletions

View file

@ -0,0 +1,70 @@
-- |
-- 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
import Crypto.Error
import Crypto.Cipher.Types
import Crypto.Cipher.Utils
import Crypto.Cipher.Types.Block
import Crypto.Cipher.AES.Primitive
import Crypto.Internal.Imports
-- | AES with 128 bit key
newtype AES128 = AES128 AES
deriving (NFData)
-- | AES with 192 bit key
newtype AES192 = AES192 AES
deriving (NFData)
-- | AES with 256 bit key
newtype AES256 = AES256 AES
deriving (NFData)
instance Cipher AES128 where
cipherName _ = "AES128"
cipherKeySize _ = KeySizeFixed 16
cipherInit k = AES128 <$> (initAES =<< validateKeySize (undefined :: AES128) k)
instance Cipher AES192 where
cipherName _ = "AES192"
cipherKeySize _ = KeySizeFixed 24
cipherInit k = AES192 <$> (initAES =<< validateKeySize (undefined :: AES192) k)
instance Cipher AES256 where
cipherName _ = "AES256"
cipherKeySize _ = KeySizeFixed 32
cipherInit k = AES256 <$> (initAES =<< validateKeySize (undefined :: AES256) k)
#define INSTANCE_BLOCKCIPHER(CSTR) \
instance BlockCipher CSTR where \
{ blockSize _ = 16 \
; ecbEncrypt (CSTR aes) = encryptECB aes \
; ecbDecrypt (CSTR aes) = decryptECB aes \
; cbcEncrypt (CSTR aes) (IV iv) = encryptCBC aes (IV iv) \
; cbcDecrypt (CSTR aes) (IV iv) = decryptCBC aes (IV iv) \
; ctrCombine (CSTR aes) (IV iv) = encryptCTR aes (IV iv) \
; aeadInit AEAD_GCM (CSTR aes) iv = CryptoPassed $ AEAD (gcmMode aes) (gcmInit aes iv) \
; aeadInit AEAD_OCB (CSTR aes) iv = CryptoPassed $ AEAD (ocbMode aes) (ocbInit aes iv) \
; aeadInit (AEAD_CCM n m l) (CSTR aes) iv = AEAD (ccmMode aes) <$> ccmInit aes iv n m l \
; aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported \
}; \
instance BlockCipher128 CSTR where \
{ xtsEncrypt (CSTR aes1, CSTR aes2) (IV iv) = encryptXTS (aes1,aes2) (IV iv) \
; xtsDecrypt (CSTR aes1, CSTR aes2) (IV iv) = decryptXTS (aes1,aes2) (IV iv) \
};
INSTANCE_BLOCKCIPHER(AES128)
INSTANCE_BLOCKCIPHER(AES192)
INSTANCE_BLOCKCIPHER(AES256)

View file

@ -0,0 +1,645 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module : Crypto.Cipher.AES.Primitive
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
module Crypto.Cipher.AES.Primitive
(
-- * Block cipher data types
AES
-- * Authenticated encryption block cipher types
, AESGCM
, AESOCB
-- * Creation
, initAES
-- * Miscellanea
, genCTR
, genCounter
-- * Encryption
, encryptECB
, encryptCBC
, encryptCTR
, encryptXTS
-- * Decryption
, decryptECB
, decryptCBC
, decryptCTR
, decryptXTS
-- * CTR with 32-bit wrapping
, combineC32
-- * Incremental GCM
, gcmMode
, gcmInit
-- * Incremental OCB
, ocbMode
, ocbInit
-- * CCM
, ccmMode
, ccmInit
) where
import Data.Word
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
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 qualified Crypto.Internal.ByteArray as B
instance Cipher AES where
cipherName _ = "AES"
cipherKeySize _ = KeySizeEnum [16,24,32]
cipherInit k = initAES k
instance BlockCipher AES where
blockSize _ = 16
ecbEncrypt = encryptECB
ecbDecrypt = decryptECB
cbcEncrypt = encryptCBC
cbcDecrypt = decryptCBC
ctrCombine = encryptCTR
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
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
}
-- | 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
}
-- | 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
}
-- | AES Context (pre-processed key)
newtype AES = AES ScrubbedBytes
deriving (NFData)
-- | AESGCM State
newtype AESGCM = AESGCM ScrubbedBytes
deriving (NFData)
-- | AESOCB State
newtype AESOCB = AESOCB ScrubbedBytes
deriving (NFData)
-- | AESCCM State
newtype AESCCM = AESCCM ScrubbedBytes
deriving (NFData)
sizeGCM :: Int
sizeGCM = 320
sizeOCB :: Int
sizeOCB = 160
sizeCCM :: Int
sizeCCM = 80
keyToPtr :: AES -> (Ptr AES -> IO a) -> IO a
keyToPtr (AES b) f = withByteArray b (f . castPtr)
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
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 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 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 gcmSt) f =
keyToPtr aes $ \aesPtr -> do
newSt <- B.copy gcmSt (\_ -> return ())
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 gcmSt) f =
keyToPtr aes $ \aesPtr -> do
newSt <- B.copy gcmSt (\_ -> return ())
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 ccmSt) f =
keyToPtr aes $ \aesPtr -> do
newSt <- B.copy ccmSt (\_ -> return ())
a <- withByteArray newSt $ \ccmStPtr -> f (castPtr ccmStPtr) aesPtr
return (a, AESCCM newSt)
-- | Initialize a new context with a key
--
-- Key needs to be of length 16, 24 or 32 bytes. Any other values will return failure
initAES :: ByteArrayAccess key => key -> CryptoFailable AES
initAES k
| len == 16 = CryptoPassed $ initWithRounds 10
| 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)
-- | encrypt using Electronic Code Book (ECB)
{-# NOINLINE encryptECB #-}
encryptECB :: ByteArray ba => AES -> ba -> ba
encryptECB = doECB c_aes_encrypt_ecb
-- | 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 = doCBC c_aes_encrypt_cbc
-- | generate a counter mode pad. this is generally xor-ed to an input
-- to make the standard counter mode block operations.
--
-- if the length requested is not a multiple of the block cipher size,
-- 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 ctx (IV iv) len
| 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
-- | generate a counter mode pad. this is generally xor-ed to an input
-- to make the standard counter mode block operations.
--
-- if the length requested is not a multiple of the block cipher size,
-- more data will be returned, so that the returned bytearray is
-- a multiple of the block cipher size.
--
-- Similiar to 'genCTR' but also return the next IV for continuation
{-# NOINLINE genCounter #-}
genCounter :: ByteArray ba
=> AES
-> IV AES
-> Int
-> (ba, IV AES)
genCounter ctx iv len
| 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)
where
(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
-}
-- | encrypt using Counter mode (CTR)
--
-- 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 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)
| 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
-- | 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 = doXTS c_aes_encrypt_xts
-- | decrypt using Electronic Code Book (ECB)
{-# NOINLINE decryptECB #-}
decryptECB :: ByteArray ba => AES -> ba -> ba
decryptECB = doECB c_aes_decrypt_ecb
-- | decrypt using Cipher block chaining (CBC)
{-# NOINLINE decryptCBC #-}
decryptCBC :: ByteArray ba => AES -> IV AES -> ba -> ba
decryptCBC = doCBC c_aes_decrypt_cbc
-- | 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 = 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 = 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 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)
| 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
{-# INLINE doECB #-}
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 =
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
{-# INLINE doCBC #-}
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)
| 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
{-# 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)
| 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
------------------------------------------------------------------------
-- GCM
------------------------------------------------------------------------
-- | initialize a gcm context
{-# NOINLINE gcmInit #-}
gcmInit :: ByteArrayAccess iv => AES -> iv -> AESGCM
gcmInit ctx iv = unsafeDoIO $ do
sm <- B.alloc sizeGCM $ \gcmStPtr ->
withKeyAndIV ctx iv $ \k v ->
c_aes_gcm_init (castPtr gcmStPtr) k v (fromIntegral $ B.length iv)
return $ AESGCM sm
-- | append data which is only going to be authenticated to the GCM context.
--
-- needs to happen after initialization and before appending encryption/decryption data.
{-# NOINLINE gcmAppendAAD #-}
gcmAppendAAD :: ByteArrayAccess aad => AESGCM -> aad -> AESGCM
gcmAppendAAD gcmSt input = unsafeDoIO doAppend
where doAppend =
withNewGCMSt gcmSt $ \gcmStPtr ->
withByteArray input $ \i ->
c_aes_gcm_aad gcmStPtr i (fromIntegral $ B.length input)
-- | append data to encrypt and append to the GCM context
--
-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
-- needs to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
c_aes_gcm_encrypt (castPtr o) gcmStPtr aesPtr i (fromIntegral len)
-- | append data to decrypt and append to the GCM context
--
-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
-- needs to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
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 ()
------------------------------------------------------------------------
-- OCB v3
------------------------------------------------------------------------
-- | initialize an ocb context
{-# NOINLINE ocbInit #-}
ocbInit :: ByteArrayAccess iv => AES -> iv -> AESOCB
ocbInit ctx iv = unsafeDoIO $ do
sm <- B.alloc sizeOCB $ \ocbStPtr ->
withKeyAndIV ctx iv $ \k v ->
c_aes_ocb_init (castPtr ocbStPtr) k v (fromIntegral $ B.length iv)
return $ AESOCB sm
-- | append data which is going to just be authenticated to the OCB context.
--
-- need to happen after initialization and before appending encryption/decryption data.
{-# 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 ->
c_aes_ocb_aad ocbStPtr aesPtr i (fromIntegral $ B.length input)
-- | append data to encrypt and append to the OCB context
--
-- the bytearray needs to be a multiple of the AES block size, unless it's the last call to this function.
-- need to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
c_aes_ocb_encrypt (castPtr o) ocbStPtr aesPtr i (fromIntegral len)
-- | append data to decrypt and append to the OCB context
--
-- the bytearray needs to be a multiple of the AES block size, unless it's the last call to this function.
-- need to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
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 ()
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
ccmGetL l = case l of
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 ctx iv n m l
| 15 - li /= B.length iv = CryptoFailed CryptoError_IvSizeInvalid
| otherwise = unsafeDoIO $ do
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)
where
mi = ccmGetM m
li = ccmGetL l
-- | append data which is only going to be authenticated to the CCM context.
--
-- needs to happen after initialization and before appending encryption/decryption data.
{-# 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)
-- | append data to encrypt and append to the CCM context
--
-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
-- needs to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
c_aes_ccm_encrypt (castPtr o) ccmStPtr aesPtr i (fromIntegral len)
-- | append data to decrypt and append to the CCM context
--
-- the bytearray needs to be a multiple of AES block size, unless it's the last call to this function.
-- needs to happen after AAD appending, or after initialization if no AAD data.
{-# 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 ->
withByteArray input $ \i ->
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 ()
------------------------------------------------------------------------
foreign import ccall "cryptonite_aes.h cryptonite_aes_initkey"
c_aes_init :: Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_ecb"
c_aes_encrypt_ecb :: CString -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_decrypt_ecb"
c_aes_decrypt_ecb :: CString -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_cbc"
c_aes_encrypt_cbc :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_decrypt_cbc"
c_aes_decrypt_cbc :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_xts"
c_aes_encrypt_xts :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_decrypt_xts"
c_aes_decrypt_xts :: CString -> Ptr AES -> Ptr AES -> Ptr Word8 -> CUInt -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gen_ctr"
c_aes_gen_ctr :: CString -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_gen_ctr_cont"
c_aes_gen_ctr_cont :: CString -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_ctr"
c_aes_encrypt_ctr :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_encrypt_c32"
c_aes_encrypt_c32 :: CString -> Ptr AES -> Ptr Word8 -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_init"
c_aes_gcm_init :: Ptr AESGCM -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_aad"
c_aes_gcm_aad :: Ptr AESGCM -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_encrypt"
c_aes_gcm_encrypt :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_decrypt"
c_aes_gcm_decrypt :: CString -> Ptr AESGCM -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_gcm_finish"
c_aes_gcm_finish :: CString -> Ptr AESGCM -> Ptr AES -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_init"
c_aes_ocb_init :: Ptr AESOCB -> Ptr AES -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_aad"
c_aes_ocb_aad :: Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_encrypt"
c_aes_ocb_encrypt :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_decrypt"
c_aes_ocb_decrypt :: CString -> Ptr AESOCB -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ocb_finish"
c_aes_ocb_finish :: CString -> Ptr AESOCB -> Ptr AES -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_init"
c_aes_ccm_init :: Ptr AESCCM -> Ptr AES -> Ptr Word8 -> CUInt -> CUInt -> CInt -> CInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_aad"
c_aes_ccm_aad :: Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_encrypt"
c_aes_ccm_encrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_decrypt"
c_aes_ccm_decrypt :: CString -> Ptr AESCCM -> Ptr AES -> CString -> CUInt -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_ccm_finish"
c_aes_ccm_finish :: CString -> Ptr AESCCM -> Ptr AES -> IO ()

View file

@ -0,0 +1,193 @@
-- |
-- Module : Crypto.Cipher.AESGCMSIV
-- License : BSD-style
-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability : experimental
-- Portability : unknown
--
-- Implementation of AES-GCM-SIV, an AEAD scheme with nonce misuse resistance
-- defined in <https://tools.ietf.org/html/rfc8452 RFC 8452>.
--
-- To achieve the nonce misuse-resistance property, encryption requires two
-- passes on the plaintext, hence no streaming API is provided. This AEAD
-- operates on complete inputs held in memory. For simplicity, the
-- implementation of decryption uses a similar pattern, with performance
-- penalty compared to an implementation which is able to merge both passes.
--
-- 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
import Data.Bits
import Data.Word
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (peekElemOff, poke, pokeElemOff)
import Data.ByteArray
import qualified Data.ByteArray as B
import Data.Memory.Endian (toLE)
import Data.Memory.PtrMethods (memXor)
import Crypto.Cipher.AES.Primitive
import Crypto.Cipher.Types
import Crypto.Error
import Crypto.Internal.Compat (unsafeDoIO)
import Crypto.Random
-- 12-byte nonces
-- | Nonce value for AES-GCM-SIV, always 12 bytes.
newtype Nonce = Nonce Bytes deriving (Show, Eq, ByteArrayAccess)
-- | Nonce smart constructor. Accepts only 12-byte inputs.
nonce :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
nonce iv
| B.length iv == 12 = CryptoPassed (Nonce $ B.convert iv)
| 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
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)
polyvalFinalize :: Polyval -> IO ScrubbedBytes
polyvalFinalize (Polyval ctx) = B.alloc 16 $ \dst ->
B.withByteArray ctx $ \pctx -> c_aes_polyval_finalize pctx dst
foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_init"
c_aes_polyval_init :: Ptr Polyval -> CString -> IO ()
foreign import ccall "cryptonite_aes.h cryptonite_aes_polyval_update"
c_aes_polyval_update :: Ptr Polyval -> CString -> CUInt -> IO ()
foreign import ccall unsafe "cryptonite_aes.h cryptonite_aes_polyval_finalize"
c_aes_polyval_finalize :: Ptr Polyval -> CString -> IO ()
-- Key Generation
le32iv :: Word32 -> Nonce -> Bytes
le32iv n (Nonce iv) = B.allocAndFreeze 16 $ \ptr -> do
poke ptr (toLE n)
copyByteArrayToPtr iv (ptr `plusPtr` 4)
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)
_ -> 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
-- | 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'
-- cipher.
--
-- 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 aes iv aad plaintext
| lengthInvalid aad = error "AESGCMSIV: aad is too large"
| lengthInvalid plaintext = error "AESGCMSIV: plaintext is too large"
| otherwise = (AuthTag tag, ciphertext)
where
(mak, mek) = deriveKeys aes iv
ss = getSs mak aad plaintext
tag = buildTag mek ss iv
ciphertext = combineC32 mek (transformTag tag) plaintext
-- | AEAD decryption with the specified key and nonce. The key must be given
-- as an initialized 'Crypto.Cipher.AES.AES128' or 'Crypto.Cipher.AES.AES256'
-- cipher.
--
-- 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 aes iv aad ciphertext (AuthTag tag)
| lengthInvalid aad = error "AESGCMSIV: aad is too large"
| lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large"
| tag `constEq` buildTag mek ss iv = Just plaintext
| otherwise = Nothing
where
(mak, mek) = deriveKeys aes iv
ss = getSs mak aad plaintext
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 mak aad plaintext = unsafeDoIO $ do
ctx <- polyvalInit mak
polyvalUpdate ctx aad
polyvalUpdate ctx plaintext
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)
toLE64 x = toLE (fromIntegral x * 8 :: Word64)
-- XOR the first 12 bytes of S_s with the nonce and clear the most significant
-- bit of the last byte.
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))
-- Encrypt the result with AES using the message-encryption key to produce the
-- tag.
buildTag :: BlockCipher128 aes => aes -> ScrubbedBytes -> Nonce -> Bytes
buildTag mek ss iv = ecbEncrypt mek (tagInput ss iv)
-- The initial counter block is the tag with the most significant bit of the
-- last byte set to one.
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

View file

@ -0,0 +1,67 @@
-- |
-- 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
import Crypto.Internal.Imports
import Crypto.Cipher.Types
import Crypto.Cipher.Blowfish.Primitive
-- | variable keyed blowfish state
newtype Blowfish = Blowfish Context
deriving (NFData)
-- | 64 bit keyed blowfish state
newtype Blowfish64 = Blowfish64 Context
deriving (NFData)
-- | 128 bit keyed blowfish state
newtype Blowfish128 = Blowfish128 Context
deriving (NFData)
-- | 256 bit keyed blowfish state
newtype Blowfish256 = Blowfish256 Context
deriving (NFData)
-- | 448 bit keyed blowfish state
newtype Blowfish448 = Blowfish448 Context
deriving (NFData)
instance Cipher Blowfish where
cipherName _ = "blowfish"
cipherKeySize _ = KeySizeRange 6 56
cipherInit k = Blowfish `fmap` initBlowfish k
instance BlockCipher Blowfish where
blockSize _ = 8
ecbEncrypt (Blowfish bf) = encrypt bf
ecbDecrypt (Blowfish bf) = decrypt bf
#define INSTANCE_CIPHER(CSTR, NAME, KEYSIZE) \
instance Cipher CSTR where \
{ cipherName _ = NAME \
; cipherKeySize _ = KeySizeFixed KEYSIZE \
; cipherInit k = CSTR `fmap` initBlowfish k \
}; \
instance BlockCipher CSTR where \
{ blockSize _ = 8 \
; ecbEncrypt (CSTR bf) = encrypt bf \
; ecbDecrypt (CSTR bf) = decrypt bf \
};
INSTANCE_CIPHER(Blowfish64, "blowfish64", 8)
INSTANCE_CIPHER(Blowfish128, "blowfish128", 16)
INSTANCE_CIPHER(Blowfish256, "blowfish256", 32)
INSTANCE_CIPHER(Blowfish448, "blowfish448", 56)

View file

@ -0,0 +1,296 @@
-- |
-- Module : Crypto.Cipher.Blowfish.Box
-- License : BSD-style
-- Stability : experimental
-- Portability : Good
{-# LANGUAGE MagicHash #-}
module Crypto.Cipher.Blowfish.Box
( KeySchedule(..)
, createKeySchedule
, copyKeySchedule
) where
import Crypto.Internal.WordArray (MutableArray32,
mutableArray32FromAddrBE,
mutableArrayRead32,
mutableArrayWrite32)
newtype KeySchedule = KeySchedule MutableArray32
-- | Copy the state of one key schedule into the other.
-- The first parameter is the destination and the second the source.
copyKeySchedule :: KeySchedule -> KeySchedule -> IO ()
copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0
where
loop 1042 = return ()
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\
\"#

View file

@ -0,0 +1,258 @@
-- |
-- Module : Crypto.Cipher.Blowfish.Primitive
-- License : BSD-style
-- Stability : experimental
-- Portability : Good
-- Rewritten by Vincent Hanquez (c) 2015
-- Lars Petersen (c) 2018
--
-- Original code:
-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
-- (as found in Crypto-4.2.4)
{-# 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
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
rnf a = a `seq` ()
-- | Initialize a new Blowfish context from a key.
--
-- key needs to be between 0 and 448 bits.
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish key
| B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
| otherwise = CryptoPassed $ unsafeDoIO $ do
ks <- createKeySchedule
expandKey ks key
freezeKeySchedule ks
-- | Get an immutable Blowfish context by freezing a mutable key schedule.
freezeKeySchedule :: KeySchedule -> IO Context
freezeKeySchedule (KeySchedule ma) = Context `fmap` mutableArray32Freeze ma
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
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)
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
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
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
let l' = xor l a0
let r' = xor r a1
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 + 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
-> 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
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
-- | 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 `mod` 8 /= 0 = error "invalid data length"
| 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 `mod` 8 /= 0 = error "invalid data length"
| 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
doRound :: Word64 -> Int -> Word64
doRound !i roundIndex
| roundIndex == 16 =
let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)
in rotateL (i `xor` final) 32
| otherwise =
let newr = fromIntegral (i `shiftR` 32) `xor` p roundIndex
newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr
in doRound newi (roundIndex+1)
-- | 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
-- 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)
| 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
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
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)
-- | 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)
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
-- | 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)
s1 i = mutableArrayRead32 ma (fromIntegral i + 274)
s2 i = mutableArrayRead32 ma (fromIntegral i + 530)
s3 i = mutableArrayRead32 ma (fromIntegral i + 786)
iterKeyStream :: (ByteArrayAccess x)
=> x
-> Word32
-> Word32
-> (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
{-# 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)
-- collapse into a tight loop after inlining.

View file

@ -0,0 +1,43 @@
-- |
-- Module : Crypto.Cipher.CAST5
-- License : BSD-style
-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability : stable
-- Portability : good
--
module Crypto.Cipher.CAST5
( CAST5
) where
import Crypto.Error
import Crypto.Cipher.Types
import Crypto.Cipher.CAST5.Primitive
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
-- | CAST5 block cipher (also known as CAST-128). Key is between
-- 40 and 128 bits.
newtype CAST5 = CAST5 Key
instance Cipher CAST5 where
cipherName _ = "CAST5"
cipherKeySize _ = KeySizeRange 5 16
cipherInit = initCAST5
instance BlockCipher CAST5 where
blockSize _ = 8
ecbEncrypt (CAST5 k) = B.mapAsWord64 (encrypt k)
ecbDecrypt (CAST5 k) = B.mapAsWord64 (decrypt k)
initCAST5 :: ByteArrayAccess key => key -> CryptoFailable CAST5
initCAST5 bs
| 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
short = len <= 10
padded :: B.Bytes
padded = B.convert bs `B.append` B.replicate (16 - len) 0

View file

@ -0,0 +1,573 @@
{-# 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
import Control.Monad (void, (>=>))
import Data.Bits
import Data.Memory.Endian
import Data.Word
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.WordArray
-- Data Types
data P = P {-# UNPACK #-} !Word32 -- left word
{-# UNPACK #-} !Word32 -- right word
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 ]
-- Big-endian Transformations
decomp64 :: Word64 -> P
decomp64 x = P (fromIntegral (x `shiftR` 32)) (fromIntegral x)
comp64 :: P -> Word64
comp64 (P l r) = (fromIntegral l `shiftL` 32) .|. fromIntegral r
decomp32 :: Word32 -> (Word8, Word8, Word8, Word8)
decomp32 x =
let a = fromIntegral (x `shiftR` 24)
b = fromIntegral (x `shiftR` 16)
c = fromIntegral (x `shiftR` 8)
d = fromIntegral x
in (a, b, c, d)
-- Encryption
-- | Encrypts a block using the specified key
encrypt :: Key -> Word64 -> Word64
encrypt k = comp64 . cast_enc k . decomp64
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
r12 = type3 a 22 r10 r11
cast_enc (K16 a) p = P r16 r15
where
P r12 r11 = cast_enc (K12 a) p
r13 = type1 a 24 r11 r12
r14 = type2 a 26 r12 r13
r15 = type3 a 28 r13 r14
r16 = type1 a 30 r14 r15
-- Decryption
-- | Decrypts a block using the specified key
decrypt :: Key -> Word64 -> Word64
decrypt k = comp64 . cast_dec k . decomp64
cast_dec :: Key -> P -> P
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
cast_dec (K16 a) (P r16 r15) = cast_dec (K12 a) (P r12 r11)
where
r14 = type1 a 30 r16 r15
r13 = type3 a 28 r15 r14
r12 = type2 a 26 r14 r13
r11 = type1 a 24 r13 r12
-- Non-Identical Rounds
type1 :: Array32 -> Int -> Word32 -> Word32 -> Word32
type1 arr idx l r =
let km = arrayRead32 arr idx
kr = arrayRead32 arr (idx + 1)
j = (km + r) `rotateL` fromIntegral kr
(ja, jb, jc, jd) = decomp32 j
in l `xor` (((sbox_s1 ja `xor` sbox_s2 jb) - sbox_s3 jc) + sbox_s4 jd)
type2 :: Array32 -> Int -> Word32 -> Word32 -> Word32
type2 arr idx l r =
let km = arrayRead32 arr idx
kr = arrayRead32 arr (idx + 1)
j = (km `xor` r) `rotateL` fromIntegral kr
(ja, jb, jc, jd) = decomp32 j
in l `xor` (((sbox_s1 ja - sbox_s2 jb) + sbox_s3 jc) `xor` sbox_s4 jd)
type3 :: Array32 -> Int -> Word32 -> Word32 -> Word32
type3 arr idx l r =
let km = arrayRead32 arr idx
kr = arrayRead32 arr (idx + 1)
j = (km - r) `rotateL` fromIntegral kr
(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 isShort key =
let P x0123 x4567 = decomp64 (fromBE $ B.toW64BE key 0)
P x89AB xCDEF = decomp64 (fromBE $ B.toW64BE key 8)
in keySchedule isShort (Q x0123 x4567 x89AB xCDEF)
keySchedule :: Bool -> Q -> Key
keySchedule isShort x
| 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
sbox_s56787 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s7 e
sbox_s56788 a b c d e = sbox_s5 a `xor` sbox_s6 b `xor` sbox_s7 c `xor` sbox_s8 d `xor` sbox_s8 e
steps123 ma off = step1 ma off >=> step2 ma (off + 8) >=> step3 ma (off + 16)
step1 :: MutableArray32 -> Int -> Q -> IO Q
step1 ma off (Q x0123 x4567 x89AB xCDEF) = do
let (x8, x9, xA, xB) = decomp32 x89AB
(xC, xD, xE, xF) = decomp32 xCDEF
z0123 = x0123 `xor` sbox_s56787 xD xF xC xE x8
z4567 = x89AB `xor` sbox_s56788 z0 z2 z1 z3 xA
z89AB = xCDEF `xor` sbox_s56785 z7 z6 z5 z4 x9
zCDEF = x4567 `xor` sbox_s56786 zA z9 zB z8 xB
(z0, z1, z2, z3) = decomp32 z0123
(z4, z5, z6, z7) = decomp32 z4567
(z8, z9, zA, zB) = decomp32 z89AB
(zC, zD, zE, zF) = decomp32 zCDEF
mutableArrayWrite32 ma (off + 0) $ sbox_s56785 z8 z9 z7 z6 z2
mutableArrayWrite32 ma (off + 2) $ sbox_s56786 zA zB z5 z4 z6
mutableArrayWrite32 ma (off + 4) $ sbox_s56787 zC zD z3 z2 z9
mutableArrayWrite32 ma (off + 6) $ sbox_s56788 zE zF z1 z0 zC
return (Q z0123 z4567 z89AB zCDEF)
step2 :: MutableArray32 -> Int -> Q -> IO Q
step2 ma off (Q z0123 z4567 z89AB zCDEF) = do
let (z0, z1, z2, z3) = decomp32 z0123
(z4, z5, z6, z7) = decomp32 z4567
x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
(x0, x1, x2, x3) = decomp32 x0123
(x4, x5, x6, x7) = decomp32 x4567
(x8, x9, xA, xB) = decomp32 x89AB
(xC, xD, xE, xF) = decomp32 xCDEF
mutableArrayWrite32 ma (off + 0) $ sbox_s56785 x3 x2 xC xD x8
mutableArrayWrite32 ma (off + 2) $ sbox_s56786 x1 x0 xE xF xD
mutableArrayWrite32 ma (off + 4) $ sbox_s56787 x7 x6 x8 x9 x3
mutableArrayWrite32 ma (off + 6) $ sbox_s56788 x5 x4 xA xB x7
return (Q x0123 x4567 x89AB xCDEF)
step3 :: MutableArray32 -> Int -> Q -> IO Q
step3 ma off (Q x0123 x4567 x89AB xCDEF) = do
let (x8, x9, xA, xB) = decomp32 x89AB
(xC, xD, xE, xF) = decomp32 xCDEF
z0123 = x0123 `xor` sbox_s56787 xD xF xC xE x8
z4567 = x89AB `xor` sbox_s56788 z0 z2 z1 z3 xA
z89AB = xCDEF `xor` sbox_s56785 z7 z6 z5 z4 x9
zCDEF = x4567 `xor` sbox_s56786 zA z9 zB z8 xB
(z0, z1, z2, z3) = decomp32 z0123
(z4, z5, z6, z7) = decomp32 z4567
(z8, z9, zA, zB) = decomp32 z89AB
(zC, zD, zE, zF) = decomp32 zCDEF
mutableArrayWrite32 ma (off + 0) $ sbox_s56785 z3 z2 zC zD z9
mutableArrayWrite32 ma (off + 2) $ sbox_s56786 z1 z0 zE zF zC
mutableArrayWrite32 ma (off + 4) $ sbox_s56787 z7 z6 z8 z9 z2
mutableArrayWrite32 ma (off + 6) $ sbox_s56788 z5 z4 zA zB z6
return (Q z0123 z4567 z89AB zCDEF)
step4 :: MutableArray32 -> Int -> Q -> IO Q
step4 ma off (Q z0123 z4567 z89AB zCDEF) = do
let (z0, z1, z2, z3) = decomp32 z0123
(z4, z5, z6, z7) = decomp32 z4567
x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
(x0, x1, x2, x3) = decomp32 x0123
(x4, x5, x6, x7) = decomp32 x4567
(x8, x9, xA, xB) = decomp32 x89AB
(xC, xD, xE, xF) = decomp32 xCDEF
mutableArrayWrite32 ma (off + 0) $ sbox_s56785 x8 x9 x7 x6 x3
mutableArrayWrite32 ma (off + 2) $ sbox_s56786 xA xB x5 x4 x7
mutableArrayWrite32 ma (off + 4) $ sbox_s56787 xC xD x3 x2 x8
mutableArrayWrite32 ma (off + 6) $ sbox_s56788 xE xF x1 x0 xD
return (Q x0123 x4567 x89AB xCDEF)
skip4 :: Q -> IO Q
skip4 (Q z0123 z4567 z89AB zCDEF) = do
let (z0, z1, z2, z3) = decomp32 z0123
(z4, z5, z6, z7) = decomp32 z4567
x0123 = z89AB `xor` sbox_s56787 z5 z7 z4 z6 z0
x4567 = z0123 `xor` sbox_s56788 x0 x2 x1 x3 z2
x89AB = z4567 `xor` sbox_s56785 x7 x6 x5 x4 z1
xCDEF = zCDEF `xor` sbox_s56786 xA x9 xB x8 z3
(x0, x1, x2, x3) = decomp32 x0123
(x4, x5, x6, x7) = decomp32 x4567
(x8, x9, xA, xB) = decomp32 x89AB
return (Q x0123 x4567 x89AB xCDEF)
-- S-Boxes
sbox_s1 :: Word8 -> Word32
sbox_s1 i = arrayRead32 t (fromIntegral i)
where
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\
\\xa1\xc9\xe0\xd6\x34\x6c\x48\x19\x61\xb7\x6d\x87\x22\x54\x0f\x2f\x2a\xbe\x32\xe1\xaa\x54\x16\x6b\x22\x56\x8e\x3a\xa2\xd3\x41\xd0\
\\x66\xdb\x40\xc8\xa7\x84\x39\x2f\x00\x4d\xff\x2f\x2d\xb9\xd2\xde\x97\x94\x3f\xac\x4a\x97\xc1\xd8\x52\x76\x44\xb7\xb5\xf4\x37\xa7\
\\xb8\x2c\xba\xef\xd7\x51\xd1\x59\x6f\xf7\xf0\xed\x5a\x09\x7a\x1f\x82\x7b\x68\xd0\x90\xec\xf5\x2e\x22\xb0\xc0\x54\xbc\x8e\x59\x35\
\\x4b\x6d\x2f\x7f\x50\xbb\x64\xa2\xd2\x66\x49\x10\xbe\xe5\x81\x2d\xb7\x33\x22\x90\xe9\x3b\x15\x9f\xb4\x8e\xe4\x11\x4b\xff\x34\x5d\
\\xfd\x45\xc2\x40\xad\x31\x97\x3f\xc4\xf6\xd0\x2e\x55\xfc\x81\x65\xd5\xb1\xca\xad\xa1\xac\x2d\xae\xa2\xd4\xb7\x6d\xc1\x9b\x0c\x50\
\\x88\x22\x40\xf2\x0c\x6e\x4f\x38\xa4\xe4\xbf\xd7\x4f\x5b\xa2\x72\x56\x4c\x1d\x2f\xc5\x9c\x53\x19\xb9\x49\xe3\x54\xb0\x46\x69\xfe\
\\xb1\xb6\xab\x8a\xc7\x13\x58\xdd\x63\x85\xc5\x45\x11\x0f\x93\x5d\x57\x53\x8a\xd5\x6a\x39\x04\x93\xe6\x3d\x37\xe0\x2a\x54\xf6\xb3\
\\x3a\x78\x7d\x5f\x62\x76\xa0\xb5\x19\xa6\xfc\xdf\x7a\x42\x20\x6a\x29\xf9\xd4\xd5\xf6\x1b\x18\x91\xbb\x72\x27\x5e\xaa\x50\x81\x67\
\\x38\x90\x10\x91\xc6\xb5\x05\xeb\x84\xc7\xcb\x8c\x2a\xd7\x5a\x0f\x87\x4a\x14\x27\xa2\xd1\x93\x6b\x2a\xd2\x86\xaf\xaa\x56\xd2\x91\
\\xd7\x89\x43\x60\x42\x5c\x75\x0d\x93\xb3\x9e\x26\x18\x71\x84\xc9\x6c\x00\xb3\x2d\x73\xe2\xbb\x14\xa0\xbe\xbc\x3c\x54\x62\x37\x79\
\\x64\x45\x9e\xab\x3f\x32\x8b\x82\x77\x18\xcf\x82\x59\xa2\xce\xa6\x04\xee\x00\x2e\x89\xfe\x78\xe6\x3f\xab\x09\x50\x32\x5f\xf6\xc2\
\\x81\x38\x3f\x05\x69\x63\xc5\xc8\x76\xcb\x5a\xd6\xd4\x99\x74\xc9\xca\x18\x0d\xcf\x38\x07\x82\xd5\xc7\xfa\x5c\xf6\x8a\xc3\x15\x11\
\\x35\xe7\x9e\x13\x47\xda\x91\xd0\xf4\x0f\x90\x86\xa7\xe2\x41\x9e\x31\x36\x62\x41\x05\x1e\xf4\x95\xaa\x57\x3b\x04\x4a\x80\x5d\x8d\
\\x54\x83\x00\xd0\x00\x32\x2a\x3c\xbf\x64\xcd\xdf\xba\x57\xa6\x8e\x75\xc6\x37\x2b\x50\xaf\xd3\x41\xa7\xc1\x32\x75\x91\x5a\x0b\xf5\
\\x6b\x54\xbf\xab\x2b\x0b\x14\x26\xab\x4c\xc9\xd7\x44\x9c\xcd\x82\xf7\xfb\xf2\x65\xab\x85\xc5\xf3\x1b\x55\xdb\x94\xaa\xd4\xe3\x24\
\\xcf\xa4\xbd\x3f\x2d\xea\xa3\xe2\x9e\x20\x4d\x02\xc8\xbd\x25\xac\xea\xdf\x55\xb3\xd5\xbd\x9e\x98\xe3\x12\x31\xb2\x2a\xd5\xad\x6c\
\\x95\x43\x29\xde\xad\xbe\x45\x28\xd8\x71\x0f\x69\xaa\x51\xc9\x0f\xaa\x78\x6b\xf6\x22\x51\x3f\x1e\xaa\x51\xa7\x9b\x2a\xd3\x44\xcc\
\\x7b\x5a\x41\xf0\xd3\x7c\xfb\xad\x1b\x06\x95\x05\x41\xec\xe4\x91\xb4\xc3\x32\xe6\x03\x22\x68\xd4\xc9\x60\x0a\xcc\xce\x38\x7e\x6d\
\\xbf\x6b\xb1\x6c\x6a\x70\xfb\x78\x0d\x03\xd9\xc9\xd4\xdf\x39\xde\xe0\x10\x63\xda\x47\x36\xf4\x64\x5a\xd3\x28\xd8\xb3\x47\xcc\x96\
\\x75\xbb\x0f\xc3\x98\x51\x1b\xfb\x4f\xfb\xcc\x35\xb5\x8b\xcf\x6a\xe1\x1f\x0a\xbc\xbf\xc5\xfe\x4a\xa7\x0a\xec\x10\xac\x39\x57\x0a\
\\x3f\x04\x44\x2f\x61\x88\xb1\x53\xe0\x39\x7a\x2e\x57\x27\xcb\x79\x9c\xeb\x41\x8f\x1c\xac\xd6\x8d\x2a\xd3\x7c\x96\x01\x75\xcb\x9d\
\\xc6\x9d\xff\x09\xc7\x5b\x65\xf0\xd9\xdb\x40\xd8\xec\x0e\x77\x79\x47\x44\xea\xd4\xb1\x1c\x32\x74\xdd\x24\xcb\x9e\x7e\x1c\x54\xbd\
\\xf0\x11\x44\xf9\xd2\x24\x0e\xb1\x96\x75\xb3\xfd\xa3\xac\x37\x55\xd4\x7c\x27\xaf\x51\xc8\x5f\x4d\x56\x90\x75\x96\xa5\xbb\x15\xe6\
\\x58\x03\x04\xf0\xca\x04\x2c\xf1\x01\x1a\x37\xea\x8d\xbf\xaa\xdb\x35\xba\x3e\x4a\x35\x26\xff\xa0\xc3\x7b\x4d\x09\xbc\x30\x6e\xd9\
\\x98\xa5\x26\x66\x56\x48\xf7\x25\xff\x5e\x56\x9d\x0c\xed\x63\xd0\x7c\x63\xb2\xcf\x70\x0b\x45\xe1\xd5\xea\x50\xf1\x85\xa9\x28\x72\
\\xaf\x1f\xbd\xa7\xd4\x23\x48\x70\xa7\x87\x0b\xf3\x2d\x3b\x4d\x79\x42\xe0\x41\x98\x0c\xd0\xed\xe7\x26\x47\x0d\xb8\xf8\x81\x81\x4c\
\\x47\x4d\x6a\xd7\x7c\x0c\x5e\x5c\xd1\x23\x19\x59\x38\x1b\x72\x98\xf5\xd2\xf4\xdb\xab\x83\x86\x53\x6e\x2f\x1e\x23\x83\x71\x9c\x9e\
\\xbd\x91\xe0\x46\x9a\x56\x45\x6e\xdc\x39\x20\x0c\x20\xc8\xc5\x71\x96\x2b\xda\x1c\xe1\xe6\x96\xff\xb1\x41\xab\x08\x7c\xca\x89\xb9\
\\x1a\x69\xe7\x83\x02\xcc\x48\x43\xa2\xf7\xc5\x79\x42\x9e\xf4\x7d\x42\x7b\x16\x9c\x5a\xc9\xf0\x49\xdd\x8f\x0f\x00\x5c\x81\x65\xbf"#
sbox_s2 :: Word8 -> Word32
sbox_s2 i = arrayRead32 t (fromIntegral i)
where
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\
\\xd1\xda\x41\x81\x3b\x09\x2a\xb1\xf9\x97\xf1\xc1\xa5\xe6\xcf\x7b\x01\x42\x0d\xdb\xe4\xe7\xef\x5b\x25\xa1\xff\x41\xe1\x80\xf8\x06\
\\x1f\xc4\x10\x80\x17\x9b\xee\x7a\xd3\x7a\xc6\xa9\xfe\x58\x30\xa4\x98\xde\x8b\x7f\x77\xe8\x3f\x4e\x79\x92\x92\x69\x24\xfa\x9f\x7b\
\\xe1\x13\xc8\x5b\xac\xc4\x00\x83\xd7\x50\x35\x25\xf7\xea\x61\x5f\x62\x14\x31\x54\x0d\x55\x4b\x63\x5d\x68\x11\x21\xc8\x66\xc3\x59\
\\x3d\x63\xcf\x73\xce\xe2\x34\xc0\xd4\xd8\x7e\x87\x5c\x67\x2b\x21\x07\x1f\x61\x81\x39\xf7\x62\x7f\x36\x1e\x30\x84\xe4\xeb\x57\x3b\
\\x60\x2f\x64\xa4\xd6\x3a\xcd\x9c\x1b\xbc\x46\x35\x9e\x81\x03\x2d\x27\x01\xf5\x0c\x99\x84\x7a\xb4\xa0\xe3\xdf\x79\xba\x6c\xf3\x8c\
\\x10\x84\x30\x94\x25\x37\xa9\x5e\xf4\x6f\x6f\xfe\xa1\xff\x3b\x1f\x20\x8c\xfb\x6a\x8f\x45\x8c\x74\xd9\xe0\xa2\x27\x4e\xc7\x3a\x34\
\\xfc\x88\x4f\x69\x3e\x4d\xe8\xdf\xef\x0e\x00\x88\x35\x59\x64\x8d\x8a\x45\x38\x8c\x1d\x80\x43\x66\x72\x1d\x9b\xfd\xa5\x86\x84\xbb\
\\xe8\x25\x63\x33\x84\x4e\x82\x12\x12\x8d\x80\x98\xfe\xd3\x3f\xb4\xce\x28\x0a\xe1\x27\xe1\x9b\xa5\xd5\xa6\xc2\x52\xe4\x97\x54\xbd\
\\xc5\xd6\x55\xdd\xeb\x66\x70\x64\x77\x84\x0b\x4d\xa1\xb6\xa8\x01\x84\xdb\x26\xa9\xe0\xb5\x67\x14\x21\xf0\x43\xb7\xe5\xd0\x58\x60\
\\x54\xf0\x30\x84\x06\x6f\xf4\x72\xa3\x1a\xa1\x53\xda\xdc\x47\x55\xb5\x62\x5d\xbf\x68\x56\x1b\xe6\x83\xca\x6b\x94\x2d\x6e\xd2\x3b\
\\xec\xcf\x01\xdb\xa6\xd3\xd0\xba\xb6\x80\x3d\x5c\xaf\x77\xa7\x09\x33\xb4\xa3\x4c\x39\x7b\xc8\xd6\x5e\xe2\x2b\x95\x5f\x0e\x53\x04\
\\x81\xed\x6f\x61\x20\xe7\x43\x64\xb4\x5e\x13\x78\xde\x18\x63\x9b\x88\x1c\xa1\x22\xb9\x67\x26\xd1\x80\x49\xa7\xe8\x22\xb7\xda\x7b\
\\x5e\x55\x2d\x25\x52\x72\xd2\x37\x79\xd2\x95\x1c\xc6\x0d\x89\x4c\x48\x8c\xb4\x02\x1b\xa4\xfe\x5b\xa4\xb0\x9f\x6b\x1c\xa8\x15\xcf\
\\xa2\x0c\x30\x05\x88\x71\xdf\x63\xb9\xde\x2f\xcb\x0c\xc6\xc9\xe9\x0b\xee\xff\x53\xe3\x21\x45\x17\xb4\x54\x28\x35\x9f\x63\x29\x3c\
\\xee\x41\xe7\x29\x6e\x1d\x2d\x7c\x50\x04\x52\x86\x1e\x66\x85\xf3\xf3\x34\x01\xc6\x30\xa2\x2c\x95\x31\xa7\x08\x50\x60\x93\x0f\x13\
\\x73\xf9\x84\x17\xa1\x26\x98\x59\xec\x64\x5c\x44\x52\xc8\x77\xa9\xcd\xff\x33\xa6\xa0\x2b\x17\x41\x7c\xba\xd9\xa2\x21\x80\x03\x6f\
\\x50\xd9\x9c\x08\xcb\x3f\x48\x61\xc2\x6b\xd7\x65\x64\xa3\xf6\xab\x80\x34\x26\x76\x25\xa7\x5e\x7b\xe4\xe6\xd1\xfc\x20\xc7\x10\xe6\
\\xcd\xf0\xb6\x80\x17\x84\x4d\x3b\x31\xee\xf8\x4d\x7e\x08\x24\xe4\x2c\xcb\x49\xeb\x84\x6a\x3b\xae\x8f\xf7\x78\x88\xee\x5d\x60\xf6\
\\x7a\xf7\x56\x73\x2f\xdd\x5c\xdb\xa1\x16\x31\xc1\x30\xf6\x6f\x43\xb3\xfa\xec\x54\x15\x7f\xd7\xfa\xef\x85\x79\xcc\xd1\x52\xde\x58\
\\xdb\x2f\xfd\x5e\x8f\x32\xce\x19\x30\x6a\xf9\x7a\x02\xf0\x3e\xf8\x99\x31\x9a\xd5\xc2\x42\xfa\x0f\xa7\xe3\xeb\xb0\xc6\x8e\x49\x06\
\\xb8\xda\x23\x0c\x80\x82\x30\x28\xdc\xde\xf3\xc8\xd3\x5f\xb1\x71\x08\x8a\x1b\xc8\xbe\xc0\xc5\x60\x61\xa3\xc9\xe8\xbc\xa8\xf5\x4d\
\\xc7\x2f\xef\xfa\x22\x82\x2e\x99\x82\xc5\x70\xb4\xd8\xd9\x4e\x89\x8b\x1c\x34\xbc\x30\x1e\x16\xe6\x27\x3b\xe9\x79\xb0\xff\xea\xa6\
\\x61\xd9\xb8\xc6\x00\xb2\x48\x69\xb7\xff\xce\x3f\x08\xdc\x28\x3b\x43\xda\xf6\x5a\xf7\xe1\x97\x98\x76\x19\xb7\x2f\x8f\x1c\x9b\xa4\
\\xdc\x86\x37\xa0\x16\xa7\xd3\xb1\x9f\xc3\x93\xb7\xa7\x13\x6e\xeb\xc6\xbc\xc6\x3e\x1a\x51\x37\x42\xef\x68\x28\xbc\x52\x03\x65\xd6\
\\x2d\x6a\x77\xab\x35\x27\xed\x4b\x82\x1f\xd2\x16\x09\x5c\x6e\x2e\xdb\x92\xf2\xfb\x5e\xea\x29\xcb\x14\x58\x92\xf5\x91\x58\x4f\x7f\
\\x54\x83\x69\x7b\x26\x67\xa8\xcc\x85\x19\x60\x48\x8c\x4b\xac\xea\x83\x38\x60\xd4\x0d\x23\xe0\xf9\x6c\x38\x7e\x8a\x0a\xe6\xd2\x49\
\\xb2\x84\x60\x0c\xd8\x35\x73\x1d\xdc\xb1\xc6\x47\xac\x4c\x56\xea\x3e\xbd\x81\xb3\x23\x0e\xab\xb0\x64\x38\xbc\x87\xf0\xb5\xb1\xfa\
\\x8f\x5e\xa2\xb3\xfc\x18\x46\x42\x0a\x03\x6b\x7a\x4f\xb0\x89\xbd\x64\x9d\xa5\x89\xa3\x45\x41\x5e\x5c\x03\x83\x23\x3e\x5d\x3b\xb9\
\\x43\xd7\x95\x72\x7e\x6d\xd0\x7c\x06\xdf\xdf\x1e\x6c\x6c\xc4\xef\x71\x60\xa5\x39\x73\xbf\xbe\x70\x83\x87\x76\x05\x45\x23\xec\xf1"#
sbox_s3 :: Word8 -> Word32
sbox_s3 i = arrayRead32 t (fromIntegral i)
where
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\
\\x55\x3f\xb2\xc0\x48\x9a\xe2\x2b\xd4\xef\x97\x94\x12\x5e\x3f\xbc\x21\xff\xfc\xee\x82\x5b\x1b\xfd\x92\x55\xc5\xed\x12\x57\xa2\x40\
\\x4e\x1a\x83\x02\xba\xe0\x7f\xff\x52\x82\x46\xe7\x8e\x57\x14\x0e\x33\x73\xf7\xbf\x8c\x9f\x81\x88\xa6\xfc\x4e\xe8\xc9\x82\xb5\xa5\
\\xa8\xc0\x1d\xb7\x57\x9f\xc2\x64\x67\x09\x4f\x31\xf2\xbd\x3f\x5f\x40\xff\xf7\xc1\x1f\xb7\x8d\xfc\x8e\x6b\xd2\xc1\x43\x7b\xe5\x9b\
\\x99\xb0\x3d\xbf\xb5\xdb\xc6\x4b\x63\x8d\xc0\xe6\x55\x81\x9d\x99\xa1\x97\xc8\x1c\x4a\x01\x2d\x6e\xc5\x88\x4a\x28\xcc\xc3\x6f\x71\
\\xb8\x43\xc2\x13\x6c\x07\x43\xf1\x83\x09\x89\x3c\x0f\xed\xdd\x5f\x2f\x7f\xe8\x50\xd7\xc0\x7f\x7e\x02\x50\x7f\xbf\x5a\xfb\x9a\x04\
\\xa7\x47\xd2\xd0\x16\x51\x19\x2e\xaf\x70\xbf\x3e\x58\xc3\x13\x80\x5f\x98\x30\x2e\x72\x7c\xc3\xc4\x0a\x0f\xb4\x02\x0f\x7f\xef\x82\
\\x8c\x96\xfd\xad\x5d\x2c\x2a\xae\x8e\xe9\x9a\x49\x50\xda\x88\xb8\x84\x27\xf4\xa0\x1e\xac\x57\x90\x79\x6f\xb4\x49\x82\x52\xdc\x15\
\\xef\xbd\x7d\x9b\xa6\x72\x59\x7d\xad\xa8\x40\xd8\x45\xf5\x45\x04\xfa\x5d\x74\x03\xe8\x3e\xc3\x05\x4f\x91\x75\x1a\x92\x56\x69\xc2\
\\x23\xef\xe9\x41\xa9\x03\xf1\x2e\x60\x27\x0d\xf2\x02\x76\xe4\xb6\x94\xfd\x65\x74\x92\x79\x85\xb2\x82\x76\xdb\xcb\x02\x77\x81\x76\
\\xf8\xaf\x91\x8d\x4e\x48\xf7\x9e\x8f\x61\x6d\xdf\xe2\x9d\x84\x0e\x84\x2f\x7d\x83\x34\x0c\xe5\xc8\x96\xbb\xb6\x82\x93\xb4\xb1\x48\
\\xef\x30\x3c\xab\x98\x4f\xaf\x28\x77\x9f\xaf\x9b\x92\xdc\x56\x0d\x22\x4d\x1e\x20\x84\x37\xaa\x88\x7d\x29\xdc\x96\x27\x56\xd3\xdc\
\\x8b\x90\x7c\xee\xb5\x1f\xd2\x40\xe7\xc0\x7c\xe3\xe5\x66\xb4\xa1\xc3\xe9\x61\x5e\x3c\xf8\x20\x9d\x60\x94\xd1\xe3\xcd\x9c\xa3\x41\
\\x5c\x76\x46\x0e\x00\xea\x98\x3b\xd4\xd6\x78\x81\xfd\x47\x57\x2c\xf7\x6c\xed\xd9\xbd\xa8\x22\x9c\x12\x7d\xad\xaa\x43\x8a\x07\x4e\
\\x1f\x97\xc0\x90\x08\x1b\xdb\x8a\x93\xa0\x7e\xbe\xb9\x38\xca\x15\x97\xb0\x3c\xff\x3d\xc2\xc0\xf8\x8d\x1a\xb2\xec\x64\x38\x0e\x51\
\\x68\xcc\x7b\xfb\xd9\x0f\x27\x88\x12\x49\x01\x81\x5d\xe5\xff\xd4\xdd\x7e\xf8\x6a\x76\xa2\xe2\x14\xb9\xa4\x03\x68\x92\x5d\x95\x8f\
\\x4b\x39\xff\xfa\xba\x39\xae\xe9\xa4\xff\xd3\x0b\xfa\xf7\x93\x3b\x6d\x49\x86\x23\x19\x3c\xbc\xfa\x27\x62\x75\x45\x82\x5c\xf4\x7a\
\\x61\xbd\x8b\xa0\xd1\x1e\x42\xd1\xce\xad\x04\xf4\x12\x7e\xa3\x92\x10\x42\x8d\xb7\x82\x72\xa9\x72\x92\x70\xc4\xa8\x12\x7d\xe5\x0b\
\\x28\x5b\xa1\xc8\x3c\x62\xf4\x4f\x35\xc0\xea\xa5\xe8\x05\xd2\x31\x42\x89\x29\xfb\xb4\xfc\xdf\x82\x4f\xb6\x6a\x53\x0e\x7d\xc1\x5b\
\\x1f\x08\x1f\xab\x10\x86\x18\xae\xfc\xfd\x08\x6d\xf9\xff\x28\x89\x69\x4b\xcc\x11\x23\x6a\x5c\xae\x12\xde\xca\x4d\x2c\x3f\x8c\xc5\
\\xd2\xd0\x2d\xfe\xf8\xef\x58\x96\xe4\xcf\x52\xda\x95\x15\x5b\x67\x49\x4a\x48\x8c\xb9\xb6\xa8\x0c\x5c\x8f\x82\xbc\x89\xd3\x6b\x45\
\\x3a\x60\x94\x37\xec\x00\xc9\xa9\x44\x71\x52\x53\x0a\x87\x4b\x49\xd7\x73\xbc\x40\x7c\x34\x67\x1c\x02\x71\x7e\xf6\x4f\xeb\x55\x36\
\\xa2\xd0\x2f\xff\xd2\xbf\x60\xc4\xd4\x3f\x03\xc0\x50\xb4\xef\x6d\x07\x47\x8c\xd1\x00\x6e\x18\x88\xa2\xe5\x3f\x55\xb9\xe6\xd4\xbc\
\\xa2\x04\x80\x16\x97\x57\x38\x33\xd7\x20\x7d\x67\xde\x0f\x8f\x3d\x72\xf8\x7b\x33\xab\xcc\x4f\x33\x76\x88\xc5\x5d\x7b\x00\xa6\xb0\
\\x94\x7b\x00\x01\x57\x00\x75\xd2\xf9\xbb\x88\xf8\x89\x42\x01\x9e\x42\x64\xa5\xff\x85\x63\x02\xe0\x72\xdb\xd9\x2b\xee\x97\x1b\x69\
\\x6e\xa2\x2f\xde\x5f\x08\xae\x2b\xaf\x7a\x61\x6d\xe5\xc9\x87\x67\xcf\x1f\xeb\xd2\x61\xef\xc8\xc2\xf1\xac\x25\x71\xcc\x82\x39\xc2\
\\x67\x21\x4c\xb8\xb1\xe5\x83\xd1\xb7\xdc\x3e\x62\x7f\x10\xbd\xce\xf9\x0a\x5c\x38\x0f\xf0\x44\x3d\x60\x6e\x6d\xc6\x60\x54\x3a\x49\
\\x57\x27\xc1\x48\x2b\xe9\x8a\x1d\x8a\xb4\x17\x38\x20\xe1\xbe\x24\xaf\x96\xda\x0f\x68\x45\x84\x25\x99\x83\x3b\xe5\x60\x0d\x45\x7d\
\\x28\x2f\x93\x50\x83\x34\xb3\x62\xd9\x1d\x11\x20\x2b\x6d\x8d\xa0\x64\x2b\x1e\x31\x9c\x30\x5a\x00\x52\xbc\xe6\x88\x1b\x03\x58\x8a\
\\xf7\xba\xef\xd5\x41\x42\xed\x9c\xa4\x31\x5c\x11\x83\x32\x3e\xc5\xdf\xef\x46\x36\xa1\x33\xc5\x01\xe9\xd3\x53\x1c\xee\x35\x37\x83"#
sbox_s4 :: Word8 -> Word32
sbox_s4 i = arrayRead32 t (fromIntegral i)
where
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\
\\xee\x4d\x11\x1a\x0f\xca\x51\x67\x71\xff\x90\x4c\x2d\x19\x5f\xfe\x1a\x05\x64\x5f\x0c\x13\xfe\xfe\x08\x1b\x08\xca\x05\x17\x01\x21\
\\x80\x53\x01\x00\xe8\x3e\x5e\xfe\xac\x9a\xf4\xf8\x7f\xe7\x27\x01\xd2\xb8\xee\x5f\x06\xdf\x42\x61\xbb\x9e\x9b\x8a\x72\x93\xea\x25\
\\xce\x84\xff\xdf\xf5\x71\x88\x01\x3d\xd6\x4b\x04\xa2\x6f\x26\x3b\x7e\xd4\x84\x00\x54\x7e\xeb\xe6\x44\x6d\x4c\xa0\x6c\xf3\xd6\xf5\
\\x26\x49\xab\xdf\xae\xa0\xc7\xf5\x36\x33\x8c\xc1\x50\x3f\x7e\x93\xd3\x77\x20\x61\x11\xb6\x38\xe1\x72\x50\x0e\x03\xf8\x0e\xb2\xbb\
\\xab\xe0\x50\x2e\xec\x8d\x77\xde\x57\x97\x1e\x81\xe1\x4f\x67\x46\xc9\x33\x54\x00\x69\x20\x31\x8f\x08\x1d\xbb\x99\xff\xc3\x04\xa5\
\\x4d\x35\x18\x05\x7f\x3d\x5c\xe3\xa6\xc8\x66\xc6\x5d\x5b\xcc\xa9\xda\xec\x6f\xea\x9f\x92\x6f\x91\x9f\x46\x22\x2f\x39\x91\x46\x7d\
\\xa5\xbf\x6d\x8e\x11\x43\xc4\x4f\x43\x95\x83\x02\xd0\x21\x4e\xeb\x02\x20\x83\xb8\x3f\xb6\x18\x0c\x18\xf8\x93\x1e\x28\x16\x58\xe6\
\\x26\x48\x6e\x3e\x8b\xd7\x8a\x70\x74\x77\xe4\xc1\xb5\x06\xe0\x7c\xf3\x2d\x0a\x25\x79\x09\x8b\x02\xe4\xea\xbb\x81\x28\x12\x3b\x23\
\\x69\xde\xad\x38\x15\x74\xca\x16\xdf\x87\x1b\x62\x21\x1c\x40\xb7\xa5\x1a\x9e\xf9\x00\x14\x37\x7b\x04\x1e\x8a\xc8\x09\x11\x40\x03\
\\xbd\x59\xe4\xd2\xe3\xd1\x56\xd5\x4f\xe8\x76\xd5\x2f\x91\xa3\x40\x55\x7b\xe8\xde\x00\xea\xe4\xa7\x0c\xe5\xc2\xec\x4d\xb4\xbb\xa6\
\\xe7\x56\xbd\xff\xdd\x33\x69\xac\xec\x17\xb0\x35\x06\x57\x23\x27\x99\xaf\xc8\xb0\x56\xc8\xc3\x91\x6b\x65\x81\x1c\x5e\x14\x61\x19\
\\x6e\x85\xcb\x75\xbe\x07\xc0\x02\xc2\x32\x55\x77\x89\x3f\xf4\xec\x5b\xbf\xc9\x2d\xd0\xec\x3b\x25\xb7\x80\x1a\xb7\x8d\x6d\x3b\x24\
\\x20\xc7\x63\xef\xc3\x66\xa5\xfc\x9c\x38\x28\x80\x0a\xce\x32\x05\xaa\xc9\x54\x8a\xec\xa1\xd7\xc7\x04\x1a\xfa\x32\x1d\x16\x62\x5a\
\\x67\x01\x90\x2c\x9b\x75\x7a\x54\x31\xd4\x77\xf7\x91\x26\xb0\x31\x36\xcc\x6f\xdb\xc7\x0b\x8b\x46\xd9\xe6\x6a\x48\x56\xe5\x5a\x79\
\\x02\x6a\x4c\xeb\x52\x43\x7e\xff\x2f\x8f\x76\xb4\x0d\xf9\x80\xa5\x86\x74\xcd\xe3\xed\xda\x04\xeb\x17\xa9\xbe\x04\x2c\x18\xf4\xdf\
\\xb7\x74\x7f\x9d\xab\x2a\xf7\xb4\xef\xc3\x4d\x20\x2e\x09\x6b\x7c\x17\x41\xa2\x54\xe5\xb6\xa0\x35\x21\x3d\x42\xf6\x2c\x1c\x7c\x26\
\\x61\xc2\xf5\x0f\x65\x52\xda\xf9\xd2\xc2\x31\xf8\x25\x13\x0f\x69\xd8\x16\x7f\xa2\x04\x18\xf2\xc8\x00\x1a\x96\xa6\x0d\x15\x26\xab\
\\x63\x31\x5c\x21\x5e\x0a\x72\xec\x49\xba\xfe\xfd\x18\x79\x08\xd9\x8d\x0d\xbd\x86\x31\x11\x70\xa7\x3e\x9b\x64\x0c\xcc\x3e\x10\xd7\
\\xd5\xca\xd3\xb6\x0c\xae\xc3\x88\xf7\x30\x01\xe1\x6c\x72\x8a\xff\x71\xea\xe2\xa1\x1f\x9a\xf3\x6e\xcf\xcb\xd1\x2f\xc1\xde\x84\x17\
\\xac\x07\xbe\x6b\xcb\x44\xa1\xd8\x8b\x9b\x0f\x56\x01\x39\x88\xc3\xb1\xc5\x2f\xca\xb4\xbe\x31\xcd\xd8\x78\x28\x06\x12\xa3\xa4\xe2\
\\x6f\x7d\xe5\x32\x58\xfd\x7e\xb6\xd0\x1e\xe9\x00\x24\xad\xff\xc2\xf4\x99\x0f\xc5\x97\x11\xaa\xc5\x00\x1d\x7b\x95\x82\xe5\xe7\xd2\
\\x10\x98\x73\xf6\x00\x61\x30\x96\xc3\x2d\x95\x21\xad\xa1\x21\xff\x29\x90\x84\x15\x7f\xbb\x97\x7f\xaf\x9e\xb3\xdb\x29\xc9\xed\x2a\
\\x5c\xe2\xa4\x65\xa7\x30\xf3\x2c\xd0\xaa\x3f\xe8\x8a\x5c\xc0\x91\xd4\x9e\x2c\xe7\x0c\xe4\x54\xa9\xd6\x0a\xcd\x86\x01\x5f\x19\x19\
\\x77\x07\x91\x03\xde\xa0\x3a\xf6\x78\xa8\x56\x5e\xde\xe3\x56\xdf\x21\xf0\x5c\xbe\x8b\x75\xe3\x87\xb3\xc5\x06\x51\xb8\xa5\xc3\xef\
\\xd8\xee\xb6\xd2\xe5\x23\xbe\x77\xc2\x15\x45\x29\x2f\x69\xef\xdf\xaf\xe6\x7a\xfb\xf4\x70\xc4\xb2\xf3\xe0\xeb\x5b\xd6\xcc\x98\x76\
\\x39\xe4\x46\x0c\x1f\xda\x85\x38\x19\x87\x83\x2f\xca\x00\x73\x67\xa9\x91\x44\xf8\x29\x6b\x29\x9e\x49\x2f\xc2\x95\x92\x66\xbe\xab\
\\xb5\x67\x6e\x69\x9b\xd3\xdd\xda\xdf\x7e\x05\x2f\xdb\x25\x70\x1c\x1b\x5e\x51\xee\xf6\x53\x24\xe6\x6a\xfc\xe3\x6c\x03\x16\xcc\x04\
\\x86\x44\x21\x3e\xb7\xdc\x59\xd0\x79\x65\x29\x1f\xcc\xd6\xfd\x43\x41\x82\x39\x79\x93\x2b\xcd\xf6\xb6\x57\xc3\x4d\x4e\xdf\xd2\x82\
\\x7a\xe5\x29\x0c\x3c\xb9\x53\x6b\x85\x1e\x20\xfe\x98\x33\x55\x7e\x13\xec\xf0\xb0\xd3\xff\xb3\x72\x3f\x85\xc5\xc1\x0a\xef\x7e\xd2"#
sbox_s5 :: Word8 -> Word32
sbox_s5 i = arrayRead32 t (fromIntegral i)
where
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\
\\x5f\x48\x0a\x01\x04\x12\xb2\xaa\x25\x98\x14\xfc\x41\xd0\xef\xe2\x4e\x40\xb4\x8d\x24\x8e\xb6\xfb\x8d\xba\x1c\xfe\x41\xa9\x9b\x02\
\\x1a\x55\x0a\x04\xba\x8f\x65\xcb\x72\x51\xf4\xe7\x95\xa5\x17\x25\xc1\x06\xec\xd7\x97\xa5\x98\x0a\xc5\x39\xb9\xaa\x4d\x79\xfe\x6a\
\\xf2\xf3\xf7\x63\x68\xaf\x80\x40\xed\x0c\x9e\x56\x11\xb4\x95\x8b\xe1\xeb\x5a\x88\x87\x09\xe6\xb0\xd7\xe0\x71\x56\x4e\x29\xfe\xa7\
\\x63\x66\xe5\x2d\x02\xd1\xc0\x00\xc4\xac\x8e\x05\x93\x77\xf5\x71\x0c\x05\x37\x2a\x57\x85\x35\xf2\x22\x61\xbe\x02\xd6\x42\xa0\xc9\
\\xdf\x13\xa2\x80\x74\xb5\x5b\xd2\x68\x21\x99\xc0\xd4\x21\xe5\xec\x53\xfb\x3c\xe8\xc8\xad\xed\xb3\x28\xa8\x7f\xc9\x3d\x95\x99\x81\
\\x5c\x1f\xf9\x00\xfe\x38\xd3\x99\x0c\x4e\xff\x0b\x06\x24\x07\xea\xaa\x2f\x4f\xb1\x4f\xb9\x69\x76\x90\xc7\x95\x05\xb0\xa8\xa7\x74\
\\xef\x55\xa1\xff\xe5\x9c\xa2\xc2\xa6\xb6\x2d\x27\xe6\x6a\x42\x63\xdf\x65\x00\x1f\x0e\xc5\x09\x66\xdf\xdd\x55\xbc\x29\xde\x06\x55\
\\x91\x1e\x73\x9a\x17\xaf\x89\x75\x32\xc7\x91\x1c\x89\xf8\x94\x68\x0d\x01\xe9\x80\x52\x47\x55\xf4\x03\xb6\x3c\xc9\x0c\xc8\x44\xb2\
\\xbc\xf3\xf0\xaa\x87\xac\x36\xe9\xe5\x3a\x74\x26\x01\xb3\xd8\x2b\x1a\x9e\x74\x49\x64\xee\x2d\x7e\xcd\xdb\xb1\xda\x01\xc9\x49\x10\
\\xb8\x68\xbf\x80\x0d\x26\xf3\xfd\x93\x42\xed\xe7\x04\xa5\xc2\x84\x63\x67\x37\xb6\x50\xf5\xb6\x16\xf2\x47\x66\xe3\x8e\xca\x36\xc1\
\\x13\x6e\x05\xdb\xfe\xf1\x83\x91\xfb\x88\x7a\x37\xd6\xe7\xf7\xd4\xc7\xfb\x7d\xc9\x30\x63\xfc\xdf\xb6\xf5\x89\xde\xec\x29\x41\xda\
\\x26\xe4\x66\x95\xb7\x56\x64\x19\xf6\x54\xef\xc5\xd0\x8d\x58\xb7\x48\x92\x54\x01\xc1\xba\xcb\x7f\xe5\xff\x55\x0f\xb6\x08\x30\x49\
\\x5b\xb5\xd0\xe8\x87\xd7\x2e\x5a\xab\x6a\x6e\xe1\x22\x3a\x66\xce\xc6\x2b\xf3\xcd\x9e\x08\x85\xf9\x68\xcb\x3e\x47\x08\x6c\x01\x0f\
\\xa2\x1d\xe8\x20\xd1\x8b\x69\xde\xf3\xf6\x57\x77\xfa\x02\xc3\xf6\x40\x7e\xda\xc3\xcb\xb3\xd5\x50\x17\x93\x08\x4d\xb0\xd7\x0e\xba\
\\x0a\xb3\x78\xd5\xd9\x51\xfb\x0c\xde\xd7\xda\x56\x41\x24\xbb\xe4\x94\xca\x0b\x56\x0f\x57\x55\xd1\xe0\xe1\xe5\x6e\x61\x84\xb5\xbe\
\\x58\x0a\x24\x9f\x94\xf7\x4b\xc0\xe3\x27\x88\x8e\x9f\x7b\x55\x61\xc3\xdc\x02\x80\x05\x68\x77\x15\x64\x6c\x6b\xd7\x44\x90\x4d\xb3\
\\x66\xb4\xf0\xa3\xc0\xf1\x64\x8a\x69\x7e\xd5\xaf\x49\xe9\x2f\xf6\x30\x9e\x37\x4f\x2c\xb6\x35\x6a\x85\x80\x85\x73\x49\x91\xf8\x40\
\\x76\xf0\xae\x02\x08\x3b\xe8\x4d\x28\x42\x1c\x9a\x44\x48\x94\x06\x73\x6e\x4c\xb8\xc1\x09\x29\x10\x8b\xc9\x5f\xc6\x7d\x86\x9c\xf4\
\\x13\x4f\x61\x6f\x2e\x77\x11\x8d\xb3\x1b\x2b\xe1\xaa\x90\xb4\x72\x3c\xa5\xd7\x17\x7d\x16\x1b\xba\x9c\xad\x90\x10\xaf\x46\x2b\xa2\
\\x9f\xe4\x59\xd2\x45\xd3\x45\x59\xd9\xf2\xda\x13\xdb\xc6\x54\x87\xf3\xe4\xf9\x4e\x17\x6d\x48\x6f\x09\x7c\x13\xea\x63\x1d\xa5\xc7\
\\x44\x5f\x73\x82\x17\x56\x83\xf4\xcd\xc6\x6a\x97\x70\xbe\x02\x88\xb3\xcd\xcf\x72\x6e\x5d\xd2\xf3\x20\x93\x60\x79\x45\x9b\x80\xa5\
\\xbe\x60\xe2\xdb\xa9\xc2\x31\x01\xeb\xa5\x31\x5c\x22\x4e\x42\xf2\x1c\x5c\x15\x72\xf6\x72\x1b\x2c\x1a\xd2\xff\xf3\x8c\x25\x40\x4e\
\\x32\x4e\xd7\x2f\x40\x67\xb7\xfd\x05\x23\x13\x8e\x5c\xa3\xbc\x78\xdc\x0f\xd6\x6e\x75\x92\x22\x83\x78\x4d\x6b\x17\x58\xeb\xb1\x6e\
\\x44\x09\x4f\x85\x3f\x48\x1d\x87\xfc\xfe\xae\x7b\x77\xb5\xff\x76\x8c\x23\x02\xbf\xaa\xf4\x75\x56\x5f\x46\xb0\x2a\x2b\x09\x28\x01\
\\x3d\x38\xf5\xf7\x0c\xa8\x1f\x36\x52\xaf\x4a\x8a\x66\xd5\xe7\xc0\xdf\x3b\x08\x74\x95\x05\x51\x10\x1b\x5a\xd7\xa8\xf6\x1e\xd5\xad\
\\x6c\xf6\xe4\x79\x20\x75\x81\x84\xd0\xce\xfa\x65\x88\xf7\xbe\x58\x4a\x04\x68\x26\x0f\xf6\xf8\xf3\xa0\x9c\x7f\x70\x53\x46\xab\xa0\
\\x5c\xe9\x6c\x28\xe1\x76\xed\xa3\x6b\xac\x30\x7f\x37\x68\x29\xd2\x85\x36\x0f\xa9\x17\xe3\xfe\x2a\x24\xb7\x97\x67\xf5\xa9\x6b\x20\
\\xd6\xcd\x25\x95\x68\xff\x1e\xbf\x75\x55\x44\x2c\xf1\x9f\x06\xbe\xf9\xe0\x65\x9a\xee\xb9\x49\x1d\x34\x01\x07\x18\xbb\x30\xca\xb8\
\\xe8\x22\xfe\x15\x88\x57\x09\x83\x75\x0e\x62\x49\xda\x62\x7e\x55\x5e\x76\xff\xa8\xb1\x53\x45\x46\x6d\x47\xde\x08\xef\xe9\xe7\xd4"#
sbox_s6 :: Word8 -> Word32
sbox_s6 i = arrayRead32 t (fromIntegral i)
where
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\
\\xa3\x14\x96\x19\xfe\xc9\x4b\xd5\xa1\x14\x17\x4a\xea\xa0\x18\x66\xa0\x84\xdb\x2d\x09\xa8\x48\x6f\xa8\x88\x61\x4a\x29\x00\xaf\x98\
\\x01\x66\x59\x91\xe1\x99\x28\x63\xc8\xf3\x0c\x60\x2e\x78\xef\x3c\xd0\xd5\x19\x32\xcf\x0f\xec\x14\xf7\xca\x07\xd2\xd0\xa8\x20\x72\
\\xfd\x41\x19\x7e\x93\x05\xa6\xb0\xe8\x6b\xe3\xda\x74\xbe\xd3\xcd\x37\x2d\xa5\x3c\x4c\x7f\x44\x48\xda\xb5\xd4\x40\x6d\xba\x0e\xc3\
\\x08\x39\x19\xa7\x9f\xba\xee\xd9\x49\xdb\xcf\xb0\x4e\x67\x0c\x53\x5c\x3d\x9c\x01\x64\xbd\xb9\x41\x2c\x0e\x63\x6a\xba\x7d\xd9\xcd\
\\xea\x6f\x73\x88\xe7\x0b\xc7\x62\x35\xf2\x9a\xdb\x5c\x4c\xdd\x8d\xf0\xd4\x8d\x8c\xb8\x81\x53\xe2\x08\xa1\x98\x66\x1a\xe2\xea\xc8\
\\x28\x4c\xaf\x89\xaa\x92\x82\x23\x93\x34\xbe\x53\x3b\x3a\x21\xbf\x16\x43\x4b\xe3\x9a\xea\x39\x06\xef\xe8\xc3\x6e\xf8\x90\xcd\xd9\
\\x80\x22\x6d\xae\xc3\x40\xa4\xa3\xdf\x7e\x9c\x09\xa6\x94\xa8\x07\x5b\x7c\x5e\xcc\x22\x1d\xb3\xa6\x9a\x69\xa0\x2f\x68\x81\x8a\x54\
\\xce\xb2\x29\x6f\x53\xc0\x84\x3a\xfe\x89\x36\x55\x25\xbf\xe6\x8a\xb4\x62\x8a\xbc\xcf\x22\x2e\xbf\x25\xac\x6f\x48\xa9\xa9\x93\x87\
\\x53\xbd\xdb\x65\xe7\x6f\xfb\xe7\xe9\x67\xfd\x78\x0b\xa9\x35\x63\x8e\x34\x2b\xc1\xe8\xa1\x1b\xe9\x49\x80\x74\x0d\xc8\x08\x7d\xfc\
\\x8d\xe4\xbf\x99\xa1\x11\x01\xa0\x7f\xd3\x79\x75\xda\x5a\x26\xc0\xe8\x1f\x99\x4f\x95\x28\xcd\x89\xfd\x33\x9f\xed\xb8\x78\x34\xbf\
\\x5f\x04\x45\x6d\x22\x25\x86\x98\xc9\xc4\xc8\x3b\x2d\xc1\x56\xbe\x4f\x62\x8d\xaa\x57\xf5\x5e\xc5\xe2\x22\x0a\xbe\xd2\x91\x6e\xbf\
\\x4e\xc7\x5b\x95\x24\xf2\xc3\xc0\x42\xd1\x5d\x99\xcd\x0d\x7f\xa0\x7b\x6e\x27\xff\xa8\xdc\x8a\xf0\x73\x45\xc1\x06\xf4\x1e\x23\x2f\
\\x35\x16\x23\x86\xe6\xea\x89\x26\x33\x33\xb0\x94\x15\x7e\xc6\xf2\x37\x2b\x74\xaf\x69\x25\x73\xe4\xe9\xa9\xd8\x48\xf3\x16\x02\x89\
\\x3a\x62\xef\x1d\xa7\x87\xe2\x38\xf3\xa5\xf6\x76\x74\x36\x48\x53\x20\x95\x10\x63\x45\x76\x69\x8d\xb6\xfa\xd4\x07\x59\x2a\xf9\x50\
\\x36\xf7\x35\x23\x4c\xfb\x6e\x87\x7d\xa4\xce\xc0\x6c\x15\x2d\xaa\xcb\x03\x96\xa8\xc5\x0d\xfe\x5d\xfc\xd7\x07\xab\x09\x21\xc4\x2f\
\\x89\xdf\xf0\xbb\x5f\xe2\xbe\x78\x44\x8f\x4f\x33\x75\x46\x13\xc9\x2b\x05\xd0\x8d\x48\xb9\xd5\x85\xdc\x04\x94\x41\xc8\x09\x8f\x9b\
\\x7d\xed\xe7\x86\xc3\x9a\x33\x73\x42\x41\x00\x05\x6a\x09\x17\x51\x0e\xf3\xc8\xa6\x89\x00\x72\xd6\x28\x20\x76\x82\xa9\xa9\xf7\xbe\
\\xbf\x32\x67\x9d\xd4\x5b\x5b\x75\xb3\x53\xfd\x00\xcb\xb0\xe3\x58\x83\x0f\x22\x0a\x1f\x8f\xb2\x14\xd3\x72\xcf\x08\xcc\x3c\x4a\x13\
\\x8c\xf6\x31\x66\x06\x1c\x87\xbe\x88\xc9\x8f\x88\x60\x62\xe3\x97\x47\xcf\x8e\x7a\xb6\xc8\x52\x83\x3c\xc2\xac\xfb\x3f\xc0\x69\x76\
\\x4e\x8f\x02\x52\x64\xd8\x31\x4d\xda\x38\x70\xe3\x1e\x66\x54\x59\xc1\x09\x08\xf0\x51\x30\x21\xa5\x6c\x5b\x68\xb7\x82\x2f\x8a\xa0\
\\x30\x07\xcd\x3e\x74\x71\x9e\xef\xdc\x87\x26\x81\x07\x33\x40\xd4\x7e\x43\x2f\xd9\x0c\x5e\xc2\x41\x88\x09\x28\x6c\xf5\x92\xd8\x91\
\\x08\xa9\x30\xf6\x95\x7e\xf3\x05\xb7\xfb\xff\xbd\xc2\x66\xe9\x6f\x6f\xe4\xac\x98\xb1\x73\xec\xc0\xbc\x60\xb4\x2a\x95\x34\x98\xda\
\\xfb\xa1\xae\x12\x2d\x4b\xd7\x36\x0f\x25\xfa\xab\xa4\xf3\xfc\xeb\xe2\x96\x91\x23\x25\x7f\x0c\x3d\x93\x48\xaf\x49\x36\x14\x00\xbc\
\\xe8\x81\x6f\x4a\x38\x14\xf2\x00\xa3\xf9\x40\x43\x9c\x7a\x54\xc2\xbc\x70\x4f\x57\xda\x41\xe7\xf9\xc2\x5a\xd3\x3a\x54\xf4\xa0\x84\
\\xb1\x7f\x55\x05\x59\x35\x7c\xbe\xed\xbd\x15\xc8\x7f\x97\xc5\xab\xba\x5a\xc7\xb5\xb6\xf6\xde\xaf\x3a\x47\x9c\x3a\x53\x02\xda\x25\
\\x65\x3d\x7e\x6a\x54\x26\x8d\x49\x51\xa4\x77\xea\x50\x17\xd5\x5b\xd7\xd2\x5d\x88\x44\x13\x6c\x76\x04\x04\xa8\xc8\xb8\xe5\xa1\x21\
\\xb8\x1a\x92\x8a\x60\xed\x58\x69\x97\xc5\x5b\x96\xea\xec\x99\x1b\x29\x93\x59\x13\x01\xfd\xb7\xf1\x08\x8e\x8d\xfa\x9a\xb6\xf6\xf5\
\\x3b\x4c\xbf\x9f\x4a\x5d\xe3\xab\xe6\x05\x1d\x35\xa0\xe1\xd8\x55\xd3\x6b\x4c\xf1\xf5\x44\xed\xeb\xb0\xe9\x35\x24\xbe\xbb\x8f\xbd\
\\xa2\xd7\x62\xcf\x49\xc9\x2f\x54\x38\xb5\xf3\x31\x71\x28\xa4\x54\x48\x39\x29\x05\xa6\x5b\x1d\xb8\x85\x1c\x97\xbd\xd6\x75\xcf\x2f"#
sbox_s7 :: Word8 -> Word32
sbox_s7 i = arrayRead32 t (fromIntegral i)
where
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\
\\x4d\x49\x50\x01\x38\xbe\x43\x41\x91\x3c\xee\x1d\x92\xa7\x9c\x3f\x08\x97\x66\xbe\xba\xee\xad\xf4\x12\x86\xbe\xcf\xb6\xea\xcb\x19\
\\x26\x60\xc2\x00\x75\x65\xbd\xe4\x64\x24\x1f\x7a\x82\x48\xdc\xa9\xc3\xb3\xad\x66\x28\x13\x60\x86\x0b\xd8\xdf\xa8\x35\x6d\x1c\xf2\
\\x10\x77\x89\xbe\xb3\xb2\xe9\xce\x05\x02\xaa\x8f\x0b\xc0\x35\x1e\x16\x6b\xf5\x2a\xeb\x12\xff\x82\xe3\x48\x69\x11\xd3\x4d\x75\x16\
\\x4e\x7b\x3a\xff\x5f\x43\x67\x1b\x9c\xf6\xe0\x37\x49\x81\xac\x83\x33\x42\x66\xce\x8c\x93\x41\xb7\xd0\xd8\x54\xc0\xcb\x3a\x6c\x88\
\\x47\xbc\x28\x29\x47\x25\xba\x37\xa6\x6a\xd2\x2b\x7a\xd6\x1f\x1e\x0c\x5c\xba\xfa\x44\x37\xf1\x07\xb6\xe7\x99\x62\x42\xd2\xd8\x16\
\\x0a\x96\x12\x88\xe1\xa5\xc0\x6e\x13\x74\x9e\x67\x72\xfc\x08\x1a\xb1\xd1\x39\xf7\xf9\x58\x37\x45\xcf\x19\xdf\x58\xbe\xc3\xf7\x56\
\\xc0\x6e\xba\x30\x07\x21\x1b\x24\x45\xc2\x88\x29\xc9\x5e\x31\x7f\xbc\x8e\xc5\x11\x38\xbc\x46\xe9\xc6\xe6\xfa\x14\xba\xe8\x58\x4a\
\\xad\x4e\xbc\x46\x46\x8f\x50\x8b\x78\x29\x43\x5f\xf1\x24\x18\x3b\x82\x1d\xba\x9f\xaf\xf6\x0f\xf4\xea\x2c\x4e\x6d\x16\xe3\x92\x64\
\\x92\x54\x4a\x8b\x00\x9b\x4f\xc3\xab\xa6\x8c\xed\x9a\xc9\x6f\x78\x06\xa5\xb7\x9a\xb2\x85\x6e\x6e\x1a\xec\x3c\xa9\xbe\x83\x86\x88\
\\x0e\x08\x04\xe9\x55\xf1\xbe\x56\xe7\xe5\x36\x3b\xb3\xa1\xf2\x5d\xf7\xde\xbb\x85\x61\xfe\x03\x3c\x16\x74\x62\x33\x3c\x03\x4c\x28\
\\xda\x6d\x0c\x74\x79\xaa\xc5\x6c\x3c\xe4\xe1\xad\x51\xf0\xc8\x02\x98\xf8\xf3\x5a\x16\x26\xa4\x9f\xee\xd8\x2b\x29\x1d\x38\x2f\xe3\
\\x0c\x4f\xb9\x9a\xbb\x32\x57\x78\x3e\xc6\xd9\x7b\x6e\x77\xa6\xa9\xcb\x65\x8b\x5c\xd4\x52\x30\xc7\x2b\xd1\x40\x8b\x60\xc0\x3e\xb7\
\\xb9\x06\x8d\x78\xa3\x37\x54\xf4\xf4\x30\xc8\x7d\xc8\xa7\x13\x02\xb9\x6d\x8c\x32\xeb\xd4\xe7\xbe\xbe\x8b\x9d\x2d\x79\x79\xfb\x06\
\\xe7\x22\x53\x08\x8b\x75\xcf\x77\x11\xef\x8d\xa4\xe0\x83\xc8\x58\x8d\x6b\x78\x6f\x5a\x63\x17\xa6\xfa\x5c\xf7\xa0\x5d\xda\x00\x33\
\\xf2\x8e\xbf\xb0\xf5\xb9\xc3\x10\xa0\xea\xc2\x80\x08\xb9\x76\x7a\xa3\xd9\xd2\xb0\x79\xd3\x42\x17\x02\x1a\x71\x8d\x9a\xc6\x33\x6a\
\\x27\x11\xfd\x60\x43\x80\x50\xe3\x06\x99\x08\xa8\x3d\x7f\xed\xc4\x82\x6d\x2b\xef\x4e\xeb\x84\x76\x48\x8d\xcf\x25\x36\xc9\xd5\x66\
\\x28\xe7\x4e\x41\xc2\x61\x0a\xca\x3d\x49\xa9\xcf\xba\xe3\xb9\xdf\xb6\x5f\x8d\xe6\x92\xae\xaf\x64\x3a\xc7\xd5\xe6\x9e\xa8\x05\x09\
\\xf2\x2b\x01\x7d\xa4\x17\x3f\x70\xdd\x1e\x16\xc3\x15\xe0\xd7\xf9\x50\xb1\xb8\x87\x2b\x9f\x4f\xd5\x62\x5a\xba\x82\x6a\x01\x79\x62\
\\x2e\xc0\x1b\x9c\x15\x48\x8a\xa9\xd7\x16\xe7\x40\x40\x05\x5a\x2c\x93\xd2\x9a\x22\xe3\x2d\xbf\x9a\x05\x87\x45\xb9\x34\x53\xdc\x1e\
\\xd6\x99\x29\x6e\x49\x6c\xff\x6f\x1c\x9f\x49\x86\xdf\xe2\xed\x07\xb8\x72\x42\xd1\x19\xde\x7e\xae\x05\x3e\x56\x1a\x15\xad\x6f\x8c\
\\x66\x62\x6c\x1c\x71\x54\xc2\x4c\xea\x08\x2b\x2a\x93\xeb\x29\x39\x17\xdc\xb0\xf0\x58\xd4\xf2\xae\x9e\xa2\x94\xfb\x52\xcf\x56\x4c\
\\x98\x83\xfe\x66\x2e\xc4\x05\x81\x76\x39\x53\xc3\x01\xd6\x69\x2e\xd3\xa0\xc1\x08\xa1\xe7\x16\x0e\xe4\xf2\xdf\xa6\x69\x3e\xd2\x85\
\\x74\x90\x46\x98\x4c\x2b\x0e\xdd\x4f\x75\x76\x56\x5d\x39\x33\x78\xa1\x32\x23\x4f\x3d\x32\x1c\x5d\xc3\xf5\xe1\x94\x4b\x26\x93\x01\
\\xc7\x9f\x02\x2f\x3c\x99\x7e\x7e\x5e\x4f\x95\x04\x3f\xfa\xfb\xbd\x76\xf7\xad\x0e\x29\x66\x93\xf4\x3d\x1f\xce\x6f\xc6\x1e\x45\xbe\
\\xd3\xb5\xab\x34\xf7\x2b\xf9\xb7\x1b\x04\x34\xc0\x4e\x72\xb5\x67\x55\x92\xa3\x3d\xb5\x22\x93\x01\xcf\xd2\xa8\x7f\x60\xae\xb7\x67\
\\x18\x14\x38\x6b\x30\xbc\xc3\x3d\x38\xa0\xc0\x7d\xfd\x16\x06\xf2\xc3\x63\x51\x9b\x58\x9d\xd3\x90\x54\x79\xf8\xe6\x1c\xb8\xd6\x47\
\\x97\xfd\x61\xa9\xea\x77\x59\xf4\x2d\x57\x53\x9d\x56\x9a\x58\xcf\xe8\x4e\x63\xad\x46\x2e\x1b\x78\x65\x80\xf8\x7e\xf3\x81\x79\x14\
\\x91\xda\x55\xf4\x40\xa2\x30\xf3\xd1\x98\x8f\x35\xb6\xe3\x18\xd2\x3f\xfa\x50\xbc\x3d\x40\xf0\x21\xc3\xc0\xbd\xae\x49\x58\xc2\x4c\
\\x51\x8f\x36\xb2\x84\xb1\xd3\x70\x0f\xed\xce\x83\x87\x8d\xda\xda\xf2\xa2\x79\xc7\x94\xe0\x1b\xe8\x90\x71\x6f\x4b\x95\x4b\x8a\xa3"#
sbox_s8 :: Word8 -> Word32
sbox_s8 i = arrayRead32 t (fromIntegral i)
where
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\
\\x0b\x15\xa1\x5d\x48\x0d\x31\x68\x8b\xbb\xde\x5a\x66\x9d\xed\x42\xc7\xec\xe8\x31\x3f\x8f\x95\xe7\x72\xdf\x19\x1b\x75\x80\x33\x0d\
\\x94\x07\x42\x51\x5c\x7d\xcd\xfa\xab\xbe\x6d\x63\xaa\x40\x21\x64\xb3\x01\xd4\x0a\x02\xe7\xd1\xca\x53\x57\x1d\xae\x7a\x31\x82\xa2\
\\x12\xa8\xdd\xec\xfd\xaa\x33\x5d\x17\x6f\x43\xe8\x71\xfb\x46\xd4\x38\x12\x90\x22\xce\x94\x9a\xd4\xb8\x47\x69\xad\x96\x5b\xd8\x62\
\\x82\xf3\xd0\x55\x66\xfb\x97\x67\x15\xb8\x0b\x4e\x1d\x5b\x47\xa0\x4c\xfd\xe0\x6f\xc2\x8e\xc4\xb8\x57\xe8\x72\x6e\x64\x7a\x78\xfc\
\\x99\x86\x5d\x44\x60\x8b\xd5\x93\x6c\x20\x0e\x03\x39\xdc\x5f\xf6\x5d\x0b\x00\xa3\xae\x63\xaf\xf2\x7e\x8b\xd6\x32\x70\x10\x8c\x0c\
\\xbb\xd3\x50\x49\x29\x98\xdf\x04\x98\x0c\xf4\x2a\x9b\x6d\xf4\x91\x9e\x7e\xdd\x53\x06\x91\x85\x48\x58\xcb\x7e\x07\x3b\x74\xef\x2e\
\\x52\x2f\xff\xb1\xd2\x47\x08\xcc\x1c\x7e\x27\xcd\xa4\xeb\x21\x5b\x3c\xf1\xd2\xe2\x19\xb4\x7a\x38\x42\x4f\x76\x18\x35\x85\x60\x39\
\\x9d\x17\xde\xe7\x27\xeb\x35\xe6\xc9\xaf\xf6\x7b\x36\xba\xf5\xb8\x09\xc4\x67\xcd\xc1\x89\x10\xb1\xe1\x1d\xbf\x7b\x06\xcd\x1a\xf8\
\\x71\x70\xc6\x08\x2d\x5e\x33\x54\xd4\xde\x49\x5a\x64\xc6\xd0\x06\xbc\xc0\xc6\x2c\x3d\xd0\x0d\xb3\x70\x8f\x8f\x34\x77\xd5\x1b\x42\
\\x26\x4f\x62\x0f\x24\xb8\xd2\xbf\x15\xc1\xb7\x9e\x46\xa5\x25\x64\xf8\xd7\xe5\x4e\x3e\x37\x81\x60\x78\x95\xcd\xa5\x85\x9c\x15\xa5\
\\xe6\x45\x97\x88\xc3\x7b\xc7\x5f\xdb\x07\xba\x0c\x06\x76\xa3\xab\x7f\x22\x9b\x1e\x31\x84\x2e\x7b\x24\x25\x9f\xd7\xf8\xbe\xf4\x72\
\\x83\x5f\xfc\xb8\x6d\xf4\xc1\xf2\x96\xf5\xb1\x95\xfd\x0a\xf0\xfc\xb0\xfe\x13\x4c\xe2\x50\x6d\x3d\x4f\x9b\x12\xea\xf2\x15\xf2\x25\
\\xa2\x23\x73\x6f\x9f\xb4\xc4\x28\x25\xd0\x49\x79\x34\xc7\x13\xf8\xc4\x61\x81\x87\xea\x7a\x6e\x98\x7c\xd1\x6e\xfc\x14\x36\x87\x6c\
\\xf1\x54\x41\x07\xbe\xde\xee\x14\x56\xe9\xaf\x27\xa0\x4a\xa4\x41\x3c\xf7\xc8\x99\x92\xec\xba\xe6\xdd\x67\x01\x6d\x15\x16\x82\xeb\
\\xa8\x42\xee\xdf\xfd\xba\x60\xb4\xf1\x90\x7b\x75\x20\xe3\x03\x0f\x24\xd8\xc2\x9e\xe1\x39\x67\x3b\xef\xa6\x3f\xb8\x71\x87\x30\x54\
\\xb6\xf2\xcf\x3b\x9f\x32\x64\x42\xcb\x15\xa4\xcc\xb0\x1a\x45\x04\xf1\xe4\x7d\x8d\x84\x4a\x1b\xe5\xba\xe7\xdf\xdc\x42\xcb\xda\x70\
\\xcd\x7d\xae\x0a\x57\xe8\x5b\x7a\xd5\x3f\x5a\xf6\x20\xcf\x4d\x8c\xce\xa4\xd4\x28\x79\xd1\x30\xa4\x34\x86\xeb\xfb\x33\xd3\xcd\xdc\
\\x77\x85\x3b\x53\x37\xef\xfc\xb5\xc5\x06\x87\x78\xe5\x80\xb3\xe6\x4e\x68\xb8\xf4\xc5\xc8\xb3\x7e\x0d\x80\x9e\xa2\x39\x8f\xeb\x7c\
\\x13\x2a\x4f\x94\x43\xb7\x95\x0e\x2f\xee\x7d\x1c\x22\x36\x13\xbd\xdd\x06\xca\xa2\x37\xdf\x93\x2b\xc4\x24\x82\x89\xac\xf3\xeb\xc3\
\\x57\x15\xf6\xb7\xef\x34\x78\xdd\xf2\x67\x61\x6f\xc1\x48\xcb\xe4\x90\x52\x81\x5e\x5e\x41\x0f\xab\xb4\x8a\x24\x65\x2e\xda\x7f\xa4\
\\xe8\x7b\x40\xe4\xe9\x8e\xa0\x84\x58\x89\xe9\xe1\xef\xd3\x90\xfc\xdd\x07\xd3\x5b\xdb\x48\x56\x94\x38\xd7\xe5\xb2\x57\x72\x01\x01\
\\x73\x0e\xde\xbc\x5b\x64\x31\x13\x94\x91\x7e\x4f\x50\x3c\x2f\xba\x64\x6f\x12\x82\x75\x23\xd2\x4a\xe0\x77\x96\x95\xf9\xc1\x7a\x8f\
\\x7a\x5b\x21\x21\xd1\x87\xb8\x96\x29\x26\x3a\x4d\xba\x51\x0c\xdf\x81\xf4\x7c\x9f\xad\x11\x63\xed\xea\x7b\x59\x65\x1a\x00\x72\x6e\
\\x11\x40\x30\x92\x00\xda\x6d\x77\x4a\x0c\xdd\x61\xad\x1f\x46\x03\x60\x5b\xdf\xb0\x9e\xed\xc3\x64\x22\xeb\xe6\xa8\xce\xe7\xd2\x8a\
\\xa0\xe7\x36\xa0\x55\x64\xa6\xb9\x10\x85\x32\x09\xc7\xeb\x8f\x37\x2d\xe7\x05\xca\x89\x51\x57\x0f\xdf\x09\x82\x2b\xbd\x69\x1a\x6c\
\\xaa\x12\xe4\xf2\x87\x45\x1c\x0f\xe0\xf6\xa2\x7a\x3a\xda\x48\x19\x4c\xf1\x76\x4f\x0d\x77\x1c\x2b\x67\xcd\xb1\x56\x35\x0d\x83\x84\
\\x59\x38\xfa\x0f\x42\x39\x9e\xf3\x36\x99\x7b\x07\x0e\x84\x09\x3d\x4a\xa9\x3e\x61\x83\x60\xd8\x7b\x1f\xa9\x8b\x0c\x11\x49\x38\x2c\
\\xe9\x76\x25\xa5\x06\x14\xd1\xb7\x0e\x25\x24\x4b\x0c\x76\x83\x47\x58\x9e\x8d\x82\x0d\x20\x59\xd1\xa4\x66\xbb\x1e\xf8\xda\x0a\x82\
\\x04\xf1\x91\x30\xba\x6e\x4e\xc0\x99\x26\x51\x64\x1e\xe7\x23\x0d\x50\xb2\xad\x80\xea\xee\x68\x01\x8d\xb2\xa2\x83\xea\x8b\xf5\x9e"#

View file

@ -0,0 +1,28 @@
-- |
-- Module : Crypto.Cipher.Camellia
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Camellia support. only 128 bit variant available for now.
module Crypto.Cipher.Camellia
( Camellia128
) where
import Crypto.Cipher.Camellia.Primitive
import Crypto.Cipher.Types
-- | Camellia block cipher with 128 bit key
newtype Camellia128 = Camellia128 Camellia
instance Cipher Camellia128 where
cipherName _ = "Camellia128"
cipherKeySize _ = KeySizeFixed 16
cipherInit k = Camellia128 `fmap` initCamellia k
instance BlockCipher Camellia128 where
blockSize _ = 16
ecbEncrypt (Camellia128 key) = encrypt key
ecbDecrypt (Camellia128 key) = decrypt key

View file

@ -0,0 +1,283 @@
-- |
-- Module : Crypto.Cipher.Camellia.Primitive
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- This only cover Camellia 128 bits for now. The API will change once
-- 192 and 256 mode are implemented too.
{-# LANGUAGE MagicHash #-}
module Crypto.Cipher.Camellia.Primitive
( Camellia
, initCamellia
, encrypt
, decrypt
) where
import Data.Word
import Data.Bits
import Crypto.Error
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Words
import Crypto.Internal.WordArray
import Data.Memory.Endian
data Mode = Decrypt | Encrypt
w64tow128 :: (Word64, Word64) -> Word128
w64tow128 (x1, x2) = Word128 x1 x2
w64tow8 :: Word64 -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)
w64tow8 x = (t1, t2, t3, t4, t5, t6, t7, t8)
where
t1 = fromIntegral (x `shiftR` 56)
t2 = fromIntegral (x `shiftR` 48)
t3 = fromIntegral (x `shiftR` 40)
t4 = fromIntegral (x `shiftR` 32)
t5 = fromIntegral (x `shiftR` 24)
t6 = fromIntegral (x `shiftR` 16)
t7 = fromIntegral (x `shiftR` 8)
t8 = fromIntegral (x)
w8tow64 :: (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)
sbox :: Int -> Word8
sbox = arrayRead8 t
where t = array8
"\x70\x82\x2c\xec\xb3\x27\xc0\xe5\xe4\x85\x57\x35\xea\x0c\xae\x41\
\\x23\xef\x6b\x93\x45\x19\xa5\x21\xed\x0e\x4f\x4e\x1d\x65\x92\xbd\
\\x86\xb8\xaf\x8f\x7c\xeb\x1f\xce\x3e\x30\xdc\x5f\x5e\xc5\x0b\x1a\
\\xa6\xe1\x39\xca\xd5\x47\x5d\x3d\xd9\x01\x5a\xd6\x51\x56\x6c\x4d\
\\x8b\x0d\x9a\x66\xfb\xcc\xb0\x2d\x74\x12\x2b\x20\xf0\xb1\x84\x99\
\\xdf\x4c\xcb\xc2\x34\x7e\x76\x05\x6d\xb7\xa9\x31\xd1\x17\x04\xd7\
\\x14\x58\x3a\x61\xde\x1b\x11\x1c\x32\x0f\x9c\x16\x53\x18\xf2\x22\
\\xfe\x44\xcf\xb2\xc3\xb5\x7a\x91\x24\x08\xe8\xa8\x60\xfc\x69\x50\
\\xaa\xd0\xa0\x7d\xa1\x89\x62\x97\x54\x5b\x1e\x95\xe0\xff\x64\xd2\
\\x10\xc4\x00\x48\xa3\xf7\x75\xdb\x8a\x03\xe6\xda\x09\x3f\xdd\x94\
\\x87\x5c\x83\x02\xcd\x4a\x90\x33\x73\x67\xf6\xf3\x9d\x7f\xbf\xe2\
\\x52\x9b\xd8\x26\xc8\x37\xc6\x3b\x81\x96\x6f\x4b\x13\xbe\x63\x2e\
\\xe9\x79\xa7\x8c\x9f\x6e\xbc\x8e\x29\xf5\xf9\xb6\x2f\xfd\xb4\x59\
\\x78\x98\x06\x6a\xe7\x46\x71\xba\xd4\x25\xab\x42\x88\xa2\x8d\xfa\
\\x72\x07\xb9\x55\xf8\xee\xac\x0a\x36\x49\x2a\x68\x3c\x38\xf1\xa4\
\\x40\x28\xd3\x7b\xbb\xc9\x43\xc1\x15\xe3\xad\xf4\x77\xc7\x80\x9e"#
sbox1 :: Word8 -> Word8
sbox1 x = sbox (fromIntegral x)
sbox2 :: Word8 -> Word8
sbox2 x = sbox1 x `rotateL` 1
sbox3 :: Word8 -> Word8
sbox3 x = sbox1 x `rotateL` 7
sbox4 :: Word8 -> Word8
sbox4 x = sbox1 (x `rotateL` 1)
sigma1, sigma2, sigma3, sigma4, sigma5, sigma6 :: Word64
sigma1 = 0xA09E667F3BCC908B
sigma2 = 0xB67AE8584CAA73B2
sigma3 = 0xC6EF372FE94F82BE
sigma4 = 0x54FF53A5F1D36F1C
sigma5 = 0x10E527FADE682D1D
sigma6 = 0xB05688C2B3E6C1FD
rotl128 :: Word128 -> Int -> Word128
rotl128 v 0 = v
rotl128 (Word128 x1 x2) 64 = Word128 x2 x1
rotl128 v@(Word128 x1 x2) w
| w > 64 = (v `rotl128` 64) `rotl128` (w - 64)
| otherwise = Word128 (x1high .|. x2low) (x2high .|. x1low)
where
splitBits i = (i .&. complement x, i .&. x)
where x = 2 ^ w - 1
(x1high, x1low) = splitBits (x1 `rotateL` w)
(x2high, x2low) = splitBits (x2 `rotateL` w)
-- | Camellia context
data Camellia = Camellia
{ k :: Array64
, kw :: Array64
, ke :: Array64
}
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)
kA = let d1 = (fst kL `xor` fst kR)
d2 = (snd kL `xor` snd kR)
d3 = d2 `xor` feistel d1 sigma1
d4 = d1 `xor` feistel d3 sigma2
d5 = d4 `xor` (fst kL)
d6 = d3 `xor` (snd kL)
d7 = d6 `xor` feistel d5 sigma3
d8 = d5 `xor` feistel d7 sigma4
in (d8, d7)
kB = let d1 = (fst kA `xor` fst kR)
d2 = (snd kA `xor` snd kR)
d3 = d2 `xor` feistel d1 sigma5
d4 = d1 `xor` feistel d3 sigma6
in (d4, d3)
-- | Initialize a 128-bit key
--
-- Return the initialized key or a error message if the given
-- keyseed was not 16-bytes in length.
initCamellia :: ByteArray key
=> key -- ^ The key to create the camellia context
-> CryptoFailable Camellia
initCamellia key
| 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 ]
}
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)
fl :: Word64 -> Word64 -> Word64
fl fin sk =
let (x1, x2) = w64to32 fin in
let (k1, k2) = w64to32 sk in
let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in
let y1 = x1 `xor` (y2 .|. k2) in
w32to64 (y1, y2)
flinv :: Word64 -> Word64 -> Word64
flinv fin sk =
let (y1, y2) = w64to32 fin in
let (k1, k2) = w64to32 sk in
let x1 = y1 `xor` (y2 .|. k2) in
let x2 = y2 `xor` ((x1 .&. k1) `rotateL` 1) in
w32to64 (x1, x2)
{- in decrypt mode 0->17 1->16 ... -}
getKeyK :: Mode -> Camellia -> Int -> Word64
getKeyK Encrypt key i = k key `arrayRead64` i
getKeyK Decrypt key i = k key `arrayRead64` (17 - i)
{- in decrypt mode 0->3 1->2 2->1 3->0 -}
getKeyKe :: Mode -> Camellia -> Int -> Word64
getKeyKe Encrypt key i = ke key `arrayRead64` i
getKeyKe Decrypt key i = ke key `arrayRead64` (3 - i)
{- in decrypt mode 0->2 1->3 2->0 3->1 -}
getKeyKw :: Mode -> Camellia -> Int -> Word64
getKeyKw Encrypt key i = (kw key) `arrayRead64` i
getKeyKw Decrypt key i = (kw key) `arrayRead64` ((i + 2) `mod` 4)
{- perform the following
D2 = D2 ^ F(D1, k1); // Round 1
D1 = D1 ^ F(D2, k2); // Round 2
D2 = D2 ^ F(D1, k3); // Round 3
D1 = D1 ^ F(D2, k4); // Round 4
D2 = D2 ^ F(D1, k5); // Round 5
D1 = D1 ^ F(D2, k6); // Round 6
-}
doBlockRound :: Mode -> Camellia -> Word64 -> Word64 -> Int -> (Word64, Word64)
doBlockRound mode key d1 d2 i =
let r1 = d2 `xor` feistel d1 (getKeyK mode key (0+i)) in {- Round 1+i -}
let r2 = d1 `xor` feistel r1 (getKeyK mode key (1+i)) in {- Round 2+i -}
let r3 = r1 `xor` feistel r2 (getKeyK mode key (2+i)) in {- Round 3+i -}
let r4 = r2 `xor` feistel r3 (getKeyK mode key (3+i)) in {- Round 4+i -}
let r5 = r3 `xor` feistel r4 (getKeyK mode key (4+i)) in {- Round 5+i -}
let r6 = r4 `xor` feistel r5 (getKeyK mode key (5+i)) in {- Round 6+i -}
(r6, r5)
doBlock :: Mode -> Camellia -> Word128 -> Word128
doBlock mode key (Word128 d1 d2) =
let d1a = d1 `xor` (getKeyKw mode key 0) in {- Prewhitening -}
let d2a = d2 `xor` (getKeyKw mode key 1) in
let (d1b, d2b) = doBlockRound mode key d1a d2a 0 in
let d1c = fl d1b (getKeyKe mode key 0) in {- FL -}
let d2c = flinv d2b (getKeyKe mode key 1) in {- FLINV -}
let (d1d, d2d) = doBlockRound mode key d1c d2c 6 in
let d1e = fl d1d (getKeyKe mode key 2) in {- FL -}
let d2e = flinv d2d (getKeyKe mode key 3) in {- FLINV -}
let (d1f, d2f) = doBlockRound mode key d1e d2e 12 in
let d2g = d2f `xor` (getKeyKw mode key 2) in {- Postwhitening -}
let d1g = d1f `xor` (getKeyKw mode key 3) in
w64tow128 (d2g, d1g)
{- encryption for 128 bits blocks -}
encryptBlock :: Camellia -> Word128 -> Word128
encryptBlock = doBlock Encrypt
{- decryption for 128 bits blocks -}
decryptBlock :: Camellia -> Word128 -> Word128
decryptBlock = doBlock Decrypt
-- | Encrypts the given ByteString using the given Key
encrypt :: ByteArray ba
=> Camellia -- ^ The key to use
-> ba -- ^ The data to encrypt
-> ba
encrypt key = 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 key = B.mapAsWord128 (decryptBlock key)

View file

@ -0,0 +1,126 @@
-- |
-- 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
, combine
, generate
, State
-- * Simple interface for DRG purpose
, initializeSimple
, generateSimple
, StateSimple
) where
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Foreign.Ptr
import Foreign.C.Types
-- | ChaCha context
newtype State = State ScrubbedBytes
deriving (NFData)
-- | ChaCha context for DRG purpose (see Crypto.Random.ChaChaDRG)
newtype StateSimple = StateSimple ScrubbedBytes -- just ChaCha's state
deriving (NFData)
-- | 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 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
stPtr <- B.alloc 132 $ \stPtr ->
B.withByteArray nonce $ \noncePtr ->
B.withByteArray key $ \keyPtr ->
ccryptonite_chacha_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
return $ State stPtr
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 seed
| sLen < 40 = error "ChaCha Random: seed length should be 40 bytes"
| otherwise = unsafeDoIO $ do
stPtr <- B.alloc 64 $ \stPtr ->
B.withByteArray seed $ \seedPtr ->
ccryptonite_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 prevSt@(State prevStMem) src
| B.null src = (B.empty, prevSt)
| otherwise = unsafeDoIO $ do
(out, st) <- B.copyRet prevStMem $ \ctx ->
B.alloc (B.length src) $ \dstPtr ->
B.withByteArray src $ \srcPtr ->
ccryptonite_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 prevSt@(State prevStMem) len
| len <= 0 = (B.empty, prevSt)
| otherwise = unsafeDoIO $ do
(out, st) <- B.copyRet prevStMem $ \ctx ->
B.alloc len $ \dstPtr ->
ccryptonite_chacha_generate dstPtr ctx (fromIntegral len)
return (out, State st)
-- | similar to 'generate' but assume certains values
generateSimple :: ByteArray ba
=> StateSimple
-> Int
-> (ba, StateSimple)
generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do
newSt <- B.copy prevSt (\_ -> return ())
output <- B.alloc nbBytes $ \dstPtr ->
B.withByteArray newSt $ \stPtr ->
ccryptonite_chacha_random 8 dstPtr stPtr (fromIntegral nbBytes)
return (output, StateSimple newSt)
foreign import ccall "cryptonite_chacha_init_core"
ccryptonite_chacha_init_core :: Ptr StateSimple -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
foreign import ccall "cryptonite_chacha_init"
ccryptonite_chacha_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
foreign import ccall "cryptonite_chacha_combine"
ccryptonite_chacha_combine :: Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall "cryptonite_chacha_generate"
ccryptonite_chacha_generate :: Ptr Word8 -> Ptr State -> CUInt -> IO ()
foreign import ccall "cryptonite_chacha_random"
ccryptonite_chacha_random :: Int -> Ptr Word8 -> Ptr StateSimple -> CUInt -> IO ()

View file

@ -0,0 +1,201 @@
-- |
-- Module : Crypto.Cipher.ChaChaPoly1305
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
-- A simple AEAD scheme using ChaCha20 and Poly1305. See
-- <https://tools.ietf.org/html/rfc7539 RFC 7539>.
--
-- The State is not modified in place, so each function changing the State,
-- returns a new State.
--
-- Authenticated Data need to be added before any call to 'encrypt' or 'decrypt',
-- and once all the data has been added, then 'finalizeAAD' need to be called.
--
-- Once 'finalizeAAD' has been called, no further 'appendAAD' call should be make.
--
-- >import Data.ByteString.Char8 as B
-- >import Data.ByteArray
-- >import Crypto.Error
-- >import Crypto.Cipher.ChaChaPoly1305 as C
-- >
-- >encrypt
-- > :: ByteString -- nonce (12 random bytes)
-- > -> ByteString -- symmetric key
-- > -> ByteString -- optional associated data (won't be encrypted)
-- > -> ByteString -- input plaintext to be encrypted
-- > -> CryptoFailable ByteString -- ciphertext with a 128-bit tag attached
-- >encrypt nonce key header plaintext = do
-- > st1 <- C.nonce12 nonce >>= C.initialize key
-- > let
-- > st2 = C.finalizeAAD $ C.appendAAD header st1
-- > (out, st3) = C.encrypt plaintext st2
-- > auth = C.finalize st3
-- > return $ out `B.append` Data.ByteArray.convert auth
--
module Crypto.Cipher.ChaChaPoly1305
( State
, Nonce
, nonce12
, nonce8
, incrementNonce
, initialize
, appendAAD
, finalizeAAD
, encrypt
, decrypt
, finalize
) where
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
import qualified Crypto.Cipher.ChaCha as ChaCha
import qualified Crypto.MAC.Poly1305 as Poly1305
import Data.Memory.Endian
import qualified Data.ByteArray.Pack as P
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
-- | 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
withByteArray (Nonce8 n) = B.withByteArray n
withByteArray (Nonce12 n) = B.withByteArray n
-- Based on the following pseudo code:
--
-- chacha20_aead_encrypt(aad, key, iv, constant, plaintext):
-- nonce = constant | iv
-- otk = poly1305_key_gen(key, nonce)
-- ciphertext = chacha20_encrypt(key, 1, nonce, plaintext)
-- mac_data = aad | pad16(aad)
-- mac_data |= ciphertext | pad16(ciphertext)
-- mac_data |= num_to_4_le_bytes(aad.length)
-- mac_data |= num_to_4_le_bytes(ciphertext.length)
-- tag = poly1305_mac(mac_data, otk)
-- return (ciphertext, tag)
pad16 :: Word64 -> Bytes
pad16 n
| modLen == 0 = B.empty
| otherwise = B.replicate (16 - modLen) 0
where
modLen = fromIntegral (n `mod` 16)
-- | Nonce smart constructor 12 bytes IV, nonce constructor
nonce12 :: ByteArrayAccess iv => iv -> CryptoFailable Nonce
nonce12 iv
| B.length iv /= 12 = CryptoFailed CryptoError_IvSizeInvalid
| 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 constant iv
| B.length constant /= 4 = CryptoFailed CryptoError_IvSizeInvalid
| B.length iv /= 8 = CryptoFailed CryptoError_IvSizeInvalid
| otherwise = CryptoPassed . Nonce8 . B.concat $ [constant, iv]
-- | Increment a nonce
incrementNonce :: Nonce -> Nonce
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)
-- | 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 key (Nonce12 nonce) = initialize' key nonce
initialize' :: ByteArrayAccess key
=> key -> Bytes -> CryptoFailable State
initialize' key nonce
| B.length key /= 32 = CryptoFailed CryptoError_KeySizeInvalid
| otherwise = CryptoPassed $ State encState polyState 0 0
where
rootState = ChaCha.initialize 20 key nonce
(polyKey, encState) = ChaCha.generate rootState 64
polyState = throwCryptoError $ Poly1305.initialize (B.take 32 polyKey :: ScrubbedBytes)
-- | Append Authenticated Data to the State and return
-- the new modified State.
--
-- Once no further call to this function need to be make,
-- the user should call 'finalizeAAD'
appendAAD :: ByteArrayAccess ba => ba -> State -> State
appendAAD ba (State encState macState aadLength plainLength) =
State encState newMacState newLength plainLength
where
newMacState = Poly1305.update macState ba
newLength = aadLength + fromIntegral (B.length ba)
-- | Finalize the Authenticated Data and return the finalized State
finalizeAAD :: State -> State
finalizeAAD (State encState macState aadLength plainLength) =
State encState newMacState aadLength plainLength
where
newMacState = Poly1305.update macState $ pad16 aadLength
-- | Encrypt a piece of data and returns the encrypted Data and the
-- updated State.
encrypt :: ByteArray ba => ba -> State -> (ba, State)
encrypt input (State encState macState aadLength plainLength) =
(output, State newEncState newMacState aadLength newPlainLength)
where
(output, newEncState) = ChaCha.combine encState 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.
decrypt :: ByteArray ba => ba -> State -> (ba, State)
decrypt input (State encState macState aadLength plainLength) =
(output, State newEncState newMacState aadLength newPlainLength)
where
(output, newEncState) = ChaCha.combine encState 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))
]

View file

@ -0,0 +1,39 @@
-- |
-- Module : Crypto.Cipher.DES
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
module Crypto.Cipher.DES
( DES
) where
import Data.Word
import Crypto.Error
import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Data.Memory.Endian
-- | DES Context
data DES = DES Word64
deriving (Eq)
instance Cipher DES where
cipherName _ = "DES"
cipherKeySize _ = KeySizeFixed 8
cipherInit k = initDES k
instance BlockCipher DES where
blockSize _ = 8
ecbEncrypt (DES key) = B.mapAsWord64 (unBlock . encrypt key . Block)
ecbDecrypt (DES key) = B.mapAsWord64 (unBlock . decrypt key . Block)
initDES :: ByteArrayAccess key => key -> CryptoFailable DES
initDES k
| len == 8 = CryptoPassed $ DES key
| otherwise = CryptoFailed $ CryptoError_KeySizeInvalid
where len = B.length k
key = fromBE $ B.toW64BE k 0

View file

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

View file

@ -0,0 +1,84 @@
-- |
-- Module : Crypto.Cipher.RC4
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Simple implementation of the RC4 stream cipher.
-- http://en.wikipedia.org/wiki/RC4
--
-- 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
import Data.Word
import Foreign.Ptr
import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
-- | The encryption state for RC4
--
-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
-- layout is architecture dependent, may contain uninitialized data fragments,
-- and change in future versions. The bytearray should not be used as input to
-- cryptographic algorithms.
newtype State = State ScrubbedBytes
deriving (ByteArrayAccess,NFData)
-- | C Call for initializing the encryptor
foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_init"
c_rc4_init :: Ptr Word8 -- ^ The rc4 key
-> Word32 -- ^ The key length
-> Ptr State -- ^ The context
-> IO ()
foreign import ccall unsafe "cryptonite_rc4.h cryptonite_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 ()
-- | 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 key = unsafeDoIO $ do
st <- B.alloc 264 $ \stPtr ->
B.withByteArray key $ \keyPtr -> c_rc4_init keyPtr (fromIntegral $ B.length key) (castPtr stPtr)
return $ State st
-- | generate the next len bytes of the rc4 stream without combining
-- it to anything.
generate :: ByteArray ba => State -> Int -> (State, ba)
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 (State prevSt) clearText = unsafeDoIO $
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

View file

@ -0,0 +1,83 @@
-- |
-- 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
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Foreign.Ptr
import Foreign.C.Types
-- | Salsa context
newtype State = State ScrubbedBytes
deriving (NFData)
-- | 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 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"
| otherwise = unsafeDoIO $ do
stPtr <- B.alloc 132 $ \stPtr ->
B.withByteArray nonce $ \noncePtr ->
B.withByteArray key $ \keyPtr ->
ccryptonite_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
return $ State stPtr
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 prevSt@(State prevStMem) src
| B.null src = (B.empty, prevSt)
| otherwise = unsafeDoIO $ do
(out, st) <- B.copyRet prevStMem $ \ctx ->
B.alloc (B.length src) $ \dstPtr ->
B.withByteArray src $ \srcPtr -> do
ccryptonite_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 prevSt@(State prevStMem) len
| len <= 0 = (B.empty, prevSt)
| otherwise = unsafeDoIO $ do
(out, st) <- B.copyRet prevStMem $ \ctx ->
B.alloc len $ \dstPtr ->
ccryptonite_salsa_generate dstPtr ctx (fromIntegral len)
return (out, State st)
foreign import ccall "cryptonite_salsa_init"
ccryptonite_salsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
foreign import ccall "cryptonite_salsa_combine"
ccryptonite_salsa_combine :: Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO ()
foreign import ccall "cryptonite_salsa_generate"
ccryptonite_salsa_generate :: Ptr Word8 -> Ptr State -> CUInt -> IO ()

View file

@ -0,0 +1,90 @@
-- |
-- Module : Crypto.Cipher.TripleDES
-- License : BSD-style
-- Stability : experimental
-- Portability : ???
module Crypto.Cipher.TripleDES
( DES_EEE3
, DES_EDE3
, DES_EEE2
, DES_EDE2
) where
import Data.Word
import Crypto.Error
import Crypto.Cipher.Types
import Crypto.Cipher.DES.Primitive
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Data.Memory.Endian
-- | 3DES with 3 different keys used all in the same direction
data DES_EEE3 = DES_EEE3 Word64 Word64 Word64
deriving (Eq)
-- | 3DES with 3 different keys used in alternative direction
data DES_EDE3 = DES_EDE3 Word64 Word64 Word64
deriving (Eq)
-- | 3DES where the first and third keys are equal, used in the same direction
data DES_EEE2 = DES_EEE2 Word64 Word64 -- key1 and key3 are equal
deriving (Eq)
-- | 3DES where the first and third keys are equal, used in alternative direction
data DES_EDE2 = DES_EDE2 Word64 Word64 -- key1 and key3 are equal
deriving (Eq)
instance Cipher DES_EEE3 where
cipherName _ = "3DES_EEE"
cipherKeySize _ = KeySizeFixed 24
cipherInit k = init3DES DES_EEE3 k
instance Cipher DES_EDE3 where
cipherName _ = "3DES_EDE"
cipherKeySize _ = KeySizeFixed 24
cipherInit k = init3DES DES_EDE3 k
instance Cipher DES_EDE2 where
cipherName _ = "2DES_EDE"
cipherKeySize _ = KeySizeFixed 16
cipherInit k = init2DES DES_EDE2 k
instance Cipher DES_EEE2 where
cipherName _ = "2DES_EEE"
cipherKeySize _ = KeySizeFixed 16
cipherInit k = init2DES DES_EEE2 k
instance BlockCipher DES_EEE3 where
blockSize _ = 8
ecbEncrypt (DES_EEE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (encrypt k3 . encrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EEE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k3) . Block)
instance BlockCipher DES_EDE3 where
blockSize _ = 8
ecbEncrypt (DES_EDE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (encrypt k3 . decrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EDE3 k1 k2 k3) = B.mapAsWord64 (unBlock . (decrypt k1 . encrypt k2 . decrypt k3) . Block)
instance BlockCipher DES_EEE2 where
blockSize _ = 8
ecbEncrypt (DES_EEE2 k1 k2) = B.mapAsWord64 (unBlock . (encrypt k1 . encrypt k2 . encrypt k1) . Block)
ecbDecrypt (DES_EEE2 k1 k2) = B.mapAsWord64 (unBlock . (decrypt k1 . decrypt k2 . decrypt k1) . Block)
instance BlockCipher DES_EDE2 where
blockSize _ = 8
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 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)
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)

View file

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

View file

@ -0,0 +1,311 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
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
-- 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
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 }
buildPackage :: ByteArray ba => ba -> Maybe (KeyPackage ba)
buildPackage key
| B.length key == 16 = return $ KeyPackage key Bytes16
| B.length key == 24 = return $ KeyPackage key Bytes24
| B.length key == 32 = return $ KeyPackage key Bytes32
| otherwise = Nothing
-- | Initialize a 128-bit, 192-bit, or 256-bit key
--
-- 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 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
-- | Encrypts the given ByteString using the given Key
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)
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
-- | Decrypts the given ByteString using the given Key
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)
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
"\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\
\\x63\x01\x83\x2e\xd9\x51\x9b\x7c\xa6\xeb\xa5\xbe\x16\x0c\xe3\x61\
\\xc0\x8c\x3a\xf5\x73\x2c\x25\x0b\xbb\x4e\x89\x6b\x53\x6a\xb4\xf1\
\\xe1\xe6\xbd\x45\xe2\xf4\xb6\x66\xcc\x95\x03\x56\xd4\x1c\x1e\xd7\
\\xfb\xc3\x8e\xb5\xe9\xcf\xbf\xba\xea\x77\x39\xaf\x33\xc9\x62\x71\
\\x81\x79\x09\xad\x24\xcd\xf9\xd8\xe5\xc5\xb9\x4d\x44\x08\x86\xe7\
\\xa1\x1d\xaa\xed\x06\x70\xb2\xd2\x41\x7b\xa0\x11\x31\xc2\x27\x90\
\\x20\xf6\x60\xff\x96\x5c\xb1\xab\x9e\x9c\x52\x1b\x5f\x93\x0a\xef\
\\x91\x85\x49\xee\x2d\x4f\x8f\x3b\x47\x87\x6d\x46\xd6\x3e\x69\x64\
\\x2a\xce\xcb\x2f\xfc\x97\x05\x7a\xac\x7f\xd5\x1a\x4b\x0e\xa7\x5a\
\\x28\x14\x3f\x29\x88\x3c\x4c\x02\xb8\xda\xb0\x17\x55\x1f\x8a\x7d\
\\x57\xc7\x8d\x74\xb7\xc4\x9f\x72\x7e\x15\x22\x12\x58\x07\x99\x34\
\\x6e\x50\xde\x68\x65\xbc\xdb\xf8\xc8\xa8\x2b\x40\xdc\xfe\x32\xa4\
\\xca\x10\x21\xf0\xd3\x5d\x0f\x00\x6f\x9d\x36\x42\x4a\x5e\xc1\xe0"#
sbox1 :: Int -> Word8
sbox1 = arrayRead8 t
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\
\\xa0\x84\x07\x14\xb5\x90\x2c\xa3\xb2\x73\x4c\x54\x92\x74\x36\x51\
\\x38\xb0\xbd\x5a\xfc\x60\x62\x96\x6c\x42\xf7\x10\x7c\x28\x27\x8c\
\\x13\x95\x9c\xc7\x24\x46\x3b\x70\xca\xe3\x85\xcb\x11\xd0\x93\xb8\
\\xa6\x83\x20\xff\x9f\x77\xc3\xcc\x03\x6f\x08\xbf\x40\xe7\x2b\xe2\
\\x79\x0c\xaa\x82\x41\x3a\xea\xb9\xe4\x9a\xa4\x97\x7e\xda\x7a\x17\
\\x66\x94\xa1\x1d\x3d\xf0\xde\xb3\x0b\x72\xa7\x1c\xef\xd1\x53\x3e\
\\x8f\x33\x26\x5f\xec\x76\x2a\x49\x81\x88\xee\x21\xc4\x1a\xeb\xd9\
\\xc5\x39\x99\xcd\xad\x31\x8b\x01\x18\x23\xdd\x1f\x4e\x2d\xf9\x48\
\\x4f\xf2\x65\x8e\x78\x5c\x58\x19\x8d\xe5\x98\x57\x67\x7f\x05\x64\
\\xaf\x63\xb6\xfe\xf5\xb7\x3c\xa5\xce\xe9\x68\x44\xe0\x4d\x43\x69\
\\x29\x2e\xac\x15\x59\xa8\x0a\x9e\x6e\x47\xdf\x34\x35\x6a\xcf\xdc\
\\x22\xc9\xc0\x9b\x89\xd4\xed\xab\x12\xa2\x0d\x52\xbb\x02\x2f\xa9\
\\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] ]
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
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]
-- 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) ->
acc `xor` gfMult rsPolynomial (B.index key $ 8 * wordIndex + colIndex) rsVal
) 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
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 :: (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
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
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
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)

View file

@ -0,0 +1,39 @@
-- |
-- Module : Crypto.Cipher.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Symmetric cipher basic types
--
{-# LANGUAGE DeriveDataTypeable #-}
module Crypto.Cipher.Types
(
-- * Cipher classes
Cipher(..)
, BlockCipher(..)
, BlockCipher128(..)
, StreamCipher(..)
, DataUnitOffset
, KeySizeSpecifier(..)
-- , cfb8Encrypt
-- , cfb8Decrypt
-- * AEAD functions
, AEADMode(..)
, CCM_M(..)
, CCM_L(..)
, module Crypto.Cipher.Types.AEAD
-- * Initial Vector type and constructor
, IV
, makeIV
, nullIV
, ivAdd
-- * Authentification Tag
, AuthTag(..)
) where
import Crypto.Cipher.Types.Base
import Crypto.Cipher.Types.Block
import Crypto.Cipher.Types.Stream
import Crypto.Cipher.Types.AEAD

View file

@ -0,0 +1,74 @@
-- |
-- Module : Crypto.Cipher.Types.AEAD
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- 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 qualified Crypto.Internal.ByteArray as B
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
}
-- | Authenticated Encryption with Associated Data algorithms
data AEAD cipher = forall st . AEAD
{ aeadModeImpl :: AEADModeImpl st
, aeadState :: !st
}
-- | Append some header information to an AEAD context
aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher
aeadAppendHeader (AEAD impl st) aad = AEAD impl $ aeadImplAppendHeader impl st aad
-- | Encrypt some data and update the AEAD context
aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplEncrypt impl st ba
-- | Decrypt some data and update the AEAD context
aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
aeadDecrypt (AEAD impl st) ba = second (AEAD impl) $ aeadImplDecrypt impl st ba
-- | Finalize the AEAD context and return the authentication tag
aeadFinalize :: AEAD cipher -> Int -> AuthTag
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 aeadIni header input taglen = (tag, output)
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 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)

View file

@ -0,0 +1,65 @@
-- |
-- Module : Crypto.Cipher.Types.Base
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Symmetric cipher basic types
--
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Cipher.Types.Base
( KeySizeSpecifier(..)
, Cipher(..)
, AuthTag(..)
, AEADMode(..)
, CCM_M(..)
, CCM_L(..)
, DataUnitOffset
) where
import Data.Word
import Crypto.Internal.ByteArray (Bytes, ByteArrayAccess, ByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.DeepSeq
import Crypto.Error
-- | Different specifier for key size in bytes
data KeySizeSpecifier =
KeySizeRange Int Int -- ^ in the range [min,max]
| KeySizeEnum [Int] -- ^ one of the specified values
| KeySizeFixed Int -- ^ a specific size
deriving (Show,Eq)
-- | Offset inside an XTS data unit, measured in block size.
type DataUnitOffset = Word32
-- | Authentication Tag for AE cipher mode
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_L = CCM_L2 | CCM_L3 | CCM_L4 deriving (Show, Eq)
-- | AEAD Mode
data AEADMode =
AEAD_OCB -- OCB3
| AEAD_CCM Int CCM_M CCM_L
| AEAD_EAX
| AEAD_CWC
| AEAD_GCM
deriving (Show,Eq)
-- | Symmetric cipher class.
class Cipher cipher where
-- | Initialize a cipher context from a key
cipherInit :: ByteArray key => key -> CryptoFailable cipher
-- | Cipher name
cipherName :: cipher -> String
-- | return the size of the key required for this cipher.
-- Some cipher accept any size for key
cipherKeySize :: cipher -> KeySizeSpecifier

View file

@ -0,0 +1,271 @@
-- |
-- Module : Crypto.Cipher.Types.Block
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Block cipher basic types
--
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE Rank2Types #-}
module Crypto.Cipher.Types.Block
(
-- * BlockCipher
BlockCipher(..)
, BlockCipher128(..)
-- * Initialization vector (IV)
, IV(..)
, makeIV
, nullIV
, ivAdd
-- * XTS
, XTS
-- * AEAD
, AEAD(..)
-- , AEADState(..)
, AEADModeImpl(..)
, aeadAppendHeader
, aeadEncrypt
, aeadDecrypt
, aeadFinalize
-- * CFB 8 bits
--, cfb8Encrypt
--, cfb8Decrypt
) 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
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, withByteArray, Bytes)
import qualified Crypto.Internal.ByteArray as B
import Foreign.Ptr
import Foreign.Storable
-- | an IV parametrized by the cipher
data IV c = forall byteArray . ByteArray byteArray => IV byteArray
instance BlockCipher c => ByteArrayAccess (IV c) where
withByteArray (IV z) f = withByteArray z f
length (IV z) = B.length z
instance Eq (IV c) where
(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
-- | Symmetric block cipher class
class Cipher cipher => BlockCipher cipher where
-- | Return the size of block required for this block cipher
blockSize :: cipher -> Int
-- | Encrypt blocks
--
-- the input string need to be multiple of the block size
ecbEncrypt :: ByteArray ba => cipher -> ba -> ba
-- | Decrypt blocks
--
-- the input string need to be multiple of the block size
ecbDecrypt :: ByteArray ba => cipher -> ba -> ba
-- | encrypt using the CBC mode.
--
-- input need to be a multiple of the blocksize
cbcEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
cbcEncrypt = cbcEncryptGeneric
-- | decrypt using the CBC mode.
--
-- input need to be a multiple of the blocksize
cbcDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
cbcDecrypt = cbcDecryptGeneric
-- | encrypt using the CFB mode.
--
-- input need to be a multiple of the blocksize
cfbEncrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
cfbEncrypt = cfbEncryptGeneric
-- | decrypt using the CFB mode.
--
-- input need to be a multiple of the blocksize
cfbDecrypt :: ByteArray ba => cipher -> IV cipher -> ba -> ba
cfbDecrypt = cfbDecryptGeneric
-- | combine using the CTR mode.
--
-- CTR mode produce a stream of randomized data that is combined
-- (by XOR operation) with the input stream.
--
-- encryption and decryption are the same operation.
--
-- input can be of any size
ctrCombine :: ByteArray ba => cipher -> IV cipher -> ba -> ba
ctrCombine = ctrCombineGeneric
-- | Initialize a new AEAD State
--
-- When Nothing is returns, it means the mode is not handled.
aeadInit :: ByteArrayAccess iv => AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit _ _ _ = CryptoFailed CryptoError_AEADModeNotSupported
-- | class of block cipher with a 128 bits block size
class BlockCipher cipher => BlockCipher128 cipher where
-- | encrypt using the XTS mode.
--
-- input need to be a multiple of the blocksize, and the cipher
-- need to process 128 bits block only
xtsEncrypt :: 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 = 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
-- | 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)
-- | 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)
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 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
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
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
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
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
xtsEncryptGeneric :: (ByteArray ba, BlockCipher128 cipher) => XTS ba cipher
xtsEncryptGeneric = xtsGeneric ecbEncrypt
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 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
{-
-- | Encrypt using CFB mode in 8 bit output
--
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Encrypt :: BlockCipher a => a -> IV a -> B.byteString -> B.byteString
cfb8Encrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
where loop d iv@(IV i) m
| B.null m = return ()
| otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
where m' = if B.length m < blockSize ctx
then m `B.append` B.replicate (blockSize ctx - B.length m) 0
else B.take (blockSize ctx) m
r = cfbEncrypt ctx iv m'
out = B.head r
ni = IV (B.drop 1 i `B.snoc` out)
-- | Decrypt using CFB mode in 8 bit output
--
-- Effectively turn a Block cipher in CFB mode into a Stream cipher
cfb8Decrypt :: BlockCipher a => a -> IV a -> B.byteString -> B.byteString
cfb8Decrypt ctx origIv msg = B.unsafeCreate (B.length msg) $ \dst -> loop dst origIv msg
where loop d iv@(IV i) m
| B.null m = return ()
| otherwise = poke d out >> loop (d `plusPtr` 1) ni (B.drop 1 m)
where m' = if B.length m < blockSize ctx
then m `B.append` B.replicate (blockSize ctx - B.length m) 0
else B.take (blockSize ctx) m
r = cfbDecrypt ctx iv m'
out = B.head r
ni = IV (B.drop 1 i `B.snoc` B.head m')
-}

View file

@ -0,0 +1,50 @@
-- |
-- Module : Crypto.Cipher.Types.GF
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Slow Galois Field arithmetic for generic XTS and GCM implementation
--
module Crypto.Cipher.Types.GF
(
-- * XTS support
xtsGFMul
) where
import Crypto.Internal.Imports
import Crypto.Internal.ByteArray (ByteArray, withByteArray)
import qualified Crypto.Internal.ByteArray as B
import Foreign.Storable
import Foreign.Ptr
import Data.Bits
-- | Compute the gfmul with the XTS polynomial
--
-- block size need to be 128 bits.
--
-- FIXME: add support for big endian.
xtsGFMul :: ByteArray ba => ba -> ba
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
| 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
{-
const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL);
uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0);
a->q[1] = cpu_to_le64((le64_to_cpu(a->q[1]) << 1) | (a->q[0] & gf_mask ? 1 : 0));
a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r;
-}

View file

@ -0,0 +1,20 @@
-- |
-- Module : Crypto.Cipher.Types.Stream
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Stream cipher basic types
--
module Crypto.Cipher.Types.Stream
( StreamCipher(..)
) where
import Crypto.Cipher.Types.Base
import Crypto.Internal.ByteArray (ByteArray)
-- | Symmetric stream cipher class
class Cipher cipher => StreamCipher cipher where
-- | Combine using the stream cipher
streamCombine :: ByteArray ba => cipher -> ba -> (ba, cipher)

View file

@ -0,0 +1,21 @@
-- |
-- Module : Crypto.Cipher.Types.Utils
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
-- Basic utility for cipher related stuff
--
module Crypto.Cipher.Types.Utils where
import Crypto.Internal.ByteArray (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

View file

@ -0,0 +1,18 @@
module Crypto.Cipher.Utils
( validateKeySize
) where
import Crypto.Error
import Crypto.Cipher.Types
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

View file

@ -0,0 +1,75 @@
-- |
-- Module : Crypto.Cipher.XSalsa
-- License : BSD-style
-- Maintainer : Brandon Hamilton <brandon.hamilton@gmail.com>
-- Stability : stable
-- Portability : good
--
-- 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
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)
-- | 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 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"
| otherwise = unsafeDoIO $ do
stPtr <- B.alloc 132 $ \stPtr ->
B.withByteArray nonce $ \noncePtr ->
B.withByteArray key $ \keyPtr ->
ccryptonite_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
return $ State stPtr
where kLen = B.length key
nonceLen = B.length nonce
-- | Use an already initialized context and new nonce material to derive another
-- XSalsa context.
--
-- This allows a multi-level cascade where a first key @k1@ and nonce @n1@ is
-- used to get @HState(k1,n1)@, and this value is then used as key @k2@ to build
-- @XSalsa(k2,n2)@. Function 'initialize' is to be called with the first 192
-- bits of @n1|n2@, and the call to @derive@ should add the remaining 128 bits.
--
-- 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 (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 ->
ccryptonite_xsalsa_derive stPtr nonceLen noncePtr
return $ State stPtr
where nonceLen = B.length nonce
foreign import ccall "cryptonite_xsalsa_init"
ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
foreign import ccall "cryptonite_xsalsa_derive"
ccryptonite_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()