├── .gitignore ├── .gitmodules ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── Setup.hs ├── btls.cabal ├── cbits └── btls.c ├── src ├── BTLS │ ├── BoringSSL │ │ ├── Base.chs │ │ ├── Cipher.chs │ │ ├── Digest.chs │ │ ├── Err.chs │ │ ├── HKDF.chs │ │ ├── HMAC.chs │ │ ├── Mem.chs │ │ ├── Obj.chs │ │ └── Rand.chs │ ├── Buffer.hs │ ├── CreateWithFinalizer.hs │ ├── Result.hs │ ├── Show.hs │ └── Types.hs ├── Codec │ └── Crypto │ │ ├── Encryption.hs │ │ └── HKDF.hs ├── Data │ ├── Digest.hs │ └── HMAC.hs └── System │ └── Random │ └── Crypto.hs └── tests ├── BTLS ├── Assertions.hs └── TestUtilities.hs ├── Codec └── Crypto │ ├── EncryptionTests.hs │ └── HKDFTests.hs ├── Data ├── Digest │ ├── HashTests.hs │ ├── MD5Tests.hs │ ├── SHA1Tests.hs │ └── SHA2Tests.hs ├── DigestTests.hs └── HMACTests.hs └── Tests.hs /.gitignore: -------------------------------------------------------------------------------- 1 | # Editor backup files 2 | *~ 3 | \#* 4 | .\#* 5 | .*.swp 6 | 7 | # Sandboxes 8 | cabal-dev/ 9 | .hsenv*/ 10 | hsenv.log 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | 14 | # GHC 15 | *.hi 16 | *.o 17 | 18 | # Cabal 19 | cabal.project.local 20 | dist*/ 21 | 22 | # Third-party builds 23 | third_party/boringssl/build 24 | third_party/boringssl/lib 25 | 26 | 27 | # Local Variables: 28 | # mode: conf 29 | # End: 30 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "third_party/boringssl/src"] 2 | path = third_party/boringssl/src 3 | url = https://boringssl.googlesource.com/boringssl 4 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to Contribute 2 | 3 | We'd love to accept your patches and contributions to this project. There are 4 | just a few small guidelines you need to follow. 5 | 6 | ## Contributor License Agreement 7 | 8 | Contributions to this project must be accompanied by a Contributor License 9 | Agreement. You (or your employer) retain the copyright to your contribution; 10 | this simply gives us permission to use and redistribute your contributions as 11 | part of the project. Head over to to see 12 | your current agreements on file or to sign a new one. 13 | 14 | You generally only need to submit a CLA once, so if you've already submitted one 15 | (even if it was for a different project), you probably don't need to do it 16 | again. 17 | 18 | ## Code reviews 19 | 20 | All submissions, including submissions by project members, require review. We 21 | use GitHub pull requests for this purpose. Consult 22 | [GitHub Help](https://help.github.com/articles/about-pull-requests/) for more 23 | information on using pull requests. 24 | 25 | ## Community Guidelines 26 | 27 | This project follows [Google's Open Source Community 28 | Guidelines](https://opensource.google.com/conduct/). 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | btls's source is licensed under the Apache License, version 2.0. That license is 2 | reproduced below. However, when built, btls statically links BoringSSL, and the 3 | resulting library may only be used in compliance with both the Apache License 4 | and the BoringSSL license. The BoringSSL license is available in 5 | third_party/boringssl/src/LICENSE. 6 | 7 | -------------------------------------------------------------------------------- 8 | 9 | Apache License 10 | Version 2.0, January 2004 11 | http://www.apache.org/licenses/ 12 | 13 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 14 | 15 | 1. Definitions. 16 | 17 | "License" shall mean the terms and conditions for use, reproduction, 18 | and distribution as defined by Sections 1 through 9 of this document. 19 | 20 | "Licensor" shall mean the copyright owner or entity authorized by 21 | the copyright owner that is granting the License. 22 | 23 | "Legal Entity" shall mean the union of the acting entity and all 24 | other entities that control, are controlled by, or are under common 25 | control with that entity. For the purposes of this definition, 26 | "control" means (i) the power, direct or indirect, to cause the 27 | direction or management of such entity, whether by contract or 28 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 29 | outstanding shares, or (iii) beneficial ownership of such entity. 30 | 31 | "You" (or "Your") shall mean an individual or Legal Entity 32 | exercising permissions granted by this License. 33 | 34 | "Source" form shall mean the preferred form for making modifications, 35 | including but not limited to software source code, documentation 36 | source, and configuration files. 37 | 38 | "Object" form shall mean any form resulting from mechanical 39 | transformation or translation of a Source form, including but 40 | not limited to compiled object code, generated documentation, 41 | and conversions to other media types. 42 | 43 | "Work" shall mean the work of authorship, whether in Source or 44 | Object form, made available under the License, as indicated by a 45 | copyright notice that is included in or attached to the work 46 | (an example is provided in the Appendix below). 47 | 48 | "Derivative Works" shall mean any work, whether in Source or Object 49 | form, that is based on (or derived from) the Work and for which the 50 | editorial revisions, annotations, elaborations, or other modifications 51 | represent, as a whole, an original work of authorship. For the purposes 52 | of this License, Derivative Works shall not include works that remain 53 | separable from, or merely link (or bind by name) to the interfaces of, 54 | the Work and Derivative Works thereof. 55 | 56 | "Contribution" shall mean any work of authorship, including 57 | the original version of the Work and any modifications or additions 58 | to that Work or Derivative Works thereof, that is intentionally 59 | submitted to Licensor for inclusion in the Work by the copyright owner 60 | or by an individual or Legal Entity authorized to submit on behalf of 61 | the copyright owner. For the purposes of this definition, "submitted" 62 | means any form of electronic, verbal, or written communication sent 63 | to the Licensor or its representatives, including but not limited to 64 | communication on electronic mailing lists, source code control systems, 65 | and issue tracking systems that are managed by, or on behalf of, the 66 | Licensor for the purpose of discussing and improving the Work, but 67 | excluding communication that is conspicuously marked or otherwise 68 | designated in writing by the copyright owner as "Not a Contribution." 69 | 70 | "Contributor" shall mean Licensor and any individual or Legal Entity 71 | on behalf of whom a Contribution has been received by Licensor and 72 | subsequently incorporated within the Work. 73 | 74 | 2. Grant of Copyright License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | copyright license to reproduce, prepare Derivative Works of, 78 | publicly display, publicly perform, sublicense, and distribute the 79 | Work and such Derivative Works in Source or Object form. 80 | 81 | 3. Grant of Patent License. Subject to the terms and conditions of 82 | this License, each Contributor hereby grants to You a perpetual, 83 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 84 | (except as stated in this section) patent license to make, have made, 85 | use, offer to sell, sell, import, and otherwise transfer the Work, 86 | where such license applies only to those patent claims licensable 87 | by such Contributor that are necessarily infringed by their 88 | Contribution(s) alone or by combination of their Contribution(s) 89 | with the Work to which such Contribution(s) was submitted. If You 90 | institute patent litigation against any entity (including a 91 | cross-claim or counterclaim in a lawsuit) alleging that the Work 92 | or a Contribution incorporated within the Work constitutes direct 93 | or contributory patent infringement, then any patent licenses 94 | granted to You under this License for that Work shall terminate 95 | as of the date such litigation is filed. 96 | 97 | 4. Redistribution. You may reproduce and distribute copies of the 98 | Work or Derivative Works thereof in any medium, with or without 99 | modifications, and in Source or Object form, provided that You 100 | meet the following conditions: 101 | 102 | (a) You must give any other recipients of the Work or 103 | Derivative Works a copy of this License; and 104 | 105 | (b) You must cause any modified files to carry prominent notices 106 | stating that You changed the files; and 107 | 108 | (c) You must retain, in the Source form of any Derivative Works 109 | that You distribute, all copyright, patent, trademark, and 110 | attribution notices from the Source form of the Work, 111 | excluding those notices that do not pertain to any part of 112 | the Derivative Works; and 113 | 114 | (d) If the Work includes a "NOTICE" text file as part of its 115 | distribution, then any Derivative Works that You distribute must 116 | include a readable copy of the attribution notices contained 117 | within such NOTICE file, excluding those notices that do not 118 | pertain to any part of the Derivative Works, in at least one 119 | of the following places: within a NOTICE text file distributed 120 | as part of the Derivative Works; within the Source form or 121 | documentation, if provided along with the Derivative Works; or, 122 | within a display generated by the Derivative Works, if and 123 | wherever such third-party notices normally appear. The contents 124 | of the NOTICE file are for informational purposes only and 125 | do not modify the License. You may add Your own attribution 126 | notices within Derivative Works that You distribute, alongside 127 | or as an addendum to the NOTICE text from the Work, provided 128 | that such additional attribution notices cannot be construed 129 | as modifying the License. 130 | 131 | You may add Your own copyright statement to Your modifications and 132 | may provide additional or different license terms and conditions 133 | for use, reproduction, or distribution of Your modifications, or 134 | for any such Derivative Works as a whole, provided Your use, 135 | reproduction, and distribution of the Work otherwise complies with 136 | the conditions stated in this License. 137 | 138 | 5. Submission of Contributions. Unless You explicitly state otherwise, 139 | any Contribution intentionally submitted for inclusion in the Work 140 | by You to the Licensor shall be under the terms and conditions of 141 | this License, without any additional terms or conditions. 142 | Notwithstanding the above, nothing herein shall supersede or modify 143 | the terms of any separate license agreement you may have executed 144 | with Licensor regarding such Contributions. 145 | 146 | 6. Trademarks. This License does not grant permission to use the trade 147 | names, trademarks, service marks, or product names of the Licensor, 148 | except as required for reasonable and customary use in describing the 149 | origin of the Work and reproducing the content of the NOTICE file. 150 | 151 | 7. Disclaimer of Warranty. Unless required by applicable law or 152 | agreed to in writing, Licensor provides the Work (and each 153 | Contributor provides its Contributions) on an "AS IS" BASIS, 154 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 155 | implied, including, without limitation, any warranties or conditions 156 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 157 | PARTICULAR PURPOSE. You are solely responsible for determining the 158 | appropriateness of using or redistributing the Work and assume any 159 | risks associated with Your exercise of permissions under this License. 160 | 161 | 8. Limitation of Liability. In no event and under no legal theory, 162 | whether in tort (including negligence), contract, or otherwise, 163 | unless required by applicable law (such as deliberate and grossly 164 | negligent acts) or agreed to in writing, shall any Contributor be 165 | liable to You for damages, including any direct, indirect, special, 166 | incidental, or consequential damages of any character arising as a 167 | result of this License or out of the use or inability to use the 168 | Work (including but not limited to damages for loss of goodwill, 169 | work stoppage, computer failure or malfunction, or any and all 170 | other commercial damages or losses), even if such Contributor 171 | has been advised of the possibility of such damages. 172 | 173 | 9. Accepting Warranty or Additional Liability. While redistributing 174 | the Work or Derivative Works thereof, You may choose to offer, 175 | and charge a fee for, acceptance of support, warranty, indemnity, 176 | or other liability obligations and/or rights consistent with this 177 | License. However, in accepting such obligations, You may act only 178 | on Your own behalf and on Your sole responsibility, not on behalf 179 | of any other Contributor, and only if You agree to indemnify, 180 | defend, and hold each Contributor harmless for any liability 181 | incurred by, or claims asserted against, such Contributor by reason 182 | of your accepting any such warranty or additional liability. 183 | 184 | END OF TERMS AND CONDITIONS 185 | 186 | APPENDIX: How to apply the Apache License to your work. 187 | 188 | To apply the Apache License to your work, attach the following 189 | boilerplate notice, with the fields enclosed by brackets "[]" 190 | replaced with your own identifying information. (Don't include 191 | the brackets!) The text should be enclosed in the appropriate 192 | comment syntax for the file format. We also recommend that a 193 | file or class name and description of purpose be included on the 194 | same "printed page" as the copyright notice for easier 195 | identification within third-party archives. 196 | 197 | Copyright [yyyy] [name of copyright owner] 198 | 199 | Licensed under the Apache License, Version 2.0 (the "License"); 200 | you may not use this file except in compliance with the License. 201 | You may obtain a copy of the License at 202 | 203 | http://www.apache.org/licenses/LICENSE-2.0 204 | 205 | Unless required by applicable law or agreed to in writing, software 206 | distributed under the License is distributed on an "AS IS" BASIS, 207 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 208 | See the License for the specific language governing permissions and 209 | limitations under the License. 210 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # btls 2 | 3 | btls is a TLS and cryptography library for Haskell. It’s built on top of 4 | [BoringSSL](https://boringssl.googlesource.com/boringssl), Google’s audited fork 5 | of OpenSSL. 6 | 7 | Although BoringSSL does not have a stable API or ABI, we expect that btls will 8 | converge to a stable API before we release btls version 1. In the meantime, the 9 | API remains unstable, we do not follow the [Package Versioning 10 | Policy](https://pvp.haskell.org), and we will not post btls on Hackage. 11 | 12 | **btls is not production ready yet.** It is feature-incomplete and has not 13 | undergone review or auditing. 14 | 15 | ## Building 16 | 17 | btls includes a copy of BoringSSL as a Git submodule. Ensure you’ve checked out 18 | that submodule before building. If you’ve just cloned btls, `git submodule 19 | update --init` should do it. You’ll also need all of BoringSSL’s build 20 | dependencies. On Debian, run 21 | 22 | apt install cmake gcc g++ golang ninja-build perl 23 | 24 | to install them. You do not need to build BoringSSL itself; btls’s Setup.hs will 25 | take care of that for you. 26 | 27 | btls needs GHC, c2hs and a few Haskell libraries to build. On Debian, 28 | 29 | apt install c2hs ghc libghc-gtk2hs-buildtools-dev 30 | 31 | should get you everything you need; you can also run 32 | 33 | apt install libghc-{base16-bytestring,monad-loops,smallcheck,tasty,tasty-hunit,tasty-smallcheck}-dev 34 | 35 | if you want to install everything you can through APT instead of Cabal. Once 36 | you’ve done so, you can build and run the test suite. 37 | 38 | cabal new-build tests 39 | dist-newstyle/build/btls-*/build/tests/tests 40 | 41 | --- 42 | 43 | This is not an official Google product. 44 | 45 | This product includes cryptographic software written by [Eric 46 | Young](mailto:eay@cryptsoft.com). 47 | 48 | This product includes software written by [Tim 49 | Hudson](mailto:tjh@cryptsoft.com). 50 | 51 | This product includes software developed by the OpenSSL Project for use in the 52 | [OpenSSL Toolkit](https://www.openssl.org). 53 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module Main (main) where 16 | 17 | import qualified Distribution.PackageDescription as PackageDescription 18 | import qualified Distribution.Simple as Simple 19 | import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo 20 | import qualified Distribution.Simple.Setup as Setup 21 | import qualified Distribution.Simple.Utils as Utils 22 | import qualified Gtk2HsSetup 23 | import System.Directory (getCurrentDirectory) 24 | import System.FilePath (()) 25 | 26 | main = 27 | let h = Simple.simpleUserHooks in 28 | Simple.defaultMainWithHooks 29 | h { Simple.preConf = \args flags -> do 30 | -- Cabal expects to find BoringSSL's libraries already built at the 31 | -- time of configuration, so we must build BoringSSL completely here. 32 | boringsslBuild flags 33 | Simple.preConf h args flags 34 | , Simple.confHook = \info flags -> do 35 | buildinfo <- Simple.confHook h info flags 36 | boringsslUpdateExtraLibDirs buildinfo 37 | , Simple.buildHook = Simple.buildHook Gtk2HsSetup.gtk2hsUserHooks 38 | } 39 | 40 | boringsslDir = "third_party" "boringssl" 41 | 42 | boringsslLibDir = boringsslDir "lib" 43 | 44 | boringsslBuild flags = do 45 | -- Build BoringSSL. 46 | let buildDir = boringsslDir "build" 47 | mkdir buildDir 48 | let cryptoTarget = "crypto" "libcrypto.a" 49 | cmd 50 | [ "cmake" 51 | , "-GNinja" 52 | , "-DCMAKE_BUILD_TYPE=Release" 53 | , "-DCMAKE_POSITION_INDEPENDENT_CODE=TRUE" 54 | , "-B" ++ buildDir 55 | , "-H" ++ boringsslDir "src" 56 | ] 57 | cmd ["ninja", "-C", buildDir, cryptoTarget] 58 | -- Rename BoringSSL's libraries so we don't accidentally grab OpenSSL. 59 | mkdir boringsslLibDir 60 | Utils.installOrdinaryFile v 61 | (buildDir cryptoTarget) 62 | (boringsslLibDir "libbtls_crypto.a") 63 | where 64 | v = Setup.fromFlag (Setup.configVerbosity flags) 65 | mkdir = Utils.createDirectoryIfMissingVerbose v True 66 | cmd (bin:args) = Utils.rawSystemExit v bin args 67 | 68 | boringsslUpdateExtraLibDirs buildinfo = do 69 | let pkg = LocalBuildInfo.localPkgDescr buildinfo 70 | Just lib = PackageDescription.library pkg 71 | libBuild = PackageDescription.libBuildInfo lib 72 | dirs = PackageDescription.extraLibDirs libBuild 73 | root <- getCurrentDirectory 74 | return 75 | buildinfo 76 | { LocalBuildInfo.localPkgDescr = 77 | pkg 78 | { PackageDescription.library = 79 | Just $ 80 | lib 81 | { PackageDescription.libBuildInfo = 82 | libBuild 83 | { PackageDescription.extraLibDirs = 84 | (root boringsslLibDir) : dirs 85 | } 86 | } 87 | } 88 | } 89 | -------------------------------------------------------------------------------- /btls.cabal: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | cabal-version: >=1.24 16 | name: btls 17 | version: 0.0.0.0 18 | synopsis: BoringSSL-backed TLS and cryptography library 19 | description: 20 | A TLS and cryptography library backed by BoringSSL, Google's fork of OpenSSL. 21 | copyright: 2018 Google LLC 22 | license: OtherLicense 23 | license-file: LICENSE 24 | author: Benjamin Barenblat 25 | maintainer: bbaren@google.com 26 | category: Network 27 | build-type: Custom 28 | tested-with: GHC ==8.0.2 29 | extra-source-files: cbits 30 | , third_party 31 | 32 | custom-setup 33 | setup-depends: base 34 | , Cabal >=1.4 && <2.1 35 | , directory <1.4 36 | , filepath <1.5 37 | , gtk2hs-buildtools >=0.13.2.1 && <0.14 38 | 39 | library 40 | hs-source-dirs: src 41 | default-language: Haskell2010 42 | other-extensions: CApiFFI 43 | build-tools: c2hs 44 | include-dirs: third_party/boringssl/src/include 45 | ghc-options: -Werror 46 | -w 47 | -Wderiving-typeable 48 | -Wduplicate-exports 49 | -Widentities 50 | -Wincomplete-patterns 51 | -Wincomplete-record-updates 52 | -Wincomplete-uni-patterns 53 | -Wmissing-fields 54 | -Wmissing-methods 55 | -Wmissing-monadfail-instances 56 | -Wnoncanonical-monad-instances 57 | -Wnoncanonical-monadfail-instances 58 | -Wnoncanonical-monoid-instances 59 | -Woverlapping-patterns 60 | -Wredundant-constraints 61 | -Wsemigroup 62 | -Wtabs 63 | -Wunused-binds 64 | -Wunused-do-bind 65 | -Wunused-foralls 66 | -Wunused-imports 67 | -Wunused-matches 68 | -Wunused-type-variables 69 | -Wwrong-do-bind 70 | -optl-Wl,-z,relro -optl-Wl,-z,now -optl-Wl,-s 71 | exposed-modules: Codec.Crypto.Encryption 72 | , Codec.Crypto.HKDF 73 | , Data.Digest 74 | , Data.HMAC 75 | , System.Random.Crypto 76 | other-modules: BTLS.BoringSSL.Base 77 | , BTLS.BoringSSL.Cipher 78 | , BTLS.BoringSSL.Digest 79 | , BTLS.BoringSSL.Err 80 | , BTLS.BoringSSL.HKDF 81 | , BTLS.BoringSSL.HMAC 82 | , BTLS.BoringSSL.Mem 83 | , BTLS.BoringSSL.Obj 84 | , BTLS.BoringSSL.Rand 85 | , BTLS.Buffer 86 | , BTLS.CreateWithFinalizer 87 | 88 | , BTLS.Result 89 | , BTLS.Show 90 | , BTLS.Types 91 | c-sources: cbits/btls.c 92 | -- Use special names for the BoringSSL libraries to avoid accidentally pulling 93 | -- in OpenSSL. 94 | extra-libraries: btls_crypto 95 | build-depends: base >=4.9 && <4.10 96 | , base16-bytestring >=0.1.1.6 && <0.2 97 | , bytestring >=0.10 && <0.11 98 | , monad-loops >=0.4.3 && <0.5 99 | , transformers >=0.5.2 && <0.6 100 | 101 | test-suite tests 102 | type: exitcode-stdio-1.0 103 | hs-source-dirs: tests 104 | default-language: Haskell2010 105 | other-extensions: OverloadedStrings 106 | ghc-options: -Werror 107 | -w 108 | -Wderiving-typeable 109 | -Wduplicate-exports 110 | -Widentities 111 | -Wincomplete-patterns 112 | -Wincomplete-record-updates 113 | -Wincomplete-uni-patterns 114 | -Wmissing-fields 115 | -Wmissing-methods 116 | -Wmissing-monadfail-instances 117 | -Wnoncanonical-monad-instances 118 | -Wnoncanonical-monadfail-instances 119 | -Wnoncanonical-monoid-instances 120 | -Woverlapping-patterns 121 | -Wredundant-constraints 122 | -Wsemigroup 123 | -Wtabs 124 | -Wunused-binds 125 | -Wunused-do-bind 126 | -Wunused-foralls 127 | -Wunused-imports 128 | -Wunused-matches 129 | -Wunused-type-variables 130 | -Wwrong-do-bind 131 | -threaded 132 | -optl-Wl,-z,relro -optl-Wl,-z,now -optl-Wl,-s 133 | main-is: Tests.hs 134 | other-modules: BTLS.Assertions 135 | , BTLS.TestUtilities 136 | , Codec.Crypto.EncryptionTests 137 | , Codec.Crypto.HKDFTests 138 | , Data.DigestTests 139 | , Data.Digest.HashTests 140 | , Data.Digest.MD5Tests 141 | , Data.Digest.SHA1Tests 142 | , Data.Digest.SHA2Tests 143 | , Data.HMACTests 144 | build-depends: base >=4.9 && <4.10 145 | , base16-bytestring >=0.1.1.6 && <0.2 146 | , btls 147 | , bytestring >=0.10 && <0.11 148 | , process >=1.4.2 && <1.5 149 | , smallcheck >=1.1.1 && <1.2 150 | , smallcheck-series >=0.2 && <0.7 151 | , tasty >=0.11.0.4 && <0.12 152 | , tasty-hunit >=0.9.2 && <0.10 153 | , tasty-smallcheck >=0.8.1 && <0.9 154 | -------------------------------------------------------------------------------- /cbits/btls.c: -------------------------------------------------------------------------------- 1 | // Copyright 2018 Google LLC 2 | // 3 | // Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | // use this file except in compliance with the License. You may obtain a copy of 5 | // the License at 6 | // 7 | // https://www.apache.org/licenses/LICENSE-2.0 8 | // 9 | // Unless required by applicable law or agreed to in writing, software 10 | // distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | // WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | // License for the specific language governing permissions and limitations under 13 | // the License. 14 | 15 | #include 16 | #include 17 | 18 | void btlsFinalizeEVPCipherCtx(EVP_CIPHER_CTX* const ctx) { 19 | (void)EVP_CIPHER_CTX_cleanup(ctx); 20 | } 21 | 22 | void btlsFinalizeEVPMDCtx(EVP_MD_CTX* const ctx) { 23 | (void)EVP_MD_CTX_cleanup(ctx); 24 | } 25 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Base.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# OPTIONS_GHC -Wno-unused-imports #-} 16 | 17 | module BTLS.BoringSSL.Base where 18 | 19 | import Foreign (Ptr, nullPtr) 20 | 21 | #include 22 | 23 | -- | The BoringSSL @ENGINE@ type. 24 | data Engine 25 | {#pointer *ENGINE as 'Ptr Engine' -> Engine nocode#} 26 | 27 | noEngine :: Ptr Engine 28 | noEngine = nullPtr 29 | 30 | -- | The BoringSSL @EVP_MD_CTX@ type, representing the state of a pending 31 | -- hashing operation. 32 | data EVPMDCtx 33 | {#pointer *EVP_MD_CTX as 'Ptr EVPMDCtx' -> EVPMDCtx nocode#} 34 | 35 | -- | The BoringSSL @EVP_MD@ type, representing a hash algorithm. 36 | data EVPMD 37 | {#pointer *EVP_MD as 'Ptr EVPMD' -> EVPMD nocode#} 38 | 39 | -- | The BoringSSL @EVP_CIPHER_CTX@ type, representing the state of a pending 40 | -- encryption or decryption operation. 41 | data EVPCipherCtx 42 | {#pointer *EVP_CIPHER_CTX as 'Ptr EVPCipherCtx' -> EVPCipherCtx nocode#} 43 | 44 | -- | The BoringSSL @EVP_CIPHER@ type, representing a cipher algorithm. 45 | data EVPCipher 46 | {#pointer *EVP_CIPHER as 'Ptr EVPCipher' -> EVPCipher nocode#} 47 | 48 | -- | The BoringSSL @HMAC_CTX@ type, representing the state of a pending HMAC 49 | -- operation. 50 | data HMACCtx 51 | {#pointer *HMAC_CTX as 'Ptr HMACCtx' -> HMACCtx nocode#} 52 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Cipher.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# OPTIONS_GHC -Wno-missing-methods #-} 16 | 17 | module BTLS.BoringSSL.Cipher 18 | ( evpRC4 19 | , mallocEVPCipherCtx 20 | , evpCipherInitEx, evpCipherUpdate, evpCipherFinalEx 21 | , evpCipherCtxSetKeyLength 22 | , evpCipherNID, evpCipherBlockSize, evpCipherKeyLength, evpCipherIVLength 23 | , CipherDirection(ReuseDirection, Decrypt, Encrypt) 24 | ) where 25 | 26 | import Data.ByteString (ByteString) 27 | import Foreign (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr) 28 | import Foreign.C.Types 29 | 30 | {#import BTLS.BoringSSL.Base#} 31 | import BTLS.Buffer (unsafeUseAsCBuffer) 32 | import BTLS.CreateWithFinalizer (createWithFinalizer) 33 | 34 | #include 35 | 36 | data CipherDirection = ReuseDirection | Decrypt | Encrypt 37 | deriving (Eq, Show) 38 | 39 | instance Enum CipherDirection where 40 | fromEnum ReuseDirection = -1 41 | fromEnum Decrypt = 0 42 | fromEnum Encrypt = 1 43 | 44 | {#fun pure EVP_rc4 as evpRC4 {} -> `Ptr EVPCipher'#} 45 | 46 | -- | Memory-safe allocator for 'EVPCipherCtx'. 47 | mallocEVPCipherCtx :: IO (ForeignPtr EVPCipherCtx) 48 | mallocEVPCipherCtx = 49 | createWithFinalizer {#call EVP_CIPHER_CTX_init as ^#} btlsFinalizeEVPCipherCtxPtr 50 | 51 | foreign import ccall "&btlsFinalizeEVPCipherCtx" 52 | btlsFinalizeEVPCipherCtxPtr :: FinalizerPtr EVPCipherCtx 53 | 54 | {#fun EVP_CipherInit_ex as evpCipherInitEx 55 | { withForeignPtr* `ForeignPtr EVPCipherCtx' 56 | , `Ptr EVPCipher' 57 | , `Ptr Engine' 58 | , id `Ptr CUChar' 59 | , id `Ptr CUChar' 60 | , 'fromIntegral . fromEnum' `CipherDirection' 61 | } -> `Int'#} 62 | 63 | {#fun EVP_CipherUpdate as evpCipherUpdate 64 | { withForeignPtr* `ForeignPtr EVPCipherCtx' 65 | , id `Ptr CUChar' 66 | , id `Ptr CInt' 67 | , unsafeUseAsCBuffer* `ByteString'& 68 | } -> `Int'#} 69 | 70 | {#fun EVP_CipherFinal_ex as evpCipherFinalEx 71 | { withForeignPtr* `ForeignPtr EVPCipherCtx' 72 | , id `Ptr CUChar' 73 | , id `Ptr CInt' 74 | } -> `Int'#} 75 | 76 | {#fun EVP_CIPHER_CTX_set_key_length as evpCipherCtxSetKeyLength 77 | {withForeignPtr* `ForeignPtr EVPCipherCtx', `Int'} -> `Int'#} 78 | 79 | {#fun pure EVP_CIPHER_nid as evpCipherNID {`Ptr EVPCipher'} -> `Int'#} 80 | 81 | {#fun pure EVP_CIPHER_block_size as evpCipherBlockSize 82 | {`Ptr EVPCipher'} -> `Int'#} 83 | 84 | {#fun pure EVP_CIPHER_key_length as evpCipherKeyLength 85 | {`Ptr EVPCipher'} -> `Int'#} 86 | 87 | {#fun pure EVP_CIPHER_iv_length as evpCipherIVLength 88 | {`Ptr EVPCipher'} -> `Int'#} 89 | 90 | instance Storable EVPCipherCtx where 91 | sizeOf _ = {#sizeof EVP_CIPHER_CTX#} 92 | alignment _ = {#alignof EVP_CIPHER_CTX#} 93 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Digest.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# OPTIONS_GHC -Wno-missing-methods #-} 16 | 17 | module BTLS.BoringSSL.Digest 18 | ( evpMD5, evpSHA1, evpSHA224, evpSHA256, evpSHA384, evpSHA512 19 | , mallocEVPMDCtx 20 | , evpDigestInitEx, evpDigestUpdate, evpDigestFinalEx 21 | , evpMaxMDSize 22 | , evpMDType 23 | ) where 24 | 25 | import Data.ByteString (ByteString) 26 | import Foreign 27 | (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr) 28 | import Foreign.C.Types 29 | 30 | {#import BTLS.BoringSSL.Base#} 31 | import BTLS.Buffer (unsafeUseAsCBuffer) 32 | import BTLS.CreateWithFinalizer (createWithFinalizer) 33 | import BTLS.Result 34 | 35 | #include 36 | 37 | {#fun pure EVP_md5 as evpMD5 {} -> `Ptr EVPMD'#} 38 | {#fun pure EVP_sha1 as evpSHA1 {} -> `Ptr EVPMD'#} 39 | {#fun pure EVP_sha224 as evpSHA224 {} -> `Ptr EVPMD'#} 40 | {#fun pure EVP_sha256 as evpSHA256 {} -> `Ptr EVPMD'#} 41 | {#fun pure EVP_sha384 as evpSHA384 {} -> `Ptr EVPMD'#} 42 | {#fun pure EVP_sha512 as evpSHA512 {} -> `Ptr EVPMD'#} 43 | 44 | -- | Memory-safe allocator for 'EVPMDCtx'. 45 | mallocEVPMDCtx :: IO (ForeignPtr EVPMDCtx) 46 | mallocEVPMDCtx = 47 | createWithFinalizer {#call EVP_MD_CTX_init as ^#} btlsFinalizeEVPMDCtxPtr 48 | 49 | foreign import ccall "&btlsFinalizeEVPMDCtx" 50 | btlsFinalizeEVPMDCtxPtr :: FinalizerPtr EVPMDCtx 51 | 52 | {#fun EVP_DigestInit_ex as evpDigestInitEx 53 | {withForeignPtr* `ForeignPtr EVPMDCtx', `Ptr EVPMD', `Ptr Engine'} 54 | -> `()' requireSuccess*-#} 55 | 56 | {#fun EVP_DigestUpdate as evpDigestUpdate 57 | {withForeignPtr* `ForeignPtr EVPMDCtx', unsafeUseAsCBuffer* `ByteString'&} 58 | -> `()' alwaysSucceeds*-#} 59 | 60 | {#fun EVP_DigestFinal_ex as evpDigestFinalEx 61 | {withForeignPtr* `ForeignPtr EVPMDCtx', id `Ptr CUChar', id `Ptr CUInt'} 62 | -> `()' alwaysSucceeds*-#} 63 | 64 | evpMaxMDSize :: Int 65 | evpMaxMDSize = {#const EVP_MAX_MD_SIZE#} 66 | 67 | {#fun pure EVP_MD_type as evpMDType {`Ptr EVPMD'} -> `Int'#} 68 | 69 | instance Storable EVPMDCtx where 70 | sizeOf _ = {#sizeof EVP_MD_CTX#} 71 | alignment _ = {#alignof EVP_MD_CTX#} 72 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Err.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE CApiFFI #-} 16 | 17 | module BTLS.BoringSSL.Err where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString as ByteString 21 | import Foreign (Storable(peek), alloca, nullPtr) 22 | import Foreign.C.String (CString, peekCString) 23 | import Foreign.C.Types 24 | 25 | #include 26 | 27 | -- Define a newtype for packed errors so c2hs doesn't try to marshal them. 28 | newtype Err = Err {rawErrValue :: CUInt} 29 | deriving (Eq) 30 | 31 | errGetLib :: Err -> ErrLib 32 | errGetLib (Err e) = castEnum (errGetLib' e) 33 | 34 | foreign import capi "openssl/err.h ERR_GET_LIB" 35 | errGetLib' :: CUInt -> CInt 36 | 37 | errGetReason :: Err -> ErrR 38 | errGetReason (Err e) = castEnum (errGetReason' e) 39 | 40 | foreign import capi "openssl/err.h ERR_GET_REASON" 41 | errGetReason' :: CUInt -> CInt 42 | 43 | errFlagString :: CInt 44 | errFlagString = {#const ERR_FLAG_STRING#} 45 | 46 | {#fun ERR_get_error_line_data as errGetErrorLineData 47 | { alloca- `FilePath' peekCStringPtr* 48 | , alloca- `Int' peekIntPtr* 49 | , alloca- `Maybe ByteString' peekErrorData* 50 | , alloca- `CInt' peek* } 51 | -> `Err' Err#} 52 | where 53 | peekCStringPtr p = do 54 | s <- peek p 55 | peekCString s 56 | peekIntPtr p = fmap fromIntegral (peek p) 57 | peekErrorData p = do 58 | s <- peek p 59 | if s == nullPtr 60 | then return Nothing 61 | else Just <$> ByteString.packCString s 62 | 63 | {#fun ERR_error_string_n as errErrorStringN 64 | {rawErrValue `Err', id `CString', `Int'} -> `()'#} 65 | 66 | {#fun ERR_clear_error as errClearError {} -> `()'#} 67 | 68 | {#enum ERR_LIB_NONE as ErrLib 69 | { underscoreToCase 70 | , ERR_LIB_BN as ErrLibBN 71 | , ERR_LIB_RSA as ErrLibRSA 72 | , ERR_LIB_DH as ErrLibDH 73 | , ERR_LIB_EVP as ErrLibEvp 74 | , ERR_LIB_PEM as ErrLibPEM 75 | , ERR_LIB_DSA as ErrLibDSA 76 | , ERR_LIB_ASN1 as ErrLibASN1 77 | , ERR_LIB_EC as ErrLibEC 78 | , ERR_LIB_SSL as ErrLibSSL 79 | , ERR_LIB_BIO as ErrLibBIO 80 | , ERR_LIB_PKCS7 as ErrLibPKCS7 81 | , ERR_LIB_PKCS8 as ErrLibPKCS8 82 | , ERR_LIB_OCSP as ErrLibOCSP 83 | , ERR_LIB_UI as ErrLibUI 84 | , ERR_LIB_ECDSA as ErrLibECDSA 85 | , ERR_LIB_ECDH as ErrLibECDH 86 | , ERR_LIB_HMAC as ErrLibHMAC 87 | , ERR_LIB_HKDF as ErrLibHKDF } 88 | omit (ERR_NUM_LIBS) 89 | deriving (Eq)#} 90 | 91 | {#enum define ErrR 92 | { ERR_R_SYS_LIB as ErrRSysLib 93 | , ERR_R_BN_LIB as ErrRBNLib 94 | , ERR_R_RSA_LIB as ErrRRSALib 95 | , ERR_R_DH_LIB as ErrRDHLib 96 | , ERR_R_EVP_LIB as ErrREVPLib 97 | , ERR_R_BUF_LIB as ErrRBufLib 98 | , ERR_R_OBJ_LIB as ErrRObjLib 99 | , ERR_R_PEM_LIB as ErrRPEMLib 100 | , ERR_R_DSA_LIB as ErrRDSALib 101 | , ERR_R_X509_LIB as ErrRX509Lib 102 | , ERR_R_ASN1_LIB as ErrRASN1Lib 103 | , ERR_R_CONF_LIB as ErrRConfLib 104 | , ERR_R_CRYPTO_LIB as ErrRCryptoLib 105 | , ERR_R_EC_LIB as ErrRECLib 106 | , ERR_R_SSL_LIB as ErrRSSLLib 107 | , ERR_R_BIO_LIB as ErrRBIOLib 108 | , ERR_R_PKCS7_LIB as ErrRPKCS7Lib 109 | , ERR_R_PKCS8_LIB as ErrRPKCS8Lib 110 | , ERR_R_X509V3_LIB as ErrRX509v3Lib 111 | , ERR_R_RAND_LIB as ErrRRandLib 112 | , ERR_R_ENGINE_LIB as ErrREngineLib 113 | , ERR_R_OCSP_LIB as ErrROCSPLib 114 | , ERR_R_UI_LIB as ErrRUILib 115 | , ERR_R_COMP_LIB as ErrRCompLib 116 | , ERR_R_ECDSA_LIB as ErrRECDSALib 117 | , ERR_R_ECDH_LIB as ErrRECDHLib 118 | , ERR_R_HMAC_LIB as ErrRHMACLib 119 | , ERR_R_USER_LIB as ErrRUserLib 120 | , ERR_R_DIGEST_LIB as ErrRDigestLib 121 | , ERR_R_CIPHER_LIB as ErrRCipherLib 122 | , ERR_R_HKDF_LIB as ErrRHKDFLib 123 | , ERR_R_FATAL as ErrRFatal 124 | , ERR_R_MALLOC_FAILURE as ErrRMallocFailure 125 | , ERR_R_SHOULD_NOT_HAVE_BEEN_CALLED as ErrRShouldNotHaveBeenCalled 126 | , ERR_R_PASSED_NULL_PARAMETER as ErrRPassedNullParameter 127 | , ERR_R_INTERNAL_ERROR as ErrRInternalError 128 | , ERR_R_OVERFLOW as ErrROverflow } 129 | deriving (Eq)#} 130 | 131 | castEnum :: (Enum a, Enum b) => a -> b 132 | castEnum = toEnum . fromEnum -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/HKDF.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.BoringSSL.HKDF 16 | ( hkdfExtract, hkdfExpand 17 | ) where 18 | 19 | import Data.ByteString (ByteString) 20 | import Foreign (Ptr) 21 | import Foreign.C.Types 22 | 23 | {#import BTLS.BoringSSL.Base#} 24 | import BTLS.Buffer (unsafeUseAsCBuffer) 25 | 26 | #include 27 | 28 | {#fun HKDF_extract as hkdfExtract 29 | { id `Ptr CUChar', id `Ptr CULong', `Ptr EVPMD' 30 | , unsafeUseAsCBuffer* `ByteString'&, unsafeUseAsCBuffer* `ByteString'& } 31 | -> `Int'#} 32 | 33 | {#fun HKDF_expand as hkdfExpand 34 | { id `Ptr CUChar', `Int', `Ptr EVPMD', unsafeUseAsCBuffer* `ByteString'& 35 | , unsafeUseAsCBuffer* `ByteString'& } -> `Int'#} 36 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/HMAC.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# OPTIONS_GHC -Wno-missing-methods #-} 16 | 17 | module BTLS.BoringSSL.HMAC 18 | ( mallocHMACCtx 19 | , hmacInitEx, hmacUpdate, hmacFinal 20 | ) where 21 | 22 | import Data.ByteString (ByteString) 23 | import Foreign 24 | (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr) 25 | import Foreign.C.Types 26 | 27 | {#import BTLS.BoringSSL.Base#} 28 | import BTLS.Buffer (unsafeUseAsCBuffer) 29 | import BTLS.CreateWithFinalizer (createWithFinalizer) 30 | import BTLS.Result 31 | 32 | #include 33 | 34 | -- | Memory-safe allocator for 'HMACCtx'. 35 | mallocHMACCtx :: IO (ForeignPtr HMACCtx) 36 | mallocHMACCtx = createWithFinalizer {#call HMAC_CTX_init as ^#} hmacCtxCleanup 37 | 38 | foreign import ccall "&HMAC_CTX_cleanup" 39 | hmacCtxCleanup :: FinalizerPtr HMACCtx 40 | 41 | {#fun HMAC_Init_ex as hmacInitEx 42 | { withForeignPtr* `ForeignPtr HMACCtx' 43 | , unsafeUseAsCBuffer* `ByteString'& 44 | , `Ptr EVPMD' 45 | , `Ptr Engine' } 46 | -> `Int'#} 47 | 48 | {#fun HMAC_Update as hmacUpdate 49 | { withForeignPtr* `ForeignPtr HMACCtx' 50 | , unsafeUseAsCBuffer* `ByteString'& } 51 | -> `()' alwaysSucceeds*-#} 52 | 53 | {#fun HMAC_Final as hmacFinal 54 | { withForeignPtr* `ForeignPtr HMACCtx' 55 | , id `Ptr CUChar' 56 | , id `Ptr CUInt' } 57 | -> `()' requireSuccess*-#} 58 | 59 | instance Storable HMACCtx where 60 | sizeOf _ = {#sizeof HMAC_CTX#} 61 | alignment _ = {#alignof HMAC_CTX#} 62 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Mem.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.BoringSSL.Mem where 16 | 17 | import Foreign (Ptr, castPtr) 18 | 19 | #include 20 | 21 | -- | Directly compares two buffers for equality. This operation takes an amount 22 | -- of time dependent on the specified size but independent of either buffer's 23 | -- contents. 24 | {#fun CRYPTO_memcmp as cryptoMemcmp 25 | {castPtr `Ptr a', castPtr `Ptr a', `Int'} -> `Int'#} 26 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Obj.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.BoringSSL.Obj 16 | ( objNID2SN 17 | ) where 18 | 19 | import Foreign (nullPtr) 20 | import Foreign.C (CString, peekCString) 21 | 22 | #include 23 | 24 | {#fun pure OBJ_nid2sn as objNID2SN 25 | {`Int'} -> `Maybe String' peekCStringOrNull*#} 26 | 27 | peekCStringOrNull :: CString -> IO (Maybe String) 28 | peekCStringOrNull ptr 29 | | ptr == nullPtr = return Nothing 30 | | otherwise = Just <$> peekCString ptr 31 | -------------------------------------------------------------------------------- /src/BTLS/BoringSSL/Rand.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.BoringSSL.Rand 16 | ( randBytes 17 | ) where 18 | 19 | import Foreign (Ptr) 20 | import Foreign.C.Types 21 | 22 | import BTLS.Result 23 | 24 | #include 25 | 26 | {#fun RAND_bytes as randBytes 27 | {id `Ptr CUChar', `Int'} -> `()' alwaysSucceeds*-#} 28 | -------------------------------------------------------------------------------- /src/BTLS/Buffer.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.Buffer 16 | ( unsafeUseAsCBuffer 17 | , packCUStringLen 18 | , onBufferOfMaxSize, onBufferOfMaxSize' 19 | ) where 20 | 21 | import Control.Monad.Trans.Class (lift) 22 | import Control.Monad.Trans.Except (ExceptT, runExceptT) 23 | import Data.ByteString (ByteString) 24 | import qualified Data.ByteString as ByteString 25 | import qualified Data.ByteString.Unsafe as ByteString 26 | import Foreign (Storable(peek), Ptr, alloca, allocaArray, castPtr) 27 | import Foreign.C.Types 28 | 29 | unsafeUseAsCBuffer :: 30 | Integral size => ByteString -> ((Ptr a, size) -> IO b) -> IO b 31 | unsafeUseAsCBuffer bs f = 32 | ByteString.unsafeUseAsCStringLen bs $ \(pStr, len) -> 33 | f (castPtr pStr, fromIntegral len) 34 | 35 | packCUStringLen :: Integral n => (Ptr CUChar, n) -> IO ByteString 36 | packCUStringLen (pStr, len) = 37 | ByteString.packCStringLen (castPtr pStr, fromIntegral len) 38 | 39 | -- | Allocates a buffer, runs a function 'f' to partially fill it, and packs the 40 | -- filled data into a 'ByteString'. 'f' must write the size of the filled data, 41 | -- in bytes and not including any trailing null, into its second argument. 42 | -- 43 | -- If 'f' is safe to use under 'unsafeLocalState', this whole function is safe 44 | -- to use under 'unsafeLocalState'. 45 | onBufferOfMaxSize :: 46 | (Integral size, Storable size) 47 | => Int 48 | -> (Ptr CUChar -> Ptr size -> IO ()) 49 | -> IO ByteString 50 | onBufferOfMaxSize maxSize f = do 51 | Right r <- onBufferOfMaxSize' maxSize (compose2 lift f) 52 | return r 53 | 54 | -- | Like 'onBufferOfMaxSize' but may fail. 55 | onBufferOfMaxSize' :: 56 | (Integral size, Storable size) 57 | => Int 58 | -> (Ptr CUChar -> Ptr size -> ExceptT e IO ()) 59 | -> IO (Either e ByteString) 60 | onBufferOfMaxSize' maxSize f = 61 | allocaArray maxSize $ \pOut -> 62 | alloca $ \pOutLen -> runExceptT $ do 63 | f pOut pOutLen 64 | outLen <- lift $ peek pOutLen 65 | lift $ packCUStringLen (pOut, outLen) 66 | 67 | compose2 :: (r -> r') -> (a -> b -> r) -> a -> b -> r' 68 | compose2 f g = \a b -> f (g a b) 69 | -------------------------------------------------------------------------------- /src/BTLS/CreateWithFinalizer.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.CreateWithFinalizer (createWithFinalizer) where 16 | 17 | import Foreign 18 | (FinalizerPtr, ForeignPtr, Ptr, Storable, addForeignPtrFinalizer, 19 | mallocForeignPtr, withForeignPtr) 20 | 21 | createWithFinalizer :: 22 | Storable a => (Ptr a -> IO ()) -> FinalizerPtr a -> IO (ForeignPtr a) 23 | createWithFinalizer initialize finalize = do 24 | fp <- mallocForeignPtr 25 | withForeignPtr fp initialize 26 | addForeignPtrFinalizer finalize fp 27 | return fp 28 | -------------------------------------------------------------------------------- /src/BTLS/Result.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.Result 16 | ( alwaysSucceeds, requireSuccess 17 | , Result, Error, file, line, errorData, errorDataIsHumanReadable 18 | , check, check' 19 | ) where 20 | 21 | import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread) 22 | import Control.Exception (assert) 23 | import Control.Monad (guard, unless, when) 24 | import Control.Monad.Loops (unfoldM) 25 | import Control.Monad.Trans.Except (ExceptT(ExceptT)) 26 | import Data.Bits ((.&.)) 27 | import Data.ByteString (ByteString) 28 | import Foreign (allocaArray) 29 | import Foreign.C.String (peekCString) 30 | import Foreign.C.Types 31 | import Foreign.Marshal.Unsafe (unsafeLocalState) 32 | 33 | import BTLS.BoringSSL.Err 34 | 35 | alwaysSucceeds :: CInt -> IO () 36 | alwaysSucceeds r = assert (r == 1) (return ()) 37 | 38 | requireSuccess :: CInt -> IO () 39 | requireSuccess r = when (r /= 1) $ ioError (userError "BoringSSL failure") 40 | 41 | type Result = Either [Error] 42 | 43 | -- | An error which occurred during processing. 44 | data Error = Error 45 | { err :: Err 46 | , file :: FilePath 47 | , line :: Int 48 | , errorData :: Maybe ByteString 49 | , flags :: CInt 50 | } 51 | 52 | errorDataIsHumanReadable :: Error -> Bool 53 | errorDataIsHumanReadable e = flags e .&. errFlagString == 1 54 | 55 | instance Show Error where 56 | show e = 57 | let len = 120 in 58 | unsafeLocalState $ 59 | allocaArray len $ \pOut -> do 60 | errErrorStringN (err e) pOut len 61 | peekCString pOut 62 | 63 | errorFromTuple :: (Err, FilePath, Int, Maybe ByteString, CInt) -> Error 64 | errorFromTuple = uncurry5 Error 65 | 66 | dequeueError :: IO (Maybe Error) 67 | dequeueError = do 68 | e@((Err code), _file, _line, _extra, _flags) <- errGetErrorLineData 69 | guard (code /= 0) 70 | return (Just (errorFromTuple e)) 71 | 72 | check :: IO Int -> ExceptT [Error] IO () 73 | check = ExceptT . check' 74 | 75 | check' :: IO Int -> IO (Either [Error] ()) 76 | check' f = do 77 | unless rtsSupportsBoundThreads $ 78 | error "btls requires the threaded runtime. Please recompile with -threaded." 79 | runInBoundThread $ do 80 | -- TODO(bbaren): Assert that the error queue is clear 81 | r <- f 82 | if r == 1 83 | then Right <$> return () 84 | else Left <$> unfoldM dequeueError 85 | 86 | uncurry5 :: (a -> b -> c -> d -> e -> z) -> (a, b, c, d, e) -> z 87 | uncurry5 f (a, b, c, d, e) = f a b c d e 88 | -------------------------------------------------------------------------------- /src/BTLS/Show.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.Show where 16 | 17 | import Data.ByteString (ByteString) 18 | import qualified Data.ByteString.Base16 as ByteString.Base16 19 | import qualified Data.ByteString.Char8 as ByteString.Char8 20 | 21 | showHex :: ByteString -> String 22 | showHex = ByteString.Char8.unpack . ByteString.Base16.encode 23 | -------------------------------------------------------------------------------- /src/BTLS/Types.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.Types where 16 | 17 | import Foreign (Ptr) 18 | 19 | import BTLS.BoringSSL.Base (EVPMD) 20 | import BTLS.BoringSSL.Digest (evpMDType) 21 | import BTLS.BoringSSL.Obj (objNID2SN) 22 | 23 | -- | A cryptographic hash function. 24 | newtype Algorithm = Algorithm (Ptr EVPMD) 25 | 26 | instance Eq Algorithm where 27 | Algorithm a == Algorithm b = evpMDType a == evpMDType b 28 | 29 | instance Show Algorithm where 30 | show (Algorithm md) = maybe "" id (objNID2SN (evpMDType md)) 31 | -------------------------------------------------------------------------------- /src/Codec/Crypto/Encryption.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module Codec.Crypto.Encryption 16 | ( Cipher, blockSize 17 | , rc4 18 | , doCipher, lazyCipher, CipherParams(..) 19 | , CipherDirection(Encrypt, Decrypt) 20 | 21 | -- * Error handling 22 | , Error 23 | ) where 24 | 25 | import Control.Monad.Trans.Except (ExceptT, runExceptT) 26 | import Data.ByteString (ByteString) 27 | import qualified Data.ByteString as ByteString 28 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 29 | import qualified Data.ByteString.Lazy as ByteString.Lazy 30 | import Foreign (ForeignPtr, Ptr, nullPtr) 31 | import Foreign.C.Types 32 | import Foreign.Marshal.Unsafe (unsafeLocalState) 33 | import System.IO.Unsafe (unsafeInterleaveIO) 34 | 35 | import BTLS.BoringSSL.Base (EVPCipher, EVPCipherCtx, noEngine) 36 | import BTLS.BoringSSL.Cipher 37 | import BTLS.BoringSSL.Obj (objNID2SN) 38 | import BTLS.Buffer (onBufferOfMaxSize', unsafeUseAsCBuffer) 39 | import BTLS.Result (Error, check) 40 | 41 | -- | A cipher. 42 | newtype Cipher = Cipher (Ptr EVPCipher) 43 | 44 | instance Eq Cipher where 45 | Cipher a == Cipher b = evpCipherNID a == evpCipherNID b 46 | 47 | instance Show Cipher where 48 | show (Cipher c) = maybe "" id (objNID2SN (evpCipherNID c)) 49 | 50 | blockSize :: Cipher -> Int 51 | blockSize (Cipher c) = evpCipherBlockSize c 52 | 53 | rc4 :: Cipher 54 | rc4 = Cipher evpRC4 55 | 56 | data CipherParams = CipherParams 57 | { cipher :: Cipher 58 | , secretKey :: ByteString 59 | , iv :: ByteString 60 | , direction :: CipherDirection 61 | } deriving (Eq, Show) 62 | 63 | -- | Performs an encryption or decryption operation. 64 | doCipher :: CipherParams -> Lazy.ByteString -> Either [Error] ByteString 65 | doCipher params plaintext = mconcat <$> sequence (lazyCipher params plaintext) 66 | 67 | lazyCipher :: CipherParams -> Lazy.ByteString -> [Either [Error] ByteString] 68 | lazyCipher params plaintext = 69 | unsafeLocalState $ do 70 | ctx <- mallocEVPCipherCtx 71 | -- TODO(bbaren): Do 'key params' and 'iv params' need to remain live past 72 | -- initialization? If not, we could move these 'unsafeUseAsCBuffer's into 73 | -- 'initializeCipherCtx'. 74 | unsafeUseAsCBuffer (secretKey params) $ \(pKey, keyLen) -> 75 | unsafeUseAsCBuffer (iv params) $ \(pIV, _ivLen) -> do 76 | -- TODO(bbaren): Validate key and IV length. 77 | initializeResult <- runExceptT $ 78 | initializeCipherCtx ctx params (pKey, keyLen) pIV 79 | case initializeResult of 80 | Left e -> return [Left e] 81 | Right () -> 82 | cipherChunks ctx (cipher params) (ByteString.Lazy.toChunks plaintext) 83 | 84 | -- | Initializes a cipher context and sets the key length. 85 | initializeCipherCtx :: 86 | ForeignPtr EVPCipherCtx 87 | -> CipherParams 88 | -> (Ptr CUChar, Int) 89 | -> Ptr CUChar 90 | -> ExceptT [Error] IO () 91 | initializeCipherCtx ctx params (pKey, keyLen) pIV = do 92 | let Cipher pCipher = cipher params 93 | engine = noEngine 94 | -- This function deals with a catch-22: We can't call 95 | -- 'evpCipherCtxSetKeyLength' on an uninitialized 'EVPCipherCtx', but 96 | -- 'evpCipherInitEx' requires a key of @keyLength cipher@ in length. 97 | -- Fortunately, @EVP_CipherInit_ex@'s documentation says that "If ctx has been 98 | -- previously configured with a cipher then cipher, key and iv may be NULL 99 | -- [...] to reuse the previous values." So first, we call 'evpCipherInitEx' 100 | -- with a dummy key (@NULL@); then, we set the key length; and finally, we 101 | -- reload 'ctx' with the actual key. 102 | check $ evpCipherInitEx ctx pCipher engine dummyKey pIV (direction params) 103 | check $ evpCipherCtxSetKeyLength ctx keyLen 104 | check $ evpCipherInitEx ctx reuseCipher engine pKey reuseIV ReuseDirection 105 | where dummyKey = nullPtr 106 | reuseCipher = nullPtr 107 | reuseIV = nullPtr 108 | 109 | -- | Lazily performs a cipher operation on 'chunks'. The operation will stop 110 | -- when all chunks have been ciphered or at the first error. 111 | cipherChunks :: 112 | ForeignPtr EVPCipherCtx 113 | -> Cipher 114 | -> [ByteString] 115 | -> IO [Either [Error] ByteString] 116 | cipherChunks ctx cipher = loop 117 | where loop (x:xs) = do 118 | y <- cipherChunk ctx cipher x 119 | case y of 120 | e@(Left _) -> return [e] -- Encrypting the chunk failed, so give up. 121 | Right _ -> do 122 | ys <- unsafeInterleaveIO (loop xs) -- Lazily keep encrypting. 123 | return (y : ys) 124 | loop [] = do 125 | -- Grab any remaining data. 126 | y <- onBufferOfMaxSize' (blockSize cipher) $ \pOut pOutLen -> 127 | check $ evpCipherFinalEx ctx pOut pOutLen 128 | return [y] 129 | 130 | cipherChunk :: 131 | ForeignPtr EVPCipherCtx 132 | -> Cipher 133 | -> ByteString 134 | -> IO (Either [Error] ByteString) 135 | cipherChunk ctx (Cipher pCipher) chunk = do 136 | let maxCiphertextLen = ByteString.length chunk + evpCipherBlockSize pCipher 137 | onBufferOfMaxSize' maxCiphertextLen $ \pOut pOutLen -> 138 | check $ evpCipherUpdate ctx pOut pOutLen chunk 139 | -------------------------------------------------------------------------------- /src/Codec/Crypto/HKDF.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-| 16 | Module: Codec.Crypto.HKDF 17 | Description: Hash-based key derivation 18 | Copyright: 2018 Google LLC 19 | License: Apache License, version 2.0 20 | 21 | The hash-based key derivation function (HKDF), as specified in 22 | [RFC 5869](https://tools.ietf.org/html/rfc5869). 23 | -} 24 | module Codec.Crypto.HKDF 25 | ( -- * Computing keys 26 | hkdf, HKDFParams(..) 27 | , extract, ExtractParams(..) 28 | , expand, ExpandParams(..) 29 | 30 | -- * Cryptographic hash algorithms 31 | , Algorithm 32 | , sha1 33 | 34 | -- ** SHA-2 family 35 | -- | The SHA-2 family of hash functions is defined in 36 | -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). 37 | , sha224, sha256, sha384, sha512 38 | 39 | -- * Error handling 40 | , Error 41 | 42 | -- * Legacy functions 43 | , md5 44 | ) where 45 | 46 | import Control.Monad ((>=>)) 47 | import Control.Monad.Trans.Class (lift) 48 | import Control.Monad.Trans.Except (runExceptT) 49 | import Data.ByteString (ByteString) 50 | import Foreign (allocaArray) 51 | import Foreign.Marshal.Unsafe (unsafeLocalState) 52 | 53 | import BTLS.BoringSSL.Digest (evpMaxMDSize) 54 | import BTLS.BoringSSL.HKDF 55 | import BTLS.Buffer (onBufferOfMaxSize', packCUStringLen) 56 | import BTLS.Result (Error, check) 57 | import BTLS.Types (Algorithm(Algorithm)) 58 | import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) 59 | 60 | -- | Computes an HKDF. It is defined as the composition of 'extract' and 61 | -- 'expand' but may be faster than calling the two functions individually. 62 | hkdf :: HKDFParams -> ByteString -> Either [Error] ByteString 63 | hkdf (HKDFParams md salt info outLen) = 64 | extract (ExtractParams md salt) >=> expand (ExpandParams md info outLen) 65 | 66 | data HKDFParams = HKDFParams 67 | { algorithm :: Algorithm 68 | , salt :: ByteString 69 | , associatedData :: ByteString 70 | , secretLen :: Int 71 | } deriving (Eq, Show) 72 | 73 | -- | Computes an HKDF pseudorandom key (PRK). 74 | extract :: ExtractParams -> ByteString -> Either [Error] ByteString 75 | extract (ExtractParams (Algorithm md) salt) secret = 76 | unsafeLocalState $ 77 | onBufferOfMaxSize' evpMaxMDSize $ \pOutKey pOutLen -> 78 | check $ hkdfExtract pOutKey pOutLen md secret salt 79 | 80 | data ExtractParams = ExtractParams 81 | { extractAlgorithm :: Algorithm 82 | , extractSalt :: ByteString 83 | } deriving (Eq, Show) 84 | 85 | -- | Computes HKDF output key material (OKM). 86 | expand :: ExpandParams -> ByteString -> Either [Error] ByteString 87 | expand (ExpandParams (Algorithm md) info outLen) secret = 88 | unsafeLocalState $ 89 | allocaArray outLen $ \pOutKey -> runExceptT $ do 90 | check $ hkdfExpand pOutKey outLen md secret info 91 | lift $ packCUStringLen (pOutKey, outLen) 92 | 93 | data ExpandParams = ExpandParams 94 | { expandAlgorithm :: Algorithm 95 | , expandAssociatedData :: ByteString 96 | , expandSecretLen :: Int 97 | } deriving (Eq, Show) 98 | -------------------------------------------------------------------------------- /src/Data/Digest.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-| 16 | Module: Data.Digest 17 | Description: Cryptographic hash functions 18 | Copyright: 2017 Google LLC 19 | License: Apache License, version 2.0 20 | 21 | Cryptographic hash functions. 22 | -} 23 | module Data.Digest 24 | ( -- * Computing digests 25 | Digest(Digest) 26 | , hash 27 | 28 | -- * Digest algorithms 29 | , Algorithm 30 | 31 | -- ** SHA-2 family 32 | -- | The SHA-2 family of hash functions is defined in 33 | -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). 34 | , sha224, sha256, sha384, sha512 35 | 36 | -- * Legacy functions 37 | , md5 38 | , sha1 39 | ) where 40 | 41 | import Data.ByteString (ByteString) 42 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 43 | import qualified Data.ByteString.Lazy as ByteString.Lazy 44 | import Foreign.Marshal.Unsafe (unsafeLocalState) 45 | 46 | import BTLS.BoringSSL.Base 47 | import BTLS.BoringSSL.Digest 48 | import BTLS.Buffer (onBufferOfMaxSize) 49 | import BTLS.Show (showHex) 50 | import BTLS.Types (Algorithm(Algorithm)) 51 | 52 | -- | The result of a hash operation. Equality comparisons on this type are 53 | -- variable-time. 54 | -- 55 | -- The 'Show' instance for this type displays the digest as a hexadecimal string. 56 | newtype Digest = Digest ByteString 57 | deriving (Eq, Ord) 58 | 59 | instance Show Digest where 60 | show (Digest d) = showHex d 61 | 62 | -- | Message Digest 5, a 128-bit digest defined in 63 | -- [RFC 1321](https://tools.ietf.org/html/rfc1321). This algorithm is 64 | -- cryptographically broken; do not use it except to interface with legacy 65 | -- applications. 66 | md5 :: Algorithm 67 | md5 = Algorithm evpMD5 68 | 69 | -- | Secure Hash Algorithm 1, a 160-bit digest defined in 70 | -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). 71 | -- Hashing with this algorithm is cryptographically broken, although 72 | -- constructing HMACs with it is safe. 73 | sha1 :: Algorithm 74 | sha1 = Algorithm evpSHA1 75 | 76 | -- | The SHA224 digest, a 224-bit digest and Secure Hash Algorithm 2 family 77 | -- member. 78 | sha224 :: Algorithm 79 | sha224 = Algorithm evpSHA224 80 | 81 | -- | The SHA256 digest, a 256-bit digest and Secure Hash Algorithm 2 family 82 | -- member. Prefer this algorithm on 32-bit CPUs; it will run faster than 83 | -- 'sha384' or 'sha512'. 84 | sha256 :: Algorithm 85 | sha256 = Algorithm evpSHA256 86 | 87 | -- | The SHA384 digest, a 384-bit digest and Secure Hash Algorithm 2 family 88 | -- member. 89 | sha384 :: Algorithm 90 | sha384 = Algorithm evpSHA384 91 | 92 | -- | The SHA512 digest, a 512-bit digest and Secure Hash Algorithm 2 family 93 | -- member. Prefer this algorithm on 64-bit CPUs; it will run faster than 94 | -- 'sha224' or 'sha256'. 95 | sha512 :: Algorithm 96 | sha512 = Algorithm evpSHA512 97 | 98 | -- | Hashes according to the given 'Algorithm'. 99 | hash :: Algorithm -> Lazy.ByteString -> Digest 100 | hash (Algorithm md) bytes = 101 | unsafeLocalState $ do 102 | ctx <- mallocEVPMDCtx 103 | evpDigestInitEx ctx md noEngine 104 | mapM_ (evpDigestUpdate ctx) (ByteString.Lazy.toChunks bytes) 105 | Digest <$> onBufferOfMaxSize evpMaxMDSize (evpDigestFinalEx ctx) 106 | -------------------------------------------------------------------------------- /src/Data/HMAC.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-| 16 | Module: Data.HMAC 17 | Description: Hash-based message authentication codes 18 | Copyright: 2018 Google LLC 19 | License: Apache License, version 2.0 20 | 21 | Hash-based message authentication codes (HMACs). An HMAC guarantees 22 | authenticity but not confidentiality. 23 | -} 24 | module Data.HMAC 25 | ( -- * Computing HMACs 26 | HMAC(HMAC) 27 | , hmac, HMACParams(..) 28 | 29 | -- * Cryptographic hash algorithms 30 | , Algorithm 31 | , sha1 32 | 33 | -- ** SHA-2 family 34 | -- | The SHA-2 family of hash functions is defined in 35 | -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). 36 | , sha224, sha256, sha384, sha512 37 | 38 | -- * Error handling 39 | , Error 40 | 41 | -- * Legacy functions 42 | , md5 43 | ) where 44 | 45 | import Control.Monad.Trans.Class (lift) 46 | import Control.Monad.Trans.Except (runExceptT) 47 | import Data.ByteString (ByteString) 48 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 49 | import qualified Data.ByteString.Lazy as ByteString.Lazy 50 | import qualified Data.ByteString.Unsafe as ByteString 51 | import Foreign.Marshal.Unsafe (unsafeLocalState) 52 | 53 | import BTLS.BoringSSL.Base 54 | import BTLS.BoringSSL.Digest (evpMaxMDSize) 55 | import BTLS.BoringSSL.HMAC 56 | import BTLS.BoringSSL.Mem (cryptoMemcmp) 57 | import BTLS.Buffer (onBufferOfMaxSize) 58 | import BTLS.Result (Error, check) 59 | import BTLS.Show (showHex) 60 | import BTLS.Types (Algorithm(Algorithm)) 61 | import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) 62 | 63 | -- | A hash-based message authentication code. Equality comparisons on this type 64 | -- are constant-time. 65 | newtype HMAC = HMAC ByteString 66 | 67 | instance Eq HMAC where 68 | (HMAC a) == (HMAC b) = 69 | unsafeLocalState $ 70 | ByteString.unsafeUseAsCStringLen a $ \(a', size) -> 71 | ByteString.unsafeUseAsCStringLen b $ \(b', _) -> 72 | (==0) <$> cryptoMemcmp a' b' size 73 | 74 | instance Show HMAC where 75 | show (HMAC m) = showHex m 76 | 77 | -- | Creates an HMAC. 78 | hmac :: HMACParams -> Lazy.ByteString -> Either [Error] HMAC 79 | hmac (HMACParams (Algorithm md) key) bytes = 80 | unsafeLocalState $ runExceptT $ do 81 | ctx <- lift mallocHMACCtx 82 | check $ hmacInitEx ctx key md noEngine 83 | lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes) 84 | lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx) 85 | 86 | data HMACParams = HMACParams 87 | { algorithm :: Algorithm 88 | , secretKey :: ByteString 89 | } deriving (Eq, Show) 90 | -------------------------------------------------------------------------------- /src/System/Random/Crypto.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-| 16 | Module: System.Random.Crypto 17 | Description: Cryptographically secure pseudorandom number generator 18 | Copyright: 2018 Google LLC 19 | License: Apache License, version 2.0 20 | -} 21 | module System.Random.Crypto 22 | ( randomBytes 23 | ) where 24 | 25 | import Data.ByteString (ByteString) 26 | import Foreign (allocaArray) 27 | 28 | import BTLS.BoringSSL.Rand (randBytes) 29 | import BTLS.Buffer (packCUStringLen) 30 | 31 | -- | Generates a cryptographically random buffer of the specified size (in 32 | -- bytes). 33 | randomBytes :: Int -> IO ByteString 34 | randomBytes len = 35 | allocaArray len $ \pBuf -> do 36 | randBytes pBuf len 37 | packCUStringLen (pBuf, len) 38 | -------------------------------------------------------------------------------- /tests/BTLS/Assertions.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module BTLS.Assertions 16 | ( isRightAndHolds 17 | ) where 18 | 19 | import Control.Monad (unless) 20 | import Test.Tasty.HUnit (Assertion, assertFailure) 21 | 22 | isRightAndHolds :: (Eq a, Show a, Show e) => Either e a -> a -> Assertion 23 | actual@(Left _) `isRightAndHolds` _ = 24 | assertFailure ("expected: Right _\n but got: " ++ show actual) 25 | Right actual `isRightAndHolds` expected = 26 | unless (expected == actual) $ 27 | assertFailure ("expected: Right " ++ show expected ++ "\n but got: Right " ++ show actual) 28 | -------------------------------------------------------------------------------- /tests/BTLS/TestUtilities.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module BTLS.TestUtilities 18 | ( abbreviate 19 | , hex 20 | , showHex 21 | ) where 22 | 23 | import qualified Data.ByteString.Base16 as Base16 24 | import qualified Data.ByteString.Base16.Lazy as L.Base16 25 | import Data.ByteString.Char8 (ByteString, unpack) 26 | import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString) 27 | import qualified Data.ByteString.Lazy.Char8 as L 28 | import Data.Char (isAscii, isPrint) 29 | import Data.Int (Int64) 30 | 31 | abbreviate :: Lazy.ByteString -> String 32 | abbreviate input = 33 | let maxLen = 22 in 34 | if L.all isShowable (L.take (maxLen - 2) input) 35 | then show (addEllipsisIfNecessary (maxLen - 2) input) 36 | else L.unpack (addEllipsisIfNecessary maxLen (L.Base16.encode input)) 37 | where isShowable c = isAscii c && isPrint c 38 | 39 | addEllipsisIfNecessary :: Int64 -> Lazy.ByteString -> Lazy.ByteString 40 | addEllipsisIfNecessary maxLen s = 41 | let ellipsis = "..." 42 | ellipsisLen = L.length ellipsis 43 | (x, y) = L.splitAt (maxLen - ellipsisLen) s in 44 | x `L.append` if L.length y <= ellipsisLen then y else ellipsis 45 | 46 | hex :: ByteString -> ByteString 47 | hex s = 48 | case Base16.decode s of 49 | (r, "") -> r 50 | _ -> error $ "invalid hex string " ++ unpack s 51 | 52 | showHex :: ByteString -> String 53 | showHex = unpack . Base16.encode 54 | -------------------------------------------------------------------------------- /tests/Codec/Crypto/EncryptionTests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Codec.Crypto.EncryptionTests (tests) where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString as ByteString 21 | import qualified Data.ByteString.Lazy as ByteString.Lazy 22 | import Test.Tasty (TestTree, testGroup) 23 | import Test.Tasty.HUnit ((@?), Assertion, assertFailure, testCase) 24 | 25 | import BTLS.TestUtilities (hex, showHex) 26 | import Codec.Crypto.Encryption 27 | (CipherDirection(Encrypt), CipherParams(..), Error, doCipher, rc4) 28 | 29 | tests :: TestTree 30 | tests = testGroup "Codec.Crypto.Encryption" [testRFC6229] 31 | 32 | -- | Tests from RFC 6229. 33 | testRFC6229 = testGroup "RFC 6229 examples (RC4)" 34 | [ index40, index56, index64, index80, index128, index192, index256 35 | , ietf40, ietf56, ietf64, ietf80, ietf128, ietf192, ietf256 ] 36 | where 37 | rc4WithKey key = doCipher 38 | CipherParams { cipher = rc4 39 | , secretKey = hex key 40 | , iv = "" 41 | , direction = Encrypt } 42 | (ByteString.Lazy.replicate 0x1010 0) 43 | index40 = testGroup "index40" $ 44 | let ciphertext = rc4WithKey "0102030405" in 45 | [ indexCheckTestCase 0x0000 (hex "b2396305f03dc027ccc3524a0a1118a8") ciphertext 46 | , indexCheckTestCase 0x0010 (hex "6982944f18fc82d589c403a47a0d0919") ciphertext 47 | , indexCheckTestCase 0x00f0 (hex "28cb1132c96ce286421dcaadb8b69eae") ciphertext 48 | , indexCheckTestCase 0x0100 (hex "1cfcf62b03eddb641d77dfcf7f8d8c93") ciphertext 49 | , indexCheckTestCase 0x01f0 (hex "42b7d0cdd918a8a33dd51781c81f4041") ciphertext 50 | , indexCheckTestCase 0x0200 (hex "6459844432a7da923cfb3eb4980661f6") ciphertext 51 | , indexCheckTestCase 0x02f0 (hex "ec10327bde2beefd18f9277680457e22") ciphertext 52 | , indexCheckTestCase 0x0300 (hex "eb62638d4f0ba1fe9fca20e05bf8ff2b") ciphertext 53 | , indexCheckTestCase 0x03f0 (hex "45129048e6a0ed0b56b490338f078da5") ciphertext 54 | , indexCheckTestCase 0x0400 (hex "30abbcc7c20b01609f23ee2d5f6bb7df") ciphertext 55 | , indexCheckTestCase 0x05f0 (hex "3294f744d8f9790507e70f62e5bbceea") ciphertext 56 | , indexCheckTestCase 0x0600 (hex "d8729db41882259bee4f825325f5a130") ciphertext 57 | , indexCheckTestCase 0x07f0 (hex "1eb14a0c13b3bf47fa2a0ba93ad45b8b") ciphertext 58 | , indexCheckTestCase 0x0800 (hex "cc582f8ba9f265e2b1be9112e975d2d7") ciphertext 59 | , indexCheckTestCase 0x0bf0 (hex "f2e30f9bd102ecbf75aaade9bc35c43c") ciphertext 60 | , indexCheckTestCase 0x0c00 (hex "ec0e11c479dc329dc8da7968fe965681") ciphertext 61 | , indexCheckTestCase 0x0ff0 (hex "068326a2118416d21f9d04b2cd1ca050") ciphertext 62 | , indexCheckTestCase 0x1000 (hex "ff25b58995996707e51fbdf08b34d875") ciphertext ] 63 | index56 = testGroup "index56" $ 64 | let ciphertext = rc4WithKey "01020304050607" in 65 | [ indexCheckTestCase 0x0000 (hex "293f02d47f37c9b633f2af5285feb46b") ciphertext 66 | , indexCheckTestCase 0x0010 (hex "e620f1390d19bd84e2e0fd752031afc1") ciphertext 67 | , indexCheckTestCase 0x00f0 (hex "914f02531c9218810df60f67e338154c") ciphertext 68 | , indexCheckTestCase 0x0100 (hex "d0fdb583073ce85ab83917740ec011d5") ciphertext 69 | , indexCheckTestCase 0x01f0 (hex "75f81411e871cffa70b90c74c592e454") ciphertext 70 | , indexCheckTestCase 0x0200 (hex "0bb87202938dad609e87a5a1b079e5e4") ciphertext 71 | , indexCheckTestCase 0x02f0 (hex "c2911246b612e7e7b903dfeda1dad866") ciphertext 72 | , indexCheckTestCase 0x0300 (hex "32828f91502b6291368de8081de36fc2") ciphertext 73 | , indexCheckTestCase 0x03f0 (hex "f3b9a7e3b297bf9ad804512f9063eff1") ciphertext 74 | , indexCheckTestCase 0x0400 (hex "8ecb67a9ba1f55a5a067e2b026a3676f") ciphertext 75 | , indexCheckTestCase 0x05f0 (hex "d2aa902bd42d0d7cfd340cd45810529f") ciphertext 76 | , indexCheckTestCase 0x0600 (hex "78b272c96e42eab4c60bd914e39d06e3") ciphertext 77 | , indexCheckTestCase 0x07f0 (hex "f4332fd31a079396ee3cee3f2a4ff049") ciphertext 78 | , indexCheckTestCase 0x0800 (hex "05459781d41fda7f30c1be7e1246c623") ciphertext 79 | , indexCheckTestCase 0x0bf0 (hex "adfd3868b8e51485d5e610017e3dd609") ciphertext 80 | , indexCheckTestCase 0x0c00 (hex "ad26581c0c5be45f4cea01db2f3805d5") ciphertext 81 | , indexCheckTestCase 0x0ff0 (hex "f3172ceffc3b3d997c85ccd5af1a950c") ciphertext 82 | , indexCheckTestCase 0x1000 (hex "e74b0b9731227fd37c0ec08a47ddd8b8") ciphertext ] 83 | index64 = testGroup "index64" $ 84 | let ciphertext = rc4WithKey "0102030405060708" in 85 | [ indexCheckTestCase 0x0000 (hex "97ab8a1bf0afb96132f2f67258da15a8") ciphertext 86 | , indexCheckTestCase 0x0010 (hex "8263efdb45c4a18684ef87e6b19e5b09") ciphertext 87 | , indexCheckTestCase 0x00f0 (hex "9636ebc9841926f4f7d1f362bddf6e18") ciphertext 88 | , indexCheckTestCase 0x0100 (hex "d0a990ff2c05fef5b90373c9ff4b870a") ciphertext 89 | , indexCheckTestCase 0x01f0 (hex "73239f1db7f41d80b643c0c52518ec63") ciphertext 90 | , indexCheckTestCase 0x0200 (hex "163b319923a6bdb4527c626126703c0f") ciphertext 91 | , indexCheckTestCase 0x02f0 (hex "49d6c8af0f97144a87df21d91472f966") ciphertext 92 | , indexCheckTestCase 0x0300 (hex "44173a103b6616c5d5ad1cee40c863d0") ciphertext 93 | , indexCheckTestCase 0x03f0 (hex "273c9c4b27f322e4e716ef53a47de7a4") ciphertext 94 | , indexCheckTestCase 0x0400 (hex "c6d0e7b226259fa9023490b26167ad1d") ciphertext 95 | , indexCheckTestCase 0x05f0 (hex "1fe8986713f07c3d9ae1c163ff8cf9d3") ciphertext 96 | , indexCheckTestCase 0x0600 (hex "8369e1a965610be887fbd0c79162aafb") ciphertext 97 | , indexCheckTestCase 0x07f0 (hex "0a0127abb44484b9fbef5abcae1b579f") ciphertext 98 | , indexCheckTestCase 0x0800 (hex "c2cdadc6402e8ee866e1f37bdb47e42c") ciphertext 99 | , indexCheckTestCase 0x0bf0 (hex "26b51ea37df8e1d6f76fc3b66a7429b3") ciphertext 100 | , indexCheckTestCase 0x0c00 (hex "bc7683205d4f443dc1f29dda3315c87b") ciphertext 101 | , indexCheckTestCase 0x0ff0 (hex "d5fa5a3469d29aaaf83d23589db8c85b") ciphertext 102 | , indexCheckTestCase 0x1000 (hex "3fb46e2c8f0f068edce8cdcd7dfc5862") ciphertext ] 103 | index80 = testGroup "index80" $ 104 | let ciphertext = rc4WithKey "0102030405060708090a" in 105 | [ indexCheckTestCase 0x0000 (hex "ede3b04643e586cc907dc21851709902") ciphertext 106 | , indexCheckTestCase 0x0010 (hex "03516ba78f413beb223aa5d4d2df6711") ciphertext 107 | , indexCheckTestCase 0x00f0 (hex "3cfd6cb58ee0fdde640176ad0000044d") ciphertext 108 | , indexCheckTestCase 0x0100 (hex "48532b21fb6079c9114c0ffd9c04a1ad") ciphertext 109 | , indexCheckTestCase 0x01f0 (hex "3e8cea98017109979084b1ef92f99d86") ciphertext 110 | , indexCheckTestCase 0x0200 (hex "e20fb49bdb337ee48b8d8dc0f4afeffe") ciphertext 111 | , indexCheckTestCase 0x02f0 (hex "5c2521eacd7966f15e056544bea0d315") ciphertext 112 | , indexCheckTestCase 0x0300 (hex "e067a7031931a246a6c3875d2f678acb") ciphertext 113 | , indexCheckTestCase 0x03f0 (hex "a64f70af88ae56b6f87581c0e23e6b08") ciphertext 114 | , indexCheckTestCase 0x0400 (hex "f449031de312814ec6f319291f4a0516") ciphertext 115 | , indexCheckTestCase 0x05f0 (hex "bdae85924b3cb1d0a2e33a30c6d79599") ciphertext 116 | , indexCheckTestCase 0x0600 (hex "8a0feddbac865a09bcd127fb562ed60a") ciphertext 117 | , indexCheckTestCase 0x07f0 (hex "b55a0a5b51a12a8be34899c3e047511a") ciphertext 118 | , indexCheckTestCase 0x0800 (hex "d9a09cea3ce75fe39698070317a71339") ciphertext 119 | , indexCheckTestCase 0x0bf0 (hex "552225ed1177f44584ac8cfa6c4eb5fc") ciphertext 120 | , indexCheckTestCase 0x0c00 (hex "7e82cbabfc95381b080998442129c2f8") ciphertext 121 | , indexCheckTestCase 0x0ff0 (hex "1f135ed14ce60a91369d2322bef25e3c") ciphertext 122 | , indexCheckTestCase 0x1000 (hex "08b6be45124a43e2eb77953f84dc8553") ciphertext ] 123 | index128 = testGroup "index128" $ 124 | let ciphertext = rc4WithKey "0102030405060708090a0b0c0d0e0f10" in 125 | [ indexCheckTestCase 0x0000 (hex "9ac7cc9a609d1ef7b2932899cde41b97") ciphertext 126 | , indexCheckTestCase 0x0010 (hex "5248c4959014126a6e8a84f11d1a9e1c") ciphertext 127 | , indexCheckTestCase 0x00f0 (hex "065902e4b620f6cc36c8589f66432f2b") ciphertext 128 | , indexCheckTestCase 0x0100 (hex "d39d566bc6bce3010768151549f3873f") ciphertext 129 | , indexCheckTestCase 0x01f0 (hex "b6d1e6c4a5e4771cad79538df295fb11") ciphertext 130 | , indexCheckTestCase 0x0200 (hex "c68c1d5c559a974123df1dbc52a43b89") ciphertext 131 | , indexCheckTestCase 0x02f0 (hex "c5ecf88de897fd57fed301701b82a259") ciphertext 132 | , indexCheckTestCase 0x0300 (hex "eccbe13de1fcc91c11a0b26c0bc8fa4d") ciphertext 133 | , indexCheckTestCase 0x03f0 (hex "e7a72574f8782ae26aabcf9ebcd66065") ciphertext 134 | , indexCheckTestCase 0x0400 (hex "bdf0324e6083dcc6d3cedd3ca8c53c16") ciphertext 135 | , indexCheckTestCase 0x05f0 (hex "b40110c4190b5622a96116b0017ed297") ciphertext 136 | , indexCheckTestCase 0x0600 (hex "ffa0b514647ec04f6306b892ae661181") ciphertext 137 | , indexCheckTestCase 0x07f0 (hex "d03d1bc03cd33d70dff9fa5d71963ebd") ciphertext 138 | , indexCheckTestCase 0x0800 (hex "8a44126411eaa78bd51e8d87a8879bf5") ciphertext 139 | , indexCheckTestCase 0x0bf0 (hex "fabeb76028ade2d0e48722e46c4615a3") ciphertext 140 | , indexCheckTestCase 0x0c00 (hex "c05d88abd50357f935a63c59ee537623") ciphertext 141 | , indexCheckTestCase 0x0ff0 (hex "ff38265c1642c1abe8d3c2fe5e572bf8") ciphertext 142 | , indexCheckTestCase 0x1000 (hex "a36a4c301ae8ac13610ccbc12256cacc") ciphertext ] 143 | index192 = testGroup "index192" $ 144 | let ciphertext = rc4WithKey "0102030405060708090a0b0c0d0e0f101112131415161718" in 145 | [ indexCheckTestCase 0x0000 (hex "0595e57fe5f0bb3c706edac8a4b2db11") ciphertext 146 | , indexCheckTestCase 0x0010 (hex "dfde31344a1af769c74f070aee9e2326") ciphertext 147 | , indexCheckTestCase 0x00f0 (hex "b06b9b1e195d13d8f4a7995c4553ac05") ciphertext 148 | , indexCheckTestCase 0x0100 (hex "6bd2378ec341c9a42f37ba79f88a32ff") ciphertext 149 | , indexCheckTestCase 0x01f0 (hex "e70bce1df7645adb5d2c4130215c3522") ciphertext 150 | , indexCheckTestCase 0x0200 (hex "9a5730c7fcb4c9af51ffda89c7f1ad22") ciphertext 151 | , indexCheckTestCase 0x02f0 (hex "0485055fd4f6f0d963ef5ab9a5476982") ciphertext 152 | , indexCheckTestCase 0x0300 (hex "591fc66bcda10e452b03d4551f6b62ac") ciphertext 153 | , indexCheckTestCase 0x03f0 (hex "2753cc83988afa3e1688a1d3b42c9a02") ciphertext 154 | , indexCheckTestCase 0x0400 (hex "93610d523d1d3f0062b3c2a3bbc7c7f0") ciphertext 155 | , indexCheckTestCase 0x05f0 (hex "96c248610aadedfeaf8978c03de8205a") ciphertext 156 | , indexCheckTestCase 0x0600 (hex "0e317b3d1c73b9e9a4688f296d133a19") ciphertext 157 | , indexCheckTestCase 0x07f0 (hex "bdf0e6c3cca5b5b9d533b69c56ada120") ciphertext 158 | , indexCheckTestCase 0x0800 (hex "88a218b6e2ece1e6246d44c759d19b10") ciphertext 159 | , indexCheckTestCase 0x0bf0 (hex "6866397e95c140534f94263421006e40") ciphertext 160 | , indexCheckTestCase 0x0c00 (hex "32cb0a1e9542c6b3b8b398abc3b0f1d5") ciphertext 161 | , indexCheckTestCase 0x0ff0 (hex "29a0b8aed54a132324c62e423f54b4c8") ciphertext 162 | , indexCheckTestCase 0x1000 (hex "3cb0f3b5020a98b82af9fe154484a168") ciphertext ] 163 | index256 = testGroup "index256" $ 164 | let ciphertext = rc4WithKey "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" in 165 | [ indexCheckTestCase 0x0000 (hex "eaa6bd25880bf93d3f5d1e4ca2611d91") ciphertext 166 | , indexCheckTestCase 0x0010 (hex "cfa45c9f7e714b54bdfa80027cb14380") ciphertext 167 | , indexCheckTestCase 0x00f0 (hex "114ae344ded71b35f2e60febad727fd8") ciphertext 168 | , indexCheckTestCase 0x0100 (hex "02e1e7056b0f623900496422943e97b6") ciphertext 169 | , indexCheckTestCase 0x01f0 (hex "91cb93c787964e10d9527d999c6f936b") ciphertext 170 | , indexCheckTestCase 0x0200 (hex "49b18b42f8e8367cbeb5ef104ba1c7cd") ciphertext 171 | , indexCheckTestCase 0x02f0 (hex "87084b3ba700bade955610672745b374") ciphertext 172 | , indexCheckTestCase 0x0300 (hex "e7a7b9e9ec540d5ff43bdb12792d1b35") ciphertext 173 | , indexCheckTestCase 0x03f0 (hex "c799b596738f6b018c76c74b1759bd90") ciphertext 174 | , indexCheckTestCase 0x0400 (hex "7fec5bfd9f9b89ce6548309092d7e958") ciphertext 175 | , indexCheckTestCase 0x05f0 (hex "40f250b26d1f096a4afd4c340a588815") ciphertext 176 | , indexCheckTestCase 0x0600 (hex "3e34135c79db010200767651cf263073") ciphertext 177 | , indexCheckTestCase 0x07f0 (hex "f656abccf88dd827027b2ce917d464ec") ciphertext 178 | , indexCheckTestCase 0x0800 (hex "18b62503bfbc077fbabb98f20d98ab34") ciphertext 179 | , indexCheckTestCase 0x0bf0 (hex "8aed95ee5b0dcbfbef4eb21d3a3f52f9") ciphertext 180 | , indexCheckTestCase 0x0c00 (hex "625a1ab00ee39a5327346bddb01a9c18") ciphertext 181 | , indexCheckTestCase 0x0ff0 (hex "a13a7c79c7e119b5ab0296ab28c300b9") ciphertext 182 | , indexCheckTestCase 0x1000 (hex "f3e4c0a2e02d1d01f7f0a74618af2b48") ciphertext ] 183 | ietf40 = testGroup "ietf40" $ 184 | let ciphertext = rc4WithKey "833222772a" in 185 | [ indexCheckTestCase 0x0000 (hex "80ad97bdc973df8a2e879e92a497efda") ciphertext 186 | , indexCheckTestCase 0x0010 (hex "20f060c2f2e5126501d3d4fea10d5fc0") ciphertext 187 | , indexCheckTestCase 0x00f0 (hex "faa148e99046181fec6b2085f3b20ed9") ciphertext 188 | , indexCheckTestCase 0x0100 (hex "f0daf5bab3d596839857846f73fbfe5a") ciphertext 189 | , indexCheckTestCase 0x01f0 (hex "1c7e2fc4639232fe297584b296996bc8") ciphertext 190 | , indexCheckTestCase 0x0200 (hex "3db9b249406cc8edffac55ccd322ba12") ciphertext 191 | , indexCheckTestCase 0x02f0 (hex "e4f9f7e0066154bbd125b745569bc897") ciphertext 192 | , indexCheckTestCase 0x0300 (hex "75d5ef262b44c41a9cf63ae14568e1b9") ciphertext 193 | , indexCheckTestCase 0x03f0 (hex "6da453dbf81e82334a3d8866cb50a1e3") ciphertext 194 | , indexCheckTestCase 0x0400 (hex "7828d074119cab5c22b294d7a9bfa0bb") ciphertext 195 | , indexCheckTestCase 0x05f0 (hex "adb89cea9a15fbe617295bd04b8ca05c") ciphertext 196 | , indexCheckTestCase 0x0600 (hex "6251d87fd4aaae9a7e4ad5c217d3f300") ciphertext 197 | , indexCheckTestCase 0x07f0 (hex "e7119bd6dd9b22afe8f89585432881e2") ciphertext 198 | , indexCheckTestCase 0x0800 (hex "785b60fd7ec4e9fcb6545f350d660fab") ciphertext 199 | , indexCheckTestCase 0x0bf0 (hex "afecc037fdb7b0838eb3d70bcd268382") ciphertext 200 | , indexCheckTestCase 0x0c00 (hex "dbc1a7b49d57358cc9fa6d61d73b7cf0") ciphertext 201 | , indexCheckTestCase 0x0ff0 (hex "6349d126a37afcba89794f9804914fdc") ciphertext 202 | , indexCheckTestCase 0x1000 (hex "bf42c3018c2f7c66bfde524975768115") ciphertext ] 203 | ietf56 = testGroup "ietf56" $ 204 | let ciphertext = rc4WithKey "1910833222772a" in 205 | [ indexCheckTestCase 0x0000 (hex "bc9222dbd3274d8fc66d14ccbda6690b") ciphertext 206 | , indexCheckTestCase 0x0010 (hex "7ae627410c9a2be693df5bb7485a63e3") ciphertext 207 | , indexCheckTestCase 0x00f0 (hex "3f0931aa03defb300f060103826f2a64") ciphertext 208 | , indexCheckTestCase 0x0100 (hex "beaa9ec8d59bb68129f3027c96361181") ciphertext 209 | , indexCheckTestCase 0x01f0 (hex "74e04db46d28648d7dee8a0064b06cfe") ciphertext 210 | , indexCheckTestCase 0x0200 (hex "9b5e81c62fe023c55be42f87bbf932b8") ciphertext 211 | , indexCheckTestCase 0x02f0 (hex "ce178fc1826efecbc182f57999a46140") ciphertext 212 | , indexCheckTestCase 0x0300 (hex "8bdf55cd55061c06dba6be11de4a578a") ciphertext 213 | , indexCheckTestCase 0x03f0 (hex "626f5f4dce652501f3087d39c92cc349") ciphertext 214 | , indexCheckTestCase 0x0400 (hex "42daac6a8f9ab9a7fd137c6037825682") ciphertext 215 | , indexCheckTestCase 0x05f0 (hex "cc03fdb79192a207312f53f5d4dc33d9") ciphertext 216 | , indexCheckTestCase 0x0600 (hex "f70f14122a1c98a3155d28b8a0a8a41d") ciphertext 217 | , indexCheckTestCase 0x07f0 (hex "2a3a307ab2708a9c00fe0b42f9c2d6a1") ciphertext 218 | , indexCheckTestCase 0x0800 (hex "862617627d2261eab0b1246597ca0ae9") ciphertext 219 | , indexCheckTestCase 0x0bf0 (hex "55f877ce4f2e1ddbbf8e13e2cde0fdc8") ciphertext 220 | , indexCheckTestCase 0x0c00 (hex "1b1556cb935f173337705fbb5d501fc1") ciphertext 221 | , indexCheckTestCase 0x0ff0 (hex "ecd0e96602be7f8d5092816cccf2c2e9") ciphertext 222 | , indexCheckTestCase 0x1000 (hex "027881fab4993a1c262024a94fff3f61") ciphertext ] 223 | ietf64 = testGroup "ietf64" $ 224 | let ciphertext = rc4WithKey "641910833222772a" in 225 | [ indexCheckTestCase 0x0000 (hex "bbf609de9413172d07660cb680716926") ciphertext 226 | , indexCheckTestCase 0x0010 (hex "46101a6dab43115d6c522b4fe93604a9") ciphertext 227 | , indexCheckTestCase 0x00f0 (hex "cbe1fff21c96f3eef61e8fe0542cbdf0") ciphertext 228 | , indexCheckTestCase 0x0100 (hex "347938bffa4009c512cfb4034b0dd1a7") ciphertext 229 | , indexCheckTestCase 0x01f0 (hex "7867a786d00a7147904d76ddf1e520e3") ciphertext 230 | , indexCheckTestCase 0x0200 (hex "8d3e9e1caefcccb3fbf8d18f64120b32") ciphertext 231 | , indexCheckTestCase 0x02f0 (hex "942337f8fd76f0fae8c52d7954810672") ciphertext 232 | , indexCheckTestCase 0x0300 (hex "b8548c10f51667f6e60e182fa19b30f7") ciphertext 233 | , indexCheckTestCase 0x03f0 (hex "0211c7c6190c9efd1237c34c8f2e06c4") ciphertext 234 | , indexCheckTestCase 0x0400 (hex "bda64f65276d2aacb8f90212203a808e") ciphertext 235 | , indexCheckTestCase 0x05f0 (hex "bd3820f732ffb53ec193e79d33e27c73") ciphertext 236 | , indexCheckTestCase 0x0600 (hex "d0168616861907d482e36cdac8cf5749") ciphertext 237 | , indexCheckTestCase 0x07f0 (hex "97b0f0f224b2d2317114808fb03af7a0") ciphertext 238 | , indexCheckTestCase 0x0800 (hex "e59616e469787939a063ceea9af956d1") ciphertext 239 | , indexCheckTestCase 0x0bf0 (hex "c47e0dc1660919c11101208f9e69aa1f") ciphertext 240 | , indexCheckTestCase 0x0c00 (hex "5ae4f12896b8379a2aad89b5b553d6b0") ciphertext 241 | , indexCheckTestCase 0x0ff0 (hex "6b6b098d0c293bc2993d80bf0518b6d9") ciphertext 242 | , indexCheckTestCase 0x1000 (hex "8170cc3ccd92a698621b939dd38fe7b9") ciphertext ] 243 | ietf80 = testGroup "ietf80" $ 244 | let ciphertext = rc4WithKey "8b37641910833222772a" in 245 | [ indexCheckTestCase 0x0000 (hex "ab65c26eddb287600db2fda10d1e605c") ciphertext 246 | , indexCheckTestCase 0x0010 (hex "bb759010c29658f2c72d93a2d16d2930") ciphertext 247 | , indexCheckTestCase 0x00f0 (hex "b901e8036ed1c383cd3c4c4dd0a6ab05") ciphertext 248 | , indexCheckTestCase 0x0100 (hex "3d25ce4922924c55f064943353d78a6c") ciphertext 249 | , indexCheckTestCase 0x01f0 (hex "12c1aa44bbf87e75e611f69b2c38f49b") ciphertext 250 | , indexCheckTestCase 0x0200 (hex "28f2b3434b65c09877470044c6ea170d") ciphertext 251 | , indexCheckTestCase 0x02f0 (hex "bd9ef822de5288196134cf8af7839304") ciphertext 252 | , indexCheckTestCase 0x0300 (hex "67559c23f052158470a296f725735a32") ciphertext 253 | , indexCheckTestCase 0x03f0 (hex "8bab26fbc2c12b0f13e2ab185eabf241") ciphertext 254 | , indexCheckTestCase 0x0400 (hex "31185a6d696f0cfa9b42808b38e132a2") ciphertext 255 | , indexCheckTestCase 0x05f0 (hex "564d3dae183c5234c8af1e51061c44b5") ciphertext 256 | , indexCheckTestCase 0x0600 (hex "3c0778a7b5f72d3c23a3135c7d67b9f4") ciphertext 257 | , indexCheckTestCase 0x07f0 (hex "f34369890fcf16fb517dcaae4463b2dd") ciphertext 258 | , indexCheckTestCase 0x0800 (hex "02f31c81e8200731b899b028e791bfa7") ciphertext 259 | , indexCheckTestCase 0x0bf0 (hex "72da646283228c14300853701795616f") ciphertext 260 | , indexCheckTestCase 0x0c00 (hex "4e0a8c6f7934a788e2265e81d6d0c8f4") ciphertext 261 | , indexCheckTestCase 0x0ff0 (hex "438dd5eafea0111b6f36b4b938da2a68") ciphertext 262 | , indexCheckTestCase 0x1000 (hex "5f6bfc73815874d97100f086979357d8") ciphertext ] 263 | ietf128 = testGroup "ietf128" $ 264 | let ciphertext = rc4WithKey "ebb46227c6cc8b37641910833222772a" in 265 | [ indexCheckTestCase 0x0000 (hex "720c94b63edf44e131d950ca211a5a30") ciphertext 266 | , indexCheckTestCase 0x0010 (hex "c366fdeacf9ca80436be7c358424d20b") ciphertext 267 | , indexCheckTestCase 0x00f0 (hex "b3394a40aabf75cba42282ef25a0059f") ciphertext 268 | , indexCheckTestCase 0x0100 (hex "4847d81da4942dbc249defc48c922b9f") ciphertext 269 | , indexCheckTestCase 0x01f0 (hex "08128c469f275342adda202b2b58da95") ciphertext 270 | , indexCheckTestCase 0x0200 (hex "970dacef40ad98723bac5d6955b81761") ciphertext 271 | , indexCheckTestCase 0x02f0 (hex "3cb89993b07b0ced93de13d2a11013ac") ciphertext 272 | , indexCheckTestCase 0x0300 (hex "ef2d676f1545c2c13dc680a02f4adbfe") ciphertext 273 | , indexCheckTestCase 0x03f0 (hex "b60595514f24bc9fe522a6cad7393644") ciphertext 274 | , indexCheckTestCase 0x0400 (hex "b515a8c5011754f59003058bdb81514e") ciphertext 275 | , indexCheckTestCase 0x05f0 (hex "3c70047e8cbc038e3b9820db601da495") ciphertext 276 | , indexCheckTestCase 0x0600 (hex "1175da6ee756de46a53e2b075660b770") ciphertext 277 | , indexCheckTestCase 0x07f0 (hex "00a542bba02111cc2c65b38ebdba587e") ciphertext 278 | , indexCheckTestCase 0x0800 (hex "5865fdbb5b48064104e830b380f2aede") ciphertext 279 | , indexCheckTestCase 0x0bf0 (hex "34b21ad2ad44e999db2d7f0863f0d9b6") ciphertext 280 | , indexCheckTestCase 0x0c00 (hex "84a9218fc36e8a5f2ccfbeae53a27d25") ciphertext 281 | , indexCheckTestCase 0x0ff0 (hex "a2221a11b833ccb498a59540f0545f4a") ciphertext 282 | , indexCheckTestCase 0x1000 (hex "5bbeb4787d59e5373fdbea6c6f75c29b") ciphertext ] 283 | ietf192 = testGroup "ietf192" $ 284 | let ciphertext = rc4WithKey "c109163908ebe51debb46227c6cc8b37641910833222772a" in 285 | [ indexCheckTestCase 0x0000 (hex "54b64e6b5a20b5e2ec84593dc7989da7") ciphertext 286 | , indexCheckTestCase 0x0010 (hex "c135eee237a85465ff97dc03924f45ce") ciphertext 287 | , indexCheckTestCase 0x00f0 (hex "cfcc922fb4a14ab45d6175aabbf2d201") ciphertext 288 | , indexCheckTestCase 0x0100 (hex "837b87e2a446ad0ef798acd02b94124f") ciphertext 289 | , indexCheckTestCase 0x01f0 (hex "17a6dbd664926a0636b3f4c37a4f4694") ciphertext 290 | , indexCheckTestCase 0x0200 (hex "4a5f9f26aeeed4d4a25f632d305233d9") ciphertext 291 | , indexCheckTestCase 0x02f0 (hex "80a3d01ef00c8e9a4209c17f4eeb358c") ciphertext 292 | , indexCheckTestCase 0x0300 (hex "d15e7d5ffaaabc0207bf200a117793a2") ciphertext 293 | , indexCheckTestCase 0x03f0 (hex "349682bf588eaa52d0aa1560346aeafa") ciphertext 294 | , indexCheckTestCase 0x0400 (hex "f5854cdb76c889e3ad63354e5f7275e3") ciphertext 295 | , indexCheckTestCase 0x05f0 (hex "532c7ceccb39df3236318405a4b1279c") ciphertext 296 | , indexCheckTestCase 0x0600 (hex "baefe6d9ceb651842260e0d1e05e3b90") ciphertext 297 | , indexCheckTestCase 0x07f0 (hex "e82d8c6db54e3c633f581c952ba04207") ciphertext 298 | , indexCheckTestCase 0x0800 (hex "4b16e50abd381bd70900a9cd9a62cb23") ciphertext 299 | , indexCheckTestCase 0x0bf0 (hex "3682ee33bd148bd9f58656cd8f30d9fb") ciphertext 300 | , indexCheckTestCase 0x0c00 (hex "1e5a0b8475045d9b20b2628624edfd9e") ciphertext 301 | , indexCheckTestCase 0x0ff0 (hex "63edd684fb826282fe528f9c0e9237bc") ciphertext 302 | , indexCheckTestCase 0x1000 (hex "e4dd2e98d6960fae0b43545456743391") ciphertext ] 303 | ietf256 = testGroup "ietf256" $ 304 | let ciphertext = rc4WithKey "1ada31d5cf688221c109163908ebe51debb46227c6cc8b37641910833222772a" in 305 | [ indexCheckTestCase 0x0000 (hex "dd5bcb0018e922d494759d7c395d02d3") ciphertext 306 | , indexCheckTestCase 0x0010 (hex "c8446f8f77abf737685353eb89a1c9eb") ciphertext 307 | , indexCheckTestCase 0x00f0 (hex "af3e30f9c095045938151575c3fb9098") ciphertext 308 | , indexCheckTestCase 0x0100 (hex "f8cb6274db99b80b1d2012a98ed48f0e") ciphertext 309 | , indexCheckTestCase 0x01f0 (hex "25c3005a1cb85de076259839ab7198ab") ciphertext 310 | , indexCheckTestCase 0x0200 (hex "9dcbc183e8cb994b727b75be3180769c") ciphertext 311 | , indexCheckTestCase 0x02f0 (hex "a1d3078dfa9169503ed9d4491dee4eb2") ciphertext 312 | , indexCheckTestCase 0x0300 (hex "8514a5495858096f596e4bcd66b10665") ciphertext 313 | , indexCheckTestCase 0x03f0 (hex "5f40d59ec1b03b33738efa60b2255d31") ciphertext 314 | , indexCheckTestCase 0x0400 (hex "3477c7f764a41baceff90bf14f92b7cc") ciphertext 315 | , indexCheckTestCase 0x05f0 (hex "ac4e95368d99b9eb78b8da8f81ffa795") ciphertext 316 | , indexCheckTestCase 0x0600 (hex "8c3c13f8c2388bb73f38576e65b7c446") ciphertext 317 | , indexCheckTestCase 0x07f0 (hex "13c4b9c1dfb66579eddd8a280b9f7316") ciphertext 318 | , indexCheckTestCase 0x0800 (hex "ddd27820550126698efaadc64b64f66e") ciphertext 319 | , indexCheckTestCase 0x0bf0 (hex "f08f2e66d28ed143f3a237cf9de73559") ciphertext 320 | , indexCheckTestCase 0x0c00 (hex "9ea36c525531b880ba124334f57b0b70") ciphertext 321 | , indexCheckTestCase 0x0ff0 (hex "d5a39e3dfcc50280bac4a6b5aa0dca7d") ciphertext 322 | , indexCheckTestCase 0x1000 (hex "370b1c1fe655916d97fd0d47ca1d72b8") ciphertext ] 323 | 324 | indexCheckTestCase :: Int -> ByteString -> Either [Error] ByteString -> TestTree 325 | indexCheckTestCase index expected actual = testCase (show index) $ 326 | assertIsRightAndHasAtIndex index expected actual 327 | 328 | assertIsRightAndHasAtIndex :: Int -> ByteString -> Either [Error] ByteString -> Assertion 329 | assertIsRightAndHasAtIndex index expected actual = 330 | case actual of 331 | Left es -> assertFailure ("expected: Right _\n but got: Left " ++ show es) 332 | Right c -> 333 | let actual = slice index (ByteString.length expected) c in 334 | expected == actual @? "expected: Right " ++ ellipsize index expected 335 | ++ "\n but got: Right " ++ ellipsize index actual 336 | 337 | slice :: Int -> Int -> ByteString -> ByteString 338 | slice start length = ByteString.take length . ByteString.drop start 339 | 340 | ellipsize :: Int -> ByteString -> String 341 | ellipsize n s = concat [if n == 0 then "" else "...", showHex s, "..."] 342 | -------------------------------------------------------------------------------- /tests/Codec/Crypto/HKDFTests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | {-# OPTIONS_GHC -Wno-missing-fields #-} 17 | 18 | module Codec.Crypto.HKDFTests (tests) where 19 | 20 | import qualified Data.ByteString as ByteString 21 | import Test.Tasty (TestTree, testGroup) 22 | import Test.Tasty.HUnit (testCase) 23 | 24 | import BTLS.Assertions (isRightAndHolds) 25 | import BTLS.TestUtilities (hex) 26 | import Codec.Crypto.HKDF 27 | (ExpandParams(..), ExtractParams(..), HKDFParams(..), expand, extract, hkdf) 28 | import Data.Digest (sha1, sha256) 29 | 30 | tests :: TestTree 31 | tests = testGroup "Codec.Crypto.HKDF" [testRFC5869] 32 | 33 | hkdfTestCase name 34 | params@(HKDFParams {algorithm = hash, salt = salt, associatedData = info}) 35 | ikm 36 | prk 37 | okm = 38 | testGroup name $ 39 | let secretLen = ByteString.length okm 40 | params' = params { secretLen = secretLen } 41 | extractParams = ExtractParams { extractAlgorithm = hash 42 | , extractSalt = salt } 43 | expandParams = ExpandParams { expandAlgorithm = hash 44 | , expandAssociatedData = info 45 | , expandSecretLen = secretLen } in 46 | [ testCase "hkdf" $ hkdf params' ikm `isRightAndHolds` okm 47 | , testCase "extract" $ extract extractParams ikm `isRightAndHolds` prk 48 | , testCase "expand" $ expand expandParams prk `isRightAndHolds` okm ] 49 | 50 | -- | Tests from RFC 5869. 51 | testRFC5869 = testGroup "RFC 5869 examples" 52 | [ hkdfTestCase "test case 1" 53 | HKDFParams { algorithm = sha256 54 | , salt = ByteString.pack [0x00 .. 0x0c] 55 | , associatedData = ByteString.pack [0xf0 .. 0xf9] } 56 | (ByteString.replicate 22 0x0b) 57 | (hex "077709362c2e32df0ddc3f0dc47bba6390b6c73bb50f9c3122ec844ad7c2b3e5") 58 | (hex "3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34007208d5b887185865") 59 | , hkdfTestCase "test case 2" 60 | HKDFParams { algorithm = sha256 61 | , salt = ByteString.pack [0x60 .. 0xaf] 62 | , associatedData = ByteString.pack [0xb0 .. 0xff] } 63 | (ByteString.pack [0x00 .. 0x4f]) 64 | (hex "06a6b88c5853361a06104c9ceb35b45cef760014904671014a193f40c15fc244") 65 | (hex "b11e398dc80327a1c8e7f78c596a49344f012eda2d4efad8a050cc4c19afa97c59045a99cac7827271cb41c65e590e09da3275600c2f09b8367793a9aca3db71cc30c58179ec3e87c14c01d5c1f3434f1d87") 66 | , hkdfTestCase "test case 3" 67 | HKDFParams { algorithm = sha256 68 | , salt = "" 69 | , associatedData = "" } 70 | (ByteString.replicate 22 0x0b) 71 | (hex "19ef24a32c717b167f33a91d6f648bdf96596776afdb6377ac434c1c293ccb04") 72 | (hex "8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8") 73 | , hkdfTestCase "test case 4" 74 | HKDFParams { algorithm = sha1 75 | , salt = ByteString.pack [0x00 .. 0x0c] 76 | , associatedData = ByteString.pack [0xf0 .. 0xf9] } 77 | (ByteString.replicate 11 0x0b) 78 | (hex "9b6c18c432a7bf8f0e71c8eb88f4b30baa2ba243") 79 | (hex "085a01ea1b10f36933068b56efa5ad81a4f14b822f5b091568a9cdd4f155fda2c22e422478d305f3f896") 80 | , hkdfTestCase "test case 5" 81 | HKDFParams { algorithm = sha1 82 | , salt = ByteString.pack [0x60 .. 0xaf] 83 | , associatedData = ByteString.pack [0xb0 .. 0xff] } 84 | (ByteString.pack [0x00 .. 0x4f]) 85 | (hex "8adae09a2a307059478d309b26c4115a224cfaf6") 86 | (hex "0bd770a74d1160f7c9f12cd5912a06ebff6adcae899d92191fe4305673ba2ffe8fa3f1a4e5ad79f3f334b3b202b2173c486ea37ce3d397ed034c7f9dfeb15c5e927336d0441f4c4300e2cff0d0900b52d3b4") 87 | , hkdfTestCase "test case 6" 88 | HKDFParams { algorithm = sha1 89 | , salt = "" 90 | , associatedData = "" } 91 | (ByteString.replicate 22 0x0b) 92 | (hex "da8c8a73c7fa77288ec6f5e7c297786aa0d32d01") 93 | (hex "0ac1af7002b3d761d1e55298da9d0506b9ae52057220a306e07b6b87e8df21d0ea00033de03984d34918") 94 | , hkdfTestCase "test case 7" 95 | HKDFParams { algorithm = sha1 96 | , salt = "" 97 | , associatedData = "" } 98 | (ByteString.replicate 22 0x0c) 99 | (hex "2adccada18779e7c2077ad2eb19d3f3e731385dd") 100 | (hex "2c91117204d745f3500d636a62f64f0ab3bae548aa53d423b0d1f27ebba6f5e5673a081d70cce7acfc48") ] 101 | -------------------------------------------------------------------------------- /tests/Data/Digest/HashTests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module Data.Digest.HashTests 16 | ( hashTestCase 17 | , testAgainstCoreutils 18 | , testAgainstOpenSSL 19 | , hexDigest 20 | ) where 21 | 22 | import Data.ByteString (ByteString) 23 | import qualified Data.ByteString as ByteString 24 | import qualified Data.ByteString.Char8 as ByteString.Char8 25 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 26 | import qualified Data.ByteString.Lazy as ByteString.Lazy 27 | import System.IO (hClose, hSetBinaryMode) 28 | import System.Process 29 | (CreateProcess(std_in, std_out), StdStream(CreatePipe), createProcess_, proc) 30 | import qualified Test.SmallCheck.Series.ByteString.Lazy as ByteString.Lazy.Series 31 | import Test.Tasty (TestTree) 32 | import Test.Tasty.HUnit ((@?=), testCase) 33 | import Test.Tasty.SmallCheck (Property, monadic, over) 34 | 35 | import BTLS.TestUtilities (abbreviate, hex) 36 | import Data.Digest (Algorithm, Digest(Digest), hash) 37 | 38 | hashTestCase :: Algorithm -> Lazy.ByteString -> ByteString -> TestTree 39 | hashTestCase algo input output = 40 | testCase (abbreviate input) $ hash algo input @?= hexDigest output 41 | 42 | testAgainstCoreutils :: Algorithm -> FilePath -> Property IO 43 | testAgainstCoreutils algo prog = 44 | over ByteString.Lazy.Series.enumW8s $ \s -> monadic $ do 45 | theirs <- externalHash (proc prog ["-b"]) s head 46 | return $ hash algo s == theirs 47 | 48 | testAgainstOpenSSL :: Algorithm -> String -> Property IO 49 | testAgainstOpenSSL algo flag = 50 | over ByteString.Lazy.Series.enumW8s $ \s -> monadic $ do 51 | theirs <- externalHash (proc "openssl" ["dgst", '-' : flag]) s (!!1) 52 | return $ hash algo s == theirs 53 | 54 | -- | Runs an external hashing command with the specified standard input. Assumes 55 | -- that the process will exit when its standard input is closed. 56 | externalHash :: CreateProcess -> Lazy.ByteString -> ([ByteString] -> ByteString) -> IO Digest 57 | externalHash p s toDigest = do 58 | (Just stdin, Just stdout, _, _) <- 59 | createProcess_ "runExternal" (p {std_in = CreatePipe, std_out = CreatePipe}) 60 | hSetBinaryMode stdin True 61 | ByteString.Lazy.hPut stdin s 62 | hClose stdin -- causes process to exit 63 | hexDigest . toDigest . ByteString.Char8.words <$> ByteString.hGetContents stdout 64 | 65 | hexDigest :: ByteString -> Digest 66 | hexDigest = Digest . hex 67 | -------------------------------------------------------------------------------- /tests/Data/Digest/MD5Tests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Data.Digest.MD5Tests (tests) where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 21 | import Test.Tasty (TestTree, testGroup) 22 | import Test.Tasty.SmallCheck (testProperty) 23 | 24 | import Data.Digest (md5) 25 | import Data.Digest.HashTests 26 | (hashTestCase, testAgainstCoreutils, testAgainstOpenSSL) 27 | 28 | tests :: TestTree 29 | tests = testGroup "MD5" 30 | [ testRFCExamples 31 | , testGoExamples 32 | , testCoreutilsConformance 33 | , testOpenSSLConformance ] 34 | 35 | md5TestCase :: Lazy.ByteString -> ByteString -> TestTree 36 | md5TestCase = hashTestCase md5 37 | 38 | -- | MD5 example vectors from RFC 1321. 39 | testRFCExamples = testGroup "RFC 1321 examples" 40 | [ md5TestCase "" "d41d8cd98f00b204e9800998ecf8427e" 41 | , md5TestCase "a" "0cc175b9c0f1b6a831c399e269772661" 42 | , md5TestCase "abc" "900150983cd24fb0d6963f7d28e17f72" 43 | , md5TestCase "message digest" "f96b697d7cb7938d525a2f31aaf161d0" 44 | , md5TestCase "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b" 45 | , md5TestCase "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f" 46 | , md5TestCase "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a" ] 47 | 48 | -- | Test vectors used to test the Go MD5 implementation. 49 | testGoExamples = testGroup "Go tests" $ 50 | [ md5TestCase "" "d41d8cd98f00b204e9800998ecf8427e" 51 | , md5TestCase "a" "0cc175b9c0f1b6a831c399e269772661" 52 | , md5TestCase "ab" "187ef4436122d1cc2f40dc2b92f0eba0" 53 | , md5TestCase "abc" "900150983cd24fb0d6963f7d28e17f72" 54 | , md5TestCase "abcd" "e2fc714c4727ee9395f324cd2e7f331f" 55 | , md5TestCase "abcde" "ab56b4d92b40713acc5af89985d4b786" 56 | , md5TestCase "abcdef" "e80b5017098950fc58aad83c8c14978e" 57 | , md5TestCase "abcdefg" "7ac66c0f148de9519b8bd264312c4d64" 58 | , md5TestCase "abcdefgh" "e8dc4081b13434b45189a720b77b6818" 59 | , md5TestCase "abcdefghi" "8aa99b1f439ff71293e95357bac6fd94" 60 | , md5TestCase "abcdefghij" "a925576942e94b2ef57a066101b48876" 61 | , md5TestCase "Discard medicine more than two years old." "d747fc1719c7eacb84058196cfe56d57" 62 | , md5TestCase "He who has a shady past knows that nice guys finish last." "bff2dcb37ef3a44ba43ab144768ca837" 63 | , md5TestCase "I wouldn't marry him with a ten foot pole." "0441015ecb54a7342d017ed1bcfdbea5" 64 | , md5TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "9e3cac8e9e9757a60c3ea391130d3689" 65 | , md5TestCase "The days of the digital watch are numbered. -Tom Stoppard" "a0f04459b031f916a59a35cc482dc039" 66 | , md5TestCase "Nepal premier won't resign." "e7a48e0fe884faf31475d2a04b1362cc" 67 | , md5TestCase "For every action there is an equal and opposite government program." "637d2fe925c07c113800509964fb0e06" 68 | , md5TestCase "His money is twice tainted: 'taint yours and 'taint mine." "834a8d18d5c6562119cf4c7f5086cb71" 69 | , md5TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "de3a4d2fd6c73ec2db2abad23b444281" 70 | , md5TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "acf203f997e2cf74ea3aff86985aefaf" 71 | , md5TestCase "size: a.out: bad magic" "e1c1384cb4d2221dfdd7c795a4222c9a" 72 | , md5TestCase "The major problem is with sendmail. -Mark Horton" "c90f3ddecc54f34228c063d7525bf644" 73 | , md5TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "cdf7ab6c1fd49bd9933c43f3ea5af185" 74 | , md5TestCase "If the enemy is within range, then so are you." "83bc85234942fc883c063cbd7f0ad5d0" 75 | , md5TestCase "It's well we cannot hear the screams/That we create in others' dreams." "277cbe255686b48dd7e8f389394d9299" 76 | , md5TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "fd3fb0a7ffb8af16603f3d3af98f8e1f" 77 | , md5TestCase "C is as portable as Stonehedge!!" "469b13a78ebf297ecda64d4723655154" 78 | , md5TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "63eb3a2f466410104731c4b037600110" 79 | , md5TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "72c2ed7592debca1c90fc0100f931a2f" 80 | , md5TestCase "How can you write a big system without C++? -Paul Glick" "132f7619d33b523b1d9e5bd8e0928355" ] 81 | 82 | -- | Tests our MD5 implementation against coreutils'. 83 | testCoreutilsConformance = testProperty "conformance with coreutils" $ 84 | testAgainstCoreutils md5 "md5sum" 85 | 86 | -- | Tests our MD5 implementation against openssl(1)'s. 87 | testOpenSSLConformance = testProperty "conformance with OpenSSL" $ 88 | testAgainstOpenSSL md5 "md5" 89 | -------------------------------------------------------------------------------- /tests/Data/Digest/SHA1Tests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Data.Digest.SHA1Tests (tests) where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 21 | import Test.Tasty (TestTree, testGroup) 22 | import Test.Tasty.HUnit ((@?=), testCase) 23 | import Test.Tasty.SmallCheck (testProperty) 24 | 25 | import Data.Digest (hash, sha1) 26 | import Data.Digest.HashTests 27 | (hashTestCase, hexDigest, testAgainstCoreutils, testAgainstOpenSSL) 28 | 29 | tests :: TestTree 30 | tests = testGroup "SHA-1" 31 | [ testNISTExamples 32 | , testGoExamples 33 | , testCoreutilsConformance 34 | , testOpenSSLConformance ] 35 | 36 | sha1TestCase :: Lazy.ByteString -> ByteString -> TestTree 37 | sha1TestCase = hashTestCase sha1 38 | 39 | -- | SHA-1 example vectors from 40 | -- https://csrc.nist.gov/projects/cryptographic-standards-and-guidelines/example-values. 41 | testNISTExamples = testGroup "NIST examples" 42 | [ testCase "one-block" $ hash sha1 "abc" @?= hexDigest "a9993e364706816aba3e25717850c26c9cd0d89d" 43 | , testCase "two-block" $ hash sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" @?= hexDigest "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] 44 | 45 | -- | Test vectors used to test the Go SHA-1 implementation. 46 | testGoExamples = testGroup "Go tests" 47 | [ sha1TestCase "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n" "76245dbf96f661bd221046197ab8b9f063f11bad" 48 | , sha1TestCase "" "da39a3ee5e6b4b0d3255bfef95601890afd80709" 49 | , sha1TestCase "a" "86f7e437faa5a7fce15d1ddcb9eaeaea377667b8" 50 | , sha1TestCase "ab" "da23614e02469a0d7c7bd1bdab5c9c474b1904dc" 51 | , sha1TestCase "abc" "a9993e364706816aba3e25717850c26c9cd0d89d" 52 | , sha1TestCase "abcd" "81fe8bfe87576c3ecb22426f8e57847382917acf" 53 | , sha1TestCase "abcde" "03de6c570bfe24bfc328ccd7ca46b76eadaf4334" 54 | , sha1TestCase "abcdef" "1f8ac10f23c5b5bc1167bda84b833e5c057a77d2" 55 | , sha1TestCase "abcdefg" "2fb5e13419fc89246865e7a324f476ec624e8740" 56 | , sha1TestCase "abcdefgh" "425af12a0743502b322e93a015bcf868e324d56a" 57 | , sha1TestCase "abcdefghi" "c63b19f1e4c8b5f76b25c49b8b87f57d8e4872a1" 58 | , sha1TestCase "abcdefghij" "d68c19a0a345b7eab78d5e11e991c026ec60db63" 59 | , sha1TestCase "Discard medicine more than two years old." "ebf81ddcbe5bf13aaabdc4d65354fdf2044f38a7" 60 | , sha1TestCase "He who has a shady past knows that nice guys finish last." "e5dea09392dd886ca63531aaa00571dc07554bb6" 61 | , sha1TestCase "I wouldn't marry him with a ten foot pole." "45988f7234467b94e3e9494434c96ee3609d8f8f" 62 | , sha1TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "55dee037eb7460d5a692d1ce11330b260e40c988" 63 | , sha1TestCase "The days of the digital watch are numbered. -Tom Stoppard" "b7bc5fb91080c7de6b582ea281f8a396d7c0aee8" 64 | , sha1TestCase "Nepal premier won't resign." "c3aed9358f7c77f523afe86135f06b95b3999797" 65 | , sha1TestCase "For every action there is an equal and opposite government program." "6e29d302bf6e3a5e4305ff318d983197d6906bb9" 66 | , sha1TestCase "His money is twice tainted: 'taint yours and 'taint mine." "597f6a540010f94c15d71806a99a2c8710e747bd" 67 | , sha1TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "6859733b2590a8a091cecf50086febc5ceef1e80" 68 | , sha1TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "514b2630ec089b8aee18795fc0cf1f4860cdacad" 69 | , sha1TestCase "size: a.out: bad magic" "c5ca0d4a7b6676fc7aa72caa41cc3d5df567ed69" 70 | , sha1TestCase "The major problem is with sendmail. -Mark Horton" "74c51fa9a04eadc8c1bbeaa7fc442f834b90a00a" 71 | , sha1TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "0b4c4ce5f52c3ad2821852a8dc00217fa18b8b66" 72 | , sha1TestCase "If the enemy is within range, then so are you." "3ae7937dd790315beb0f48330e8642237c61550a" 73 | , sha1TestCase "It's well we cannot hear the screams/That we create in others' dreams." "410a2b296df92b9a47412b13281df8f830a9f44b" 74 | , sha1TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "841e7c85ca1adcddbdd0187f1289acb5c642f7f5" 75 | , sha1TestCase "C is as portable as Stonehedge!!" "163173b825d03b952601376b25212df66763e1db" 76 | , sha1TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "32b0377f2687eb88e22106f133c586ab314d5279" 77 | , sha1TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "0885aaf99b569542fd165fa44e322718f4a984e0" 78 | , sha1TestCase "How can you write a big system without C++? -Paul Glick" "6627d6904d71420b0bf3886ab629623538689f45" ] 79 | 80 | -- | Tests our SHA-1 implementation against coreutils'. 81 | testCoreutilsConformance = testProperty "conformance with coreutils" $ 82 | testAgainstCoreutils sha1 "sha1sum" 83 | 84 | -- | Tests our SHA-1 implementation against openssl(1)'s. 85 | testOpenSSLConformance = testProperty "conformance with OpenSSL" $ 86 | testAgainstOpenSSL sha1 "sha1" 87 | -------------------------------------------------------------------------------- /tests/Data/Digest/SHA2Tests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Data.Digest.SHA2Tests (tests) where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 21 | import Test.Tasty (TestTree, testGroup) 22 | import Test.Tasty.HUnit ((@?=), testCase) 23 | import Test.Tasty.SmallCheck (testProperty) 24 | 25 | import Data.Digest (hash, sha224, sha256, sha384, sha512) 26 | import Data.Digest.HashTests 27 | (hashTestCase, hexDigest, testAgainstCoreutils, testAgainstOpenSSL) 28 | 29 | tests :: TestTree 30 | tests = testGroup "SHA-2" 31 | [ testNISTExamples 32 | , testGoExamples 33 | , testCoreutilsConformance 34 | , testOpenSSLConformance ] 35 | 36 | -- | SHA-2 example vectors from 37 | -- https://csrc.nist.gov/projects/cryptographic-standards-and-guidelines/example-values. 38 | testNISTExamples = testGroup "NIST examples" 39 | [ testNISTSHA224 40 | , testNISTSHA256 41 | , testNISTSHA384 42 | , testNISTSHA512 ] 43 | 44 | testNISTSHA224 = testGroup "SHA-224" 45 | [ testCase "one-block" $ hash sha224 "abc" @?= hexDigest "23097d223405d8228642a477bda255b32aadbce4bda0b3f7e36c9da7" 46 | , testCase "two-block" $ hash sha224 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" @?= hexDigest "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ] 47 | 48 | testNISTSHA256 = testGroup "SHA-256" 49 | [ testCase "one-block" $ hash sha256 "abc" @?= hexDigest "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" 50 | , testCase "two-block" $ hash sha256 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" @?= hexDigest "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1" ] 51 | 52 | testNISTSHA384 = testGroup "SHA-384" 53 | [ testCase "one-block" $ hash sha384 "abc" @?= hexDigest "cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7" 54 | , testCase "two-block" $ hash sha384 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" @?= hexDigest "09330c33f71147e83d192fc782cd1b4753111b173b3b05d22fa08086e3b0f712fcc7c71a557e2db966c3e9fa91746039" ] 55 | 56 | testNISTSHA512 = testGroup "SHA-512" 57 | [ testCase "one-block" $ hash sha512 "abc" @?= hexDigest "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f" 58 | , testCase "two-block" $ hash sha512 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" @?= hexDigest "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ] 59 | 60 | -- | Test vectors used to test the Go SHA-2 implementations. 61 | testGoExamples = testGroup "Go tests" 62 | [ testGoSHA224 63 | , testGoSHA256 64 | , testGoSHA384 65 | , testGoSHA512 ] 66 | 67 | sha224TestCase, sha256TestCase, sha384TestCase, sha512TestCase :: 68 | Lazy.ByteString -> ByteString -> TestTree 69 | sha224TestCase = hashTestCase sha224 70 | sha256TestCase = hashTestCase sha256 71 | sha384TestCase = hashTestCase sha384 72 | sha512TestCase = hashTestCase sha512 73 | 74 | testGoSHA224 = testGroup "SHA-224" 75 | [ sha224TestCase "" "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f" 76 | , sha224TestCase "a" "abd37534c7d9a2efb9465de931cd7055ffdb8879563ae98078d6d6d5" 77 | , sha224TestCase "ab" "db3cda86d4429a1d39c148989566b38f7bda0156296bd364ba2f878b" 78 | , sha224TestCase "abc" "23097d223405d8228642a477bda255b32aadbce4bda0b3f7e36c9da7" 79 | , sha224TestCase "abcd" "a76654d8e3550e9a2d67a0eeb6c67b220e5885eddd3fde135806e601" 80 | , sha224TestCase "abcde" "bdd03d560993e675516ba5a50638b6531ac2ac3d5847c61916cfced6" 81 | , sha224TestCase "abcdef" "7043631cb415556a275a4ebecb802c74ee9f6153908e1792a90b6a98" 82 | , sha224TestCase "abcdefg" "d1884e711701ad81abe0c77a3b0ea12e19ba9af64077286c72fc602d" 83 | , sha224TestCase "abcdefgh" "17eb7d40f0356f8598e89eafad5f6c759b1f822975d9c9b737c8a517" 84 | , sha224TestCase "abcdefghi" "aeb35915346c584db820d2de7af3929ffafef9222a9bcb26516c7334" 85 | , sha224TestCase "abcdefghij" "d35e1e5af29ddb0d7e154357df4ad9842afee527c689ee547f753188" 86 | , sha224TestCase "Discard medicine more than two years old." "19297f1cef7ddc8a7e947f5c5a341e10f7245045e425db67043988d7" 87 | , sha224TestCase "He who has a shady past knows that nice guys finish last." "0f10c2eb436251f777fbbd125e260d36aecf180411726c7c885f599a" 88 | , sha224TestCase "I wouldn't marry him with a ten foot pole." "4d1842104919f314cad8a3cd20b3cba7e8ed3e7abed62b57441358f6" 89 | , sha224TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "a8ba85c6fe0c48fbffc72bbb2f03fcdbc87ae2dc7a56804d1590fb3b" 90 | , sha224TestCase "The days of the digital watch are numbered. -Tom Stoppard" "5543fbab26e67e8885b1a852d567d1cb8b9bfe42e0899584c50449a9" 91 | , sha224TestCase "Nepal premier won't resign." "65ca107390f5da9efa05d28e57b221657edc7e43a9a18fb15b053ddb" 92 | , sha224TestCase "For every action there is an equal and opposite government program." "84953962be366305a9cc9b5cd16ed019edc37ac96c0deb3e12cca116" 93 | , sha224TestCase "His money is twice tainted: 'taint yours and 'taint mine." "35a189ce987151dfd00b3577583cc6a74b9869eecf894459cb52038d" 94 | , sha224TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "2fc333713983edfd4ef2c0da6fb6d6415afb94987c91e4069eb063e6" 95 | , sha224TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "cbe32d38d577a1b355960a4bc3c659c2dc4670859a19777a875842c4" 96 | , sha224TestCase "size: a.out: bad magic" "a2dc118ce959e027576413a7b440c875cdc8d40df9141d6ef78a57e1" 97 | , sha224TestCase "The major problem is with sendmail. -Mark Horton" "d10787e24052bcff26dc484787a54ed819e4e4511c54890ee977bf81" 98 | , sha224TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "62efcf16ab8a893acdf2f348aaf06b63039ff1bf55508c830532c9fb" 99 | , sha224TestCase "If the enemy is within range, then so are you." "3e9b7e4613c59f58665104c5fa86c272db5d3a2ff30df5bb194a5c99" 100 | , sha224TestCase "It's well we cannot hear the screams/That we create in others' dreams." "5999c208b8bdf6d471bb7c359ac5b829e73a8211dff686143a4e7f18" 101 | , sha224TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "3b2d67ff54eabc4ef737b14edf87c64280ef582bcdf2a6d56908b405" 102 | , sha224TestCase "C is as portable as Stonehedge!!" "d0733595d20e4d3d6b5c565a445814d1bbb2fd08b9a3b8ffb97930c6" 103 | , sha224TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "43fb8aeed8a833175c9295c1165415f98c866ef08a4922959d673507" 104 | , sha224TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "ec18e66e93afc4fb1604bc2baedbfd20b44c43d76e65c0996d7851c6" 105 | , sha224TestCase "How can you write a big system without C++? -Paul Glick" "86ed2eaa9c75ba98396e5c9fb2f679ecf0ea2ed1e0ee9ceecb4a9332" ] 106 | 107 | testGoSHA256 = testGroup "SHA-256" 108 | [ sha256TestCase "" "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" 109 | , sha256TestCase "a" "ca978112ca1bbdcafac231b39a23dc4da786eff8147c4e72b9807785afee48bb" 110 | , sha256TestCase "ab" "fb8e20fc2e4c3f248c60c39bd652f3c1347298bb977b8b4d5903b85055620603" 111 | , sha256TestCase "abc" "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" 112 | , sha256TestCase "abcd" "88d4266fd4e6338d13b845fcf289579d209c897823b9217da3e161936f031589" 113 | , sha256TestCase "abcde" "36bbe50ed96841d10443bcb670d6554f0a34b761be67ec9c4a8ad2c0c44ca42c" 114 | , sha256TestCase "abcdef" "bef57ec7f53a6d40beb640a780a639c83bc29ac8a9816f1fc6c5c6dcd93c4721" 115 | , sha256TestCase "abcdefg" "7d1a54127b222502f5b79b5fb0803061152a44f92b37e23c6527baf665d4da9a" 116 | , sha256TestCase "abcdefgh" "9c56cc51b374c3ba189210d5b6d4bf57790d351c96c47c02190ecf1e430635ab" 117 | , sha256TestCase "abcdefghi" "19cc02f26df43cc571bc9ed7b0c4d29224a3ec229529221725ef76d021c8326f" 118 | , sha256TestCase "abcdefghij" "72399361da6a7754fec986dca5b7cbaf1c810a28ded4abaf56b2106d06cb78b0" 119 | , sha256TestCase "Discard medicine more than two years old." "a144061c271f152da4d151034508fed1c138b8c976339de229c3bb6d4bbb4fce" 120 | , sha256TestCase "He who has a shady past knows that nice guys finish last." "6dae5caa713a10ad04b46028bf6dad68837c581616a1589a265a11288d4bb5c4" 121 | , sha256TestCase "I wouldn't marry him with a ten foot pole." "ae7a702a9509039ddbf29f0765e70d0001177914b86459284dab8b348c2dce3f" 122 | , sha256TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "6748450b01c568586715291dfa3ee018da07d36bb7ea6f180c1af6270215c64f" 123 | , sha256TestCase "The days of the digital watch are numbered. -Tom Stoppard" "14b82014ad2b11f661b5ae6a99b75105c2ffac278cd071cd6c05832793635774" 124 | , sha256TestCase "Nepal premier won't resign." "7102cfd76e2e324889eece5d6c41921b1e142a4ac5a2692be78803097f6a48d8" 125 | , sha256TestCase "For every action there is an equal and opposite government program." "23b1018cd81db1d67983c5f7417c44da9deb582459e378d7a068552ea649dc9f" 126 | , sha256TestCase "His money is twice tainted: 'taint yours and 'taint mine." "8001f190dfb527261c4cfcab70c98e8097a7a1922129bc4096950e57c7999a5a" 127 | , sha256TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "8c87deb65505c3993eb24b7a150c4155e82eee6960cf0c3a8114ff736d69cad5" 128 | , sha256TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "bfb0a67a19cdec3646498b2e0f751bddc41bba4b7f30081b0b932aad214d16d7" 129 | , sha256TestCase "size: a.out: bad magic" "7f9a0b9bf56332e19f5a0ec1ad9c1425a153da1c624868fda44561d6b74daf36" 130 | , sha256TestCase "The major problem is with sendmail. -Mark Horton" "b13f81b8aad9e3666879af19886140904f7f429ef083286195982a7588858cfc" 131 | , sha256TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "b26c38d61519e894480c70c8374ea35aa0ad05b2ae3d6674eec5f52a69305ed4" 132 | , sha256TestCase "If the enemy is within range, then so are you." "049d5e26d4f10222cd841a119e38bd8d2e0d1129728688449575d4ff42b842c1" 133 | , sha256TestCase "It's well we cannot hear the screams/That we create in others' dreams." "0e116838e3cc1c1a14cd045397e29b4d087aa11b0853fc69ec82e90330d60949" 134 | , sha256TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "4f7d8eb5bcf11de2a56b971021a444aa4eafd6ecd0f307b5109e4e776cd0fe46" 135 | , sha256TestCase "C is as portable as Stonehedge!!" "61c0cc4c4bd8406d5120b3fb4ebc31ce87667c162f29468b3c779675a85aebce" 136 | , sha256TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "1fb2eb3688093c4a3f80cd87a5547e2ce940a4f923243a79a2a1e242220693ac" 137 | , sha256TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "395585ce30617b62c80b93e8208ce866d4edc811a177fdb4b82d3911d8696423" 138 | , sha256TestCase "How can you write a big system without C++? -Paul Glick" "4f9b189a13d030838269dce846b16a1ce9ce81fe63e65de2f636863336a98fe6" ] 139 | 140 | testGoSHA384 = testGroup "SHA-384" 141 | [ sha384TestCase "" "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b" 142 | , sha384TestCase "a" "54a59b9f22b0b80880d8427e548b7c23abd873486e1f035dce9cd697e85175033caa88e6d57bc35efae0b5afd3145f31" 143 | , sha384TestCase "ab" "c7be03ba5bcaa384727076db0018e99248e1a6e8bd1b9ef58a9ec9dd4eeebb3f48b836201221175befa74ddc3d35afdd" 144 | , sha384TestCase "abc" "cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7" 145 | , sha384TestCase "abcd" "1165b3406ff0b52a3d24721f785462ca2276c9f454a116c2b2ba20171a7905ea5a026682eb659c4d5f115c363aa3c79b" 146 | , sha384TestCase "abcde" "4c525cbeac729eaf4b4665815bc5db0c84fe6300068a727cf74e2813521565abc0ec57a37ee4d8be89d097c0d2ad52f0" 147 | , sha384TestCase "abcdef" "c6a4c65b227e7387b9c3e839d44869c4cfca3ef583dea64117859b808c1e3d8ae689e1e314eeef52a6ffe22681aa11f5" 148 | , sha384TestCase "abcdefg" "9f11fc131123f844c1226f429b6a0a6af0525d9f40f056c7fc16cdf1b06bda08e302554417a59fa7dcf6247421959d22" 149 | , sha384TestCase "abcdefgh" "9000cd7cada59d1d2eb82912f7f24e5e69cc5517f68283b005fa27c285b61e05edf1ad1a8a9bded6fd29eb87d75ad806" 150 | , sha384TestCase "abcdefghi" "ef54915b60cf062b8dd0c29ae3cad69abe6310de63ac081f46ef019c5c90897caefd79b796cfa81139788a260ded52df" 151 | , sha384TestCase "abcdefghij" "a12070030a02d86b0ddacd0d3a5b598344513d0a051e7355053e556a0055489c1555399b03342845c4adde2dc44ff66c" 152 | , sha384TestCase "Discard medicine more than two years old." "86f58ec2d74d1b7f8eb0c2ff0967316699639e8d4eb129de54bdf34c96cdbabe200d052149f2dd787f43571ba74670d4" 153 | , sha384TestCase "He who has a shady past knows that nice guys finish last." "ae4a2b639ca9bfa04b1855d5a05fe7f230994f790891c6979103e2605f660c4c1262a48142dcbeb57a1914ba5f7c3fa7" 154 | , sha384TestCase "I wouldn't marry him with a ten foot pole." "40ae213df6436eca952aa6841886fcdb82908ef1576a99c8f49bb9dd5023169f7c53035abdda0b54c302f4974e2105e7" 155 | , sha384TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "e7cf8b873c9bc950f06259aa54309f349cefa72c00d597aebf903e6519a50011dfe355afff064a10701c705693848df9" 156 | , sha384TestCase "The days of the digital watch are numbered. -Tom Stoppard" "c3d4f0f4047181c7d39d34703365f7bf70207183caf2c2f6145f04da895ef69124d9cdeb635da636c3a474e61024e29b" 157 | , sha384TestCase "Nepal premier won't resign." "a097aab567e167d5cf93676ed73252a69f9687cb3179bb2d27c9878119e94bf7b7c4b58dc90582edfaf66e11388ed714" 158 | , sha384TestCase "For every action there is an equal and opposite government program." "5026ca45c41fc64712eb65065da92f6467541c78f8966d3fe2c8e3fb769a3ec14215f819654b47bd64f7f0eac17184f3" 159 | , sha384TestCase "His money is twice tainted: 'taint yours and 'taint mine." "ac1cc0f5ac8d5f5514a7b738ac322b7fb52a161b449c3672e9b6a6ad1a5e4b26b001cf3bad24c56598676ca17d4b445a" 160 | , sha384TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "722d10c5de371ec0c8c4b5247ac8a5f1d240d68c73f8da13d8b25f0166d6f309bf9561979a111a0049405771d201941a" 161 | , sha384TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "dc2d3ea18bfa10549c63bf2b75b39b5167a80c12aff0e05443168ea87ff149fb0eda5e0bd234eb5d48c7d02ffc5807f1" 162 | , sha384TestCase "size: a.out: bad magic" "1d67c969e2a945ae5346d2139760261504d4ba164c522443afe19ef3e29b152a4c52445489cfc9d7215e5a450e8e1e4e" 163 | , sha384TestCase "The major problem is with sendmail. -Mark Horton" "5ff8e075e465646e7b73ef36d812c6e9f7d60fa6ea0e533e5569b4f73cde53cdd2cc787f33540af57cca3fe467d32fe0" 164 | , sha384TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "5bd0a997a67c9ae1979a894eb0cde403dde003c9b6f2c03cf21925c42ff4e1176e6df1ca005381612ef18457b9b7ec3b" 165 | , sha384TestCase "If the enemy is within range, then so are you." "1eee6da33e7e54fc5be52ae23b94b16ba4d2a947ae4505c6a3edfc7401151ea5205ac01b669b56f27d8ef7f175ed7762" 166 | , sha384TestCase "It's well we cannot hear the screams/That we create in others' dreams." "76b06e9dea66bfbb1a96029426dc0dfd7830bd297eb447ff5358d94a87cd00c88b59df2493fef56ecbb5231073892ea9" 167 | , sha384TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "12acaf21452cff586143e3f5db0bfdf7802c057e1adf2a619031c4e1b0ccc4208cf6cef8fe722bbaa2fb46a30d9135d8" 168 | , sha384TestCase "C is as portable as Stonehedge!!" "0fc23d7f4183efd186f0bc4fc5db867e026e2146b06cb3d52f4bdbd57d1740122caa853b41868b197b2ac759db39df88" 169 | , sha384TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "bc805578a7f85d34a86a32976e1c34fe65cf815186fbef76f46ef99cda10723f971f3f1464d488243f5e29db7488598d" 170 | , sha384TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "b23918399a12ebf4431559eec3813eaf7412e875fd7464f16d581e473330842d2e96c6be49a7ce3f9bb0b8bc0fcbe0fe" 171 | , sha384TestCase "How can you write a big system without C++? -Paul Glick" "1764b700eb1ead52a2fc33cc28975c2180f1b8faa5038d94cffa8d78154aab16e91dd787e7b0303948ebed62561542c8" ] 172 | 173 | testGoSHA512 = testGroup "SHA-512" 174 | [ sha512TestCase "" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" 175 | , sha512TestCase "a" "1f40fc92da241694750979ee6cf582f2d5d7d28e18335de05abc54d0560e0f5302860c652bf08d560252aa5e74210546f369fbbbce8c12cfc7957b2652fe9a75" 176 | , sha512TestCase "ab" "2d408a0717ec188158278a796c689044361dc6fdde28d6f04973b80896e1823975cdbf12eb63f9e0591328ee235d80e9b5bf1aa6a44f4617ff3caf6400eb172d" 177 | , sha512TestCase "abc" "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f" 178 | , sha512TestCase "abcd" "d8022f2060ad6efd297ab73dcc5355c9b214054b0d1776a136a669d26a7d3b14f73aa0d0ebff19ee333368f0164b6419a96da49e3e481753e7e96b716bdccb6f" 179 | , sha512TestCase "abcde" "878ae65a92e86cac011a570d4c30a7eaec442b85ce8eca0c2952b5e3cc0628c2e79d889ad4d5c7c626986d452dd86374b6ffaa7cd8b67665bef2289a5c70b0a1" 180 | , sha512TestCase "abcdef" "e32ef19623e8ed9d267f657a81944b3d07adbb768518068e88435745564e8d4150a0a703be2a7d88b61e3d390c2bb97e2d4c311fdc69d6b1267f05f59aa920e7" 181 | , sha512TestCase "abcdefg" "d716a4188569b68ab1b6dfac178e570114cdf0ea3a1cc0e31486c3e41241bc6a76424e8c37ab26f096fc85ef9886c8cb634187f4fddff645fb099f1ff54c6b8c" 182 | , sha512TestCase "abcdefgh" "a3a8c81bc97c2560010d7389bc88aac974a104e0e2381220c6e084c4dccd1d2d17d4f86db31c2a851dc80e6681d74733c55dcd03dd96f6062cdda12a291ae6ce" 183 | , sha512TestCase "abcdefghi" "f22d51d25292ca1d0f68f69aedc7897019308cc9db46efb75a03dd494fc7f126c010e8ade6a00a0c1a5f1b75d81e0ed5a93ce98dc9b833db7839247b1d9c24fe" 184 | , sha512TestCase "abcdefghij" "ef6b97321f34b1fea2169a7db9e1960b471aa13302a988087357c520be957ca119c3ba68e6b4982c019ec89de3865ccf6a3cda1fe11e59f98d99f1502c8b9745" 185 | , sha512TestCase "Discard medicine more than two years old." "2210d99af9c8bdecda1b4beff822136753d8342505ddce37f1314e2cdbb488c6016bdaa9bd2ffa513dd5de2e4b50f031393d8ab61f773b0e0130d7381e0f8a1d" 186 | , sha512TestCase "He who has a shady past knows that nice guys finish last." "a687a8985b4d8d0a24f115fe272255c6afaf3909225838546159c1ed685c211a203796ae8ecc4c81a5b6315919b3a64f10713da07e341fcdbb08541bf03066ce" 187 | , sha512TestCase "I wouldn't marry him with a ten foot pole." "8ddb0392e818b7d585ab22769a50df660d9f6d559cca3afc5691b8ca91b8451374e42bcdabd64589ed7c91d85f626596228a5c8572677eb98bc6b624befb7af8" 188 | , sha512TestCase "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave" "26ed8f6ca7f8d44b6a8a54ae39640fa8ad5c673f70ee9ce074ba4ef0d483eea00bab2f61d8695d6b34df9c6c48ae36246362200ed820448bdc03a720366a87c6" 189 | , sha512TestCase "The days of the digital watch are numbered. -Tom Stoppard" "e5a14bf044be69615aade89afcf1ab0389d5fc302a884d403579d1386a2400c089b0dbb387ed0f463f9ee342f8244d5a38cfbc0e819da9529fbff78368c9a982" 190 | , sha512TestCase "Nepal premier won't resign." "420a1faa48919e14651bed45725abe0f7a58e0f099424c4e5a49194946e38b46c1f8034b18ef169b2e31050d1648e0b982386595f7df47da4b6fd18e55333015" 191 | , sha512TestCase "For every action there is an equal and opposite government program." "d926a863beadb20134db07683535c72007b0e695045876254f341ddcccde132a908c5af57baa6a6a9c63e6649bba0c213dc05fadcf9abccea09f23dcfb637fbe" 192 | , sha512TestCase "His money is twice tainted: 'taint yours and 'taint mine." "9a98dd9bb67d0da7bf83da5313dff4fd60a4bac0094f1b05633690ffa7f6d61de9a1d4f8617937d560833a9aaa9ccafe3fd24db418d0e728833545cadd3ad92d" 193 | , sha512TestCase "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977" "d7fde2d2351efade52f4211d3746a0780a26eec3df9b2ed575368a8a1c09ec452402293a8ea4eceb5a4f60064ea29b13cdd86918cd7a4faf366160b009804107" 194 | , sha512TestCase "It's a tiny change to the code and not completely disgusting. - Bob Manchek" "b0f35ffa2697359c33a56f5c0cf715c7aeed96da9905ca2698acadb08fbc9e669bf566b6bd5d61a3e86dc22999bcc9f2224e33d1d4f32a228cf9d0349e2db518" 195 | , sha512TestCase "size: a.out: bad magic" "3d2e5f91778c9e66f7e061293aaa8a8fc742dd3b2e4f483772464b1144189b49273e610e5cccd7a81a19ca1fa70f16b10f1a100a4d8c1372336be8484c64b311" 196 | , sha512TestCase "The major problem is with sendmail. -Mark Horton" "b2f68ff58ac015efb1c94c908b0d8c2bf06f491e4de8e6302c49016f7f8a33eac3e959856c7fddbc464de618701338a4b46f76dbfaf9a1e5262b5f40639771c7" 197 | , sha512TestCase "Give me a rock, paper and scissors and I will move the world. CCFestoon" "d8c92db5fdf52cf8215e4df3b4909d29203ff4d00e9ad0b64a6a4e04dec5e74f62e7c35c7fb881bd5de95442123df8f57a489b0ae616bd326f84d10021121c57" 198 | , sha512TestCase "If the enemy is within range, then so are you." "19a9f8dc0a233e464e8566ad3ca9b91e459a7b8c4780985b015776e1bf239a19bc233d0556343e2b0a9bc220900b4ebf4f8bdf89ff8efeaf79602d6849e6f72e" 199 | , sha512TestCase "It's well we cannot hear the screams/That we create in others' dreams." "00b4c41f307bde87301cdc5b5ab1ae9a592e8ecbb2021dd7bc4b34e2ace60741cc362560bec566ba35178595a91932b8d5357e2c9cec92d393b0fa7831852476" 200 | , sha512TestCase "You remind me of a TV show, but that's all right: I watch it anyway." "91eccc3d5375fd026e4d6787874b1dce201cecd8a27dbded5065728cb2d09c58a3d467bb1faf353bf7ba567e005245d5321b55bc344f7c07b91cb6f26c959be7" 201 | , sha512TestCase "C is as portable as Stonehedge!!" "fabbbe22180f1f137cfdc9556d2570e775d1ae02a597ded43a72a40f9b485d500043b7be128fb9fcd982b83159a0d99aa855a9e7cc4240c00dc01a9bdf8218d7" 202 | , sha512TestCase "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley" "2ecdec235c1fa4fc2a154d8fba1dddb8a72a1ad73838b51d792331d143f8b96a9f6fcb0f34d7caa351fe6d88771c4f105040e0392f06e0621689d33b2f3ba92e" 203 | , sha512TestCase "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule" "7ad681f6f96f82f7abfa7ecc0334e8fa16d3dc1cdc45b60b7af43fe4075d2357c0c1d60e98350f1afb1f2fe7a4d7cd2ad55b88e458e06b73c40b437331f5dab4" 204 | , sha512TestCase "How can you write a big system without C++? -Paul Glick" "833f9248ab4a3b9e5131f745fda1ffd2dd435b30e965957e78291c7ab73605fd1912b0794e5c233ab0a12d205a39778d19b83515d6a47003f19cdee51d98c7e0" ] 205 | 206 | -- | Tests our SHA-2 implementations against coreutils'. 207 | testCoreutilsConformance = testGroup "conformance with coreutils" 208 | [ testProperty "SHA-224" $ testAgainstCoreutils sha224 "sha224sum" 209 | , testProperty "SHA-256" $ testAgainstCoreutils sha256 "sha256sum" 210 | , testProperty "SHA-384" $ testAgainstCoreutils sha384 "sha384sum" 211 | , testProperty "SHA-512" $ testAgainstCoreutils sha512 "sha512sum" ] 212 | 213 | -- | Tests our SHA-2 implementations against openssl(1)'s. 214 | testOpenSSLConformance = testGroup "conformance with OpenSSL" 215 | [ testProperty "SHA-224" $ testAgainstOpenSSL sha224 "sha224" 216 | , testProperty "SHA-256" $ testAgainstOpenSSL sha256 "sha256" 217 | , testProperty "SHA-384" $ testAgainstOpenSSL sha384 "sha384" 218 | , testProperty "SHA-512" $ testAgainstOpenSSL sha512 "sha512" ] 219 | -------------------------------------------------------------------------------- /tests/Data/DigestTests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module Data.DigestTests (tests) where 16 | 17 | import Test.Tasty (TestTree, testGroup) 18 | import Test.Tasty.HUnit ((@?), testCase) 19 | 20 | import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) 21 | import qualified Data.Digest.MD5Tests 22 | import qualified Data.Digest.SHA1Tests 23 | import qualified Data.Digest.SHA2Tests 24 | 25 | tests :: TestTree 26 | tests = testGroup "Data.Digest" 27 | [ showTests 28 | , Data.Digest.MD5Tests.tests 29 | , Data.Digest.SHA1Tests.tests 30 | , Data.Digest.SHA2Tests.tests ] 31 | 32 | showTests = testGroup "show" 33 | [ testNonEmpty "MD5" (show md5) 34 | , testNonEmpty "SHA-1" (show sha1) 35 | , testNonEmpty "SHA-224" (show sha224) 36 | , testNonEmpty "SHA-256" (show sha256) 37 | , testNonEmpty "SHA-384" (show sha384) 38 | , testNonEmpty "SHA-512" (show sha512) ] 39 | where 40 | testNonEmpty description string = testCase description $ 41 | not (null string) @? "expected: nonempty string\n but got: " ++ show string 42 | -------------------------------------------------------------------------------- /tests/Data/HMACTests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2018 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Data.HMACTests (tests) where 18 | 19 | import Data.ByteString (ByteString) 20 | import qualified Data.ByteString as ByteString 21 | import qualified Data.ByteString.Lazy as Lazy (ByteString) 22 | import qualified Data.ByteString.Lazy as ByteString.Lazy 23 | import Test.Tasty (TestTree, testGroup) 24 | import Test.Tasty.HUnit (testCase) 25 | 26 | import BTLS.Assertions (isRightAndHolds) 27 | import BTLS.TestUtilities (abbreviate, hex) 28 | import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) 29 | import Data.HMAC (HMAC(HMAC), HMACParams(..), hmac) 30 | 31 | tests :: TestTree 32 | tests = testGroup "Data.HMAC" 33 | [ testRFC2202 34 | , testFIPS198 35 | , testRFC4231 ] 36 | 37 | hmacTestCase :: HMACParams -> Lazy.ByteString -> ByteString -> TestTree 38 | hmacTestCase params input output = hmacTestCase' (abbreviate input) params input output 39 | 40 | hmacTestCase' :: String -> HMACParams -> Lazy.ByteString -> ByteString -> TestTree 41 | hmacTestCase' description params input output = 42 | testCase description $ hmac params input `isRightAndHolds` hexHMAC output 43 | 44 | -- | Tests from RFC 2202. 45 | testRFC2202 = testGroup "RFC 2202" [testMD5, testSHA1] 46 | where testMD5 = testGroup "MD5" 47 | [ hmacTestCase 48 | HMACParams { algorithm = md5 49 | , secretKey = ByteString.replicate 16 0x0b } 50 | "Hi There" 51 | "9294727a3638bb1c13f48ef8158bfc9d" 52 | , hmacTestCase 53 | HMACParams { algorithm = md5 54 | , secretKey = "Jefe" } 55 | "what do ya want for nothing?" 56 | "750c783e6ab0b503eaa86e310a5db738" 57 | , hmacTestCase 58 | HMACParams { algorithm = md5 59 | , secretKey = ByteString.replicate 16 0xaa } 60 | (ByteString.Lazy.replicate 50 0xdd) 61 | "56be34521d144c88dbb8c733f0e8b3f6" 62 | , hmacTestCase 63 | HMACParams { algorithm = md5 64 | , secretKey = ByteString.pack [0x01 .. 0x19] } 65 | (ByteString.Lazy.replicate 50 0xcd) 66 | "697eaf0aca3a3aea3a75164746ffaa79" 67 | , hmacTestCase 68 | HMACParams { algorithm = md5 69 | , secretKey = ByteString.replicate 16 0x0c } 70 | "Test With Truncation" 71 | "56461ef2342edc00f9bab995690efd4c" 72 | , hmacTestCase 73 | HMACParams { algorithm = md5 74 | , secretKey = ByteString.replicate 80 0xaa } 75 | "Test Using Larger Than Block-Size Key - Hash Key First" 76 | "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" 77 | , hmacTestCase 78 | HMACParams { algorithm = md5 79 | , secretKey = ByteString.replicate 80 0xaa } 80 | "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" 81 | "6f630fad67cda0ee1fb1f562db3aa53e" ] 82 | testSHA1 = testGroup "SHA-1" 83 | [ hmacTestCase 84 | HMACParams { algorithm = sha1 85 | , secretKey = ByteString.replicate 20 0x0b } 86 | "Hi There" 87 | "b617318655057264e28bc0b6fb378c8ef146be00" 88 | , hmacTestCase 89 | HMACParams { algorithm = sha1 90 | , secretKey = "Jefe" } 91 | "what do ya want for nothing?" 92 | "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" 93 | , hmacTestCase 94 | HMACParams { algorithm = sha1 95 | , secretKey = ByteString.replicate 20 0xaa } 96 | (ByteString.Lazy.replicate 50 0xdd) 97 | "125d7342b9ac11cd91a39af48aa17b4f63f175d3" 98 | , hmacTestCase 99 | HMACParams { algorithm = sha1 100 | , secretKey = ByteString.pack [0x01 .. 0x19] } 101 | (ByteString.Lazy.replicate 50 0xcd) 102 | "4c9007f4026250c6bc8414f9bf50c86c2d7235da" 103 | , hmacTestCase 104 | HMACParams { algorithm = sha1 105 | , secretKey = ByteString.replicate 20 0x0c } 106 | "Test With Truncation" 107 | "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04" 108 | , hmacTestCase 109 | HMACParams { algorithm = sha1 110 | , secretKey = ByteString.replicate 80 0xaa } 111 | "Test Using Larger Than Block-Size Key - Hash Key First" 112 | "aa4ae5e15272d00e95705637ce8a3b55ed402112" 113 | , hmacTestCase 114 | HMACParams { algorithm = sha1 115 | , secretKey = ByteString.replicate 80 0xaa } 116 | "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" 117 | "e8e99d0f45237d786d6bbaa7965c7808bbff1a91" ] 118 | 119 | -- | Tests from FIPS 198. 120 | testFIPS198 = testGroup "FIPS 198 (SHA-1)" $ 121 | [ hmacTestCase 122 | HMACParams { algorithm = sha1 123 | , secretKey = ByteString.pack [0 .. 0x3f] } 124 | "Sample #1" 125 | "4f4ca3d5d68ba7cc0a1208c9c61e9c5da0403c0a" 126 | , hmacTestCase 127 | HMACParams { algorithm = sha1 128 | , secretKey = ByteString.pack [0x30 .. 0x43] } 129 | "Sample #2" 130 | "0922d3405faa3d194f82a45830737d5cc6c75d24" 131 | , hmacTestCase 132 | HMACParams { algorithm = sha1 133 | , secretKey = ByteString.pack [0x50 .. 0xb3] } 134 | "Sample #3" 135 | "bcf41eab8bb2d802f3d05caf7cb092ecf8d1a3aa" 136 | ] ++ [truncatedFIPS198Test] 137 | where truncatedFIPS198Test = 138 | let input = "Sample #4" in 139 | testCase (abbreviate input) $ 140 | (truncateHMAC 24 <$> hmac HMACParams { algorithm = sha1, secretKey = ByteString.pack [0x70 .. 0xa0] } input) 141 | `isRightAndHolds` hexHMAC "9ea886efe268dbecce420c75" 142 | 143 | -- | Tests from RFC 4231. 144 | testRFC4231 = testGroup "RFC 4231" $ 145 | let rfc4231TestCase key input sha224Output sha256Output sha384Output sha512Output = 146 | testGroup (abbreviate input) 147 | [ hmacTestCase' "SHA-224" HMACParams { algorithm = sha224, secretKey = key } input sha224Output 148 | , hmacTestCase' "SHA-256" HMACParams { algorithm = sha256, secretKey = key } input sha256Output 149 | , hmacTestCase' "SHA-384" HMACParams { algorithm = sha384, secretKey = key } input sha384Output 150 | , hmacTestCase' "SHA-512" HMACParams { algorithm = sha512, secretKey = key } input sha512Output ] in 151 | [ rfc4231TestCase (ByteString.replicate 20 0x0b) "Hi There" 152 | "896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22" 153 | "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" 154 | "afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6" 155 | "87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854" 156 | , rfc4231TestCase ("Jefe") "what do ya want for nothing?" 157 | "a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44" 158 | "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843" 159 | "af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649" 160 | "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" 161 | , rfc4231TestCase (ByteString.replicate 20 0xaa) (ByteString.Lazy.replicate 50 0xdd) 162 | "7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea" 163 | "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe" 164 | "88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27" 165 | "fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb" 166 | , rfc4231TestCase (ByteString.pack [0x01 .. 0x19]) (ByteString.Lazy.replicate 50 0xcd) 167 | "6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a" 168 | "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b" 169 | "3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb" 170 | "b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd" 171 | , rfc4231TestCase (ByteString.replicate 131 0xaa) "Test Using Larger Than Block-Size Key - Hash Key First" 172 | "95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e" 173 | "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54" 174 | "4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952" 175 | "80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598" 176 | , rfc4231TestCase (ByteString.replicate 131 0xaa) "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm." 177 | "3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1" 178 | "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2" 179 | "6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e" 180 | "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58" 181 | ] ++ [truncatedRFC4231Test] 182 | where truncatedRFC4231Test = 183 | let key = ByteString.replicate 20 0x0c 184 | input = "Test With Truncation" 185 | truncatedTestCase description algo output = 186 | testCase description $ 187 | (truncateHMAC 32 <$> hmac HMACParams { algorithm = algo, secretKey = key } input) 188 | `isRightAndHolds` hexHMAC output in 189 | testGroup (abbreviate input) 190 | [ truncatedTestCase "SHA-224" sha224 "0e2aea68a90c8d37c988bcdb9fca6fa8" 191 | , truncatedTestCase "SHA-256" sha256 "a3b6167473100ee06e0c796c2955552b" 192 | , truncatedTestCase "SHA-384" sha384 "3abf34c3503b2a23a46efc619baef897" 193 | , truncatedTestCase "SHA-512" sha512 "415fad6271580a531d4179bc891d87a6" ] 194 | 195 | hexHMAC :: ByteString -> HMAC 196 | hexHMAC = HMAC . hex 197 | 198 | truncateHMAC :: Int -> HMAC -> HMAC 199 | truncateHMAC n (HMAC m) = HMAC (ByteString.take n m) 200 | -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 Google LLC 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); you may not 4 | -- use this file except in compliance with the License. You may obtain a copy of 5 | -- the License at 6 | -- 7 | -- https://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT 11 | -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the 12 | -- License for the specific language governing permissions and limitations under 13 | -- the License. 14 | 15 | module Main 16 | ( main 17 | ) where 18 | 19 | import Test.Tasty (defaultMain, testGroup) 20 | 21 | import qualified Codec.Crypto.EncryptionTests 22 | import qualified Codec.Crypto.HKDFTests 23 | import qualified Data.DigestTests 24 | import qualified Data.HMACTests 25 | 26 | main :: IO () 27 | main = defaultMain $ testGroup "btls" 28 | [ Codec.Crypto.EncryptionTests.tests 29 | , Codec.Crypto.HKDFTests.tests 30 | , Data.DigestTests.tests 31 | , Data.HMACTests.tests 32 | ] 33 | --------------------------------------------------------------------------------