diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +See also http://pvp.haskell.org/faq + +# 0.0.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/aes-gcm.cabal b/aes-gcm.cabal new file mode 100644 --- /dev/null +++ b/aes-gcm.cabal @@ -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 diff --git a/cbits/hs_aes_gcm.h b/cbits/hs_aes_gcm.h new file mode 100644 --- /dev/null +++ b/cbits/hs_aes_gcm.h @@ -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 . + */ + +#ifndef HS_AES_GCM_H +#define HS_AES_GCM_H + +#include +#include +#include +#include + +/* 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 diff --git a/src-test/CAVS.hs b/src-test/CAVS.hs new file mode 100644 --- /dev/null +++ b/src-test/CAVS.hs @@ -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 diff --git a/src-test/Test.hs b/src-test/Test.hs new file mode 100644 --- /dev/null +++ b/src-test/Test.hs @@ -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 diff --git a/src/Crypto/Cipher/AES/GCM.hs b/src/Crypto/Cipher/AES/GCM.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Cipher/AES/GCM.hs @@ -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 . + +-- | +-- 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 diff --git a/testdata/README b/testdata/README new file mode 100644 --- /dev/null +++ b/testdata/README @@ -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. diff --git a/testdata/gcm-spec.rsp b/testdata/gcm-spec.rsp new file mode 100644 --- /dev/null +++ b/testdata/gcm-spec.rsp @@ -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 +