{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- Module : Crypto.Cipher.AES.Primitive -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : stable -- Portability : good -- module Crypto.Cipher.AES.Primitive ( -- * block cipher data types AES -- * Authenticated encryption block cipher types , AESGCM , AESOCB -- * creation , initAES -- * misc , genCTR , genCounter -- * encryption , encryptECB , encryptCBC , encryptCTR , encryptXTS -- * decryption , decryptECB , decryptCBC , decryptCTR , decryptXTS -- * incremental GCM , gcmMode , gcmInit -- * incremental OCB , ocbMode , ocbInit ) 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 _ _ _ = 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 } -- | 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) sizeGCM :: Int sizeGCM = 80 sizeOCB :: Int sizeOCB = 160 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) -- | 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 {-# 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 () ------------------------------------------------------------------------ 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_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 ()