aes-gcm (empty) → 0.0.0.0
raw patch · 9 files changed
+2095/−0 lines, 9 filesdep +aes-gcmdep +basedep +base16-bytestring
Dependencies added: aes-gcm, base, base16-bytestring, bytestring, tasty, tasty-hunit
Files
- ChangeLog.md +5/−0
- LICENSE +339/−0
- aes-gcm.cabal +65/−0
- cbits/hs_aes_gcm.h +265/−0
- src-test/CAVS.hs +204/−0
- src-test/Test.hs +197/−0
- src/Crypto/Cipher/AES/GCM.hs +721/−0
- testdata/README +9/−0
- testdata/gcm-spec.rsp +290/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+See also http://pvp.haskell.org/faq++# 0.0.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ aes-gcm.cabal view
@@ -0,0 +1,65 @@+cabal-version: 3.0+name: aes-gcm+version: 0.0.0.0+license: GPL-2.0-or-later+license-file: LICENSE+author: Herbert Valerio Riedel+maintainer: hvr@gnu.org+copyright: © 2024 Herbert Valerio Riedel+category: Cryptography+build-type: Simple+extra-doc-files: ChangeLog.md++synopsis: AES Galois/Counter Mode (GCM) AEAD Cipher+description:+ This library provides a type-safe API to OpenSSL's AES GCM ([NIST SP 800-38D](https://doi.org/10.6028/NIST.SP.800-38D)) implementation.+ The API provides both a pure one-shot interface as well as an 'IO'-based incremental interface for streaming large amounts of data.++extra-source-files:+ cbits/hs_aes_gcm.h+ testdata/README+ testdata/gcm-spec.rsp++common defaults+ default-language: Haskell2010+ other-extensions:+ CApiFFI+ DeriveDataTypeable+ ExistentialQuantification+ Rank2Types+ ScopedTypeVariables++ ghc-options: -Wall++ build-depends:+ , base ^>= { 4.10, 4.11, 4.12, 4.13, 4.14, 4.15, 4.16, 4.17, 4.18, 4.19, 4.20, 4.21 }+ , bytestring ^>= { 0.10.8, 0.11, 0.12 }++library+ import: defaults++ hs-source-dirs: src+ exposed-modules: Crypto.Cipher.AES.GCM+ include-dirs: cbits/++ -- compat with version 1.1.1w verified on Debian 10+ pkgconfig-depends: libcrypto >= 1.1.1w++test-suite aes-gcm-test+ import: defaults+ type: exitcode-stdio-1.0++ other-extensions:+ DeriveFunctor+ OverloadedStrings+ ghc-options: -rtsopts++ hs-source-dirs: src-test+ main-is: Test.hs+ other-modules: CAVS++ build-depends:+ , aes-gcm+ , base16-bytestring ^>= 1.0.2.0+ , tasty ^>= 1.5+ , tasty-hunit ^>= 0.10
+ cbits/hs_aes_gcm.h view
@@ -0,0 +1,265 @@+/* SPDX-License-Identifier: GPL-2.0-or-later+ *+ * 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 <https://www.gnu.org/licenses/>.+ */++#ifndef HS_AES_GCM_H+#define HS_AES_GCM_H++#include <openssl/evp.h>+#include <openssl/err.h>+#include <stdint.h>+#include <stddef.h>++/* return codes */+#define HS_AES_GCM_OK 0+#define HS_AES_GCM_AUTHFAIL 1++#define HS_AES_GCM_ERR (-1)+#define HS_AES_GCM_INVAL (-2)++typedef enum {+ HS_AES_GCM_ENC = 1,+ HS_AES_GCM_DEC = 2+} hs_aes_gcm_op_t;++static inline int+hs_aes_gcm_ctx_init(EVP_CIPHER_CTX **pctx,+ const hs_aes_gcm_op_t op,+ const uint8_t key[], size_t keysize,+ const uint8_t iv[], size_t ivsize)++{+ if (!(op == HS_AES_GCM_DEC || op == HS_AES_GCM_ENC))+ return HS_AES_GCM_INVAL;++ if (!key || (!iv || ivsize<1))+ return HS_AES_GCM_INVAL;++ const EVP_CIPHER *cipher = NULL;+ switch(keysize) {+ case 16: cipher = EVP_aes_128_gcm(); break;+ case 24: cipher = EVP_aes_192_gcm(); break;+ case 32: cipher = EVP_aes_256_gcm(); break;+ default: return HS_AES_GCM_INVAL;+ }++ int ret = HS_AES_GCM_ERR;++ EVP_CIPHER_CTX *ctx = *pctx = EVP_CIPHER_CTX_new();+ if (!ctx) goto done;++ switch(op) {+ case HS_AES_GCM_ENC:+ if (ivsize == 12) {+ if (1 != EVP_EncryptInit_ex(ctx, cipher, NULL, key, iv))+ goto done;+ } else {+ if (1 != EVP_EncryptInit_ex(ctx, cipher, NULL, key, NULL))+ goto done;++ if (1 != EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, (int)ivsize, NULL))+ goto done;++ if (1 != EVP_EncryptInit_ex(ctx, NULL, NULL, NULL, iv))+ goto done;+ }+ break;++ case HS_AES_GCM_DEC:+ if (ivsize == 12) {+ if (1 != EVP_DecryptInit_ex(ctx, cipher, NULL, key, iv))+ goto done;+ } else {+ if (1 != EVP_DecryptInit_ex(ctx, cipher, NULL, key, NULL))+ goto done;++ if (1 != EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, (int)ivsize, NULL))+ goto done;++ if (1 != EVP_DecryptInit_ex(ctx, NULL, NULL, NULL, iv))+ goto done;+ }+ break;++ default: /* impossible */+ ret = HS_AES_GCM_INVAL;+ goto done;+ }++ return HS_AES_GCM_OK;++ done:+ if (ctx) {+ EVP_CIPHER_CTX_free(ctx);+ *pctx = NULL;+ }+ if (ret != HS_AES_GCM_OK) ERR_clear_error();+ return ret;+}++static inline int+hs_aes_gcm_check_params(const uint8_t aad[], size_t aadsize,+ const uint8_t tag[], size_t tagsize,+ const uint8_t ct[],+ const uint8_t pt[], size_t msgsize)+{+ if (!aad && aadsize>0)+ return HS_AES_GCM_INVAL;++ if ((!pt || !ct) && msgsize>0)+ return HS_AES_GCM_INVAL;++ if (!tag || !(tagsize == 4 || tagsize == 8 || (tagsize >= 12 && tagsize <= 16)))+ return HS_AES_GCM_INVAL;++ return HS_AES_GCM_OK;+}++/* set dst = NULL for AAD */+static inline int+hs_aes_gcm_ctx_update(EVP_CIPHER_CTX *ctx,+ const hs_aes_gcm_op_t op,+ const uint8_t src[],+ uint8_t dst[], const size_t msgsize)+{+ if (!(op == HS_AES_GCM_DEC || op == HS_AES_GCM_ENC))+ return HS_AES_GCM_INVAL;++ const size_t blocksize = 1024*1024; /* guaranteed to fit into an 'int' */++ for(size_t ofs = 0; ofs < msgsize; ofs += blocksize) {+ const size_t n = (ofs + blocksize <= msgsize) ? blocksize : msgsize - ofs;++ int written = 0;+ int rc = 0;++ switch(op) {+ case HS_AES_GCM_ENC:+ rc = EVP_EncryptUpdate(ctx, dst ? (dst+ofs) : dst, &written, src+ofs, (int)n);+ break;+ case HS_AES_GCM_DEC:+ rc = EVP_DecryptUpdate(ctx, dst ? (dst+ofs) : dst, &written, src+ofs, (int)n);+ break;+ }++ if (1 != rc) return HS_AES_GCM_ERR;+ if (n != written) return HS_AES_GCM_ERR;+ } /* for */++ return HS_AES_GCM_OK;+}++static inline int+hs_aes_gcm_ctx_finalize_enc(EVP_CIPHER_CTX *ctx, uint8_t tag[], const size_t tagsize)+{+ int written = 0;+ if (1 != EVP_EncryptFinal_ex(ctx, NULL, &written)) return HS_AES_GCM_ERR;+ if (written) return HS_AES_GCM_ERR;++ if (1 != EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_GET_TAG, (int)tagsize, (void*)tag))+ return HS_AES_GCM_ERR;++ return HS_AES_GCM_OK;+}++static inline int+hs_aes_gcm_ctx_finalize_dec(EVP_CIPHER_CTX *ctx, const uint8_t tag[], const size_t tagsize)+{+ if (1 != EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_TAG, (int)tagsize, (void*)tag))+ return HS_AES_GCM_ERR;++ int written = 0;+ int rc = EVP_DecryptFinal_ex(ctx, NULL, &written);+ if (written) return HS_AES_GCM_ERR;++ switch(rc) {+ case 1:+ return HS_AES_GCM_OK;+ case 0:+ /* the OpenSSL documentation isn't clear about how to+ differentiate between auth failures and other internal+ errors, so we have to trust that when EVP_DecryptFinal_ex+ returns with 0 it means auth failure */+ return HS_AES_GCM_AUTHFAIL;+ default:+ return HS_AES_GCM_ERR;+ }+}++/*****************************************************************************/++static inline int+hs_aes_gcm_enc(const uint8_t key[], const size_t keysize,+ const uint8_t iv[], const size_t ivsize,+ uint8_t tag[], const size_t tagsize,+ const uint8_t aad[], const size_t aadsize,+ const uint8_t pt[],+ uint8_t ct[], const size_t msgsize)+{+ EVP_CIPHER_CTX *ctx = NULL;++ int ret = hs_aes_gcm_check_params(aad, aadsize, tag, tagsize, ct, pt, msgsize);+ if (HS_AES_GCM_OK != ret) return ret;++ ret = hs_aes_gcm_ctx_init(&ctx, HS_AES_GCM_ENC, key, keysize, iv, ivsize);+ if (HS_AES_GCM_OK != ret) return ret;++ ret = hs_aes_gcm_ctx_update(ctx, HS_AES_GCM_ENC, aad, NULL, aadsize);+ if (HS_AES_GCM_OK != ret) goto done;++ ret = hs_aes_gcm_ctx_update(ctx, HS_AES_GCM_ENC, pt, ct, msgsize);+ if (HS_AES_GCM_OK != ret) goto done;++ hs_aes_gcm_ctx_finalize_enc(ctx, tag, tagsize);++ done:+ if (ctx) EVP_CIPHER_CTX_free(ctx);+ if (ret != HS_AES_GCM_OK) ERR_clear_error();+ return ret;+}++static inline int+hs_aes_gcm_dec(const uint8_t key[], const size_t keysize,+ const uint8_t iv[], const size_t ivsize,+ const uint8_t tag[], const size_t tagsize,+ const uint8_t aad[], const size_t aadsize,+ const uint8_t ct[],+ uint8_t pt[], const size_t msgsize)+{+ EVP_CIPHER_CTX *ctx = NULL;++ int ret = hs_aes_gcm_check_params(aad, aadsize, tag, tagsize, ct, pt, msgsize);+ if (HS_AES_GCM_OK != ret) return ret;++ ret = hs_aes_gcm_ctx_init(&ctx, HS_AES_GCM_DEC, key, keysize, iv, ivsize);+ if (HS_AES_GCM_OK != ret) return ret;++ ret = hs_aes_gcm_ctx_update(ctx, HS_AES_GCM_DEC, aad, NULL, aadsize);+ if (HS_AES_GCM_OK != ret) goto done;++ ret = hs_aes_gcm_ctx_update(ctx, HS_AES_GCM_DEC, ct, pt, msgsize);+ if (HS_AES_GCM_OK != ret) goto done;++ ret = hs_aes_gcm_ctx_finalize_dec(ctx, tag, tagsize);++ done:+ if (ctx) EVP_CIPHER_CTX_free(ctx);+ if (ret != HS_AES_GCM_OK) ERR_clear_error();+ return ret;+}++#endif
+ src-test/CAVS.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE Haskell2010 #-}++{-# LANGUAGE OverloadedStrings #-}++-- SPDX-License-Identifier: GPL-2.0-or-later++module CAVS(TestVec(..), TestVecHdr(..), EncDec(..), PT(..), parseTestVecs, hex, unhex) where++import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy.Char8 as BLC+import Data.Char (isHexDigit)+import Data.Either+import Data.Maybe+import Text.Read (readMaybe)++-- WARNING: the code that follows will make you cry;+-- a safety pig is provided below for your benefit.+--+-- _+-- _._ _..._ .-', _.._(`))+-- '-. ` ' /-._.-' ',/+-- ) \ '.+-- / _ _ | \+-- | a a / |+-- \ .-. ;+-- '-('' ).-' ,' ;+-- '-; | .'+-- \ \ /+-- | 7 .__ _.-\ \+-- | | | ``/ /` /+-- /,_| | /,_/ /+-- /,_/ '`-'+--++data EncDec = Enc | Dec deriving (Show,Eq)++data PT = PT !EncDec !ByteString | P'FAIL deriving (Show,Eq)++data TestVec = TestVec+ { tv'Count :: !Int+ , tv'Key :: !ByteString+ , tv'IV :: !ByteString+ , tv'AAD :: !ByteString+ , tv'CT :: !ByteString+ , tv'Tag :: !ByteString+ , tv'PT :: !PT+ } deriving Show++data TestVecHdr = TestVecHdr+ { tv'Keylen :: !Int+ , tv'IVlen :: !Int+ , tv'PTlen :: !Int+ , tv'AADlen :: !Int+ , tv'Taglen :: !Int+ } deriving Show++mkTestVec :: Int -> ByteString -> ByteString -> ByteString -> ByteString -> ByteString -> PT -> TestVec+mkTestVec count key0 iv0 aad0 ct0 tag0 pt0_ = TestVec count key iv aad ct tag pt_+ where+ pt0 = case pt0_ of { PT _ x -> x; P'FAIL -> mempty }+ merged0 = mconcat [key0, iv0, aad0, ct0, tag0, pt0]++ keyLen = BSC.length key0 `div` 2+ ivLen = BSC.length iv0 `div` 2+ aadLen = BSC.length aad0 `div` 2+ ctLen = BSC.length ct0 `div` 2+ tagLen = BSC.length tag0 `div` 2+ ptLen = BSC.length pt0 `div` 2++ merged = unhex merged0+ slice ofs len+ | len > 0 = BSC.take len $ BSC.drop ofs merged+ | otherwise = BSC.empty++ key = slice 0 keyLen+ iv = slice keyLen ivLen+ aad = slice (keyLen+ivLen) aadLen+ ct = slice (keyLen+ivLen+aadLen) ctLen+ tag = slice (keyLen+ivLen+aadLen+ctLen) tagLen+ pt = slice (keyLen+ivLen+aadLen+ctLen+tagLen) ptLen++ pt_ = case pt0_ of+ P'FAIL -> P'FAIL+ PT d _ -> PT d pt++parseTestVecs :: BLC.ByteString -> [(TestVecHdr,[TestVec])]+parseTestVecs = token2tvecs . tokenize++token2tvecs :: [Token] -> [(TestVecHdr,[TestVec])]+token2tvecs = groupEither . go0 . dedupEmpty . filter (not . isComment)+ where+ go0 [] = []+ go0 (Token'empty:Token'empty:rest) = go0 (Token'empty:rest)+ go0 (Token'empty:Token'parmLen Parm'Key key:Token'parmLen Parm'IV iv:Token'parmLen Parm'PT pt : Token'parmLen Parm'AAD aad:Token'parmLen Parm'Tag tag:Token'empty:rest) = Left (TestVecHdr key iv pt aad tag) : go1 rest+ go0 xs = error ("parseTestVecs/go0: " ++ show (take 10 xs))++ go1 [] = []+ go1 (Token'count cnt : Token'parmVal Parm'Key key:Token'parmVal Parm'IV iv:Token'parmVal Parm'CT ct : Token'parmVal Parm'AAD aad:Token'parmVal Parm'Tag tag:tok:Token'empty:rest)+ | Token'parmVal Parm'PT pt <- tok = (Right $! (mkTestVec cnt key iv aad ct tag (PT Dec pt))) : go1' rest+ | Token'fail <- tok = (Right $! (mkTestVec cnt key iv aad ct tag P'FAIL)) : go1' rest+ go1 (Token'count cnt : Token'parmVal Parm'Key key:Token'parmVal Parm'IV iv:Token'parmVal Parm'PT pt : Token'parmVal Parm'AAD aad:Token'parmVal Parm'CT ct : Token'parmVal Parm'Tag tag:Token'empty:rest)+ = (Right $! (mkTestVec cnt key iv aad ct tag (PT Enc pt))) : go1' rest+ go1 xs = error ("parseTestVecs/go1: " ++ show (take 10 xs))++ go1' toks@(Token'parmLen _ _ :_) = go0 (Token'empty:toks)+ go1' toks = go1 toks++ dedupEmpty (Token'empty : rest@(Token'empty : _)) = dedupEmpty rest+ dedupEmpty [Token'empty] = [Token'empty]+ dedupEmpty (tok:rest) = tok : dedupEmpty rest+ dedupEmpty [] = [Token'empty]++groupEither :: [Either l r] -> [(l,[r])]+groupEither [] = []+groupEither (Left l : xs) = (l, [r | Right r <- rs]) : groupEither rest+ where+ (rs, rest) = span isRight xs+groupEither (Right _ : _) = error "groupEither: leading Rights"++data Parm = Parm'Key+ | Parm'IV+ | Parm'PT+ | Parm'AAD+ | Parm'CT+ | Parm'Tag+ deriving (Show,Eq)++bs2parm :: ByteString -> Maybe Parm+bs2parm "Key" = Just Parm'Key+bs2parm "IV" = Just Parm'IV+bs2parm "PT" = Just Parm'PT+bs2parm "AAD" = Just Parm'AAD+bs2parm "CT" = Just Parm'CT+bs2parm "Tag" = Just Parm'Tag+bs2parm _ = Nothing+++data Token = Token'empty -- empty line+ | Token'comment !ByteString+ | Token'parmLen Parm !Int+ | Token'parmVal Parm !ByteString+ | Token'fail+ | Token'count !Int+ | Token'UNPARSED !ByteString+ deriving (Show,Eq)++isComment :: Token -> Bool+isComment (Token'comment _) = True+isComment _ = False++tokenize :: BLC.ByteString -> [Token]+tokenize = map (tokLine . BLC.toStrict) . BLC.lines+ where+ tokLine l0+ | Just c <- BSC.stripPrefix "#" l = Token'comment c+ | l == "" = Token'empty+ | l == "FAIL" = Token'fail+ | Just (k,v) <- decodeParmLen l = Token'parmLen k v+ | Just (k,v) <- decodeParmVal l = Token'parmVal k v+ | Just x <- decodeCount l = Token'count x+ | otherwise = Token'UNPARSED l0+ where+ l = fromMaybe l0 $ BSC.stripSuffix "\r" l0++ decodeCount l0 = do+ [ "Count", "=", v ] <- Just $ BSC.words l0+ readMaybe (BSC.unpack v)++ decodeParmLen :: ByteString -> Maybe (Parm,Int)+ decodeParmLen l0 = do+ l1 <- BSC.stripPrefix "[" l0+ l2 <- BSC.stripSuffix "]" l1++ [ k1, "=", v ] <- Just $ BSC.words l2++ k2 <- BSC.stripSuffix "len" k1+ k3 <- bs2parm k2++ v' <- readMaybe (BSC.unpack v)++ pure (k3,v')++ decodeParmVal :: ByteString -> Maybe (Parm,ByteString)+ decodeParmVal l0 = do+ (k1,v2) <- case BSC.words l0 of+ [ k1, "=", v1 ] -> Just (k1,v1)+ [ k1, "=" ] -> Just (k1,"")+ _ -> Nothing++ k2 <- bs2parm k1++ guard (even $ BSC.length v2)+ guard (BSC.all isHexDigit v2)++ pure (k2,v2)++unhex :: ByteString -> ByteString+unhex = either (\err -> error ("mkTestVec/unhex: " ++ err)) id . B16.decode++hex :: ByteString -> ByteString+hex = B16.encode
+ src-test/Test.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE Haskell2010 #-}++{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- SPDX-License-Identifier: GPL-2.0-or-later++module Main (main) where++import Control.Exception (catchJust)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Maybe+import System.IO (hPutStrLn, stderr)+import System.IO.Error (isDoesNotExistError)+import Test.Tasty+import Test.Tasty.HUnit++import CAVS++import Crypto.Cipher.AES.GCM as GCM++-- WARNING: the code that follows will make you cry;+-- a safety pig is provided below for your benefit.+--+-- _+-- _._ _..._ .-', _.._(`))+-- '-. ` ' /-._.-' ',/+-- ) \ '.+-- / _ _ | \+-- | a a / |+-- \ .-. ;+-- '-('' ).-' ,' ;+-- '-; | .'+-- \ \ /+-- | 7 .__ _.-\ \+-- | | | ``/ /` /+-- /,_| | /,_/ /+-- /,_/ '`-'+--++main :: IO ()+main = do+ rspGrps <- forM rspFiles $ \(opt,fn) -> do+ let fn' = "testdata/" ++ fn ++ ".rsp"+ tvs <- catchJust (\e -> if isDoesNotExistError e && opt then Just () else Nothing)+ (parseTestVecs <$> BL.readFile fn')+ (\() -> hPutStrLn stderr ("optional " ++ fn ++ " test vectors not found; see testdata/README for how to procure those") >> pure [])++ pure $ testGroup fn $ map (uncurry mkTestGrp) tvs++ defaultMain $ testGroup "aes-gcm"+ [ testGroup "large data" largeTests+ , testGroup "test vectors" rspGrps+ ]+ where+ rspFiles = [ (False,"gcm-spec")+ , (True,"gcmDecrypt128")+ , (True,"gcmDecrypt192")+ , (True,"gcmDecrypt256")+ , (True,"gcmEncryptExtIV128")+ , (True,"gcmEncryptExtIV192")+ , (True,"gcmEncryptExtIV256")+ ]++ mkTestGrp :: TestVecHdr -> [TestVec] -> TestTree+ mkTestGrp tvh tvs = testGroup glabel $ concatMap mkTestCase tvs+ where+ glabel = mconcat [ "AES-", show (tv'Keylen tvh), "-GCM"+ , " iv=", show (tv'IVlen tvh)+ , " pt=", show (tv'PTlen tvh)+ , " aad=", show (tv'AADlen tvh)+ , " tag=", show (tv'Taglen tvh)+ ]++-- aes-256-gcm with Key=0^256 IV=0^96 and max-size PT has T=0x646f81304169ebaff70a564a6edf79ba+largeTests :: [TestTree]+largeTests =+ [ testCase ("AES-" ++ show (8*klen) ++ "-GCM 1GiB") $ do+ let key = fromJust $ someKey'fromByteString (BS.replicate klen 0x00)+ iv96 = fromJust $ iv'fromByteString (BS.replicate 12 0x00)++ (ectx,dctx) <- case key of+ SomeKey k -> (,) <$> encryptInit k iv96+ <*> decryptInit k iv96++ -- let pt'ref = BS.replicate (1024*1024) 0xa5 -- 1 MiB+ let pt'in = BS.replicate (1024*1024) 0x00 -- 1 MiB++ -- 1 GiB of AAD+ forM_ [1 .. 1024 :: Int] $ \_ -> encryptUpdateAAD ectx pt'in+ forM_ [1 .. 1024 :: Int] $ \_ -> decryptUpdateAAD dctx pt'in++ -- 1 GiB of PT/CT+ forM_ [1 .. 1024] $ \j -> do+ ct <- encryptUpdate ectx pt'in+ pt <- decryptUpdate dctx ct+ assertEqual ("decrypt(encrypt(chunk)) != chunk #" ++ show (j :: Int)) pt'in pt++ tag <- encryptFinalize ectx++ valid <- decryptFinalize dctx (tag :: Tag Bits'128)++ assertBool "auth tag mismatched" valid++ assertEqual "auth tag" tag'ref (hex $ tag'toByteString tag)++ pure ()+ | (klen,tag'ref) <- [(16,"c15882df03ccc44a1ade08a947478855")+ ,(24,"3dbf18efe8699ececd1a571c9737dcc3")+ ,(32,"95cb9913f41ca00ec7c6d3ad6d5c7ede")+ ]+ ]+++tv'SomeKey :: TestVec -> SomeKey+tv'SomeKey tv = fromMaybe (error "invalid key-length in test-case") $ someKey'fromByteString (tv'Key tv)++tv'SomeTag :: TestVec -> SomeTag+tv'SomeTag tv = fromMaybe (error "invalid tag-length in test-case") $ someTag'fromByteString (tv'Tag tv)++mkTestCase :: TestVec -> [TestTree]+mkTestCase tv = concat $+ [ [ testCase ("encrypt #"++show(tv'Count tv)) $+ Right (ct,tag) @=? encryptViaSome key iv aad pt tagLen++ | Just pt <- [mpt]+ ]+ , [ testCase ("encrypt... #"++show(tv'Count tv)) $ do+ ctx <- case key of SomeKey k -> encryptInit k iv+ unless (BS.null aad) $ encryptUpdateAAD ctx aad+ ct'new <- encryptUpdate ctx pt+ ct @=? ct'new++ tag'new <- fromJust $ someTagFunctor tagLen (encryptFinalize ctx)+ tag @=? tag'new++ | Just pt <- [mpt]+ ]+ , [ testCase ("decrypt ("++lab++") #"++show(tv'Count tv)) $+ Right mpt @=? decryptViaSome key iv tag aad ct+ ]+ , [ testCase ("decrypt... ("++lab++") #"++show(tv'Count tv)) $ do+ ctx <- case key of SomeKey k -> decryptInit k iv+ unless (BS.null aad) $ decryptUpdateAAD ctx aad+ pt'new <- decryptUpdate ctx ct++ valid <- case tag of SomeTag t -> decryptFinalize ctx t+ case mpt of+ Nothing -> assertBool ("unexpected auth tag match") (not valid)+ Just pt -> do+ assertBool ("unexpected auth tag mismatch") valid+ pt @=? pt'new+ ]+ ]+ where+ aad = tv'AAD tv+ key = tv'SomeKey tv+ tag = tv'SomeTag tv+ tagLen = BS.length (tv'Tag tv)+ iv = fromMaybe (error "invalid iv-length in test-case") (iv'fromByteString $ tv'IV tv)+ ct = tv'CT tv++ (mpt,lab) = case tv'PT tv of+ PT _ pt -> (Just pt,"pass")+ P'FAIL -> (Nothing,"fail")++----------------------------------------------------------------------------+-- SomeKey/SomeTag based wrappers++decryptViaSome :: SomeKey -> IV -> SomeTag -> ByteString -> ByteString -> Either AesGcmError (Maybe ByteString)+decryptViaSome (SomeKey key) iv (SomeTag tag) aad pt = decrypt key iv tag aad pt++encryptViaSome :: SomeKey -> IV -> ByteString -> ByteString -> Int -> Either AesGcmError (ByteString, SomeTag)+encryptViaSome (SomeKey key) iv aad pt tlen+ = unERes $ fromMaybe (error "invalid tag-length in test-case") $ someTagFunctor tlen $ ERes $+ encrypt key iv aad pt++-- type helper+newtype EncRes a = ERes { unERes :: (Either AesGcmError (ByteString, a)) } deriving Functor++{-# INLINE someTagFunctor #-}+someTagFunctor :: forall f . Functor f => Int -> (forall tlen . (KnownTagLength tlen) => f (Tag tlen)) -> Maybe (f SomeTag)+someTagFunctor tlen ftag = case tlen of+ 4 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'32))+ 8 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'64))+ 12 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'96))+ 13 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'104))+ 14 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'112))+ 15 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'120))+ 16 -> Just $ fmap SomeTag (ftag :: f (Tag Bits'128))+ _ -> Nothing
+ src/Crypto/Cipher/AES/GCM.hs view
@@ -0,0 +1,721 @@+{-# 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
+ testdata/README view
@@ -0,0 +1,9 @@+Additional NIST CAVP test vectors can be downloaded from++ http://csrc.nist.gov/groups/STM/cavp/documents/mac/gcmtestvectors.zip++and extracted into this folder and the test-suite will pick them up.++See+https://csrc.nist.gov/Projects/cryptographic-algorithm-validation-program/cavp-testing-block-cipher-modes+for more information.
+ testdata/gcm-spec.rsp view
@@ -0,0 +1,290 @@+# GCM test vectors from https://csrc.nist.rip/groups/ST/toolkit/BCM/documents/proposedmodes/gcm/gcm-spec.pdf + +# Test case 1 + +[Keylen = 128] +[IVlen = 96] +[PTlen = 0] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 00000000000000000000000000000000 +IV = 000000000000000000000000 +PT = +AAD = +CT = +Tag = 58e2fccefa7e3061367f1d57a4e7455a + +# Test case 2 + +[Keylen = 128] +[IVlen = 96] +[PTlen = 128] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 00000000000000000000000000000000 +IV = 000000000000000000000000 +PT = 00000000000000000000000000000000 +AAD = +CT = 0388dace60b6a392f328c2b971b2fe78 +Tag = ab6e47d42cec13bdf53a67b21257bddf + +# Test case 3 + +[Keylen = 128] +[IVlen = 96] +[PTlen = 512] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b391aafd255 +AAD = +CT = 42831ec2217774244b7221b784d0d49ce3aa212f2c02a4e035c17e2329aca12e21d514b25466931c7d8f6a5aac84aa051ba30b396a0aac973d58e091473f5985 +Tag = 4d5c2af327cd64a62cf35abd2ba6fab4 + +# Test case 4 + +[Keylen = 128] +[IVlen = 96] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 42831ec2217774244b7221b784d0d49ce3aa212f2c02a4e035c17e2329aca12e21d514b25466931c7d8f6a5aac84aa051ba30b396a0aac973d58e091 +Tag = 5bc94fbc3221a5db94fae95ae7121a47 + +# Test case 5 + +[Keylen = 128] +[IVlen = 64] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbad +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 61353b4c2806934a777ff51fa22a4755699b2a714fcdc6f83766e5f97b6c742373806900e49f24b22b097544d4896b424989b5e1ebac0f07c23f4598 +Tag = 3612d2e79e3b0785561be14aaca2fccb + +# Test case 6 + +[Keylen = 128] +[IVlen = 480] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308 +IV = 9313225df88406e555909c5aff5269aa6a7a9538534f7da1e4c303d2a318a728c3c0c95156809539fcf0e2429a6b525416aedbf5a0de6a57a637b39b +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 8ce24998625615b603a033aca13fb894be9112a5c3a211a8ba262a3cca7e2ca701e4a9a4fba43c90ccdcb281d48c7c6fd62875d2aca417034c34aee5 +Tag = 619cc5aefffe0bfa462af43c1699d050 + +# Test case 7 + +[Keylen = 192] +[IVlen = 96] +[PTlen = 0] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 000000000000000000000000000000000000000000000000 +IV = 000000000000000000000000 +PT = +AAD = +CT = +Tag = cd33b28ac773f74ba00ed1f312572435 + +# Test case 8 + +[Keylen = 192] +[IVlen = 96] +[PTlen = 128] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 000000000000000000000000000000000000000000000000 +IV = 000000000000000000000000 +PT = 00000000000000000000000000000000 +AAD = +CT = 98e7247c07f0fe411c267e4384b0f600 +Tag = 2ff58d80033927ab8ef4d4587514f0fb + +# Test case 9 + +[Keylen = 192] +[IVlen = 96] +[PTlen = 512] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b391aafd255 +AAD = +CT = 3980ca0b3c00e841eb06fac4872a2757859e1ceaa6efd984628593b40ca1e19c7d773d00c144c525ac619d18c84a3f4718e2448b2fe324d9ccda2710acade256 +Tag = 9924a7c8587336bfb118024db8674a14 + +# Test case 10 + +[Keylen = 192] +[IVlen = 96] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 3980ca0b3c00e841eb06fac4872a2757859e1ceaa6efd984628593b40ca1e19c7d773d00c144c525ac619d18c84a3f4718e2448b2fe324d9ccda2710 +Tag = 2519498e80f1478f37ba55bd6d27618c + +# Test case 11 + +[Keylen = 192] +[IVlen = 64] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c +IV = cafebabefacedbad +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 0f10f599ae14a154ed24b36e25324db8c566632ef2bbb34f8347280fc4507057fddc29df9a471f75c66541d4d4dad1c9e93a19a58e8b473fa0f062f7 +Tag = 65dcc57fcf623a24094fcca40d3533f8 + +# Test case 12 + +[Keylen = 192] +[IVlen = 480] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c +IV = 9313225df88406e555909c5aff5269aa6a7a9538534f7da1e4c303d2a318a728c3c0c95156809539fcf0e2429a6b525416aedbf5a0de6a57a637b39b +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = d27e88681ce3243c4830165a8fdcf9ff1de9a1d8e6b447ef6ef7b79828666e4581e79012af34ddd9e2f037589b292db3e67c036745fa22e7e9b7373b +Tag = dcf566ff291c25bbb8568fc3d376a6d9 + +# Test case 13 + +[Keylen = 256] +[IVlen = 96] +[PTlen = 0] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 0000000000000000000000000000000000000000000000000000000000000000 +IV = 000000000000000000000000 +PT = +AAD = +CT = +Tag = 530f8afbc74536b9a963b4f1c4cb738b + +# Test case 14 + +[Keylen = 256] +[IVlen = 96] +[PTlen = 128] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = 0000000000000000000000000000000000000000000000000000000000000000 +IV = 000000000000000000000000 +PT = 00000000000000000000000000000000 +AAD = +CT = cea7403d4d606b6e074ec5d3baf39d18 +Tag = d0d1c8a799996bf0265b98b5d48ab919 + +# Test case 15 + +[Keylen = 256] +[IVlen = 96] +[PTlen = 512] +[AADlen = 0] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b391aafd255 +AAD = +CT = 522dc1f099567d07f47f37a32a84427d643a8cdcbfe5c0c97598a2bd2555d1aa8cb08e48590dbb3da7b08b1056828838c5f61e6393ba7a0abcc9f662898015ad +Tag = b094dac5d93471bdec1a502270e3cc6c + +# Test case 16 + +[Keylen = 256] +[IVlen = 96] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbaddecaf888 +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 522dc1f099567d07f47f37a32a84427d643a8cdcbfe5c0c97598a2bd2555d1aa8cb08e48590dbb3da7b08b1056828838c5f61e6393ba7a0abcc9f662 +Tag = 76fc6ece0f4e1768cddf8853bb2d551b + +# Test case 17 + +[Keylen = 256] +[IVlen = 64] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c6d6a8f9467308308 +IV = cafebabefacedbad +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = c3762df1ca787d32ae47c13bf19844cbaf1ae14d0b976afac52ff7d79bba9de0feb582d33934a4f0954cc2363bc73f7862ac430e64abe499f47c9b1f +Tag = 3a337dbf46a792c45e454913fe2ea8f2 + +# Test case 18 + +[Keylen = 256] +[IVlen = 480] +[PTlen = 480] +[AADlen = 160] +[Taglen = 128] + +Count = 0 +Key = feffe9928665731c6d6a8f9467308308feffe9928665731c6d6a8f9467308308 +IV = 9313225df88406e555909c5aff5269aa6a7a9538534f7da1e4c303d2a318a728c3c0c95156809539fcf0e2429a6b525416aedbf5a0de6a57a637b39b +PT = d9313225f88406e5a55909c5aff5269a86a7a9531534f7da2e4c303d8a318a721c3c0c95956809532fcf0e2449a6b525b16aedf5aa0de657ba637b39 +AAD = feedfacedeadbeeffeedfacedeadbeefabaddad2 +CT = 5a8def2f0c9e53f1f75d7853659e2a20eeb2b22aafde6419a058ab4f6f746bf40fc0c3b780f244452da3ebf1c5d82cdea2418997200ef82e44ae7e3f +Tag = a44a8266ee1c8eb0c8b5d4cf5ae9f19a +