{-# 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 . -- | -- 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