aes-gcm-0.0.0.0: src/Crypto/Cipher/AES/GCM.hs
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Copyright (C) 2024 Herbert Valerio Riedel
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
-- |
-- Module : Crypto.Cipher.AES.GCM
-- Copyright : © 2024 Herbert Valerio Riedel
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- Maintainer : hvr@gnu.org
--
-- This library provides a type-safe API to OpenSSL's AES Galois\/Counter Mode (GCM) AEAD Cipher implementation.
-- The API provides both a pure one-shot interface as well as an 'IO'-based incremental interface for streaming large amounts of data.
--
-- === Usage Example
--
-- @
-- {-# LANGUAGE OverloadedStrings #-}
--
-- import "Crypto.Cipher.AES.GCM"
--
-- main :: IO ()
-- main = do
-- let key :: 'Key' Bits'256
-- Just key = key'fromByteString "0123456789abcdef0123456789abcdef"
--
-- iv :: 'IV'
-- Just iv = iv'fromByteString "some-nonce-iv123"
--
-- aad :: 'AAD'
-- aad = "header-data-part1"
--
-- putStrLn "== One-shot interface =="
--
-- -- One-shot encryption
-- let Right (ciphertext, tag) = 'encrypt' key iv aad "This is the message"
-- putStrLn $ "Ciphertext: " ++ show ciphertext
-- putStrLn $ "Auth Tag: " ++ show (tag :: 'Tag' Bits'128)
--
-- -- One-shot decryption
-- case 'decrypt' key iv tag aad ciphertext of
-- Right (Just pt) -> putStrLn $ "Plaintext: " ++ show pt
-- Right Nothing -> putStrLn "Authentication failed"
--
-- putStrLn "== Incremental interface =="
--
-- -- Incremental encryption
-- encCtx <- 'encryptInit' key iv
-- 'encryptUpdateAAD' encCtx aad
-- ct1 <- 'encryptUpdate' encCtx "This is"
-- ct2 <- 'encryptUpdate' encCtx " the message"
-- tagInc <- 'encryptFinalize' encCtx
-- putStrLn $ "Ciphertext: " ++ show (ct1 <> ct2)
-- putStrLn $ "Auth Tag: " ++ show (tagInc :: Tag Bits'128)
--
-- -- Incremental decryption
-- decCtx <- 'decryptInit' key iv
-- 'decryptUpdateAAD' decCtx aad
-- pt1 <- 'decryptUpdate' decCtx ct1
-- pt2 <- 'decryptUpdate' decCtx ct2
-- authOk <- 'decryptFinalize' decCtx tagInc
-- putStrLn $ "Plaintext: " ++ show (pt1 <> pt2)
-- putStrLn $ "Authenticated? " ++ show authOk
-- @
--
-- === References
--
-- Dworkin, M., /"Recommendation for Block Cipher Modes of Operation: Galois\/Counter Mode (GCM) and GMAC"/, NIST SP 800-38D, Nov. 2007.
-- [DOI: 10.6028/NIST.SP.800-38D](https://doi.org/10.6028/NIST.SP.800-38D)
--
module Crypto.Cipher.AES.GCM
(
-- * One-shot cipher operation API
encrypt
, decrypt
-- * Incremental cipher operation API
-- ** Encryption
, EncryptCtx
, encryptInit
, encryptUpdateAAD
, encryptUpdate
, encryptFinalize
-- ** Decryption
, DecryptCtx
, decryptInit
, decryptUpdateAAD
, decryptUpdate
, decryptFinalize
-- * Exception type
, AesGcmError(..)
-- * Cipher operation parameter types
, AAD, PT, CT
-- ** Encryption 'Key'
, Key, key'fromByteString, key'toByteString, KnownKeyLength, key'length
, SomeKey(SomeKey), someKey, someKey'fromByteString
-- ** Initialization Vector ('IV')
, IV, iv'fromByteString, iv'toByteString, iv'length
-- ** Authentication 'Tag'
, Tag, tag'fromByteString, tag'toByteString, KnownTagLength, tag'length
, SomeTag(SomeTag), someTag, someTag'fromByteString
-- ** Type-level Bit-sizes
, Bits'32
, Bits'64
, Bits'96
, Bits'104
, Bits'112
, Bits'120
, Bits'128
, Bits'192
, Bits'256
) where
import Control.Exception (Exception (..), mask_, throwIO)
import Control.Monad
import Data.ByteString as BS
import Data.ByteString.Internal (ByteString (PS), mallocByteString)
import Data.Int
import Data.IORef
import Data.Typeable (Typeable)
import Data.Word
import Foreign (ForeignPtr, alloca,
finalizeForeignPtr, newForeignPtr,
peek, withForeignPtr)
import Foreign.C.Types
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)
-- | Exceptional errors that may be raised during AES GCM cipher operation
--
-- These errors indicate incorrect usage or unexpected internal failures.
data AesGcmError
= AesGcmError'InvalidState -- ^ Cipher context (i.e. 'EncryptCtx' or 'DecryptCtx') in wrong state (i.e. operations invoked in wrong order)
| AesGcmError'LimitExceeded -- ^ AAD or message beyond size limits
| AesGcmError'EngineError -- ^ A call to the underlying cryptographic engine (i.e. OpenSSL) unexpectedly failed
| AesGcmError'Impossible -- ^ indicates internal logic corruption (i.e. most likely a bug)
deriving (Eq,Show,Typeable)
{-# INLINE limitMsg #-}
limitMsg :: Int64
limitMsg = 68719476704 -- 2^36 - 32 bytes
{-# INLINE limitAAD #-}
limitAAD :: Int64
limitAAD = 2305843009213693951 -- 2^61 - 1 bytes
{-# INLINE limitIV #-}
limitIV :: Int64
limitIV = 128 -- formally this would be 2^61 - 1 bytes; but OpenSSL limits to 1024-bit IVs
instance Exception AesGcmError
-- | AES GCM Initialization Vector (IV)
--
-- The only requirement imposed on the IV according to the NIST specification is
--
-- \[
-- 1 \leq len(IV) \leq 2^{64} - 1
-- \]
--
-- where \(len(IV)\) denotes the size of the IV expressed in bits.
--
-- Unfortunately, OpenSSL 3.x imposes a limit of 1024 bits on IV length, and this library adheres to that limit.
--
-- However, it's preferable to use a 96-bit (i.e. 12 octets) IV if possible, as other
-- IV lengths require an additional GHASH transformation as specified for the GCM AES algorithm.
newtype IV = IV ByteString deriving (Eq,Ord,Show)
-- | Additional authenticated data ('AAD')
--
-- Formally, the AES GCM specification requires
--
-- \[
-- len(AAD) \leq 2^{64} - 1
-- \]
--
-- where \(len(AAD)\) denotes the total size of the additional authenticated data expressed in bits.
-- When this limit is exceeded 'AesGcmError'LimitExceeded' is thrown.
type AAD = ByteString
-- | Plaintext
--
-- Formally, the AES GCM specification requires
--
-- \[
-- len(PT) \leq 2^{39} - 256
-- \]
--
-- where \(len(PT)\) denotes the total size of the plaintext expressed in bits.
-- When this limit is exceeded 'AesGcmError'LimitExceeded' is thrown.
type PT = ByteString
-- | Ciphertext
--
-- The same size limit as for 'PT' applies.
type CT = ByteString
-- | AES GCM Authentication Tag
--
-- Only tag lengths of 4, 8, 12, 13, 14, 15, or 16 bytes are supported by this implementation. These are the only bit-length provided as instances of the 'KnownTagLength' class for use as phantom types with 'Tag'.
--
-- Note: When using shorter tags (i.e. 4 or 8 bytes), refer to the NIST SP 800-38D
-- appendix for guidance, as they provide weaker authentication guarantees.
--
newtype Tag t = Tag ByteString deriving (Eq,Ord,Show)
-- | 4 bytes
data Bits'32
-- | 8 bytes
data Bits'64
-- | 12 bytes
data Bits'96
-- | 13 bytes
data Bits'104
-- | 14 bytes
data Bits'112
-- | 15 bytes
data Bits'120
-- | 16 bytes
data Bits'128
-- | 24 bytes
data Bits'192
-- | 32 bytes
data Bits'256
-- | Type class representing valid 'Tag' lengths
class KnownTagLength t where tagLength :: Tag t -> Int
instance KnownTagLength Bits'32 where tagLength _ = 4
instance KnownTagLength Bits'64 where tagLength _ = 8
instance KnownTagLength Bits'96 where tagLength _ = 12
instance KnownTagLength Bits'104 where tagLength _ = 13
instance KnownTagLength Bits'112 where tagLength _ = 14
instance KnownTagLength Bits'120 where tagLength _ = 15
instance KnownTagLength Bits'128 where tagLength _ = 16
-- | Type class representing valid 'Key' lengths
class KnownKeyLength t where keyLength :: Key t -> Int
instance KnownKeyLength Bits'128 where keyLength _ = 16
instance KnownKeyLength Bits'192 where keyLength _ = 24
instance KnownKeyLength Bits'256 where keyLength _ = 32
-- | Construct GCM authentication 'Tag' from 'ByteString'
--
-- Returns 'Nothing' if input 'ByteString' doesn't match type-level tag length. See documentation of 'Tag' for more information.
--
tag'fromByteString :: forall t . KnownTagLength t => ByteString -> Maybe (Tag t)
tag'fromByteString bs
| BS.length bs == tagLength tag = Just tag
| otherwise = Nothing
where
tag :: Tag t
tag = Tag bs
-- | Destructure 'Tag' into 'ByteString'
tag'toByteString :: KnownTagLength tlen => Tag tlen -> ByteString
tag'toByteString (Tag b) = b
-- | Tag size in octets
tag'length :: KnownTagLength tlen => Tag tlen -> Int
tag'length = tagLength
-- | Represents a 'Tag' whose length isn't statically known
data SomeTag = forall klen . KnownTagLength klen => SomeTag (Tag klen)
instance Eq SomeTag where
(==) (SomeTag (Tag a)) (SomeTag ((Tag b))) = a == b
instance Ord SomeTag where
compare (SomeTag (Tag a)) (SomeTag ((Tag b))) = compare a b
instance Show SomeTag where
showsPrec p (SomeTag t) = showsPrec p t
-- | Construct AES encryption 'Tag' from 'ByteString' with dynamic length
--
-- Returns 'Nothing' for invalid tag lengths.
someTag'fromByteString :: ByteString -> Maybe SomeTag
someTag'fromByteString b = someTag (BS.length b) (Tag b)
{-# INLINE someTag #-}
-- | Reflect a length value into a known tag length type and box into a 'SomeTag'
someTag :: Int -> (forall tlen . KnownTagLength tlen => Tag tlen) -> Maybe SomeTag
someTag tlen tag = case tlen of
4 -> Just $ SomeTag (tag :: Tag Bits'32)
8 -> Just $ SomeTag (tag :: Tag Bits'64)
12 -> Just $ SomeTag (tag :: Tag Bits'96)
13 -> Just $ SomeTag (tag :: Tag Bits'104)
14 -> Just $ SomeTag (tag :: Tag Bits'112)
15 -> Just $ SomeTag (tag :: Tag Bits'120)
16 -> Just $ SomeTag (tag :: Tag Bits'128)
_ -> Nothing
-- | AES GCM Encryption Key
--
-- The phantom type is used to encode the AES key length. Valid key lengths are 16, 24, and 32 octets.
--
newtype Key t = Key ByteString deriving (Eq,Ord)
-- | Construct AES encryption 'Key' from 'ByteString'
--
-- Returns 'Nothing' if input 'ByteString' doesn't match type-level key length.
-- See documentation of the 'Key' type for details on valid lengths.
key'fromByteString :: forall tlen . KnownKeyLength tlen => ByteString -> Maybe (Key tlen)
key'fromByteString bs = do
let key = Key bs :: Key tlen
guard (BS.length bs == keyLength key)
Just key
-- | Destructure 'Key' into 'ByteString'
key'toByteString :: KnownKeyLength t => Key t -> ByteString
key'toByteString (Key b) = b
-- | Key size in octets
key'length :: KnownKeyLength klen => Key klen -> Int
key'length = keyLength
-- | Represents a 'Key' whose length isn't statically known
data SomeKey = forall klen . KnownKeyLength klen => SomeKey (Key klen)
instance Eq SomeKey where
(==) (SomeKey (Key a)) (SomeKey ((Key b))) = a == b
instance Ord SomeKey where
compare (SomeKey (Key a)) (SomeKey ((Key b))) = compare a b
-- | Construct AES encryption 'Key' from 'ByteString' with dynamic length
--
-- Returns 'Nothing' for invalid key lengths.
someKey'fromByteString :: ByteString -> Maybe SomeKey
someKey'fromByteString b = someKey (BS.length b) (Key b)
{-# INLINE someKey #-}
-- | Reflect a length value into a known tag length type and box into a 'SomeKey'
someKey :: Int -> (forall tlen . KnownKeyLength tlen => Key tlen) -> Maybe SomeKey
someKey tlen tag = case tlen of
16 -> Just $ SomeKey (tag :: Key Bits'128)
24 -> Just $ SomeKey (tag :: Key Bits'192)
32 -> Just $ SomeKey (tag :: Key Bits'256)
_ -> Nothing
-- | Construct GCM 'IV' from 'ByteString'
--
-- Returns 'Nothing' if input 'ByteString' has an invalid length.
-- See documentation of the 'IV' type for details on valid lengths.
iv'fromByteString :: ByteString -> Maybe IV
iv'fromByteString bs = do
guard (not $ BS.null bs)
guard (fromIntegral (BS.length bs) <= limitIV)
Just (IV bs)
-- | Destructure 'IV' into 'ByteString'
iv'toByteString :: IV -> ByteString
iv'toByteString (IV b) = b
-- | 'IV' length in octets
iv'length :: IV -> Int
iv'length (IV bs) = BS.length bs
----------------------------------------------------------------------------
-- | Encrypt plaintext using AES GCM according to provided parameters
--
-- On success returns the ciphertext and authentication tag.
--
-- In case of internal errors 'Left' is returned with an appropriate 'AesGcmError' value.
encrypt :: (KnownKeyLength klen, KnownTagLength tlen)
=> Key klen -> IV -> AAD -> PT -> Either AesGcmError (CT,Tag tlen)
encrypt key iv aad pt = do
unless (fromIntegral (BS.length aad) <= limitAAD) $
Left AesGcmError'LimitExceeded
unless (fromIntegral (BS.length pt) <= limitMsg) $
Left AesGcmError'LimitExceeded
let (ct,tag0,rc) = hs_gcm_aes_encrypt key iv tag'len aad pt
tag = Tag tag0
tag'len = fromIntegral (tagLength tag)
case rc of
0 -> Right (ct,tag)
_ -> Left $ cint2err rc
-- | Decrypt ciphertext using AES GCM according to provided parameters
--
-- On success returns the plaintext; if an authentication tag mismatch occurs, @Right Nothing@ is returned instead.
--
-- In case of internal errors 'Left' is returned with an appropriate 'AesGcmError' value.
decrypt :: (KnownKeyLength klen, KnownTagLength tlen)
=> Key klen -> IV -> Tag tlen -> AAD -> CT -> Either AesGcmError (Maybe PT)
decrypt key iv tag aad ct = do
unless (fromIntegral (BS.length aad) <= limitAAD) $
Left AesGcmError'LimitExceeded
unless (fromIntegral (BS.length ct) <= limitMsg) $
Left AesGcmError'LimitExceeded
let (pt,rc) = hs_gcm_aes_decrypt key iv tag aad ct
case rc of
0 -> Right (Just pt)
1 -> Right Nothing -- authentication failed
_ -> Left $ cint2err rc
----------------------------------------------------------------------------
-- State gatekeeping
data CtxState = CS'AAD CtxFP !Int64 | CS'MSG CtxFP !Int64 | CS'FIN deriving (Eq)
goState'AAD :: IORef CtxState -> Int -> (CtxFP -> IO a) -> IO a
goState'AAD stref chunkSize act = mask_ $ do
st <- readIORef stref
(sz',ctxfptr) <- case st of
CS'AAD ctxfptr sz -> pure (sz + chunkSize',ctxfptr)
CS'MSG _ _ -> throwIO AesGcmError'InvalidState
CS'FIN -> throwIO AesGcmError'InvalidState
unless (sz' <= limitAAD) $
throwIO AesGcmError'LimitExceeded
atomicWriteIORef stref $! (CS'AAD ctxfptr sz')
act ctxfptr
where
chunkSize' = fromIntegral chunkSize
goState'MSG :: IORef CtxState -> Int -> (CtxFP -> IO a) -> IO a
goState'MSG stref chunkSize act = mask_ $ do
st <- readIORef stref
(sz',ctxfptr) <- case st of
CS'AAD ctxfptr _ -> pure (chunkSize',ctxfptr)
CS'MSG ctxfptr sz -> pure (sz + chunkSize',ctxfptr)
CS'FIN -> throwIO AesGcmError'InvalidState
unless (sz' <= limitMsg) $
throwIO AesGcmError'LimitExceeded
atomicWriteIORef stref $! (CS'MSG ctxfptr sz')
act ctxfptr
where
chunkSize' = fromIntegral chunkSize
goState'FIN :: IORef CtxState -> (CtxFP -> IO a) -> IO a
goState'FIN stref act = mask_ $ do
st <- readIORef stref
ctxfptr <- case st of
CS'AAD ctxfptr _ -> pure ctxfptr
CS'MSG ctxfptr _ -> pure ctxfptr
CS'FIN -> throwIO AesGcmError'InvalidState
atomicWriteIORef stref CS'FIN
act ctxfptr <* finalizeForeignPtr ctxfptr
-- | AES GCM Encryption Context
--
-- If this context is accessed concurrently from multiple threads it needs
-- to be protected by an 'Control.Concurrent.MVar.MVar'.
newtype EncryptCtx = ECtx (IORef CtxState)
-- | AES GCM Decryption Context
--
-- If this context is accessed concurrently from multiple threads it needs
-- to be protected by an 'Control.Concurrent.MVar.MVar'.
newtype DecryptCtx = DCtx (IORef CtxState)
-- | Construct and initialize a new AES GCM encryption context
--
-- This operation throws 'AesGcmError' in case of internal errors.
--
-- The following operations may be then be invoked on the resulting context (in order):
--
-- - 'encryptUpdateAAD' (zero or more times)
-- - 'encryptUpdate' (zero or more times)
-- - 'encryptFinalize' (at most once)
--
encryptInit :: KnownKeyLength klen => Key klen -> IV -> IO EncryptCtx
encryptInit key iv = do { ctxfptr <- ctx_new Enc key iv; ECtx <$> newIORef (CS'AAD ctxfptr 0) }
-- | Construct and initialize a new AES GCM decryption context (throws 'AesGcmError')
--
-- This operation throws 'AesGcmError' in case of internal errors.
--
-- The following operations may be then be invoked on the resulting context (in order):
--
-- - 'decryptUpdateAAD' (zero or more times)
-- - 'decryptUpdate' (zero or more times)
-- - 'decryptFinalize' (at most once)
--
decryptInit :: KnownKeyLength klen => Key klen -> IV -> IO DecryptCtx
decryptInit key iv = do { ctxfptr <- ctx_new Dec key iv; DCtx <$> newIORef (CS'AAD ctxfptr 0) }
-- | Update the AES GCM encryption context with (a chunk) of additional authenticated data ('AAD')
--
-- This operation can be called zero or more times.
--
-- It must be called before 'encryptUpdate' or 'encryptFinalize'; otherwise 'AesGcmError'InvalidState' is thrown.
encryptUpdateAAD :: EncryptCtx -> AAD -> IO ()
encryptUpdateAAD (ECtx stref) aad = seq aad $ goState'AAD stref (BS.length aad) $ ctx_update_aad Enc aad
-- | Update the AES GCM decryption context with (a chunk) of additional authenticated data ('AAD')
--
-- This operation can be called zero or more times.
--
-- It must be called before 'decryptUpdate' or 'decryptFinalize'; otherwise 'AesGcmError'InvalidState' is thrown.
decryptUpdateAAD :: DecryptCtx -> AAD -> IO ()
decryptUpdateAAD (DCtx stref) aad = seq aad $ goState'AAD stref (BS.length aad) $ ctx_update_aad Dec aad
-- | Update the AES GCM encryption context with (a chunk) of plaintext data
--
-- This operation can be called zero or more times.
--
-- It must be called before 'encryptFinalize'; otherwise 'AesGcmError'InvalidState' is thrown.
encryptUpdate :: EncryptCtx -> PT -> IO CT
encryptUpdate (ECtx stref) pt = seq pt $ goState'MSG stref (BS.length pt) $ ctx_update_msg Enc pt
-- | Update the AES GCM decryption context with (a chunk) of ciphertext data
--
-- This operation can be called zero or more times.
--
-- It must be called before 'decryptFinalize'; otherwise 'AesGcmError'InvalidState' is thrown.
decryptUpdate :: DecryptCtx -> CT -> IO PT
decryptUpdate (DCtx stref) ct = seq ct $ goState'MSG stref (BS.length ct) $ ctx_update_msg Dec ct
-- | Finalize AES GCM encryption context and produce authentication 'Tag'
--
-- This operation can be called at most once; calling it more than once throws 'AesGcmError'InvalidState'.
encryptFinalize :: KnownTagLength tlen => EncryptCtx -> IO (Tag tlen)
encryptFinalize (ECtx stref) = goState'FIN stref ctx_finalize_enc
-- | Finalize AES GCM decryption context and verify authentication 'Tag'.
--
-- Returns 'False' in case of an authentication tag mismatch.
--
-- This operation can be called at most once; calling it more than once throws 'AesGcmError'InvalidState'.
decryptFinalize :: KnownTagLength tlen => DecryptCtx -> Tag tlen -> IO Bool
decryptFinalize (DCtx stref) tag = goState'FIN stref $ ctx_finalize_dec tag
----------------------------------------------------------------------------
-- FFI ByteString helpers
{-# INLINE createBS' #-}
createBS' :: CSize -> (Ptr Word8 -> IO a) -> IO (ByteString,a)
createBS' 0 act = (,) BS.empty <$> act nullPtr
createBS' sz act = do -- TODO: provide version based on 'deferedForeignPtrAvailable' when available
fptr <- mallocByteString n
res <- withForeignPtr fptr $ \ptr -> act ptr
pure $! ((,) $! PS fptr 0 n) $ res
where
n = fromIntegral sz
{-# INLINE withBSAsPtr #-}
withBSAsPtr :: ByteString -> (Ptr Word8 -> CSize -> IO a) -> IO a
withBSAsPtr (PS _ _ 0) act = act nullPtr 0
withBSAsPtr (PS fp off len) act = withForeignPtr fp $ \ptr -> act (ptr `plusPtr` off) (fromIntegral len)
----------------------------------------------------------------------------
-- FFI imports
cint2err :: CInt -> AesGcmError
cint2err (-1) = AesGcmError'EngineError
cint2err (-2) = AesGcmError'Impossible -- the Haskell layer should never trigger invalid params errors
cint2err _ = AesGcmError'Impossible
foreign import capi "hs_aes_gcm.h hs_aes_gcm_enc"
c'hs_aes_gcm_enc :: Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8
-> Ptr Word8 -> CSize
-> IO CInt
{-# NOINLINE hs_gcm_aes_encrypt #-}
hs_gcm_aes_encrypt :: Key klen -> IV -> CSize -> AAD -> ByteString -> (ByteString,ByteString,CInt)
hs_gcm_aes_encrypt (Key key) (IV iv) tag'len aad pt = repack $ unsafePerformIO go
where
go = withBSAsPtr pt $ \pt'ptr pt'len ->
withBSAsPtr key $ \key'ptr key'len ->
withBSAsPtr iv $ \iv'ptr iv'len ->
withBSAsPtr aad $ \aad'ptr aad'len -> do
createBS' pt'len $ \ct'ptr ->
createBS' tag'len $ \tag'ptr ->
c'hs_aes_gcm_enc key'ptr key'len iv'ptr iv'len tag'ptr tag'len aad'ptr aad'len pt'ptr ct'ptr pt'len
repack (x,(y,z)) = (x,y,z)
foreign import capi "hs_aes_gcm.h hs_aes_gcm_dec"
c'hs_aes_gcm_dec :: Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> Ptr Word8
-> Ptr Word8 -> CSize
-> IO CInt
{-# NOINLINE hs_gcm_aes_decrypt #-}
hs_gcm_aes_decrypt :: Key klen -> IV -> Tag tlen -> AAD -> ByteString -> (ByteString,CInt)
hs_gcm_aes_decrypt (Key key) (IV iv) (Tag tag) aad ct = unsafePerformIO go
where
go = withBSAsPtr ct $ \ct'ptr ct'len ->
withBSAsPtr key $ \key'ptr key'len ->
withBSAsPtr iv $ \iv'ptr iv'len ->
withBSAsPtr tag $ \tag'ptr tag'len ->
withBSAsPtr aad $ \aad'ptr aad'len -> do
createBS' ct'len $ \pt'ptr ->
c'hs_aes_gcm_dec key'ptr key'len iv'ptr iv'len tag'ptr tag'len aad'ptr aad'len ct'ptr pt'ptr ct'len
data {-# CTYPE "openssl/evp.h" "EVP_CIPHER_CTX" #-} EVP_CIPHER_CTX
foreign import capi "hs_aes_gcm.h hs_aes_gcm_ctx_init"
c'hs_aes_gcm_ctx_init :: Ptr (Ptr EVP_CIPHER_CTX)
-> CInt
-> Ptr Word8 -> CSize
-> Ptr Word8 -> CSize
-> IO CInt
foreign import capi "openssl/evp.h &EVP_CIPHER_CTX_free"
cp'EVP_CIPHER_CTX_free :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ())
data EncOrDec = Enc | Dec;
dirToCInt :: EncOrDec -> CInt
dirToCInt Enc = 1
dirToCInt Dec = 2
type CtxFP = ForeignPtr EVP_CIPHER_CTX
ctx_new :: EncOrDec -> Key klen -> IV -> IO CtxFP
ctx_new dir (Key key) (IV iv) = do
withBSAsPtr key $ \key'ptr key'len ->
withBSAsPtr iv $ \iv'ptr iv'len ->
alloca $ \ctxptrptr -> mask_ $ do
rc <- c'hs_aes_gcm_ctx_init ctxptrptr (dirToCInt dir) key'ptr key'len iv'ptr iv'len
case rc of
0 -> do
ctxptr <- peek ctxptrptr
newForeignPtr cp'EVP_CIPHER_CTX_free ctxptr
_ -> throwIO $! cint2err rc
foreign import capi "hs_aes_gcm.h hs_aes_gcm_ctx_update"
c'hs_aes_gcm_ctx_update :: Ptr EVP_CIPHER_CTX -> CInt -> Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
ctx_update_aad :: EncOrDec -> ByteString -> CtxFP -> IO ()
ctx_update_aad dir inp ctxfptr = do
withForeignPtr ctxfptr $ \ctxptr -> do
withBSAsPtr inp $ \inp'ptr inp'len -> do
rc <- c'hs_aes_gcm_ctx_update ctxptr (dirToCInt dir) inp'ptr nullPtr inp'len
case rc of
0 -> pure ()
_ -> throwIO $! cint2err rc
ctx_update_msg :: EncOrDec -> ByteString -> CtxFP -> IO ByteString
ctx_update_msg dir inp ctxfptr = do
withForeignPtr ctxfptr $ \ctxptr -> do
withBSAsPtr inp $ \inp'ptr inp'len -> do
(bs,rc) <- createBS' inp'len $ \out'ptr -> c'hs_aes_gcm_ctx_update ctxptr (dirToCInt dir) inp'ptr out'ptr inp'len
case rc of
0 -> pure bs
_ -> throwIO $! cint2err rc
foreign import capi "hs_aes_gcm.h hs_aes_gcm_ctx_finalize_enc"
c'hs_aes_gcm_ctx_finalize_enc :: Ptr EVP_CIPHER_CTX -> Ptr Word8 -> CSize -> IO CInt
ctx_finalize_enc :: forall tlen . KnownTagLength tlen => CtxFP -> IO (Tag tlen)
ctx_finalize_enc ctxfptr = do
withForeignPtr ctxfptr $ \ctxptr -> do
(bs,rc) <- createBS' tag'len $ \tag'ptr -> c'hs_aes_gcm_ctx_finalize_enc ctxptr tag'ptr tag'len
case rc of
0 -> pure (Tag bs)
_ -> throwIO $! cint2err rc
where
tag'len = fromIntegral (tagLength (Tag mempty :: Tag tlen))
foreign import capi "hs_aes_gcm.h hs_aes_gcm_ctx_finalize_dec"
c'hs_aes_gcm_ctx_finalize_dec :: Ptr EVP_CIPHER_CTX -> Ptr Word8 -> CSize -> IO CInt
-- 'False' == auth failure
ctx_finalize_dec :: Tag tlen -> CtxFP -> IO Bool
ctx_finalize_dec (Tag tag) ctxfptr = do
withForeignPtr ctxfptr $ \ctxptr -> do
withBSAsPtr tag $ \tag'ptr tag'len -> do
rc <- c'hs_aes_gcm_ctx_finalize_dec ctxptr tag'ptr tag'len
case rc of
0 -> pure True
1 -> pure False
_ -> throwIO $! cint2err rc