la_ancapo/stellar-veritas
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

70
bundled/Crypto/Cipher/AES.hs Normal file
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)

645
bundled/Crypto/Cipher/AES/Primitive.hs Normal file
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 ()

193
bundled/Crypto/Cipher/AESGCMSIV.hs Normal file
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

67
bundled/Crypto/Cipher/Blowfish.hs Normal file
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)

296
bundled/Crypto/Cipher/Blowfish/Box.hs Normal file
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\
\"#

258
bundled/Crypto/Cipher/Blowfish/Primitive.hs Normal file
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.

43
bundled/Crypto/Cipher/CAST5.hs Normal file
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

573
bundled/Crypto/Cipher/CAST5/Primitive.hs Normal file
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"#

28
bundled/Crypto/Cipher/Camellia.hs Normal file
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

283
bundled/Crypto/Cipher/Camellia/Primitive.hs Normal file
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)

126
bundled/Crypto/Cipher/ChaCha.hs Normal file
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 ()

201
bundled/Crypto/Cipher/ChaChaPoly1305.hs Normal file
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))
]

39
bundled/Crypto/Cipher/DES.hs Normal file
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

223
bundled/Crypto/Cipher/DES/Primitive.hs Normal file
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

84
bundled/Crypto/Cipher/RC4.hs Normal file
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

83
bundled/Crypto/Cipher/Salsa.hs Normal file
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 ()

90
bundled/Crypto/Cipher/TripleDES.hs Normal file
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)

45
bundled/Crypto/Cipher/Twofish.hs Normal file
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

311
bundled/Crypto/Cipher/Twofish/Primitive.hs Normal file
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)

39
bundled/Crypto/Cipher/Types.hs Normal file
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

74
bundled/Crypto/Cipher/Types/AEAD.hs Normal file
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)

65
bundled/Crypto/Cipher/Types/Base.hs Normal file
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

271
bundled/Crypto/Cipher/Types/Block.hs Normal file
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')
-}

50
bundled/Crypto/Cipher/Types/GF.hs Normal file
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;
-}

20
bundled/Crypto/Cipher/Types/Stream.hs Normal file
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)

21
bundled/Crypto/Cipher/Types/Utils.hs Normal file
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

18
bundled/Crypto/Cipher/Utils.hs Normal file
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

75
bundled/Crypto/Cipher/XSalsa.hs Normal file
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 ()

12
bundled/Crypto/Error.hs Normal file
View file

@ -0,0 +1,12 @@
-- |
-- Module : Crypto.Error
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : Stable
-- Portability : Excellent
--
module Crypto.Error
( module Crypto.Error.Types
) where
import Crypto.Error.Types

119
bundled/Crypto/Error/Types.hs Normal file
View file

@ -0,0 +1,119 @@
-- |
-- Module : Crypto.Error.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Cryptographic Error enumeration and handling
--
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.Error.Types
( CryptoError(..)
, CryptoFailable(..)
, throwCryptoErrorIO
, throwCryptoError
, onCryptoFailure
, eitherCryptoError
, maybeCryptoError
) where
import qualified Control.Exception as E
import Data.Data
import Basement.Monad (MonadFailure(..))
-- | Enumeration of all possible errors that can be found in this library
data CryptoError =
-- symmetric cipher errors
CryptoError_KeySizeInvalid
| CryptoError_IvSizeInvalid
| CryptoError_SeedSizeInvalid
| CryptoError_AEADModeNotSupported
-- public key cryptography error
| CryptoError_SecretKeySizeInvalid
| CryptoError_SecretKeyStructureInvalid
| CryptoError_PublicKeySizeInvalid
| CryptoError_SharedSecretSizeInvalid
-- elliptic cryptography error
| CryptoError_EcScalarOutOfBounds
| CryptoError_PointSizeInvalid
| CryptoError_PointFormatInvalid
| CryptoError_PointFormatUnsupported
| CryptoError_PointCoordinatesInvalid
| CryptoError_ScalarMultiplicationInvalid
-- Message authentification error
| CryptoError_MacKeyInvalid
| CryptoError_AuthenticationTagSizeInvalid
-- Prime generation error
| CryptoError_PrimeSizeInvalid
-- Parameter errors
| CryptoError_SaltTooSmall
| CryptoError_OutputLengthTooSmall
| CryptoError_OutputLengthTooBig
deriving (Show,Eq,Enum,Data)
instance E.Exception CryptoError
-- | A simple Either like type to represent a computation that can fail
--
-- 2 possibles values are:
--
-- * 'CryptoPassed' : The computation succeeded, and contains the result of the computation
--
-- * 'CryptoFailed' : The computation failed, and contains the cryptographic error associated
--
data CryptoFailable a =
CryptoPassed a
| CryptoFailed CryptoError
deriving (Show)
instance Eq a => Eq (CryptoFailable a) where
(==) (CryptoPassed a) (CryptoPassed b) = a == b
(==) (CryptoFailed e1) (CryptoFailed e2) = e1 == e2
(==) _ _ = False
instance Functor CryptoFailable where
fmap f (CryptoPassed a) = CryptoPassed (f a)
fmap _ (CryptoFailed r) = CryptoFailed r
instance Applicative CryptoFailable where
pure a = CryptoPassed a
(<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
instance Monad CryptoFailable where
return = pure
(>>=) m1 m2 = do
case m1 of
CryptoPassed a -> m2 a
CryptoFailed e -> CryptoFailed e
instance MonadFailure CryptoFailable where
type Failure CryptoFailable = CryptoError
mFail = CryptoFailed
-- | Throw an CryptoError as exception on CryptoFailed result,
-- otherwise return the computed value
throwCryptoErrorIO :: CryptoFailable a -> IO a
throwCryptoErrorIO (CryptoFailed e) = E.throwIO e
throwCryptoErrorIO (CryptoPassed r) = return r
-- | Same as 'throwCryptoErrorIO' but throw the error asynchronously.
throwCryptoError :: CryptoFailable a -> a
throwCryptoError (CryptoFailed e) = E.throw e
throwCryptoError (CryptoPassed r) = r
-- | Simple 'either' like combinator for CryptoFailable type
onCryptoFailure :: (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure onError _ (CryptoFailed e) = onError e
onCryptoFailure _ onSuccess (CryptoPassed r) = onSuccess r
-- | Transform a CryptoFailable to an Either
eitherCryptoError :: CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailed e) = Left e
eitherCryptoError (CryptoPassed a) = Right a
-- | Transform a CryptoFailable to a Maybe
maybeCryptoError :: CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailed _) = Nothing
maybeCryptoError (CryptoPassed r) = Just r

53
bundled/Crypto/Internal/Builder.hs Normal file
View file

@ -0,0 +1,53 @@
-- |
-- Module : Crypto.Internal.Builder
-- License : BSD-style
-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability : stable
-- Portability : Good
--
-- Delaying and merging ByteArray allocations. This is similar to module
-- "Data.ByteArray.Pack" except the total length is computed automatically based
-- on what is appended.
--
{-# LANGUAGE BangPatterns #-}
module Crypto.Internal.Builder
( Builder
, buildAndFreeze
, builderLength
, byte
, bytes
, zero
) where
import Data.ByteArray (ByteArray, ByteArrayAccess)
import qualified Data.ByteArray as B
import Data.Memory.PtrMethods (memSet)
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (poke)
import Crypto.Internal.Imports hiding (empty)
data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer
instance Semigroup Builder where
(Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f
where f p = f1 p >> f2 (p `plusPtr` s1)
builderLength :: Builder -> Int
builderLength (Builder s _) = s
buildAndFreeze :: ByteArray ba => Builder -> ba
buildAndFreeze (Builder s f) = B.allocAndFreeze s f
byte :: Word8 -> Builder
byte !b = Builder 1 (`poke` b)
bytes :: ByteArrayAccess ba => ba -> Builder
bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs)
zero :: Int -> Builder
zero s = if s > 0 then Builder s (\p -> memSet p 0 s) else empty
empty :: Builder
empty = Builder 0 (const $ return ())

39
bundled/Crypto/Internal/ByteArray.hs Normal file
View file

@ -0,0 +1,39 @@
-- |
-- Module : Crypto.Internal.ByteArray
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Simple and efficient byte array types
--
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide #-}
module Crypto.Internal.ByteArray
( module Data.ByteArray
, module Data.ByteArray.Mapping
, module Data.ByteArray.Encoding
, constAllZero
) where
import Data.ByteArray
import Data.ByteArray.Mapping
import Data.ByteArray.Encoding
import Data.Bits ((.|.))
import Data.Word (Word8)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peekByteOff)
import Crypto.Internal.Compat (unsafeDoIO)
constAllZero :: ByteArrayAccess ba => ba -> Bool
constAllZero b = unsafeDoIO $ withByteArray b $ \p -> loop p 0 0
where
loop :: Ptr b -> Int -> Word8 -> IO Bool
loop p i !acc
| i == len = return $! acc == 0
| otherwise = do
e <- peekByteOff p i
loop p (i+1) (acc .|. e)
len = Data.ByteArray.length b

48
bundled/Crypto/Internal/Compat.hs Normal file
View file

@ -0,0 +1,48 @@
-- |
-- Module : Crypto.Internal.Compat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- This module tries to keep all the difference between versions of base
-- or other needed packages, so that modules don't need to use CPP.
--
{-# LANGUAGE CPP #-}
module Crypto.Internal.Compat
( unsafeDoIO
, popCount
, byteSwap64
) where
import System.IO.Unsafe
import Data.Word
import Data.Bits
-- | Perform io for hashes that do allocation and FFI.
-- 'unsafeDupablePerformIO' is used when possible as the
-- computation is pure and the output is directly linked
-- to the input. We also do not modify anything after it has
-- been returned to the user.
unsafeDoIO :: IO a -> a
#if __GLASGOW_HASKELL__ > 704
unsafeDoIO = unsafeDupablePerformIO
#else
unsafeDoIO = unsafePerformIO
#endif
#if !(MIN_VERSION_base(4,5,0))
popCount :: Word64 -> Int
popCount n = loop 0 n
where loop c 0 = c
loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
#endif
#if !(MIN_VERSION_base(4,7,0))
byteSwap64 :: Word64 -> Word64
byteSwap64 w =
(w `shiftR` 56) .|. (w `shiftL` 56)
.|. ((w `shiftR` 40) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 40)
.|. ((w `shiftR` 24) .&. 0xff0000) .|. ((w .&. 0xff0000) `shiftL` 24)
.|. ((w `shiftR` 8) .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
#endif

109
bundled/Crypto/Internal/CompatPrim.hs Normal file
View file

@ -0,0 +1,109 @@
-- |
-- Module : Crypto.Internal.CompatPrim
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Compat
--
-- This module tries to keep all the difference between versions of ghc primitive
-- or other needed packages, so that modules don't need to use CPP.
--
-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
-- to write compat code for primitives.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Crypto.Internal.CompatPrim
( be32Prim
, le32Prim
, byteswap32Prim
, booleanPrim
, convert4To32
) where
#if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
import Data.Memory.Endian (getSystemEndianness, Endianness(..))
#endif
#if __GLASGOW_HASKELL__ >= 902
import GHC.Prim
#else
import GHC.Prim hiding (Word32#)
type Word32# = Word#
#endif
-- | Byteswap Word# to or from Big Endian
--
-- On a big endian machine, this function is a nop.
be32Prim :: Word32# -> Word32#
#ifdef ARCH_IS_LITTLE_ENDIAN
be32Prim = byteswap32Prim
#elif defined(ARCH_IS_BIG_ENDIAN)
be32Prim = id
#else
be32Prim w = if getSystemEndianness == LittleEndian then byteswap32Prim w else w
#endif
-- | Byteswap Word# to or from Little Endian
--
-- On a little endian machine, this function is a nop.
le32Prim :: Word32# -> Word32#
#ifdef ARCH_IS_LITTLE_ENDIAN
le32Prim w = w
#elif defined(ARCH_IS_BIG_ENDIAN)
le32Prim = byteswap32Prim
#else
le32Prim w = if getSystemEndianness == LittleEndian then w else byteswap32Prim w
#endif
-- | Simple compatibility for byteswap the lower 32 bits of a Word#
-- at the primitive level
byteswap32Prim :: Word32# -> Word32#
#if __GLASGOW_HASKELL__ >= 902
byteswap32Prim w = wordToWord32# (byteSwap32# (word32ToWord# w))
#else
byteswap32Prim w = byteSwap32# w
#endif
-- | Combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d]
convert4To32 :: Word# -> Word# -> Word# -> Word#
-> Word#
convert4To32 a b c d = or# (or# c1 c2) (or# c3 c4)
where
#ifdef ARCH_IS_LITTLE_ENDIAN
!c1 = uncheckedShiftL# a 24#
!c2 = uncheckedShiftL# b 16#
!c3 = uncheckedShiftL# c 8#
!c4 = d
#elif defined(ARCH_IS_BIG_ENDIAN)
!c1 = uncheckedShiftL# d 24#
!c2 = uncheckedShiftL# c 16#
!c3 = uncheckedShiftL# b 8#
!c4 = a
#else
!c1
| getSystemEndianness == LittleEndian = uncheckedShiftL# a 24#
| otherwise = uncheckedShiftL# d 24#
!c2
| getSystemEndianness == LittleEndian = uncheckedShiftL# b 16#
| otherwise = uncheckedShiftL# c 16#
!c3
| getSystemEndianness == LittleEndian = uncheckedShiftL# c 8#
| otherwise = uncheckedShiftL# b 8#
!c4
| getSystemEndianness == LittleEndian = d
| otherwise = a
#endif
-- | Simple wrapper to handle pre 7.8 and future, where
-- most comparaison functions don't returns a boolean
-- anymore.
#if __GLASGOW_HASKELL__ >= 708
booleanPrim :: Int# -> Bool
booleanPrim v = tagToEnum# v
#else
booleanPrim :: Bool -> Bool
booleanPrim b = b
#endif

35
bundled/Crypto/Internal/DeepSeq.hs Normal file
View file

@ -0,0 +1,35 @@
-- |
-- Module : Crypto.Internal.DeepSeq
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Simple abstraction module to allow compilation without deepseq
-- by defining our own NFData class if not compiling with deepseq
-- support.
--
{-# LANGUAGE CPP #-}
module Crypto.Internal.DeepSeq
( NFData(..)
) where
#ifdef WITH_DEEPSEQ_SUPPORT
import Control.DeepSeq
#else
import Data.Word
import Data.ByteArray
class NFData a where rnf :: a -> ()
instance NFData Word8 where rnf w = w `seq` ()
instance NFData Word16 where rnf w = w `seq` ()
instance NFData Word32 where rnf w = w `seq` ()
instance NFData Word64 where rnf w = w `seq` ()
instance NFData Bytes where rnf b = b `seq` ()
instance NFData ScrubbedBytes where rnf b = b `seq` ()
instance NFData Integer where rnf i = i `seq` ()
#endif

20
bundled/Crypto/Internal/Imports.hs Normal file
View file

@ -0,0 +1,20 @@
-- |
-- Module : Crypto.Internal.Imports
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
{-# LANGUAGE CPP #-}
module Crypto.Internal.Imports
( module X
) where
import Data.Word as X
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup as X (Semigroup(..))
#endif
import Control.Applicative as X
import Control.Monad as X (forM, forM_, void)
import Control.Arrow as X (first, second)
import Crypto.Internal.DeepSeq as X

213
bundled/Crypto/Internal/Nat.hs Normal file
View file

@ -0,0 +1,213 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Internal.Nat
( type IsDivisibleBy8
, type IsAtMost, type IsAtLeast
, byteLen
, integralNatVal
, type IsDiv8
, type Div8
, type Mod8
) where
import GHC.TypeLits
byteLen :: (KnownNat bitlen, Num a) => proxy bitlen -> a
byteLen d = fromInteger ((natVal d + 7) `div` 8)
integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a
integralNatVal = fromInteger . natVal
type family IsLE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
IsLE _ _ 'True = 'True
#if MIN_VERSION_base(4,9,0)
IsLE bitlen n 'False = TypeError
( ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is greater than " ':<>: 'ShowType n)
':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
)
#else
IsLE bitlen n 'False = 'False
#endif
-- | ensure the given `bitlen` is lesser or equal to `n`
--
type IsAtMost (bitlen :: Nat) (n :: Nat) = IsLE bitlen n (bitlen <=? n) ~ 'True
type family IsGE (bitlen :: Nat) (n :: Nat) (c :: Bool) where
IsGE _ _ 'True = 'True
#if MIN_VERSION_base(4,9,0)
IsGE bitlen n 'False = TypeError
( ('Text "bitlen " ':<>: 'ShowType bitlen ':<>: 'Text " is lesser than " ':<>: 'ShowType n)
':$$: ('Text "You have tried to use an invalid Digest size. Please, refer to the documentation.")
)
#else
IsGE bitlen n 'False = 'False
#endif
-- | ensure the given `bitlen` is greater or equal to `n`
--
type IsAtLeast (bitlen :: Nat) (n :: Nat) = IsGE bitlen n (n <=? bitlen) ~ 'True
type family Div8 (bitLen :: Nat) where
Div8 0 = 0
Div8 1 = 0
Div8 2 = 0
Div8 3 = 0
Div8 4 = 0
Div8 5 = 0
Div8 6 = 0
Div8 7 = 0
Div8 8 = 1
Div8 9 = 1
Div8 10 = 1
Div8 11 = 1
Div8 12 = 1
Div8 13 = 1
Div8 14 = 1
Div8 15 = 1
Div8 16 = 2
Div8 17 = 2
Div8 18 = 2
Div8 19 = 2
Div8 20 = 2
Div8 21 = 2
Div8 22 = 2
Div8 23 = 2
Div8 24 = 3
Div8 25 = 3
Div8 26 = 3
Div8 27 = 3
Div8 28 = 3
Div8 29 = 3
Div8 30 = 3
Div8 31 = 3
Div8 32 = 4
Div8 33 = 4
Div8 34 = 4
Div8 35 = 4
Div8 36 = 4
Div8 37 = 4
Div8 38 = 4
Div8 39 = 4
Div8 40 = 5
Div8 41 = 5
Div8 42 = 5
Div8 43 = 5
Div8 44 = 5
Div8 45 = 5
Div8 46 = 5
Div8 47 = 5
Div8 48 = 6
Div8 49 = 6
Div8 50 = 6
Div8 51 = 6
Div8 52 = 6
Div8 53 = 6
Div8 54 = 6
Div8 55 = 6
Div8 56 = 7
Div8 57 = 7
Div8 58 = 7
Div8 59 = 7
Div8 60 = 7
Div8 61 = 7
Div8 62 = 7
Div8 63 = 7
Div8 64 = 8
Div8 n = 8 + Div8 (n - 64)
type family IsDiv8 (bitLen :: Nat) (n :: Nat) where
IsDiv8 _ 0 = 'True
#if MIN_VERSION_base(4,9,0)
IsDiv8 bitLen 1 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 2 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 3 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 4 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 5 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 6 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
IsDiv8 bitLen 7 = TypeError ('Text "bitLen " ':<>: 'ShowType bitLen ':<>: 'Text " is not divisible by 8")
#else
IsDiv8 _ 1 = 'False
IsDiv8 _ 2 = 'False
IsDiv8 _ 3 = 'False
IsDiv8 _ 4 = 'False
IsDiv8 _ 5 = 'False
IsDiv8 _ 6 = 'False
IsDiv8 _ 7 = 'False
#endif
IsDiv8 _ n = IsDiv8 n (Mod8 n)
type family Mod8 (n :: Nat) where
Mod8 0 = 0
Mod8 1 = 1
Mod8 2 = 2
Mod8 3 = 3
Mod8 4 = 4
Mod8 5 = 5
Mod8 6 = 6
Mod8 7 = 7
Mod8 8 = 0
Mod8 9 = 1
Mod8 10 = 2
Mod8 11 = 3
Mod8 12 = 4
Mod8 13 = 5
Mod8 14 = 6
Mod8 15 = 7
Mod8 16 = 0
Mod8 17 = 1
Mod8 18 = 2
Mod8 19 = 3
Mod8 20 = 4
Mod8 21 = 5
Mod8 22 = 6
Mod8 23 = 7
Mod8 24 = 0
Mod8 25 = 1
Mod8 26 = 2
Mod8 27 = 3
Mod8 28 = 4
Mod8 29 = 5
Mod8 30 = 6
Mod8 31 = 7
Mod8 32 = 0
Mod8 33 = 1
Mod8 34 = 2
Mod8 35 = 3
Mod8 36 = 4
Mod8 37 = 5
Mod8 38 = 6
Mod8 39 = 7
Mod8 40 = 0
Mod8 41 = 1
Mod8 42 = 2
Mod8 43 = 3
Mod8 44 = 4
Mod8 45 = 5
Mod8 46 = 6
Mod8 47 = 7
Mod8 48 = 0
Mod8 49 = 1
Mod8 50 = 2
Mod8 51 = 3
Mod8 52 = 4
Mod8 53 = 5
Mod8 54 = 6
Mod8 55 = 7
Mod8 56 = 0
Mod8 57 = 1
Mod8 58 = 2
Mod8 59 = 3
Mod8 60 = 4
Mod8 61 = 5
Mod8 62 = 6
Mod8 63 = 7
Mod8 n = Mod8 (n - 64)
-- | ensure the given `bitlen` is divisible by 8
--
type IsDivisibleBy8 bitLen = IsDiv8 bitLen bitLen ~ 'True

157
bundled/Crypto/Internal/WordArray.hs Normal file
View file

@ -0,0 +1,157 @@
-- |
-- Module : Crypto.Internal.WordArray
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : Good
--
-- Small and self contained array representation
-- with limited safety for internal use.
--
-- The array produced should never be exposed to the user directly.
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Crypto.Internal.WordArray
( Array8
, Array32
, Array64
, MutableArray32
, array8
, array32
, array32FromAddrBE
, allocArray32AndFreeze
, mutableArray32
, array64
, arrayRead8
, arrayRead32
, arrayRead64
, mutableArrayRead32
, mutableArrayWrite32
, mutableArrayWriteXor32
, mutableArray32FromAddrBE
, mutableArray32Freeze
) where
import Data.Word
import Data.Bits (xor)
import Crypto.Internal.Compat
import Crypto.Internal.CompatPrim
import GHC.Prim
import GHC.Types
import GHC.Word
-- | Array of Word8
data Array8 = Array8 Addr#
-- | Array of Word32
data Array32 = Array32 ByteArray#
-- | Array of Word64
data Array64 = Array64 ByteArray#
-- | Array of mutable Word32
data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
-- | Create an array of Word8 aliasing an Addr#
array8 :: Addr# -> Array8
array8 = Array8
-- | Create an Array of Word32 of specific size from a list of Word32
array32 :: Int -> [Word32] -> Array32
array32 n l = unsafeDoIO (mutableArray32 n l >>= mutableArray32Freeze)
{-# NOINLINE array32 #-}
-- | Create an Array of BE Word32 aliasing an Addr
array32FromAddrBE :: Int -> Addr# -> Array32
array32FromAddrBE n a =
unsafeDoIO (mutableArray32FromAddrBE n a >>= mutableArray32Freeze)
{-# NOINLINE array32FromAddrBE #-}
-- | Create an Array of Word32 using an initializer
allocArray32AndFreeze :: Int -> (MutableArray32 -> IO ()) -> Array32
allocArray32AndFreeze n f =
unsafeDoIO (mutableArray32 n [] >>= \m -> f m >> mutableArray32Freeze m)
{-# NOINLINE allocArray32AndFreeze #-}
-- | Create an Array of Word64 of specific size from a list of Word64
array64 :: Int -> [Word64] -> Array64
array64 (I# n) l = unsafeDoIO $ IO $ \s ->
case newAlignedPinnedByteArray# (n *# 8#) 8# s of
(# s', mbarr #) -> loop 0# s' mbarr l
where
loop _ st mb [] = freezeArray mb st
loop i st mb ((W64# x):xs)
| booleanPrim (i ==# n) = freezeArray mb st
| otherwise =
let !st' = writeWord64Array# mb i x st
in loop (i +# 1#) st' mb xs
freezeArray mb st =
case unsafeFreezeByteArray# mb st of
(# st', b #) -> (# st', Array64 b #)
{-# NOINLINE array64 #-}
-- | Create a Mutable Array of Word32 of specific size from a list of Word32
mutableArray32 :: Int -> [Word32] -> IO MutableArray32
mutableArray32 (I# n) l = IO $ \s ->
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
(# s', mbarr #) -> loop 0# s' mbarr l
where
loop _ st mb [] = (# st, MutableArray32 mb #)
loop i st mb ((W32# x):xs)
| booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
| otherwise =
let !st' = writeWord32Array# mb i x st
in loop (i +# 1#) st' mb xs
-- | Create a Mutable Array of BE Word32 aliasing an Addr
mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
mutableArray32FromAddrBE (I# n) a = IO $ \s ->
case newAlignedPinnedByteArray# (n *# 4#) 4# s of
(# s', mbarr #) -> loop 0# s' mbarr
where
loop i st mb
| booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
| otherwise =
let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
in loop (i +# 1#) st' mb
-- | freeze a Mutable Array of Word32 into a immutable Array of Word32
mutableArray32Freeze :: MutableArray32 -> IO Array32
mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
case unsafeFreezeByteArray# mb st of
(# st', b #) -> (# st', Array32 b #)
-- | Read a Word8 from an Array
arrayRead8 :: Array8 -> Int -> Word8
arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
{-# INLINE arrayRead8 #-}
-- | Read a Word32 from an Array
arrayRead32 :: Array32 -> Int -> Word32
arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
{-# INLINE arrayRead32 #-}
-- | Read a Word64 from an Array
arrayRead64 :: Array64 -> Int -> Word64
arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
{-# INLINE arrayRead64 #-}
-- | Read a Word32 from a Mutable Array of Word32
mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
{-# INLINE mutableArrayRead32 #-}
-- | Write a Word32 from a Mutable Array of Word32
mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let !s' = writeWord32Array# m o w s in (# s', () #)
{-# INLINE mutableArrayWrite32 #-}
-- | Write into the Mutable Array of Word32 by combining through xor the current value and the new value.
--
-- > x[i] = x[i] xor value
mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
mutableArrayWriteXor32 m o w =
mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
{-# INLINE mutableArrayWriteXor32 #-}

26
bundled/Crypto/Internal/Words.hs Normal file
View file

@ -0,0 +1,26 @@
-- |
-- Module : Crypto.Internal.Words
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Extra Word size
--
module Crypto.Internal.Words
( Word128(..)
, w64to32
, w32to64
) where
import Data.Word
import Data.Bits
import Data.Memory.ExtendedWords
-- | Split a 'Word64' into the highest and lowest 'Word32'
w64to32 :: Word64 -> (Word32, Word32)
w64to32 w = (fromIntegral (w `shiftR` 32), fromIntegral w)
-- | Reconstruct a 'Word64' from two 'Word32'
w32to64 :: (Word32, Word32) -> Word64
w32to64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)

116
bundled/Crypto/Number/Basic.hs Normal file
View file

@ -0,0 +1,116 @@
-- |
-- Module : Crypto.Number.Basic
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Basic
( sqrti
, gcde
, areEven
, log2
, numBits
, numBytes
, asPowerOf2AndOdd
) where
import Data.Bits
import Crypto.Number.Compat
-- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@.
-- The implementation is quite naive, use an approximation for the first number
-- and use a dichotomy algorithm to compute the bound relatively efficiently.
sqrti :: Integer -> (Integer, Integer)
sqrti i
| i < 0 = error "cannot compute negative square root"
| i == 0 = (0,0)
| i == 1 = (1,1)
| i == 2 = (1,2)
| otherwise = loop x0
where
nbdigits = length $ show i
x0n = (if even nbdigits then nbdigits - 2 else nbdigits - 1) `div` 2
x0 = if even nbdigits then 2 * 10 ^ x0n else 6 * 10 ^ x0n
loop x = case compare (sq x) i of
LT -> iterUp x
EQ -> (x, x)
GT -> iterDown x
iterUp lb = if sq ub >= i then iter lb ub else iterUp ub
where ub = lb * 2
iterDown ub = if sq lb >= i then iterDown lb else iter lb ub
where lb = ub `div` 2
iter lb ub
| lb == ub = (lb, ub)
| lb+1 == ub = (lb, ub)
| otherwise =
let d = (ub - lb) `div` 2 in
if sq (lb + d) >= i
then iter lb (ub-d)
else iter (lb+d) ub
sq a = a * a
-- | Get the extended GCD of two integer using integer divMod
--
-- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
--
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
gcde a b = onGmpUnsupported (gmpGcde a b) $
if d < 0 then (-x,-y,-d) else (x,y,d)
where
(d, x, y) = f (a,1,0) (b,0,1)
f t (0, _, _) = t
f (a', sa, ta) t@(b', sb, tb) =
let (q, r) = a' `divMod` b' in
f t (r, sa - (q * sb), ta - (q * tb))
-- | Check if a list of integer are all even
areEven :: [Integer] -> Bool
areEven = and . map even
-- | Compute the binary logarithm of a integer
log2 :: Integer -> Int
log2 n = onGmpUnsupported (gmpLog2 n) $ imLog 2 n
where
-- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html
imLog b x = if x < b then 0 else (x `div` b^l) `doDiv` l
where
l = 2 * imLog (b * b) x
doDiv x' l' = if x' < b then l' else (x' `div` b) `doDiv` (l' + 1)
{-# INLINE log2 #-}
-- | Compute the number of bits for an integer
numBits :: Integer -> Int
numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBits 0 n)
where computeBits !acc i
| q == 0 =
if r >= 0x80 then acc+8
else if r >= 0x40 then acc+7
else if r >= 0x20 then acc+6
else if r >= 0x10 then acc+5
else if r >= 0x08 then acc+4
else if r >= 0x04 then acc+3
else if r >= 0x02 then acc+2
else if r >= 0x01 then acc+1
else acc -- should be catch by previous loop
| otherwise = computeBits (acc+8) q
where (q,r) = i `divMod` 256
-- | Compute the number of bytes for an integer
numBytes :: Integer -> Int
numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8)
-- | Express an integer as an odd number and a power of 2
asPowerOf2AndOdd :: Integer -> (Int, Integer)
asPowerOf2AndOdd a
| a == 0 = (0, 0)
| odd a = (0, a)
| a < 0 = let (e, a1) = asPowerOf2AndOdd $ abs a in (e, -a1)
| isPowerOf2 a = (log2 a, 1)
| otherwise = loop a 0
where
isPowerOf2 n = (n /= 0) && ((n .&. (n - 1)) == 0)
loop n pw = if n `mod` 2 == 0 then loop (n `div` 2) (pw + 1)
else (pw, n)

195
bundled/Crypto/Number/Compat.hs Normal file
View file

@ -0,0 +1,195 @@
-- |
-- Module : Crypto.Number.Compat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
module Crypto.Number.Compat
( GmpSupported(..)
, onGmpUnsupported
, gmpGcde
, gmpLog2
, gmpPowModSecInteger
, gmpPowModInteger
, gmpInverse
, gmpNextPrime
, gmpTestPrimeMillerRabin
, gmpSizeInBytes
, gmpSizeInBits
, gmpExportInteger
, gmpExportIntegerLE
, gmpImportInteger
, gmpImportIntegerLE
) where
#ifndef MIN_VERSION_integer_gmp
#define MIN_VERSION_integer_gmp(a,b,c) 0
#endif
#if MIN_VERSION_integer_gmp(0,5,1)
import GHC.Integer.GMP.Internals
import GHC.Base
import GHC.Integer.Logarithms (integerLog2#)
#endif
import Data.Word
import GHC.Ptr (Ptr(..))
-- | GMP Supported / Unsupported
data GmpSupported a = GmpSupported a
| GmpUnsupported
deriving (Show,Eq)
-- | Simple combinator in case the operation is not supported through GMP
onGmpUnsupported :: GmpSupported a -> a -> a
onGmpUnsupported (GmpSupported a) _ = a
onGmpUnsupported GmpUnsupported f = f
-- | Compute the GCDE of a two integer through GMP
gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gmpGcde a b =
GmpSupported (s, t, g)
where (# g, s #) = gcdExtInteger a b
t = (g - s * a) `div` b
#else
gmpGcde _ _ = GmpUnsupported
#endif
-- | Compute the binary logarithm of an integer through GMP
gmpLog2 :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpLog2 0 = GmpSupported 0
gmpLog2 x = GmpSupported (I# (integerLog2# x))
#else
gmpLog2 _ = GmpUnsupported
#endif
-- | Compute the power modulus using extra security to remain constant
-- time wise through GMP
gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(1,1,0)
gmpPowModSecInteger _ _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(1,0,2)
gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
#elif MIN_VERSION_integer_gmp(1,0,0)
gmpPowModSecInteger _ _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
#else
gmpPowModSecInteger _ _ _ = GmpUnsupported
#endif
-- | Compute the power modulus through GMP
gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(0,5,1)
gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
#else
gmpPowModInteger _ _ _ = GmpUnsupported
#endif
-- | Inverse modulus of a number through GMP
gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gmpInverse g m
| r == 0 = GmpSupported Nothing
| otherwise = GmpSupported (Just r)
where r = recipModInteger g m
#else
gmpInverse _ _ = GmpUnsupported
#endif
-- | Get the next prime from a specific value through GMP
gmpNextPrime :: Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(1,1,0)
gmpNextPrime _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpNextPrime n = GmpSupported (nextPrimeInteger n)
#else
gmpNextPrime _ = GmpUnsupported
#endif
-- | Test if a number is prime using Miller Rabin
gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
#if MIN_VERSION_integer_gmp(1,1,0)
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
case testPrimeInteger n tries of
0# -> False
_ -> True
#else
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
#endif
-- | Return the size in bytes of an integer
gmpSizeInBytes :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
#else
gmpSizeInBytes _ = GmpUnsupported
#endif
-- | Return the size in bits of an integer
gmpSizeInBits :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
#else
gmpSizeInBits _ = GmpUnsupported
#endif
-- | Export an integer to a memory (big-endian)
gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
#if MIN_VERSION_integer_gmp(1,0,0)
gmpExportInteger n (Ptr addr) = GmpSupported $ do
_ <- exportIntegerToAddr n addr 1#
return ()
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
case exportIntegerToAddr n addr 1# s of
(# s2, _ #) -> (# s2, () #)
#else
gmpExportInteger _ _ = GmpUnsupported
#endif
-- | Export an integer to a memory (little-endian)
gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
#if MIN_VERSION_integer_gmp(1,0,0)
gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
_ <- exportIntegerToAddr n addr 0#
return ()
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s ->
case exportIntegerToAddr n addr 0# s of
(# s2, _ #) -> (# s2, () #)
#else
gmpExportIntegerLE _ _ = GmpUnsupported
#endif
-- | Import an integer from a memory (big-endian)
gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
#if MIN_VERSION_integer_gmp(1,0,0)
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
importIntegerFromAddr addr (int2Word# n) 1#
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
importIntegerFromAddr addr (int2Word# n) 1# s
#else
gmpImportInteger _ _ = GmpUnsupported
#endif
-- | Import an integer from a memory (little-endian)
gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
#if MIN_VERSION_integer_gmp(1,0,0)
gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
importIntegerFromAddr addr (int2Word# n) 0#
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
importIntegerFromAddr addr (int2Word# n) 0# s
#else
gmpImportIntegerLE _ _ = GmpUnsupported
#endif

169
bundled/Crypto/Number/F2m.hs Normal file
View file

@ -0,0 +1,169 @@
-- |
-- Module : Crypto.Math.F2m
-- License : BSD-style
-- Maintainer : Danny Navarro <j@dannynavarro.net>
-- Stability : experimental
-- Portability : Good
--
-- This module provides basic arithmetic operations over F₂m. Performance is
-- not optimal and it doesn't provide protection against timing
-- attacks. The 'm' parameter is implicitly derived from the irreducible
-- polynomial where applicable.
module Crypto.Number.F2m
( BinaryPolynomial
, addF2m
, mulF2m
, squareF2m'
, squareF2m
, powF2m
, modF2m
, sqrtF2m
, invF2m
, divF2m
) where
import Data.Bits (xor, shift, testBit, setBit)
import Data.List
import Crypto.Number.Basic
-- | Binary Polynomial represented by an integer
type BinaryPolynomial = Integer
-- | Addition over F₂m. This is just a synonym of 'xor'.
addF2m :: Integer
-> Integer
-> Integer
addF2m = xor
{-# INLINE addF2m #-}
-- | Reduction by modulo over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
modF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
modF2m fx i
| fx < 0 || i < 0 = error "modF2m: negative number represent no binary polynomial"
| fx == 0 = error "modF2m: cannot divide by zero polynomial"
| fx == 1 = 0
| otherwise = go i
where
lfx = log2 fx
go n | s == 0 = n `addF2m` fx
| s < 0 = n
| otherwise = go $ n `addF2m` shift fx s
where s = log2 n - lfx
{-# INLINE modF2m #-}
-- | Multiplication over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
mulF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
-> Integer
mulF2m fx n1 n2
| fx < 0
|| n1 < 0
|| n2 < 0 = error "mulF2m: negative number represent no binary polynomial"
| fx == 0 = error "mulF2m: cannot multiply modulo zero polynomial"
| otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2)
where
go n s | s == 0 = n
| otherwise = if testBit n2 s
then go (n `addF2m` shift n1 s) (s - 1)
else go n (s - 1)
{-# INLINABLE mulF2m #-}
-- | Squaring over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
squareF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
squareF2m fx = modF2m fx . squareF2m'
{-# INLINE squareF2m #-}
-- | Squaring over F₂m without reduction by modulo.
--
-- The implementation utilizes the fact that for binary polynomial S(x) we have
-- S(x)^2 = S(x^2). In other words, insert a zero bit between every bits of argument: 1101 -> 1010001.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent.
squareF2m' :: Integer
-> Integer
squareF2m' n
| n < 0 = error "mulF2m: negative number represent no binary polynomial"
| otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n]
{-# INLINE squareF2m' #-}
-- | Exponentiation in F₂m by computing @a^b mod fx@.
--
-- This implements an exponentiation by squaring based solution. It inherits the
-- same restrictions as 'squareF2m'. Negative exponents are disallowed.
powF2m :: BinaryPolynomial -- ^Modulus
-> Integer -- ^a
-> Integer -- ^b
-> Integer
powF2m fx a b
| b < 0 = error "powF2m: negative exponents disallowed"
| b == 0 = if fx > 1 then 1 else 0
| even b = squareF2m fx x
| otherwise = mulF2m fx a (squareF2m' x)
where x = powF2m fx a (b `div` 2)
-- | Square rooot in F₂m.
--
-- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@
-- from a classical result by Lagrange. Thus the square root is simply @a^(2^(m
-- - 1))@.
sqrtF2m :: BinaryPolynomial -- ^Modulus
-> Integer -- ^a
-> Integer
sqrtF2m fx a = go (log2 fx - 1) a
where go 0 x = x
go n x = go (n - 1) (squareF2m fx x)
-- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@.
--
-- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm
gcdF2m :: Integer
-> Integer
-> (Integer, Integer, Integer)
gcdF2m a b = go (a, b, 1, 0, 0, 1)
where
go (g, 0, u, _, v, _)
= (g, u, v)
go (r0, r1, s0, s1, t0, t1)
= go (r1, r0 `addF2m` shift r1 j, s1, s0 `addF2m` shift s1 j, t1, t0 `addF2m` shift t1 j)
where j = max 0 (log2 r0 - log2 r1)
-- | Modular inversion over F₂m.
-- If @n@ doesn't have an inverse, 'Nothing' is returned.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
invF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Maybe Integer
invF2m fx n = if g == 1 then Just (modF2m fx u) else Nothing
where
(g, u, _) = gcdF2m n fx
{-# INLINABLE invF2m #-}
-- | Division over F₂m. If the dividend doesn't have an inverse it returns
-- 'Nothing'.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
divF2m :: BinaryPolynomial -- ^ Modulus
-> Integer -- ^ Dividend
-> Integer -- ^ Divisor
-> Maybe Integer -- ^ Quotient
divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2
{-# INLINE divF2m #-}

123
bundled/Crypto/Number/Generate.hs Normal file
View file

@ -0,0 +1,123 @@
-- |
-- Module : Crypto.Number.Generate
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
module Crypto.Number.Generate
( GenTopPolicy(..)
, generateParams
, generateMax
, generateBetween
) where
import Crypto.Internal.Imports
import Crypto.Number.Basic
import Crypto.Number.Serialize
import Crypto.Random.Types
import Control.Monad (when)
import Foreign.Ptr
import Foreign.Storable
import Data.Bits ((.|.), (.&.), shiftL, complement, testBit)
import Crypto.Internal.ByteArray (ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
-- | Top bits policy when generating a number
data GenTopPolicy =
SetHighest -- ^ set the highest bit
| SetTwoHighest -- ^ set the two highest bit
deriving (Show,Eq)
-- | Generate a number for a specific size of bits,
-- and optionaly set bottom and top bits
--
-- If the top bit policy is 'Nothing', then nothing is
-- done on the highest bit (it's whatever the random generator set).
--
-- If @generateOdd is set to 'True', then the number generated
-- is guaranteed to be odd. Otherwise it will be whatever is generated
--
generateParams :: MonadRandom m
=> Int -- ^ number of bits
-> Maybe GenTopPolicy -- ^ top bit policy
-> Bool -- ^ force the number to be odd
-> m Integer
generateParams bits genTopPolicy generateOdd
| bits <= 0 = return 0
| otherwise = os2ip . tweak <$> getRandomBytes bytes
where
tweak :: ScrubbedBytes -> ScrubbedBytes
tweak orig = B.copyAndFreeze orig $ \p0 -> do
let p1 = p0 `plusPtr` 1
pEnd = p0 `plusPtr` (bytes - 1)
case genTopPolicy of
Nothing -> return ()
Just SetHighest -> p0 |= (1 `shiftL` bit)
Just SetTwoHighest
| bit == 0 -> do p0 $= 0x1
p1 |= 0x80
| otherwise -> p0 |= (0x3 `shiftL` (bit - 1))
p0 &= (complement $ mask)
when generateOdd (pEnd |= 0x1)
($=) :: Ptr Word8 -> Word8 -> IO ()
($=) p w = poke p w
(|=) :: Ptr Word8 -> Word8 -> IO ()
(|=) p w = peek p >>= \v -> poke p (v .|. w)
(&=) :: Ptr Word8 -> Word8 -> IO ()
(&=) p w = peek p >>= \v -> poke p (v .&. w)
bytes = (bits + 7) `div` 8;
bit = (bits - 1) `mod` 8;
mask = 0xff `shiftL` (bit + 1);
-- | Generate a positive integer x, s.t. 0 <= x < range
generateMax :: MonadRandom m
=> Integer -- ^ range
-> m Integer
generateMax range
| range <= 1 = return 0
| range < 127 = generateSimple
| canOverGenerate = loopGenerateOver tries
| otherwise = loopGenerate tries
where
-- this "generator" is mostly for quickcheck benefits. it'll be biased if
-- range is not a multiple of 2, but overall, no security should be
-- assumed for a number between 0 and 127.
generateSimple = flip mod range `fmap` generateParams bits Nothing False
loopGenerate count
| count == 0 = error $ "internal: generateMax(" ++ show range ++ " bits=" ++ show bits ++ ") (normal) doesn't seems to work properly"
| otherwise = do
r <- generateParams bits Nothing False
if isValid r then return r else loopGenerate (count-1)
loopGenerateOver count
| count == 0 = error $ "internal: generateMax(" ++ show range ++ " bits=" ++ show bits ++ ") (over) doesn't seems to work properly"
| otherwise = do
r <- generateParams (bits+1) Nothing False
let r2 = r - range
r3 = r2 - range
if isValid r
then return r
else if isValid r2
then return r2
else if isValid r3
then return r3
else loopGenerateOver (count-1)
bits = numBits range
canOverGenerate = bits > 3 && not (range `testBit` (bits-2)) && not (range `testBit` (bits-3))
isValid n = n < range
tries :: Int
tries = 100
-- | generate a number between the inclusive bound [low,high].
generateBetween :: MonadRandom m => Integer -> Integer -> m Integer
generateBetween low high = (low +) <$> generateMax (high - low + 1)

217
bundled/Crypto/Number/ModArithmetic.hs Normal file
View file

@ -0,0 +1,217 @@
{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Crypto.Number.ModArithmetic
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
module Crypto.Number.ModArithmetic
(
-- * Exponentiation
expSafe
, expFast
-- * Inverse computing
, inverse
, inverseCoprimes
, inverseFermat
-- * Squares
, jacobi
, squareRoot
) where
import Control.Exception (throw, Exception)
import Crypto.Number.Basic
import Crypto.Number.Compat
-- | Raised when two numbers are supposed to be coprimes but are not.
data CoprimesAssertionError = CoprimesAssertionError
deriving (Show)
instance Exception CoprimesAssertionError
-- | Compute the modular exponentiation of base^exponent using
-- algorithms design to avoid side channels and timing measurement
--
-- Modulo need to be odd otherwise the normal fast modular exponentiation
-- is used.
--
-- When used with integer-simple, this function is not different
-- from expFast, and thus provide the same unstudied and dubious
-- timing and side channels claims.
--
-- Before GHC 8.4.2, powModSecInteger is missing from integer-gmp,
-- so expSafe has the same security as expFast.
expSafe :: Integer -- ^ base
-> Integer -- ^ exponent
-> Integer -- ^ modulo
-> Integer -- ^ result
expSafe b e m
| odd m = gmpPowModSecInteger b e m `onGmpUnsupported`
(gmpPowModInteger b e m `onGmpUnsupported`
exponentiation b e m)
| otherwise = gmpPowModInteger b e m `onGmpUnsupported`
exponentiation b e m
-- | Compute the modular exponentiation of base^exponent using
-- the fastest algorithm without any consideration for
-- hiding parameters.
--
-- Use this function when all the parameters are public,
-- otherwise 'expSafe' should be preferred.
expFast :: Integer -- ^ base
-> Integer -- ^ exponent
-> Integer -- ^ modulo
-> Integer -- ^ result
expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m
-- | @exponentiation@ computes modular exponentiation as /b^e mod m/
-- using repetitive squaring.
exponentiation :: Integer -> Integer -> Integer -> Integer
exponentiation b e m
| b == 1 = b
| e == 0 = 1
| e == 1 = b `mod` m
| even e = let p = exponentiation b (e `div` 2) m `mod` m
in (p^(2::Integer)) `mod` m
| otherwise = (b * exponentiation b (e-1) m) `mod` m
-- | @inverse@ computes the modular inverse as in /g^(-1) mod m/.
inverse :: Integer -> Integer -> Maybe Integer
inverse g m = gmpInverse g m `onGmpUnsupported` v
where
v
| d > 1 = Nothing
| otherwise = Just (x `mod` m)
(x,_,d) = gcde g m
-- | Compute the modular inverse of two coprime numbers.
-- This is equivalent to inverse except that the result
-- is known to exists.
--
-- If the numbers are not defined as coprime, this function
-- will raise a 'CoprimesAssertionError'.
inverseCoprimes :: Integer -> Integer -> Integer
inverseCoprimes g m =
case inverse g m of
Nothing -> throw CoprimesAssertionError
Just i -> i
-- | Computes the Jacobi symbol (a/n).
-- 0 ≤ a < n; n ≥ 3 and odd.
--
-- The Legendre and Jacobi symbols are indistinguishable exactly when the
-- lower argument is an odd prime, in which case they have the same value.
--
-- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
jacobi :: Integer -> Integer -> Maybe Integer
jacobi a n
| n < 3 || even n = Nothing
| a == 0 || a == 1 = Just a
| n <= a = jacobi (a `mod` n) n
| a < 0 =
let b = if n `mod` 4 == 1 then 1 else -1
in fmap (*b) (jacobi (-a) n)
| otherwise =
let (e, a1) = asPowerOf2AndOdd a
nMod8 = n `mod` 8
nMod4 = n `mod` 4
a1Mod4 = a1 `mod` 4
s' = if even e || nMod8 == 1 || nMod8 == 7 then 1 else -1
s = if nMod4 == 3 && a1Mod4 == 3 then -s' else s'
n1 = n `mod` a1
in if a1 == 1 then Just s
else fmap (*s) (jacobi n1 a1)
-- | Modular inverse using Fermat's little theorem. This works only when
-- the modulus is prime but avoids side channels like in 'expSafe'.
inverseFermat :: Integer -> Integer -> Integer
inverseFermat g p = expSafe g (p - 2) p
-- | Raised when the assumption about the modulus is invalid.
data ModulusAssertionError = ModulusAssertionError
deriving (Show)
instance Exception ModulusAssertionError
-- | Modular square root of @g@ modulo a prime @p@.
--
-- If the modulus is found not to be prime, the function will raise a
-- 'ModulusAssertionError'.
--
-- This implementation is variable time and should be used with public
-- parameters only.
squareRoot :: Integer -> Integer -> Maybe Integer
squareRoot p
| p < 2 = throw ModulusAssertionError
| otherwise =
case p `divMod` 8 of
(v, 3) -> method1 (2 * v + 1)
(v, 7) -> method1 (2 * v + 2)
(u, 5) -> method2 u
(_, 1) -> tonelliShanks p
(0, 2) -> \a -> Just (if even a then 0 else 1)
_ -> throw ModulusAssertionError
where
x `eqMod` y = (x - y) `mod` p == 0
validate g y | (y * y) `eqMod` g = Just y
| otherwise = Nothing
-- p == 4u + 3 and u' == u + 1
method1 u' g =
let y = expFast g u' p
in validate g y
-- p == 8u + 5
method2 u g =
let gamma = expFast (2 * g) u p
g_gamma = g * gamma
i = (2 * g_gamma * gamma) `mod` p
y = (g_gamma * (i - 1)) `mod` p
in validate g y
tonelliShanks :: Integer -> Integer -> Maybe Integer
tonelliShanks p a
| aa == 0 = Just 0
| otherwise =
case expFast aa p2 p of
b | b == p1 -> Nothing
| b == 1 -> Just $ go (expFast aa ((s + 1) `div` 2) p)
(expFast aa s p)
(expFast n s p)
e
| otherwise -> throw ModulusAssertionError
where
aa = a `mod` p
p1 = p - 1
p2 = p1 `div` 2
n = findN 2
x `mul` y = (x * y) `mod` p
pow2m 0 x = x
pow2m i x = pow2m (i - 1) (x `mul` x)
(e, s) = asPowerOf2AndOdd p1
-- find a quadratic non-residue
findN i
| expFast i p2 p == p1 = i
| otherwise = findN (i + 1)
-- find m such that b^(2^m) == 1 (mod p)
findM b i
| b == 1 = i
| otherwise = findM (b `mul` b) (i + 1)
go !x b g !r
| b == 1 = x
| otherwise =
let r' = findM b 0
z = pow2m (r - r' - 1) g
x' = x `mul` z
b' = b `mul` g'
g' = z `mul` z
in go x' b' g' r'

63
bundled/Crypto/Number/Nat.hs Normal file
View file

@ -0,0 +1,63 @@
-- |
-- Module : Crypto.Number.Nat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Numbers at type level.
--
-- This module provides extensions to "GHC.TypeLits" and "GHC.TypeNats" useful
-- to work with cryptographic algorithms parameterized with a variable bit
-- length. Constraints like @'IsDivisibleBy8' n@ ensure that the type-level
-- parameter is applicable to the algorithm.
--
-- Functions are also provided to test whether constraints are satisfied from
-- values known at runtime. The following example shows how to discharge
-- 'IsDivisibleBy8' in a computation @fn@ requiring this constraint:
--
-- > withDivisibleBy8 :: Integer
-- > -> (forall proxy n . (KnownNat n, IsDivisibleBy8 n) => proxy n -> a)
-- > -> Maybe a
-- > withDivisibleBy8 len fn = do
-- > SomeNat p <- someNatVal len
-- > Refl <- isDivisibleBy8 p
-- > pure (fn p)
--
-- Function @withDivisibleBy8@ above returns 'Nothing' when the argument @len@
-- is negative or not divisible by 8.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Crypto.Number.Nat
( type IsDivisibleBy8
, type IsAtMost, type IsAtLeast
, isDivisibleBy8
, isAtMost
, isAtLeast
) where
import Data.Type.Equality
import GHC.TypeLits
import Unsafe.Coerce (unsafeCoerce)
import Crypto.Internal.Nat
-- | get a runtime proof that the constraint @'IsDivisibleBy8' n@ is satified
isDivisibleBy8 :: KnownNat n => proxy n -> Maybe (IsDiv8 n n :~: 'True)
isDivisibleBy8 n
| mod (natVal n) 8 == 0 = Just (unsafeCoerce Refl)
| otherwise = Nothing
-- | get a runtime proof that the constraint @'IsAtMost' value bound@ is
-- satified
isAtMost :: (KnownNat value, KnownNat bound)
=> proxy value -> proxy' bound -> Maybe ((value <=? bound) :~: 'True)
isAtMost x y
| natVal x <= natVal y = Just (unsafeCoerce Refl)
| otherwise = Nothing
-- | get a runtime proof that the constraint @'IsAtLeast' value bound@ is
-- satified
isAtLeast :: (KnownNat value, KnownNat bound)
=> proxy value -> proxy' bound -> Maybe ((bound <=? value) :~: 'True)
isAtLeast = flip isAtMost

235
bundled/Crypto/Number/Prime.hs Normal file
View file

@ -0,0 +1,235 @@
-- |
-- Module : Crypto.Number.Prime
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Prime
(
generatePrime
, generateSafePrime
, isProbablyPrime
, findPrimeFrom
, findPrimeFromWith
, primalityTestMillerRabin
, primalityTestNaive
, primalityTestFermat
, isCoprime
) where
import Crypto.Number.Compat
import Crypto.Number.Generate
import Crypto.Number.Basic (sqrti, gcde)
import Crypto.Number.ModArithmetic (expSafe)
import Crypto.Random.Types
import Crypto.Random.Probabilistic
import Crypto.Error
import Data.Bits
-- | Returns if the number is probably prime.
-- First a list of small primes are implicitely tested for divisibility,
-- then a fermat primality test is used with arbitrary numbers and
-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions.
isProbablyPrime :: Integer -> Bool
isProbablyPrime !n
| any (\p -> p `divides` n) (filter (< n) firstPrimes) = False
| n >= 2 && n <= 2903 = True
| primalityTestFermat 50 (n `div` 2) n = primalityTestMillerRabin 30 n
| otherwise = False
-- | Generate a prime number of the required bitsize (i.e. in the range
-- [2^(b-1)+2^(b-2), 2^b)).
--
-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less
-- than 5 bits, as the smallest prime meeting these conditions is 29.
-- This function requires that the two highest bits are set, so that when
-- multiplied with another prime to create a key, it is guaranteed to be of
-- the proper size.
generatePrime :: MonadRandom m => Int -> m Integer
generatePrime bits = do
if bits < 5 then
throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
else do
sp <- generateParams bits (Just SetTwoHighest) True
let prime = findPrimeFrom sp
if prime < 1 `shiftL` bits then
return $ prime
else generatePrime bits
-- | Generate a prime number of the form 2p+1 where p is also prime.
-- it is also knowed as a Sophie Germaine prime or safe prime.
--
-- The number of safe prime is significantly smaller to the number of prime,
-- as such it shouldn't be used if this number is supposed to be kept safe.
--
-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less than
-- 6 bits, as the smallest safe prime with the two highest bits set is 59.
generateSafePrime :: MonadRandom m => Int -> m Integer
generateSafePrime bits = do
if bits < 6 then
throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
else do
sp <- generateParams bits (Just SetTwoHighest) True
let p = findPrimeFromWith (\i -> isProbablyPrime (2*i+1)) (sp `div` 2)
let val = 2 * p + 1
if val < 1 `shiftL` bits then
return $ val
else generateSafePrime bits
-- | Find a prime from a starting point where the property hold.
findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith prop !n
| even n = findPrimeFromWith prop (n+1)
| otherwise =
if not (isProbablyPrime n)
then findPrimeFromWith prop (n+2)
else
if prop n
then n
else findPrimeFromWith prop (n+2)
-- | Find a prime from a starting point with no specific property.
findPrimeFrom :: Integer -> Integer
findPrimeFrom n =
case gmpNextPrime n of
GmpSupported p -> p
GmpUnsupported -> findPrimeFromWith (\_ -> True) n
-- | Miller Rabin algorithm return if the number is probably prime or composite.
-- the tries parameter is the number of recursion, that determines the accuracy of the test.
primalityTestMillerRabin :: Int -> Integer -> Bool
primalityTestMillerRabin tries !n =
case gmpTestPrimeMillerRabin tries n of
GmpSupported b -> b
GmpUnsupported -> probabilistic run
where
run
| n <= 3 = error "Miller-Rabin requires tested value to be > 3"
| even n = return False
| tries <= 0 = error "Miller-Rabin tries need to be > 0"
| otherwise = loop <$> generateTries tries
!nm1 = n-1
!nm2 = n-2
(!s,!d) = (factorise 0 nm1)
generateTries 0 = return []
generateTries t = do
v <- generateBetween 2 nm2
vs <- generateTries (t-1)
return (v:vs)
-- factorise n-1 into the form 2^s*d
factorise :: Integer -> Integer -> (Integer, Integer)
factorise !si !vi
| vi `testBit` 0 = (si, vi)
| otherwise = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continuously, but just once.
expmod = expSafe
-- when iteration reach zero, we have a probable prime
loop [] = True
loop (w:ws) = let x = expmod w d n
in if x == (1 :: Integer) || x == nm1
then loop ws
else loop' ws ((x*x) `mod` n) 1
-- loop from 1 to s-1. if we reach the end then it's composite
loop' ws !x2 !r
| r == s = False
| x2 == 1 = False
| x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)
| otherwise = loop ws
{-
n < z -> witness to test
1373653 [2,3]
9080191 [31,73]
4759123141 [2,7,61]
2152302898747 [2,3,5,7,11]
3474749660383 [2,3,5,7,11,13]
341550071728321 [2,3,5,7,11,13,17]
-}
-- | Probabilitic Test using Fermat primility test.
-- Beware of Carmichael numbers that are Fermat liars, i.e. this test
-- is useless for them. always combines with some other test.
primalityTestFermat :: Int -- ^ number of iterations of the algorithm
-> Integer -- ^ starting a
-> Integer -- ^ number to test for primality
-> Bool
primalityTestFermat n a p = and $ map expTest [a..(a+fromIntegral n)]
where !pm1 = p-1
expTest i = expSafe i pm1 p == 1
-- | Test naively is integer is prime.
-- while naive, we skip even number and stop iteration at i > sqrt(n)
primalityTestNaive :: Integer -> Bool
primalityTestNaive n
| n <= 1 = False
| n == 2 = True
| even n = False
| otherwise = search 3
where !ubound = snd $ sqrti n
search !i
| i > ubound = True
| i `divides` n = False
| otherwise = search (i+2)
-- | Test is two integer are coprime to each other
isCoprime :: Integer -> Integer -> Bool
isCoprime m n = case gcde m n of (_,_,d) -> d == 1
-- | List of the first primes till 2903.
firstPrimes :: [Integer]
firstPrimes =
[ 2 , 3 , 5 , 7 , 11 , 13 , 17 , 19 , 23 , 29
, 31 , 37 , 41 , 43 , 47 , 53 , 59 , 61 , 67 , 71
, 73 , 79 , 83 , 89 , 97 , 101 , 103 , 107 , 109 , 113
, 127 , 131 , 137 , 139 , 149 , 151 , 157 , 163 , 167 , 173
, 179 , 181 , 191 , 193 , 197 , 199 , 211 , 223 , 227 , 229
, 233 , 239 , 241 , 251 , 257 , 263 , 269 , 271 , 277 , 281
, 283 , 293 , 307 , 311 , 313 , 317 , 331 , 337 , 347 , 349
, 353 , 359 , 367 , 373 , 379 , 383 , 389 , 397 , 401 , 409
, 419 , 421 , 431 , 433 , 439 , 443 , 449 , 457 , 461 , 463
, 467 , 479 , 487 , 491 , 499 , 503 , 509 , 521 , 523 , 541
, 547 , 557 , 563 , 569 , 571 , 577 , 587 , 593 , 599 , 601
, 607 , 613 , 617 , 619 , 631 , 641 , 643 , 647 , 653 , 659
, 661 , 673 , 677 , 683 , 691 , 701 , 709 , 719 , 727 , 733
, 739 , 743 , 751 , 757 , 761 , 769 , 773 , 787 , 797 , 809
, 811 , 821 , 823 , 827 , 829 , 839 , 853 , 857 , 859 , 863
, 877 , 881 , 883 , 887 , 907 , 911 , 919 , 929 , 937 , 941
, 947 , 953 , 967 , 971 , 977 , 983 , 991 , 997 , 1009 , 1013
, 1019 , 1021 , 1031 , 1033 , 1039 , 1049 , 1051 , 1061 , 1063 , 1069
, 1087 , 1091 , 1093 , 1097 , 1103 , 1109 , 1117 , 1123 , 1129 , 1151
, 1153 , 1163 , 1171 , 1181 , 1187 , 1193 , 1201 , 1213 , 1217 , 1223
, 1229 , 1231 , 1237 , 1249 , 1259 , 1277 , 1279 , 1283 , 1289 , 1291
, 1297 , 1301 , 1303 , 1307 , 1319 , 1321 , 1327 , 1361 , 1367 , 1373
, 1381 , 1399 , 1409 , 1423 , 1427 , 1429 , 1433 , 1439 , 1447 , 1451
, 1453 , 1459 , 1471 , 1481 , 1483 , 1487 , 1489 , 1493 , 1499 , 1511
, 1523 , 1531 , 1543 , 1549 , 1553 , 1559 , 1567 , 1571 , 1579 , 1583
, 1597 , 1601 , 1607 , 1609 , 1613 , 1619 , 1621 , 1627 , 1637 , 1657
, 1663 , 1667 , 1669 , 1693 , 1697 , 1699 , 1709 , 1721 , 1723 , 1733
, 1741 , 1747 , 1753 , 1759 , 1777 , 1783 , 1787 , 1789 , 1801 , 1811
, 1823 , 1831 , 1847 , 1861 , 1867 , 1871 , 1873 , 1877 , 1879 , 1889
, 1901 , 1907 , 1913 , 1931 , 1933 , 1949 , 1951 , 1973 , 1979 , 1987
, 1993 , 1997 , 1999 , 2003 , 2011 , 2017 , 2027 , 2029 , 2039 , 2053
, 2063 , 2069 , 2081 , 2083 , 2087 , 2089 , 2099 , 2111 , 2113 , 2129
, 2131 , 2137 , 2141 , 2143 , 2153 , 2161 , 2179 , 2203 , 2207 , 2213
, 2221 , 2237 , 2239 , 2243 , 2251 , 2267 , 2269 , 2273 , 2281 , 2287
, 2293 , 2297 , 2309 , 2311 , 2333 , 2339 , 2341 , 2347 , 2351 , 2357
, 2371 , 2377 , 2381 , 2383 , 2389 , 2393 , 2399 , 2411 , 2417 , 2423
, 2437 , 2441 , 2447 , 2459 , 2467 , 2473 , 2477 , 2503 , 2521 , 2531
, 2539 , 2543 , 2549 , 2551 , 2557 , 2579 , 2591 , 2593 , 2609 , 2617
, 2621 , 2633 , 2647 , 2657 , 2659 , 2663 , 2671 , 2677 , 2683 , 2687
, 2689 , 2693 , 2699 , 2707 , 2711 , 2713 , 2719 , 2729 , 2731 , 2741
, 2749 , 2753 , 2767 , 2777 , 2789 , 2791 , 2797 , 2801 , 2803 , 2819
, 2833 , 2837 , 2843 , 2851 , 2857 , 2861 , 2879 , 2887 , 2897 , 2903
]
{-# INLINE divides #-}
divides :: Integer -> Integer -> Bool
divides i n = n `mod` i == 0

54
bundled/Crypto/Number/Serialize.hs Normal file
View file

@ -0,0 +1,54 @@
-- |
-- Module : Crypto.Number.Serialize
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize
( i2osp
, os2ip
, i2ospOf
, i2ospOf_
) where
import Crypto.Number.Basic
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Internal.ByteArray as B
import qualified Crypto.Number.Serialize.Internal as Internal
-- | @os2ip@ converts a byte string into a positive integer.
os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
-- | @i2osp@ converts a positive integer into a byte string.
--
-- The first byte is MSB (most significant byte); the last byte is the LSB (least significant byte)
i2osp :: B.ByteArray ba => Integer -> ba
i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ())
i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
where
!sz = numBytes m
-- | Just like 'i2osp', but takes an extra parameter for size.
-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
-- otherwise the number is padded with 0 to fit the @len@ required.
{-# INLINABLE i2ospOf #-}
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf len m
| len <= 0 = Nothing
| m < 0 = Nothing
| sz > len = Nothing
| otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
where
!sz = numBytes m
-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
-- an integer larger than the number of output bytes requested.
--
-- For example if you just took a modulo of the number that represent
-- the size (example the RSA modulo n).
i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len

76
bundled/Crypto/Number/Serialize/Internal.hs Normal file
View file

@ -0,0 +1,76 @@
-- |
-- Module : Crypto.Number.Serialize.Internal
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer using raw pointers
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.Internal
( i2osp
, i2ospOf
, os2ip
) where
import Crypto.Number.Compat
import Crypto.Number.Basic
import Data.Bits
import Data.Memory.PtrMethods
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
-- | Fill a pointer with the big endian binary representation of an integer
--
-- If the room available @ptrSz@ is less than the number of bytes needed,
-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
--
-- Returns the number of bytes written
i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
i2osp m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| m == 0 = pokeByteOff ptr 0 (0 :: Word8) >> return 1
| ptrSz < sz = return 0
| otherwise = fillPtr ptr sz m >> return sz
where
!sz = numBytes m
-- | Similar to 'i2osp', except it will pad any remaining space with zero.
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| ptrSz < sz = return 0
| otherwise = do
memSet ptr 0 ptrSz
fillPtr (ptr `plusPtr` padSz) sz m
return ptrSz
where
!sz = numBytes m
!padSz = ptrSz - sz
fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr p sz m = gmpExportInteger m p `onGmpUnsupported` export (sz-1) m
where
export ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export (ofs-1) i'
-- | Transform a big endian binary integer representation pointed by a pointer and a size
-- into an integer
os2ip :: Ptr Word8 -> Int -> IO Integer
os2ip ptr ptrSz
| ptrSz <= 0 = return 0
| otherwise = gmpImportInteger ptrSz ptr `onGmpUnsupported` loop 0 0 ptr
where
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i !p
| i == ptrSz = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i+1) p

75
bundled/Crypto/Number/Serialize/Internal/LE.hs Normal file
View file

@ -0,0 +1,75 @@
-- |
-- Module : Crypto.Number.Serialize.Internal.LE
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer using raw pointers (little endian)
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.Internal.LE
( i2osp
, i2ospOf
, os2ip
) where
import Crypto.Number.Compat
import Crypto.Number.Basic
import Data.Bits
import Data.Memory.PtrMethods
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
-- | Fill a pointer with the little endian binary representation of an integer
--
-- If the room available @ptrSz@ is less than the number of bytes needed,
-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
--
-- Returns the number of bytes written
i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
i2osp m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| m == 0 = pokeByteOff ptr 0 (0 :: Word8) >> return 1
| ptrSz < sz = return 0
| otherwise = fillPtr ptr sz m >> return sz
where
!sz = numBytes m
-- | Similar to 'i2osp', except it will pad any remaining space with zero.
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| ptrSz < sz = return 0
| otherwise = do
memSet ptr 0 ptrSz
fillPtr ptr sz m
return ptrSz
where
!sz = numBytes m
fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr p sz m = gmpExportIntegerLE m p `onGmpUnsupported` export 0 m
where
export ofs i
| ofs >= sz = return ()
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export (ofs+1) i'
-- | Transform a little endian binary integer representation pointed by a
-- pointer and a size into an integer
os2ip :: Ptr Word8 -> Int -> IO Integer
os2ip ptr ptrSz
| ptrSz <= 0 = return 0
| otherwise = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr
where
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i !p
| i < 0 = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i-1) p

54
bundled/Crypto/Number/Serialize/LE.hs Normal file
View file

@ -0,0 +1,54 @@
-- |
-- Module : Crypto.Number.Serialize.LE
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer (little endian)
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.LE
( i2osp
, os2ip
, i2ospOf
, i2ospOf_
) where
import Crypto.Number.Basic
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Internal.ByteArray as B
import qualified Crypto.Number.Serialize.Internal.LE as Internal
-- | @os2ip@ converts a byte string into a positive integer.
os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
-- | @i2osp@ converts a positive integer into a byte string.
--
-- The first byte is LSB (least significant byte); the last byte is the MSB (most significant byte)
i2osp :: B.ByteArray ba => Integer -> ba
i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ())
i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
where
!sz = numBytes m
-- | Just like 'i2osp', but takes an extra parameter for size.
-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
-- otherwise the number is padded with 0 to fit the @len@ required.
{-# INLINABLE i2ospOf #-}
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf len m
| len <= 0 = Nothing
| m < 0 = Nothing
| sz > len = Nothing
| otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
where
!sz = numBytes m
-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
-- an integer larger than the number of output bytes requested.
--
-- For example if you just took a modulo of the number that represent
-- the size (example the RSA modulo n).
i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len

98
bundled/Crypto/Random.hs Normal file
View file

@ -0,0 +1,98 @@
-- |
-- Module : Crypto.Random
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Random
(
-- * Deterministic instances
ChaChaDRG
, SystemDRG
, Seed
-- * Seed
, seedNew
, seedFromInteger
, seedToInteger
, seedFromBinary
-- * Deterministic Random class
, getSystemDRG
, drgNew
, drgNewSeed
, drgNewTest
, withDRG
, withRandomBytes
, DRG(..)
-- * Random abstraction
, MonadRandom(..)
, MonadPseudoRandom
) where
import Crypto.Error
import Crypto.Random.Types
import Crypto.Random.ChaChaDRG
import Crypto.Random.SystemDRG
import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Data.ByteArray as B
import Crypto.Internal.Imports
import qualified Crypto.Number.Serialize as Serialize
newtype Seed = Seed ScrubbedBytes
deriving (ByteArrayAccess)
-- Length for ChaCha DRG seed
seedLength :: Int
seedLength = 40
-- | Create a new Seed from system entropy
seedNew :: MonadRandom randomly => randomly Seed
seedNew = Seed `fmap` getRandomBytes seedLength
-- | Convert a Seed to an integer
seedToInteger :: Seed -> Integer
seedToInteger (Seed b) = Serialize.os2ip b
-- | Convert an integer to a Seed
seedFromInteger :: Integer -> Seed
seedFromInteger i = Seed $ Serialize.i2ospOf_ seedLength (i `mod` 2^(seedLength * 8))
-- | Convert a binary to a seed
seedFromBinary :: ByteArrayAccess b => b -> CryptoFailable Seed
seedFromBinary b
| B.length b /= 40 = CryptoFailed (CryptoError_SeedSizeInvalid)
| otherwise = CryptoPassed $ Seed $ B.convert b
-- | Create a new DRG from system entropy
drgNew :: MonadRandom randomly => randomly ChaChaDRG
drgNew = drgNewSeed `fmap` seedNew
-- | Create a new DRG from a seed
drgNewSeed :: Seed -> ChaChaDRG
drgNewSeed (Seed seed) = initialize seed
-- | Create a new DRG from 5 Word64.
--
-- This is a convenient interface to create deterministic interface
-- for quickcheck style testing.
--
-- It can also be used in other contexts provided the input
-- has been properly randomly generated.
--
-- Note that the @Arbitrary@ instance provided by QuickCheck for 'Word64' does
-- not have a uniform distribution. It is often better to use instead
-- @arbitraryBoundedRandom@.
--
-- System endianness impacts how the tuple is interpreted and therefore changes
-- the resulting DRG.
drgNewTest :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
drgNewTest = initializeWords
-- | Generate @len random bytes and mapped the bytes to the function @f.
--
-- This is equivalent to use Control.Arrow 'first' with 'randomBytesGenerate'
withRandomBytes :: (ByteArray ba, DRG g) => g -> Int -> (ba -> a) -> (a, g)
withRandomBytes rng len f = (f bs, rng')
where (bs, rng') = randomBytesGenerate len rng

46
bundled/Crypto/Random/ChaChaDRG.hs Normal file
View file

@ -0,0 +1,46 @@
-- |
-- Module : Crypto.Random.ChaChaDRG
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Random.ChaChaDRG
( ChaChaDRG
, initialize
, initializeWords
) where
import Crypto.Random.Types
import Crypto.Internal.Imports
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Foreign.Storable (pokeElemOff)
import qualified Crypto.Cipher.ChaCha as C
instance DRG ChaChaDRG where
randomBytesGenerate = generate
-- | ChaCha Deterministic Random Generator
newtype ChaChaDRG = ChaChaDRG C.StateSimple
deriving (NFData)
-- | Initialize a new ChaCha context with the number of rounds,
-- the key and the nonce associated.
initialize :: ByteArrayAccess seed
=> seed -- ^ 40 bytes of seed
-> ChaChaDRG -- ^ the initial ChaCha state
initialize seed = ChaChaDRG $ C.initializeSimple seed
-- | Initialize a new ChaCha context from 5-tuple of words64.
-- This interface is useful when creating a RNG out of tests generators (e.g. QuickCheck).
initializeWords :: (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
initializeWords (a,b,c,d,e) = initialize (B.allocAndFreeze 40 fill :: ScrubbedBytes)
where fill s = mapM_ (uncurry (pokeElemOff s)) [(0,a), (1,b), (2,c), (3,d), (4,e)]
generate :: ByteArray output => Int -> ChaChaDRG -> (output, ChaChaDRG)
generate nbBytes st@(ChaChaDRG prevSt)
| nbBytes <= 0 = (B.empty, st)
| otherwise = let (output, newSt) = C.generateSimple prevSt nbBytes in (output, ChaChaDRG newSt)

22
bundled/Crypto/Random/Entropy.hs Normal file
View file

@ -0,0 +1,22 @@
-- |
-- Module : Crypto.Random.Entropy
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.Entropy
( getEntropy
) where
import Data.Maybe (catMaybes)
import Crypto.Internal.ByteArray (ByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Random.Entropy.Unsafe
-- | Get some entropy from the system source of entropy
getEntropy :: ByteArray byteArray => Int -> IO byteArray
getEntropy n = do
backends <- catMaybes `fmap` sequence supportedBackends
B.alloc n (replenish n backends)

57
bundled/Crypto/Random/Entropy/Backend.hs Normal file
View file

@ -0,0 +1,57 @@
-- |
-- Module : Crypto.Random.Entropy.Backend
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : stable
-- Portability : good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
module Crypto.Random.Entropy.Backend
( EntropyBackend
, supportedBackends
, gatherBackend
) where
import Foreign.Ptr
import Data.Proxy
import Data.Word (Word8)
import Crypto.Random.Entropy.Source
#ifdef SUPPORT_RDRAND
import Crypto.Random.Entropy.RDRand
#endif
#ifdef WINDOWS
import Crypto.Random.Entropy.Windows
#else
import Crypto.Random.Entropy.Unix
#endif
-- | All supported backends
supportedBackends :: [IO (Maybe EntropyBackend)]
supportedBackends =
[
#ifdef SUPPORT_RDRAND
openBackend (Proxy :: Proxy RDRand),
#endif
#ifdef WINDOWS
openBackend (Proxy :: Proxy WinCryptoAPI)
#else
openBackend (Proxy :: Proxy DevRandom), openBackend (Proxy :: Proxy DevURandom)
#endif
]
-- | Any Entropy Backend
data EntropyBackend = forall b . EntropySource b => EntropyBackend b
-- | Open a backend handle
openBackend :: EntropySource b => Proxy b -> IO (Maybe EntropyBackend)
openBackend b = fmap EntropyBackend `fmap` callOpen b
where callOpen :: EntropySource b => Proxy b -> IO (Maybe b)
callOpen _ = entropyOpen
-- | Gather randomness from an open handle
gatherBackend :: EntropyBackend -- ^ An open Entropy Backend
-> Ptr Word8 -- ^ Pointer to a buffer to write to
-> Int -- ^ number of bytes to write
-> IO Int -- ^ return the number of bytes actually written
gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n

38
bundled/Crypto/Random/Entropy/RDRand.hs Normal file
View file

@ -0,0 +1,38 @@
-- |
-- Module : Crypto.Random.Entropy.RDRand
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE ForeignFunctionInterface #-}
module Crypto.Random.Entropy.RDRand
( RDRand
) where
import Foreign.Ptr
import Foreign.C.Types
import Data.Word (Word8)
import Crypto.Random.Entropy.Source
foreign import ccall unsafe "cryptonite_cpu_has_rdrand"
c_cpu_has_rdrand :: IO CInt
foreign import ccall unsafe "cryptonite_get_rand_bytes"
c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt
-- | Fake handle to Intel RDRand entropy CPU instruction
data RDRand = RDRand
instance EntropySource RDRand where
entropyOpen = rdrandGrab
entropyGather _ = rdrandGetBytes
entropyClose _ = return ()
rdrandGrab :: IO (Maybe RDRand)
rdrandGrab = supported `fmap` c_cpu_has_rdrand
where supported 0 = Nothing
supported _ = Just RDRand
rdrandGetBytes :: Ptr Word8 -> Int -> IO Int
rdrandGetBytes ptr sz = fromIntegral `fmap` c_get_rand_bytes ptr (fromIntegral sz)

22
bundled/Crypto/Random/Entropy/Source.hs Normal file
View file

@ -0,0 +1,22 @@
-- |
-- Module : Crypto.Random.Entropy.Source
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.Entropy.Source where
import Foreign.Ptr
import Data.Word (Word8)
-- | A handle to an entropy maker, either a system capability
-- or a hardware generator.
class EntropySource a where
-- | Try to open an handle for this source
entropyOpen :: IO (Maybe a)
-- | Try to gather a number of entropy bytes into a buffer.
-- Return the number of actual bytes gathered
entropyGather :: a -> Ptr Word8 -> Int -> IO Int
-- | Close an open handle
entropyClose :: a -> IO ()

74
bundled/Crypto/Random/Entropy/Unix.hs Normal file
View file

@ -0,0 +1,74 @@
-- |
-- Module : Crypto.Random.Entropy.Unix
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.Random.Entropy.Unix
( DevRandom
, DevURandom
) where
import Foreign.Ptr
import Data.Word (Word8)
import Crypto.Random.Entropy.Source
import Control.Exception as E
--import System.Posix.Types (Fd)
import System.IO
type H = Handle
type DeviceName = String
-- | Entropy device @/dev/random@ on unix system
newtype DevRandom = DevRandom DeviceName
-- | Entropy device @/dev/urandom@ on unix system
newtype DevURandom = DevURandom DeviceName
instance EntropySource DevRandom where
entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random"
entropyGather (DevRandom name) ptr n =
withDev name $ \h -> gatherDevEntropyNonBlock h ptr n
entropyClose (DevRandom _) = return ()
instance EntropySource DevURandom where
entropyOpen = fmap DevURandom `fmap` testOpen "/dev/urandom"
entropyGather (DevURandom name) ptr n =
withDev name $ \h -> gatherDevEntropy h ptr n
entropyClose (DevURandom _) = return ()
testOpen :: DeviceName -> IO (Maybe DeviceName)
testOpen filepath = do
d <- openDev filepath
case d of
Nothing -> return Nothing
Just h -> closeDev h >> return (Just filepath)
openDev :: String -> IO (Maybe H)
openDev filepath = (Just `fmap` openAndNoBuffering) `E.catch` \(_ :: IOException) -> return Nothing
where openAndNoBuffering = do
h <- openBinaryFile filepath ReadMode
hSetBuffering h NoBuffering
return h
withDev :: String -> (H -> IO a) -> IO a
withDev filepath f = openDev filepath >>= \h ->
case h of
Nothing -> error ("device " ++ filepath ++ " cannot be grabbed")
Just fd -> f fd `E.finally` closeDev fd
closeDev :: H -> IO ()
closeDev h = hClose h
gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int
gatherDevEntropy h ptr sz =
(fromIntegral `fmap` hGetBufSome h ptr (fromIntegral sz))
`E.catch` \(_ :: IOException) -> return 0
gatherDevEntropyNonBlock :: H -> Ptr Word8 -> Int -> IO Int
gatherDevEntropyNonBlock h ptr sz =
(fromIntegral `fmap` hGetBufNonBlocking h ptr (fromIntegral sz))
`E.catch` \(_ :: IOException) -> return 0

34
bundled/Crypto/Random/Entropy/Unsafe.hs Normal file
View file

@ -0,0 +1,34 @@
-- |
-- Module : Crypto.Random.Entropy.Unsafe
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.Entropy.Unsafe
( replenish
, module Crypto.Random.Entropy.Backend
) where
import Data.Word (Word8)
import Foreign.Ptr (Ptr, plusPtr)
import Crypto.Random.Entropy.Backend
-- | Refill the entropy in a buffer
--
-- Call each entropy backend in turn until the buffer has
-- been replenished.
--
-- If the buffer cannot be refill after 3 loopings, this will raise
-- an User Error exception
replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system"
replenish poolSize backends ptr = loop 0 backends ptr poolSize
where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO ()
loop retry [] p n | n == 0 = return ()
| retry == 3 = error "cryptonite: random: cannot fully replenish"
| otherwise = loop (retry+1) backends p n
loop _ (_:_) _ 0 = return ()
loop retry (b:bs) p n = do
r <- gatherBackend b p n
loop retry bs (p `plusPtr` r) (n - r)

103
bundled/Crypto/Random/Entropy/Windows.hs Normal file
View file

@ -0,0 +1,103 @@
-- |
-- Module : Crypto.Random.Entropy.Windows
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Code originally from the entropy package and thus is:
-- Copyright (c) Thomas DuBuisson.
--
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module Crypto.Random.Entropy.Windows
( WinCryptoAPI
) where
import Data.Int (Int32)
import Data.Word
import Foreign.C.String (CString, withCString)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (toBool)
import Foreign.Storable (peek)
import System.Win32.Types (getLastError)
import Crypto.Random.Entropy.Source
-- | Handle to Windows crypto API for random generation
data WinCryptoAPI = WinCryptoAPI
instance EntropySource WinCryptoAPI where
entropyOpen = do
mctx <- cryptAcquireCtx
maybe (return Nothing) (\ctx -> cryptReleaseCtx ctx >> return (Just WinCryptoAPI)) mctx
entropyGather WinCryptoAPI ptr n = do
mctx <- cryptAcquireCtx
case mctx of
Nothing -> do
lastError <- getLastError
fail $ "cannot re-grab win crypto api: error " ++ show lastError
Just ctx -> do
r <- cryptGenRandom ctx ptr n
cryptReleaseCtx ctx
return r
entropyClose WinCryptoAPI = return ()
type DWORD = Word32
type BOOL = Int32
type BYTE = Word8
#if defined(ARCH_X86)
# define WINDOWS_CCONV stdcall
type CryptCtx = Word32
#elif defined(ARCH_X86_64)
# define WINDOWS_CCONV ccall
type CryptCtx = Word64
#else
# error Unknown mingw32 arch
#endif
-- Declare the required CryptoAPI imports
foreign import WINDOWS_CCONV unsafe "CryptAcquireContextA"
c_cryptAcquireCtx :: Ptr CryptCtx -> CString -> CString -> DWORD -> DWORD -> IO BOOL
foreign import WINDOWS_CCONV unsafe "CryptGenRandom"
c_cryptGenRandom :: CryptCtx -> DWORD -> Ptr BYTE -> IO BOOL
foreign import WINDOWS_CCONV unsafe "CryptReleaseContext"
c_cryptReleaseCtx :: CryptCtx -> DWORD -> IO BOOL
-- Define the constants we need from WinCrypt.h
msDefProv :: String
msDefProv = "Microsoft Base Cryptographic Provider v1.0"
provRSAFull :: DWORD
provRSAFull = 1
cryptVerifyContext :: DWORD
cryptVerifyContext = 0xF0000000
cryptAcquireCtx :: IO (Maybe CryptCtx)
cryptAcquireCtx =
alloca $ \handlePtr ->
withCString msDefProv $ \provName -> do
r <- toBool `fmap` c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
if r
then Just `fmap` peek handlePtr
else return Nothing
cryptGenRandom :: CryptCtx -> Ptr Word8 -> Int -> IO Int
cryptGenRandom h buf n = do
success <- toBool `fmap` c_cryptGenRandom h (fromIntegral n) buf
return $ if success then n else 0
cryptReleaseCtx :: CryptCtx -> IO ()
cryptReleaseCtx h = do
success <- toBool `fmap` c_cryptReleaseCtx h 0
if success
then return ()
else do
lastError <- getLastError
fail $ "cryptReleaseCtx: error " ++ show lastError

71
bundled/Crypto/Random/EntropyPool.hs Normal file
View file

@ -0,0 +1,71 @@
-- |
-- Module : Crypto.Random.EntropyPool
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.EntropyPool
( EntropyPool
, createEntropyPool
, createEntropyPoolWith
, getEntropyFrom
) where
import Control.Concurrent.MVar
import Crypto.Random.Entropy.Unsafe
import Crypto.Internal.ByteArray (ByteArray, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Data.Word (Word8)
import Data.Maybe (catMaybes)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (plusPtr, Ptr)
-- | Pool of Entropy. Contains a self-mutating pool of entropy,
-- that is always guaranteed to contain data.
data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) ScrubbedBytes
-- size of entropy pool by default
defaultPoolSize :: Int
defaultPoolSize = 4096
-- | Create a new entropy pool of a specific size
--
-- While you can create as many entropy pools as you want,
-- the pool can be shared between multiples RNGs.
createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool
createEntropyPoolWith poolSize backends = do
m <- newMVar 0
sm <- B.alloc poolSize (replenish poolSize backends)
return $ EntropyPool backends m sm
-- | Create a new entropy pool with a default size.
--
-- While you can create as many entropy pools as you want,
-- the pool can be shared between multiples RNGs.
createEntropyPool :: IO EntropyPool
createEntropyPool = do
backends <- catMaybes `fmap` sequence supportedBackends
createEntropyPoolWith defaultPoolSize backends
-- | Put a chunk of the entropy pool into a buffer
getEntropyPtr :: EntropyPool -> Int -> Ptr Word8 -> IO ()
getEntropyPtr (EntropyPool backends posM sm) n outPtr =
B.withByteArray sm $ \entropyPoolPtr ->
modifyMVar_ posM $ \pos ->
copyLoop outPtr entropyPoolPtr pos n
where poolSize = B.length sm
copyLoop d s pos left
| left == 0 = return pos
| otherwise = do
wrappedPos <-
if pos == poolSize
then replenish poolSize backends s >> return 0
else return pos
let m = min (poolSize - wrappedPos) left
copyBytes d (s `plusPtr` wrappedPos) m
copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m)
-- | Grab a chunk of entropy from the entropy pool.
getEntropyFrom :: ByteArray byteArray => EntropyPool -> Int -> IO byteArray
getEntropyFrom pool n = B.alloc n (getEntropyPtr pool n)

28
bundled/Crypto/Random/Probabilistic.hs Normal file
View file

@ -0,0 +1,28 @@
-- |
-- Module : Crypto.Random.Probabilistic
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.Probabilistic
( probabilistic
) where
import Crypto.Internal.Compat
import Crypto.Random.Types
import Crypto.Random
-- | This create a random number generator out of thin air with
-- the system entropy; don't generally use as the IO is not exposed
-- this can have unexpected random for.
--
-- This is useful for probabilistic algorithm like Miller Rabin
-- probably prime algorithm, given appropriate choice of the heuristic
--
-- Generally, it's advised not to use this function.
probabilistic :: MonadPseudoRandom ChaChaDRG a -> a
probabilistic f = fst $ withDRG drg f
where {-# NOINLINE drg #-}
drg = unsafeDoIO drgNew
{-# NOINLINE probabilistic #-}

63
bundled/Crypto/Random/SystemDRG.hs Normal file
View file

@ -0,0 +1,63 @@
-- |
-- Module : Crypto.Random.SystemDRG
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE BangPatterns #-}
module Crypto.Random.SystemDRG
( SystemDRG
, getSystemDRG
) where
import Crypto.Random.Types
import Crypto.Random.Entropy.Unsafe
import Crypto.Internal.Compat
import Data.ByteArray (ScrubbedBytes, ByteArray)
import Data.Memory.PtrMethods as B (memCopy)
import Data.Maybe (catMaybes)
import Data.Tuple (swap)
import Foreign.Ptr
import qualified Data.ByteArray as B
import System.IO.Unsafe (unsafeInterleaveIO)
-- | A referentially transparent System representation of
-- the random evaluated out of the system.
--
-- Holding onto a specific DRG means that all the already
-- evaluated bytes will be consistently replayed.
--
-- There's no need to reseed this DRG, as only pure
-- entropy is represented here.
data SystemDRG = SystemDRG !Int [ScrubbedBytes]
instance DRG SystemDRG where
randomBytesGenerate = generate
systemChunkSize :: Int
systemChunkSize = 256
-- | Grab one instance of the System DRG
getSystemDRG :: IO SystemDRG
getSystemDRG = do
backends <- catMaybes `fmap` sequence supportedBackends
let getNext = unsafeInterleaveIO $ do
bs <- B.alloc systemChunkSize (replenish systemChunkSize backends)
more <- getNext
return (bs:more)
SystemDRG 0 <$> getNext
generate :: ByteArray output => Int -> SystemDRG -> (output, SystemDRG)
generate nbBytes (SystemDRG ofs sysChunks) = swap $ unsafeDoIO $ B.allocRet nbBytes $ loop ofs sysChunks nbBytes
where loop currentOfs chunks 0 _ = return $! SystemDRG currentOfs chunks
loop _ [] _ _ = error "SystemDRG: the impossible happened: empty chunk"
loop currentOfs oChunks@(c:cs) n d = do
let currentLeft = B.length c - currentOfs
toCopy = min n currentLeft
nextOfs = currentOfs + toCopy
n' = n - toCopy
B.withByteArray c $ \src -> B.memCopy d (src `plusPtr` currentOfs) toCopy
if nextOfs == B.length c
then loop 0 cs n' (d `plusPtr` toCopy)
else loop nextOfs oChunks n' (d `plusPtr` toCopy)

60
bundled/Crypto/Random/Types.hs Normal file
View file

@ -0,0 +1,60 @@
-- |
-- Module : Crypto.Random.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
module Crypto.Random.Types
(
MonadRandom(..)
, MonadPseudoRandom
, DRG(..)
, withDRG
) where
import Crypto.Random.Entropy
import Crypto.Internal.ByteArray
-- | A monad constraint that allows to generate random bytes
class Monad m => MonadRandom m where
getRandomBytes :: ByteArray byteArray => Int -> m byteArray
-- | A Deterministic Random Generator (DRG) class
class DRG gen where
-- | Generate N bytes of randomness from a DRG
randomBytesGenerate :: ByteArray byteArray => Int -> gen -> (byteArray, gen)
instance MonadRandom IO where
getRandomBytes = getEntropy
-- | A simple Monad class very similar to a State Monad
-- with the state being a DRG.
newtype MonadPseudoRandom gen a = MonadPseudoRandom
{ runPseudoRandom :: gen -> (a, gen)
}
instance DRG gen => Functor (MonadPseudoRandom gen) where
fmap f m = MonadPseudoRandom $ \g1 ->
let (a, g2) = runPseudoRandom m g1 in (f a, g2)
instance DRG gen => Applicative (MonadPseudoRandom gen) where
pure a = MonadPseudoRandom $ \g -> (a, g)
(<*>) fm m = MonadPseudoRandom $ \g1 ->
let (f, g2) = runPseudoRandom fm g1
(a, g3) = runPseudoRandom m g2
in (f a, g3)
instance DRG gen => Monad (MonadPseudoRandom gen) where
return = pure
(>>=) m1 m2 = MonadPseudoRandom $ \g1 ->
let (a, g2) = runPseudoRandom m1 g1
in runPseudoRandom (m2 a) g2
instance DRG gen => MonadRandom (MonadPseudoRandom gen) where
getRandomBytes n = MonadPseudoRandom (randomBytesGenerate n)
-- | Run a pure computation with a Deterministic Random Generator
-- in the 'MonadPseudoRandom'
withDRG :: DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG gen m = runPseudoRandom m gen

819
bundled/Crypto/Sign/Ed25519.hs Normal file
View file

@ -0,0 +1,819 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
-- |
-- Module : Crypto.Sign.Ed25519
-- Copyright : (c) Austin Seipp 2013-2015
-- License : MIT
--
-- Maintainer : aseipp@pobox.com
-- Stability : experimental
-- Portability : portable
--
-- This module provides bindings to the Ed25519 public-key signature
-- system, including detached signatures. The documentation should be
-- self explanatory with complete examples.
--
-- Below the basic documentation you'll find API, performance and
-- security notes, which you may want to read carefully before
-- continuing. (Nonetheless, @Ed25519@ is one of the easiest-to-use
-- signature systems around, and is simple to get started with for
-- building more complex protocols. But the below details are highly
-- educational and should help adjust your expectations properly.)
--
-- For more reading on the underlying implementation and theory
-- (including how to get a copy of the Ed25519 software),
-- visit <http://ed25519.cr.yp.to>. There are two papers that discuss
-- the design of EdDSA/Ed25519 in detail:
--
-- * <http://ed25519.cr.yp.to/ed25519-20110926.pdf "High-speed high-security signatures"> -
-- The original specification by Bernstein, Duif, Lange, Schwabe,
-- and Yang.
--
-- * <http://ed25519.cr.yp.to/eddsa-20150704.pdf "EdDSA for more curves"> -
-- An extension of the original EdDSA specification allowing it to
-- be used with more curves (such as Ed41417, or Ed488), as well as
-- defining the support for __message prehashing__. The original
-- EdDSA is easily derived from the extended version through a few
-- parameter defaults. (This package won't consider non-Ed25519
-- EdDSA systems any further.)
--
module Crypto.Sign.Ed25519
( -- * A crash course introduction
-- $intro
-- * Keypair creation
-- $creatingkeys
PublicKey(..) -- :: *
, SecretKey(..) -- :: *
, createKeypair -- :: IO (PublicKey, SecretKey)
, createKeypairFromSeed_ -- :: ByteString -> Maybe (PublicKey, SecretKey)
, createKeypairFromSeed -- :: ByteString -> (PublicKey, SecretKey)
, toPublicKey -- :: SecretKey -> PublicKey
-- * Signing and verifying messages
-- $signatures
, sign -- :: SecretKey -> ByteString -> ByteString
, verify -- :: PublicKey -> ByteString -> Bool
-- * Detached signatures
-- $detachedsigs
, Signature(..) -- :: *
, dsign -- :: SecretKey -> ByteString -> Signature
, dverify -- :: PublicKey -> ByteString -> Signature -> Bool
-- ** Deprecated interface
-- | The below interface is deprecated but functionally
-- equivalent to the above; it simply has \"worse\" naming and will
-- eventually be removed.
, sign' -- :: SecretKey -> ByteString -> Signature
, verify' -- :: PublicKey -> ByteString -> Signature -> Bool
-- * Security, design and implementation notes
-- $security
-- ** EdDSA background and properties
-- $background
-- *** Generation of psuedo-random seeds
-- $seedgen
-- ** Performance and implementation
-- $performance
-- ** Secure @'SecretKey'@ storage
-- $keystorage
-- ** Prehashing and large input messages
-- $prehashing
) where
import Foreign.C.Types
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr
import Foreign.Storable
import System.IO.Unsafe (unsafePerformIO)
import Data.Maybe (fromMaybe)
import Data.ByteString as S
import Data.ByteString.Internal as SI
import Data.ByteString.Unsafe as SU
import Data.Word
#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic)
#endif
-- Doctest setup with some examples
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.ByteString.Char8
-- >>> let hash x = x
-- >>> let readBigFile x = return x
--------------------------------------------------------------------------------
-- Key creation
-- $creatingkeys
--
-- Ed25519 signatures start off life by having a keypair created,
-- using @'createKeypair'@ or @'createKeypairFromSeed_'@, which gives
-- you back a @'SecretKey'@ you can use for signing messages, and a
-- @'PublicKey'@ your users can use to verify you in fact authored the
-- messages.
--
-- Ed25519 is a /deterministic signature system/, meaning that you may
-- always recompute a @'PublicKey'@ and a @'SecretKey'@ from an
-- initial, 32-byte input seed. Despite that, the default interface
-- almost all clients will wish to use is simply @'createKeypair'@,
-- which uses an Operating System provided source of secure randomness
-- to seed key creation. (For more information, see the security notes
-- at the bottom of this page.)
-- | A @'PublicKey'@ created by @'createKeypair'@.
--
-- @since 0.0.1.0
newtype PublicKey = PublicKey { unPublicKey :: ByteString
-- ^ Unwrapper for getting the raw
-- @'ByteString'@ in a
-- @'PublicKey'@. In general you
-- should not make any assumptions
-- about the underlying blob; this is
-- only provided for interoperability.
}
deriving (Eq, Show, Ord)
-- | A @'SecretKey'@ created by @'createKeypair'@. __Be sure to keep this__
-- __safe!__
--
-- @since 0.0.1.0
newtype SecretKey = SecretKey { unSecretKey :: ByteString
-- ^ Unwrapper for getting the raw
-- @'ByteString'@ in a
-- @'SecretKey'@. In general you
-- should not make any assumptions
-- about the underlying blob; this is
-- only provided for interoperability.
}
deriving (Eq, Show, Ord)
#if __GLASGOW_HASKELL__ >= 702
deriving instance Generic PublicKey
deriving instance Generic SecretKey
#endif
-- | Randomly generate a @'SecretKey'@ and @'PublicKey'@ for doing
-- authenticated signing and verification. This essentically calls
-- @'createKeypairFromSeed_'@ with a randomly generated 32-byte seed,
-- the source of which is operating-system dependent (see security
-- notes below). However, internally it is implemented more
-- efficiently (with less allocations and copies).
--
-- If you wish to use your own seed (for design purposes so you may
-- recreate keys, due to high paranoia, or because you have your own
-- source of randomness), please use @'createKeypairFromSeed_'@
-- instead.
--
-- @since 0.0.1.0
createKeypair :: IO (PublicKey, SecretKey)
createKeypair = do
pk <- SI.mallocByteString cryptoSignPUBLICKEYBYTES
sk <- SI.mallocByteString cryptoSignSECRETKEYBYTES
_ <- withForeignPtr pk $ \ppk -> do
_ <- withForeignPtr sk $ \psk -> do
_ <- c_crypto_sign_keypair ppk psk
return ()
return ()
return (PublicKey $ SI.fromForeignPtr pk 0 cryptoSignPUBLICKEYBYTES,
SecretKey $ SI.fromForeignPtr sk 0 cryptoSignSECRETKEYBYTES)
-- | Generate a deterministic @'PublicKey'@ and @'SecretKey'@ from a
-- given 32-byte seed, allowing you to recreate a keypair at any point
-- in time, providing you have the seed available.
--
-- If the input seed is not 32 bytes in length,
-- @'createKeypairFromSeed_'@ returns @'Nothing'@. Otherwise, it
-- always returns @'Just' (pk, sk)@ for the given seed.
--
-- __/NOTE/__: This function will replace @'createKeypairFromSeed'@ in
-- the future.
--
-- @since 0.0.4.0
createKeypairFromSeed_ :: ByteString -- ^ 32-byte seed
-> Maybe (PublicKey, SecretKey) -- ^ Resulting keypair
createKeypairFromSeed_ seed
| S.length seed /= cryptoSignSEEDBYTES = Nothing
| otherwise = unsafePerformIO $ do
pk <- SI.mallocByteString cryptoSignPUBLICKEYBYTES
sk <- SI.mallocByteString cryptoSignSECRETKEYBYTES
_ <- SU.unsafeUseAsCString seed $ \pseed -> do
_ <- withForeignPtr pk $ \ppk -> do
_ <- withForeignPtr sk $ \psk -> do
_ <- c_crypto_sign_seed_keypair ppk psk pseed
return ()
return ()
return ()
return $ Just (PublicKey $ SI.fromForeignPtr pk 0 cryptoSignPUBLICKEYBYTES,
SecretKey $ SI.fromForeignPtr sk 0 cryptoSignSECRETKEYBYTES)
-- | Generate a deterministic @'PublicKey'@ and @'SecretKey'@ from a
-- given 32-byte seed, allowing you to recreate a keypair at any point
-- in time, providing you have the seed available.
--
-- Note that this will @'error'@ if the given input is not 32 bytes in
-- length, so you must be careful with this input.
--
-- @since 0.0.3.0
createKeypairFromSeed :: ByteString -- ^ 32-byte seed
-> (PublicKey, SecretKey) -- ^ Resulting keypair
createKeypairFromSeed seed
= fromMaybe (error "seed has incorrect length") (createKeypairFromSeed_ seed)
{-# DEPRECATED createKeypairFromSeed "This function is unsafe as it can @'fail'@ with an invalid input. Use @'createKeypairWithSeed_'@ instead." #-}
-- | Derive the @'PublicKey'@ for a given @'SecretKey'@. This is a
-- convenience which allows (for example) using @'createKeypair'@ and
-- only ever storing the returned @'SecretKey'@ for any future
-- operations.
--
-- @since 0.0.3.0
toPublicKey :: SecretKey -- ^ Any valid @'SecretKey'@
-> PublicKey -- ^ Corresponding @'PublicKey'@
toPublicKey = PublicKey . S.drop prefixBytes . unSecretKey
where prefixBytes = cryptoSignSECRETKEYBYTES - cryptoSignPUBLICKEYBYTES
--------------------------------------------------------------------------------
-- Default, non-detached API
-- $signatures
--
-- By default, the Ed25519 interface computes a /signed message/ given
-- a @'SecretKey'@ and an input message. A /signed message/ consists
-- of an Ed25519 signature (of unspecified format), followed by the
-- input message. This means that given an input message of @M@
-- bytes, you get back a message of @M+N@ bytes where @N@ is a
-- constant (the size of the Ed25519 signature blob).
--
-- The default interface in this package reflects that. As a result,
-- any time you use @'sign'@ or @'verify'@ you will be given back the
-- full input, and then some.
--
-- | Sign a message with a particular @'SecretKey'@. Note that the resulting
-- signed message contains both the message itself, and the signature
-- attached. If you only want the signature of a given input string,
-- please see @'dsign'@.
--
-- @since 0.0.1.0
sign :: SecretKey
-- ^ Signers @'SecretKey'@
-> ByteString
-- ^ Input message
-> ByteString
-- ^ Resulting signed message
sign (SecretKey sk) xs =
unsafePerformIO . SU.unsafeUseAsCStringLen xs $ \(mstr,mlen) ->
SU.unsafeUseAsCString sk $ \psk ->
SI.createAndTrim (mlen+cryptoSignBYTES) $ \out ->
alloca $ \smlen -> do
_ <- c_crypto_sign out smlen mstr (fromIntegral mlen) psk
fromIntegral `fmap` peek smlen
{-# INLINE sign #-}
-- | Verifies a signed message against a @'PublicKey'@. Note that the input
-- message must be generated by @'sign'@ (that is, it is the message
-- itself plus its signature). If you want to verify an arbitrary
-- signature against an arbitrary message, please see @'dverify'@.
--
-- @since 0.0.1.0
verify :: PublicKey
-- ^ Signers @'PublicKey'@
-> ByteString
-- ^ Signed message
-> Bool
-- ^ Verification result
verify (PublicKey pk) xs =
unsafePerformIO . SU.unsafeUseAsCStringLen xs $ \(smstr,smlen) ->
SU.unsafeUseAsCString pk $ \ppk ->
alloca $ \pmlen -> do
out <- SI.mallocByteString smlen
r <- withForeignPtr out $ \pout ->
c_crypto_sign_open pout pmlen smstr (fromIntegral smlen) ppk
return (r == 0)
{-# INLINE verify #-}
--------------------------------------------------------------------------------
-- Detached signature support
-- $detachedsigs
--
-- This package also provides an alternative interface for /detached/
-- /signatures/, which is more in-line with what you might
-- traditionally expect from a signing API. In this mode, the
-- @'dsign'@ and @'dverify'@ interfaces simply return a constant-sized
-- blob, representing the Ed25519 signature of the input message.
--
-- This allows users to independently download, verify or attach
-- signatures to messages in any way they see fit - for example, by
-- providing a tarball file to download, with a corresponding @.sig@
-- file containing the Ed25519 signature from the author.
-- | A @'Signature'@ which is detached from the message it signed.
--
-- @since 0.0.1.0
newtype Signature = Signature { unSignature :: ByteString
-- ^ Unwrapper for getting the raw
-- @'ByteString'@ in a
-- @'Signature'@. In general you
-- should not make any assumptions
-- about the underlying blob; this is
-- only provided for interoperability.
}
deriving (Eq, Show, Ord)
#if __GLASGOW_HASKELL__ >= 702
deriving instance Generic Signature
#endif
-- | Sign a message with a particular @'SecretKey'@, only returning the
-- @'Signature'@ without the message.
--
-- @since 0.0.4.0
dsign :: SecretKey
-- ^ Signers @'SecretKey'@
-> ByteString
-- ^ Input message
-> Signature
-- ^ Message @'Signature'@, without the message
dsign sk xs =
let sm = sign sk xs
l = S.length sm
in Signature $! S.take (l - S.length xs) sm
{-# INLINE dsign #-}
-- | Verify a message with a detached @'Signature'@ against a given
-- @'PublicKey'@.
--
-- @since 0.0.4.0
dverify :: PublicKey
-- ^ Signers @'PublicKey'@
-> ByteString
-- ^ Raw input message
-> Signature
-- ^ Message @'Signature'@
-> Bool
-- ^ Verification result
dverify pk xs (Signature sig) = verify pk (sig `S.append` xs)
{-# INLINE dverify #-}
-- | Sign a message with a particular @'SecretKey'@, only returning the
-- @'Signature'@ without the message. Simply an alias for @'dsign'@.
--
-- @since 0.0.1.0
sign' :: SecretKey
-- ^ Signers @'SecretKey'@
-> ByteString
-- ^ Input message
-> Signature
-- ^ Message @'Signature'@, without the message
sign' sk xs = dsign sk xs
{-# DEPRECATED sign' "@'sign''@ will be removed in a future release; use @'dsign'@ instead." #-}
-- | Verify a message with a detached @'Signature'@ against a given
-- @'PublicKey'@. Simply an alias for @'dverify'@.
--
-- @since 0.0.1.0
verify' :: PublicKey
-- ^ Signers @'PublicKey'@
-> ByteString
-- ^ Raw input message
-> Signature
-- ^ Message @'Signature'@
-> Bool
-- ^ Verification result
verify' pk xs sig = dverify pk xs sig
{-# DEPRECATED verify' "@'verify''@ will be removed in a future release; use @'dverify'@ instead." #-}
--------------------------------------------------------------------------------
-- FFI binding
cryptoSignSECRETKEYBYTES :: Int
cryptoSignSECRETKEYBYTES = 64
cryptoSignPUBLICKEYBYTES :: Int
cryptoSignPUBLICKEYBYTES = 32
cryptoSignBYTES :: Int
cryptoSignBYTES = 64
cryptoSignSEEDBYTES :: Int
cryptoSignSEEDBYTES = 32
foreign import ccall unsafe "ed25519_sign_seed_keypair"
c_crypto_sign_seed_keypair :: Ptr Word8 -> Ptr Word8
-> Ptr CChar -> IO CInt
foreign import ccall unsafe "ed25519_sign_keypair"
c_crypto_sign_keypair :: Ptr Word8 -> Ptr Word8 -> IO CInt
foreign import ccall unsafe "ed25519_sign"
c_crypto_sign :: Ptr Word8 -> Ptr CULLong ->
Ptr CChar -> CULLong -> Ptr CChar -> IO CULLong
foreign import ccall unsafe "ed25519_sign_open"
c_crypto_sign_open :: Ptr Word8 -> Ptr CULLong ->
Ptr CChar -> CULLong -> Ptr CChar -> IO CInt
--------------------------------------------------------------------------------
-- Documentation and notes
-- $intro
--
-- The simplest use of this library is one where you probably need to
-- sign short messages, so they can be verified independently. That's
-- easily done by first creating a keypair with @'createKeypair'@, and
-- using @'sign'@ to create a signed message. Then, you can distribute
-- your public key and the signed message, and any recipient can
-- verify that message:
--
-- >>> (pk, sk) <- createKeypair
-- >>> let msg = sign sk "Hello world"
-- >>> verify pk msg
-- True
--
-- This interface is fine if your messages are small and simple binary
-- blobs you want to verify in an opaque manner, but internally it
-- creates a copy of the input message. Often, you'll want the
-- signature independently of the message, and that can be done with
-- @'dsign'@ and @'dverify'@. Naturally, verification fails if the
-- message is incorrect:
--
-- >>> (pk, sk) <- createKeypair
-- >>> let msg = "Hello world" :: ByteString
-- >>> let sig = dsign sk msg
-- >>> dverify pk msg sig
-- True
-- >>> dverify pk "Hello world" sig
-- True
-- >>> dverify pk "Goodbye world" sig
-- False
--
-- Finally, it's worth keeping in mind this package doesn't expose any
-- kind of incremental interface, and signing/verification can be
-- expensive. So, if you're dealing with __large inputs__, you can
-- hash the input with a robust, fast cryptographic hash, and then
-- sign that (for example, the @hash@ function below could be
-- __SHA-512__ or __BLAKE2b__):
--
-- >>> (pk, sk) <- createKeypair
-- >>> msg <- readBigFile "blob.tar.gz" :: IO ByteString
-- >>> let sig = dsign sk (hash msg)
-- >>> dverify pk (hash msg) sig
-- True
--
-- See the notes at the bottom of this module for more on message
-- prehashing (as it acts slightly differently in an EdDSA system).
-- $security
--
-- Included below are some notes on the security aspects of the
-- Ed25519 signature system, its implementation and design, this
-- package, and suggestions for how you might use it properly.
-- $background
--
-- Ed25519 is a specific instantiation of the __EdDSA__ digital
-- signature scheme - a high performance, secure-by-design variant of
-- Schnorr signatures based on "Twisted Edwards Curves" (hence the
-- name __Ed__DSA). The (__extended__) EdDSA system is defined by an
-- elliptic curve:
--
-- > ax^2 + y^2 = 1 + d*x^2*y^2
--
-- along with several other parameters, chosen by the implementation
-- in question. These parameters include @a@, @d@, and a field @GF(p)@
-- where @p@ is prime. Ed25519 specifically uses @d = -121665/121666@,
-- @a = -1@, and the finite field @GF((2^155)-19)@, where @(2^155)-19@
-- is a prime number (which is also the namesake of the algorithm in
-- question, as Ed__25519__). This yields the equation:
--
-- > -x^2 + y^2 = 1 - (121665/121666)*x^2*y^2
--
-- This curve is \'birationally equivalent\' to the well-known
-- Montgomery curve \'Curve25519\', which means that EdDSA shares the
-- same the difficult problem as Curve25519: that of the Elliptic
-- Curve Discrete Logarithm Problem (ECDLP). Ed25519 is currently
-- still the recommended EdDSA curve for most deployments.
--
-- As Ed25519 is an elliptic curve algorithm, the security level
-- (i.e. number of computations taken to find a solution to the ECDLP
-- with the fastest known attacks) is roughly half the key size in
-- bits, as it stands. As Ed25519 features 32-byte keys, the security
-- level of Ed25519 is thus @2^((32*8)/2) = 2^128@, far beyond any
-- attacker capability (modulo major breakthroughs for the ECDLP,
-- which would likely catastrophically be applicable to other systems
-- too).
--
-- Ed25519 designed to meet the standard notion of unforgeability for
-- a public-key signature scheme under chosen-message attacks. This
-- means that even should the attacker be able to request someone sign
-- any arbitrary message of their choice (hence /chosen-message/),
-- they are still not capable of any forgery what-so-ever, even the
-- weakest kind of \'existential forgery\'.
-- $seedgen
--
-- Seed generation as done by @'createKeypair'@ uses Operating System
-- provided APIs for generating cryptographically secure psuedo-random
-- data to be used as an Ed25519 key seed. Your own deterministic keys
-- may be generated using @'createKeypairFromSeed_'@, provided you have
-- your own cryptographically secure psuedo-random data from
-- somewhere.
--
-- On __Linux__, __OS X__ and __other Unix__ machines, the
-- @\/dev\/urandom@ device is consulted internally in order to generate
-- random data. In the current implementation, a global file
-- descriptor is used through the lifetime of the program to
-- periodically get psuedo-random data.
--
-- On __Windows__, the @CryptGenRandom@ API is used internally. This
-- does not require file handles of any kind, and should work on all
-- versions of Windows. (Windows may instead use @RtlGenRandom@ in the
-- future for even less overhead.)
--
-- In the future, there are plans for this package to internally take
-- advantage of better APIs when they are available; for example, on
-- Linux 3.17 and above, @getrandom(2)@ provides psuedo-random data
-- directly through the internal pool provided by @\/dev\/urandom@,
-- without a file descriptor. Similarly, OpenBSD provides the
-- @arc4random(3)@ family of functions, which internally uses a data
-- generator based on ChaCha20. These should offer somewhat better
-- efficiency, and also avoid file-descriptor exhaustion attacks which
-- could lead to denial of service in some scenarios.
-- $performance
--
-- Ed25519 is exceptionally fast, although the implementation provided
-- by this package is not the fastest possible implementation. Indeed,
-- it is rather slow, even by non-handwritten-assembly standards of
-- speed. That said, it should still be competitive with most other
-- signature schemes: the underlying implementation is @ref10@ from
-- <http://bench.cr.yp.to/ SUPERCOP>, authored by Daniel J. Bernstein,
-- which is within the
-- <http://bench.cr.yp.to/impl-sign/ed25519.html realm of competition>
-- against some assembly implementations (only 2x slower), and much
-- faster than the slow reference implementation (25x slower). When up
-- <http://bench.cr.yp.to/web-impl/amd64-skylake-crypto_sign.html against RSA>
-- signatures (ronald3072) on a modern Intel machine, it is still __15x__
-- faster at signing messages /at the same 128-bit security level/.
--
-- On the author's Sandy Bridge i5-2520M 2.50GHz CPU, the benchmarking
-- code included with the library reports the following numbers for
-- the Haskell interface:
--
-- @
-- benchmarking deterministic key generation
-- time 250.0 μs (249.8 μs .. 250.3 μs)
-- 1.000 R² (1.000 R² .. 1.000 R²)
-- mean 250.0 μs (249.9 μs .. 250.2 μs)
-- std dev 467.0 ns (331.7 ns .. 627.9 ns)
--
-- benchmarking signing a 256 byte message
-- time 273.2 μs (273.0 μs .. 273.4 μs)
-- 1.000 R² (1.000 R² .. 1.000 R²)
-- mean 273.3 μs (273.1 μs .. 273.5 μs)
-- std dev 616.2 ns (374.1 ns .. 998.8 ns)
--
-- benchmarking verifying a signature
-- time 635.7 μs (634.6 μs .. 637.3 μs)
-- 1.000 R² (1.000 R² .. 1.000 R²)
-- mean 635.4 μs (635.0 μs .. 636.0 μs)
-- std dev 1.687 μs (999.3 ns .. 2.487 μs)
--
-- benchmarking roundtrip 256-byte sign/verify
-- time 923.6 μs (910.0 μs .. 950.6 μs)
-- 0.998 R² (0.996 R² .. 1.000 R²)
-- mean 913.2 μs (910.6 μs .. 923.0 μs)
-- std dev 15.93 μs (1.820 μs .. 33.72 μs)
-- @
--
-- In the future, this package will hopefully provide an opt-in (or
-- possibly default) implementation of
-- <https://github.com/floodyberry/ed25519-donna ed25519-donna>, which
-- should dramatically increase speed at no cost for many/all
-- platforms.
-- $keystorage
--
-- By default, keys are not encrypted in any meaningful manner with
-- any mechanism, and this package does not provide any means of doing
-- so. As a result, your secret keys are only as secure as the
-- computing environment housing them - a server alone out on the
-- hostile internet, or a USB stick that's susceptable to theft.
--
-- If you wish to add some security to your keys, a very simple and
-- effective way is __to add a password to your @'SecretKey'@ with a__
-- __KDF and a hash__. How does this work?
--
-- * First, hash the secret key you have generated. Use this as a
-- __checksum__ of the original key. Truncating this hash to save
-- space is acceptable; see below for more details and boring
-- hemming and hawing.
--
-- * Given an input password, use a KDF to stretch it to the length
-- of a @'SecretKey'@.
--
-- * XOR the @'SecretKey'@ bytewise, directly with the output of
-- your chosen KDF.
--
-- * Attach the checksum you generated to the resulting encrypted
-- key, and store it as you like.
--
-- In this mode, your key is XOR'd with the psuedo-random result of a
-- KDF, which will stretch simple passwords like "I am the robot" into
-- a suitable amount of psuedo-random data for a given secret key to
-- be encrypted with. Decryption is simply the act of taking the
-- password, generating the psuedo-random stream again, XORing the key
-- bytewise, and validating the checksum. In this sense, you are
-- simply using a KDF as a short stream cipher.
--
-- __Recommendation__: Encrypt keys by stretching a password with
-- __scrypt__ (or __yescrypt__), using better-than-default parameters.
-- (These being @N = 2^14@, @r = 8@, @p = 1@; the default results in
-- 16mb of memory per invocation, and this is the recommended default
-- for 'interactive systems'; signing keys may be loaded on-startup
-- for some things however, so it may be profitable to increase
-- security as well as memory use in these cases. For example, at @N =
-- 2^18@, @r = 10@ and @p = 2@, you'll get 320mb of memory per use,
-- which may be acceptable for dramatic security increases. See
-- elsewhere for exact memory use.) Checksums may be computed with an
-- exceptionally fast hash such as __BLAKE2b__.
--
-- __Bonus points__: Print that resulting checksum + key out on a
-- piece of paper (~100 bytes, tops), and put /that/ somewhere safe.
--
-- __Q__: What is the hash needed for? __A__: A simple file integrity
-- check. Rather than invoke complicated methods of verifying if an
-- ed25519 keypair is valid (as it is simply an opaque binary blob,
-- for all intents and purposes), especially after 'streaming
-- decryption', it's far easier to simply compute and compare against
-- a checksum of the original to determine if decryption with your
-- password worked.
--
-- __Q__: Wait, why is it OK to truncate the hash here? That sounds
-- scary. Won't that open up collisions or something like that if they
-- stole my encrypted key? __A__: No. The hash in this case is only
-- used as a checksum to see if the password is legitimate after
-- running the KDF and XORing with the result. Think about how the
-- \'challenge\' itself is chosen: if you know @H(m)@, do you want to
-- find @m@ itself, or simply find @m'@ where @H(m') = H(m)@? To
-- forge a signature, you want the original key, @m@. Suppose given an
-- input of 256-bits, we hashed it and truncated to one bit. Finding
-- collisions would be easy: you would only need to try a few times to
-- find a collision or preimage. But you probably found @m'@ such that
-- @H(m') = H(m)@ - you didn't necessarily find @m@ itself. In this
-- sense, finding collisions or preimages of the hash is not useful to
-- the attacker, because you must find the unique @m@.
--
-- __Q__: Okay, why use hashes at all? Why not CRC32? __A__: You could
-- do that, it wouldn't change much. You can really use any kind of
-- error detecting code you want. The thing is, some hashes such as
-- __BLAKE2__ are very fast in things like software (not every CPU has
-- CRC instructions, not all software uses CRC instructions), and
-- you're likely to already have a fast, modern hash function sitting
-- around anyway if you're signing stuff with Ed25519. Why not use it?
-- $prehashing
--
-- __Message prehashing__ (although not an official term in any right)
-- is the idea of first taking an input @x@, using a
-- __cryptographically secure__ hash function @H@ to calculate @y =
-- H(x)@, and then generating a signature via @Sign(secretKey,
-- y)@. The idea is that signing is often expensive, while hashing is
-- often extremely fast. As a result, signing the hash of a message
-- (which should be indistinguishable from a truly random function) is
-- often faster than simply signing the full message alone, and in
-- larger cases can save a significant amount of CPU cycles. However,
-- internally Ed25519 uses a hash function @H@ already to hash the
-- input message for computing the signature. Thus, there is a
-- question - is it appropriate or desireable to hash the input
-- already if this is the case?
--
-- Generally speaking, it's OK to prehash messages before giving them
-- to Ed25519. However, there is a caveat. In the paper
-- <http://ed25519.cr.yp.to/eddsa-20150704.pdf "EdDSA for more curves">,
-- the authors of the original EdDSA enhance the specification by
-- extending it with a message prehash function, @H'@, along with an
-- internal hash @H@. Here, the prehash @H'@ is simply applied to the
-- original message first before anything else. The original EdDSA
-- specification (and the implementation in /this package/) was a
-- trivial case of this enhancement: it was implicit that @H'@ is
-- simply the identity function. We call the case where @H'@ is the
-- identity function __PureEdDSA__, while the case where @H'@ is a
-- cryptographic hash function is known as __HashEdDSA__. (Thus, the
-- interfaces @'sign'@ and @'dsign'@ implement PureEdDSA - while they can
-- be converted to HashEdDSA by simply hashing the @'ByteString'@
-- first with some other function.)
--
-- However, the authors note that HashEdDSA suffers from a weakness
-- that PureEdDSA does not - PureEdDSA is resiliant to collision
-- attacks in the underlying hash function @H@, while HashEdDSA is
-- vulnerable to collisions in @H'@. This is an important
-- distinction. Assume that the attacker finds a collision such that
-- @H'(x) = H'(y)@, and then gets convinces a signer to HashEdDSA-sign
-- @x@ - the attacker may then forge this signature and use it as the
-- same signature as for the message @y@. For a hash function of
-- @N@-bits of output, a collision attack takes roughly @2^(N/2)@
-- operations.
--
-- Ed25519 internally sets @H = SHA-512@ anyway, which has no known
-- collision attacks or weaknesses in any meaningful sense. It is
-- however slower compared to other, more modern hash functions, and
-- is used on the input message in its entirety (and there are no
-- plans to switch the internal implementation of this package, or the
-- standard Ed25519 away from @H = SHA-512@).
--
-- But note: /all other hash-then-sign constructions suffer from/
-- /this/, in the sense they are all vulnerable to collision attacks
-- in @H'@, should you prehash the message. In fact, PureEdDSA is
-- unique (as far as I am aware) in that it is immune to collision
-- attacks in @H@ - should a collision be found, it would not suffer
-- from these forgeries. By this view, it's arguable that /depending/
-- on the HashEdDSA construction (for efficiency or size purposes)
-- when using EdDSA is somewhat less robust, even if SHA-512 or
-- whatever is not very fast. Despite that, just about any /modern/
-- /hash/ you pick is going to be collision resistant to a fine degree
-- (say, 256 bits of output, therefore collisions 'at best' happen in
-- @2^128@ operations), so in practice this robustness issue may not
-- be that big of a deal.
--
-- However, the more pertinent issue is that due to the current design
-- of the API which requires the entire blob to sign up front, using
-- the HashEdDSA construction is often much more convenient, faster
-- and sometimes /necessary/ too. For example, when signing very large
-- messages (such as creating a very large @tar.gz@ file which you
-- wish to sign after creation), it is often convenient and possible
-- to use \'incremental\' hashing APIs to incrementally consume data
-- blocks from the input in a constant amount of memory. At the end of
-- consumption, you can \'finalize\' the data blocks and get back a
-- final N-bit hash, and sign this hash all in a constant amount of
-- memory. With the current API, using PureDSA would require you
-- loading the entire file up front to either sign, or verify it. This
-- is especially unoptimal for possibly smaller, low-memory systems
-- (where decompression, hashing or verification are all best done in
-- constant space if possible).
--
-- Beware however, that if you do this sort of incremental hashing for
-- large blobs, you are __taking untrusted data__ and hashing it
-- __before checking the signature__ - be __exceptionally careful__
-- with data from a possibly untrustworthy source until you can verify
-- the signature.
--
-- So, __some basic guidelines are__:
--
-- - If you are simply not worried about efficiency very much, just
-- use __PureEdDSA__ (i.e. just use @'sign'@ and @'verify'@
-- directly).
--
-- - If you have __lots of small messages__, use __PureEdDSA__ (i.e.
-- just use @'sign'@ and @'verify'@ directly).
--
-- - If you have to sign/verify __large messages__, possibly __in__
-- __an incremental fashion__, use __HashEdDSA__ with __a fast__
-- __hash__ (i.e. just hash a message before using @'sign'@ or
-- @'verify'@ on it).
--
-- - A hash like __BLAKE2b__ is recommended. Fast and very secure.
--
-- - Remember: __never touch input data in any form until you__
-- __are done hashing it and verifying the signature__.
--
-- As a result, you should be safe hashing your input before passing
-- it to @'sign'@ or @'dsign'@ in this library if you desire, and it may
-- save you CPU cycles for large inputs. It should be no different
-- than the typical /hash-then-sign/ construction you see elsewhere,
-- with the same downfalls. Should you do this, an extremely
-- fast-yet-secure hash such as __BLAKE2b__ is recommended, which is
-- even faster than MD5 or SHA-1 (and __do not ever use MD5 or__
-- __SHA-1__, on that note - they suffer from collision attacks).