module Crypto.Cipher.AES128.Internal
( AESKey(..), RawKey(..), GCM(..)
, generateKey, generateGCM
, encryptECB
, decryptECB
, encryptGCM
, decryptGCM
, finishGCM
, encryptCTR
, decryptCTR
) where
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Data.Word
import Data.Bits (shiftL, (.|.))
data AESKeyStruct
type AESKeyPtr = Ptr AESKeyStruct
data RawKey = RKey { lowK,highK :: !Word64 }
data AESKey = AESKey { rawKey :: !RawKey
, expandedKey :: ForeignPtr AESKeyStruct }
type AESGcmPtr = Ptr GCMStruct
data GCMStruct
data GCM = GCM { _gcmFP :: ForeignPtr GCMStruct }
foreign import ccall unsafe "aes/aes.h generate_key128"
c_generate_key128 :: AESKeyPtr -> Ptr Word8 -> IO ()
foreign import ccall unsafe "aes/aes.h allocate_key128"
c_allocate_key128 :: IO AESKeyPtr
foreign import ccall unsafe "aes/aes.h &free_key128"
c_free_key128 :: FunPtr (AESKeyPtr -> IO ())
foreign import ccall unsafe "aes/aes.h free_key128"
c_key128_free :: AESKeyPtr -> IO ()
foreign import ccall unsafe "aes/aes.h encrypt_ecb"
c_encrypt_ecb :: AESKeyPtr -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "aes/aes.h decrypt_ecb"
c_decrypt_ecb :: AESKeyPtr -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
foreign import ccall unsafe "aes/aes.h allocate_gcm"
c_gcm_allocate :: IO AESGcmPtr
foreign import ccall unsafe "aes/aes.h aes_gcm_init"
c_gcm_init :: AESGcmPtr
-> AESKeyPtr
-> Ptr Word8 -> Word32
-> IO ()
foreign import ccall unsafe "aes/aes.h aes_gcm_enc_finish"
c_gcm_encrypt :: Ptr Word8
-> Ptr Word8
-> AESGcmPtr
-> Ptr Word8 -> Word32
-> Ptr Word8 -> Word32
-> Ptr Word8 -> Word32
-> IO ()
foreign import ccall unsafe "aes/aes.h aes_gcm_dec_finish"
c_gcm_decrypt :: Ptr Word8
-> Ptr Word8
-> AESGcmPtr
-> Ptr Word8 -> Word32
-> Ptr Word8 -> Word32
-> Ptr Word8 -> Word32
-> IO ()
foreign import ccall unsafe "aes/aes.h allocate_gcm"
c_gcm_finish :: Ptr Word8 -> AESGcmPtr -> IO ()
foreign import ccall unsafe "aes/aes.h &free_gcm"
c_free_gcm :: FunPtr (AESGcmPtr -> IO ())
foreign import ccall unsafe "aes/aes.h free_gcm"
_c_gcm_free :: AESGcmPtr -> IO ()
foreign import ccall unsafe "aes/aes.h encrypt_ctr"
c_encrypt_ctr :: AESKeyPtr
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Word32
-> IO ()
c_decrypt_ctr :: AESKeyPtr
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Word32
-> IO ()
c_decrypt_ctr = c_encrypt_ctr
blkSzC :: Word32
blkSzC = 16
generateKey :: Ptr Word64
-> IO AESKey
generateKey keyPtr = do
raw <- do
a <- peekLE (castPtr keyPtr)
let keyPtr2 = (castPtr keyPtr) `plusPtr` sizeOf a
b <- peekLE keyPtr2
return (RKey b a)
k <- c_allocate_key128
c_generate_key128 k (castPtr keyPtr)
fmap (AESKey raw) (newForeignPtr c_free_key128 k)
where
peekLE :: Ptr Word8 -> IO Word64
peekLE p = do
a1 <- peekElemOff p 0
a2 <- peekElemOff p 1
a3 <- peekElemOff p 2
a4 <- peekElemOff p 3
a5 <- peekElemOff p 4
a6 <- peekElemOff p 5
a7 <- peekElemOff p 6
a8 <- peekElemOff p 7
let f n s = fromIntegral n `shiftL` s
let a = (f a1 56) .|. (f a2 48) .|. (f a3 40) .|.
(f a4 32) .|. (f a5 24) .|. (f a6 16) .|.
(f a7 8) .|. fromIntegral a8
return a
generateGCM :: Ptr Word64
-> IO GCM
generateGCM keyPtr = do
g <- c_gcm_allocate
k <- c_allocate_key128
c_generate_key128 k (castPtr keyPtr)
allocaBytes 12 $ \ivPtr -> do
mapM_ (\i -> pokeElemOff ivPtr i (0::Word8)) [0..11]
c_gcm_init g k ivPtr 12
c_key128_free k
fmap GCM (newForeignPtr c_free_gcm g)
encryptECB :: AESKey
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ()
encryptECB (AESKey _ k) dst src blks = withForeignPtr k $ \p -> c_encrypt_ecb p dst src (fromIntegral blks)
decryptECB :: AESKey
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ()
decryptECB (AESKey _ k) dst src blks
| blks > fromIntegral (maxBound `div` blkSzC :: Word32) = error "Can not decrypt so many blocks at once"
| otherwise = withForeignPtr k $ \p -> c_decrypt_ecb p dst src (fromIntegral blks)
encryptGCM :: GCM
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
encryptGCM (GCM k) iv ivlen pt ptlen aad aadlen ct tg = withForeignPtr k $ \g ->
c_gcm_encrypt ct tg g iv (fromIntegral ivlen)
pt (fromIntegral ptlen)
aad (fromIntegral aadlen)
decryptGCM :: GCM
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
decryptGCM (GCM k) iv ivlen ct ctlen aad aadlen pt tg = withForeignPtr k $ \g ->
c_gcm_decrypt pt tg g
iv (fromIntegral ivlen)
ct (fromIntegral ctlen)
aad (fromIntegral aadlen)
finishGCM :: GCM
-> Ptr Word8
-> IO ()
finishGCM (GCM k) tagPtr = withForeignPtr k $ \g -> c_gcm_finish tagPtr g
encryptCTR :: AESKey
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ()
encryptCTR (AESKey _ k) iv niv ct pt len = withForeignPtr k $ \p -> do
c_encrypt_ctr p iv niv ct pt (fromIntegral len)
decryptCTR :: AESKey
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO ()
decryptCTR (AESKey _ k) iv niv ct pt len = withForeignPtr k $ \p -> do
c_decrypt_ctr p iv niv ct pt (fromIntegral len)