├── .circleci └── config.yml ├── .envrc ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.rst ├── Setup.hs ├── cmd └── interop-entrypoint │ └── Main.hs ├── flake.lock ├── flake.nix ├── requirements.txt ├── spake2.cabal ├── src └── Crypto │ ├── Spake2.hs │ └── Spake2 │ ├── Group.hs │ ├── Groups.hs │ ├── Groups │ ├── Ed25519.hs │ └── IntegerGroup.hs │ ├── Math.hs │ └── Util.hs └── tests ├── Groups.hs ├── Integration.hs ├── Spake2.hs ├── Tasty.hs └── python └── spake2_exchange.py /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2.1 2 | jobs: 3 | build: 4 | docker: 5 | - image: fpco/stack-build:lts 6 | steps: 7 | - run: 8 | name: Install Dependencies 9 | command: | 10 | apt-get update 11 | apt-get install cabal-install 12 | 13 | - checkout 14 | 15 | - run: 16 | name: workaround for certificate failure 17 | command: | 18 | mv /etc/apt/sources.list.d/nodesource.list /etc/apt/sources.list.d/nodesource.list.disabled 19 | apt-get update 20 | apt-get -y upgrade 21 | apt-get install -y ca-certificates libgnutls30 22 | mv /etc/apt/sources.list.d/nodesource.list.disabled /etc/apt/sources.list.d/nodesource.list 23 | 24 | - run: 25 | name: Install pip 26 | command: apt-get install -y python3-pip 27 | 28 | - run: 29 | name: Install dependencies 30 | command: pip install --user -r requirements.txt 31 | 32 | - run: 33 | name: Tests 34 | command: cabal test 35 | -------------------------------------------------------------------------------- /.envrc: -------------------------------------------------------------------------------- 1 | use flake 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.stack-work 2 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 0.4.3 (2020-11-19) 4 | 5 | * general maintenance and removal of bitrot. 6 | * Pin protolude to 0.3.x to prevent further breakage due to changes in 7 | protolude. 8 | 9 | ## 0.4.2 (2018-01-22) 10 | 11 | * Minor release to allow docs to be generated on Hackage. 12 | 13 | ## 0.4.1 (2018-01-17) 14 | 15 | * Fixed potential security issue in Ed25519 (see 16 | https://github.com/jml/haskell-spake2/pull/16), present since 17 | initial release. Please update as soon as possible. 18 | 19 | ## 0.4.0 (2017-11-22) 20 | 21 | * Change `createSessionKey` inputs to be `inbound`, `outbound` rather than 22 | `side A`, `side B`. If you were passing as `side A`, `side B` before, it 23 | should continue to work, unless you were deliberately triggering an error 24 | condition. 25 | * Add `spake2Exchange`, for much more convenient exchanges. 26 | 27 | ## 0.3.0 (2017-11-11) 28 | 29 | * Depend on protolude 0.2 minimum 30 | 31 | ## 0.2.0 (2017-06-08) 32 | 33 | * `Group` typeclass split into `Group` and `AbelianGroup` typeclasses 34 | 35 | ## 0.1.0 (2017-05-28) 36 | 37 | Initial release 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | 3 | Version 2.0, January 2004 4 | 5 | http://www.apache.org/licenses/ 6 | 7 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 8 | 9 | 1. Definitions. 10 | 11 | "License" shall mean the terms and conditions for use, reproduction, and 12 | distribution as defined by Sections 1 through 9 of this document. 13 | 14 | "Licensor" shall mean the copyright owner or entity authorized by the 15 | copyright owner that is granting the License. 16 | 17 | "Legal Entity" shall mean the union of the acting entity and all other 18 | entities that control, are controlled by, or are under common control with 19 | that entity. For the purposes of this definition, "control" means (i) the 20 | power, direct or indirect, to cause the direction or management of such 21 | entity, whether by contract or otherwise, or (ii) ownership of fifty percent 22 | (50%) or more of the outstanding shares, or (iii) beneficial ownership of such 23 | entity. 24 | 25 | "You" (or "Your") shall mean an individual or Legal Entity exercising 26 | permissions granted by this License. 27 | 28 | "Source" form shall mean the preferred form for making modifications, 29 | including but not limited to software source code, documentation source, and 30 | configuration files. 31 | 32 | "Object" form shall mean any form resulting from mechanical transformation or 33 | translation of a Source form, including but not limited to compiled object 34 | code, generated documentation, and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or Object form, 37 | made available under the License, as indicated by a copyright notice that is 38 | included in or attached to the work (an example is provided in the Appendix 39 | below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object form, that 42 | is based on (or derived from) the Work and for which the editorial revisions, 43 | annotations, elaborations, or other modifications represent, as a whole, an 44 | original work of authorship. For the purposes of this License, Derivative 45 | Works shall not include works that remain separable from, or merely link (or 46 | bind by name) to the interfaces of, the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including the original 49 | version of the Work and any modifications or additions to that Work or 50 | Derivative Works thereof, that is intentionally submitted to Licensor for 51 | inclusion in the Work by the copyright owner or by an individual or Legal 52 | Entity authorized to submit on behalf of the copyright owner. For the purposes 53 | of this definition, "submitted" means any form of electronic, verbal, or 54 | written communication sent to the Licensor or its representatives, including 55 | but not limited to communication on electronic mailing lists, source code 56 | control systems, and issue tracking systems that are managed by, or on behalf 57 | of, the Licensor for the purpose of discussing and improving the Work, but 58 | excluding communication that is conspicuously marked or otherwise designated 59 | in writing by the copyright owner as "Not a Contribution." 60 | 61 | "Contributor" shall mean Licensor and any individual or Legal Entity on behalf 62 | of whom a Contribution has been received by Licensor and subsequently 63 | incorporated within the Work. 64 | 65 | 2. Grant of Copyright License. Subject to the terms and conditions of this 66 | License, each Contributor hereby grants to You a perpetual, worldwide, 67 | non-exclusive, no-charge, royalty-free, irrevocable copyright license to 68 | reproduce, prepare Derivative Works of, publicly display, publicly perform, 69 | sublicense, and distribute the Work and such Derivative Works in Source or 70 | Object form. 71 | 72 | 3. Grant of Patent License. Subject to the terms and conditions of this 73 | License, each Contributor hereby grants to You a perpetual, worldwide, 74 | non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this 75 | section) patent license to make, have made, use, offer to sell, sell, import, 76 | and otherwise transfer the Work, where such license applies only to those 77 | patent claims licensable by such Contributor that are necessarily infringed by 78 | their Contribution(s) alone or by combination of their Contribution(s) with 79 | the Work to which such Contribution(s) was submitted. If You institute patent 80 | litigation against any entity (including a cross-claim or counterclaim in a 81 | lawsuit) alleging that the Work or a Contribution incorporated within the Work 82 | constitutes direct or contributory patent infringement, then any patent 83 | licenses granted to You under this License for that Work shall terminate as of 84 | the date such litigation is filed. 85 | 86 | 4. Redistribution. You may reproduce and distribute copies of the Work or 87 | Derivative Works thereof in any medium, with or without modifications, and in 88 | Source or Object form, provided that You meet the following conditions: 89 | 90 | You must give any other recipients of the Work or Derivative Works a copy of 91 | this License; and 92 | 93 | You must cause any modified files to carry prominent notices stating that You 94 | changed the files; and 95 | 96 | You must retain, in the Source form of any Derivative Works that You 97 | distribute, all copyright, patent, trademark, and attribution notices from the 98 | Source form of the Work, excluding those notices that do not pertain to any 99 | part of the Derivative Works; and 100 | 101 | If the Work includes a "NOTICE" text file as part of its distribution, then 102 | any Derivative Works that You distribute must include a readable copy of the 103 | attribution notices contained within such NOTICE file, excluding those notices 104 | that do not pertain to any part of the Derivative Works, in at least one of 105 | the following places: within a NOTICE text file distributed as part of the 106 | Derivative Works; within the Source form or documentation, if provided along 107 | with the Derivative Works; or, within a display generated by the Derivative 108 | Works, if and wherever such third-party notices normally appear. The contents 109 | of the NOTICE file are for informational purposes only and do not modify the 110 | License. You may add Your own attribution notices within Derivative Works that 111 | You distribute, alongside or as an addendum to the NOTICE text from the Work, 112 | provided that such additional attribution notices cannot be construed as 113 | modifying the License. 114 | 115 | You may add Your own copyright statement to Your modifications and may provide 116 | additional or different license terms and conditions for use, reproduction, or 117 | distribution of Your modifications, or for any such Derivative Works as a 118 | whole, provided Your use, reproduction, and distribution of the Work otherwise 119 | complies with the conditions stated in this License. 120 | 121 | 5. Submission of Contributions. Unless You explicitly state otherwise, any 122 | Contribution intentionally submitted for inclusion in the Work by You to the 123 | Licensor shall be under the terms and conditions of this License, without any 124 | additional terms or conditions. Notwithstanding the above, nothing herein 125 | shall supersede or modify the terms of any separate license agreement you may 126 | have executed with Licensor regarding such Contributions. 127 | 128 | 6. Trademarks. This License does not grant permission to use the trade names, 129 | trademarks, service marks, or product names of the Licensor, except as 130 | required for reasonable and customary use in describing the origin of the Work 131 | and reproducing the content of the NOTICE file. 132 | 133 | 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in 134 | writing, Licensor provides the Work (and each Contributor provides its 135 | Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 136 | KIND, either express or implied, including, without limitation, any warranties 137 | or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 138 | PARTICULAR PURPOSE. You are solely responsible for determining the 139 | appropriateness of using or redistributing the Work and assume any risks 140 | associated with Your exercise of permissions under this License. 141 | 142 | 8. Limitation of Liability. In no event and under no legal theory, whether in 143 | tort (including negligence), contract, or otherwise, unless required by 144 | applicable law (such as deliberate and grossly negligent acts) or agreed to in 145 | writing, shall any Contributor be liable to You for damages, including any 146 | direct, indirect, special, incidental, or consequential damages of any 147 | character arising as a result of this License or out of the use or inability 148 | to use the Work (including but not limited to damages for loss of goodwill, 149 | work stoppage, computer failure or malfunction, or any and all other 150 | commercial damages or losses), even if such Contributor has been advised of 151 | the possibility of such damages. 152 | 153 | 9. Accepting Warranty or Additional Liability. While redistributing the Work 154 | or Derivative Works thereof, You may choose to offer, and charge a fee for, 155 | acceptance of support, warranty, indemnity, or other liability obligations 156 | and/or rights consistent with this License. However, in accepting such 157 | obligations, You may act only on Your own behalf and on Your sole 158 | responsibility, not on behalf of any other Contributor, and only if You agree 159 | to indemnify, defend, and hold each Contributor harmless for any liability 160 | incurred by, or claims asserted against, such Contributor by reason of your 161 | accepting any such warranty or additional liability. 162 | 163 | END OF TERMS AND CONDITIONS 164 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | ============================= 2 | Haskell SPAKE2 implementation 3 | ============================= 4 | 5 | Implementation of SPAKE2 key exchange protocol. 6 | 7 | Status 8 | ====== 9 | 10 | Working implementation that interoperates with python-spake2 11 | using the default settings, i.e. with Ed25519. 12 | 13 | No other groups implemented. 14 | 15 | Goals 16 | ===== 17 | 18 | * compatibility with `python-spake2 `_ 19 | * (stretch) submit to `cryptonite `_ 20 | 21 | Non-goals 22 | ========= 23 | 24 | Right now: 25 | 26 | * PAKE2+ 27 | * any `Elligator Edition `_ variants 28 | 29 | How to use it 30 | ============= 31 | 32 | The `interoperability harness entry point `_ 33 | is the best working example of how to use the code. 34 | 35 | The `main module documentation `_ might also help. 36 | 37 | Testing for interoperability 38 | ---------------------------- 39 | 40 | Requires the `LeastAuthority interoperability harness `_. 41 | 42 | Assumes that haskell-spake2 has been compiled (``stack build`` will do it) 43 | and that you know where the executable lives (``stack install`` might be helpful here). 44 | 45 | .. these instructions are not yet verified 46 | 47 | To show that Python works as Side A and Haskell works as Side B: 48 | 49 | .. code-block:: console 50 | 51 | $ runhaskell TestInterop.hs ./python-spake2-interop-entrypoint.hs A abc -- /path/to/haskell-spake2-interop-entrypoint B abc 52 | ["./python-spake2-interop-entrypoint.py","A","abc"] 53 | ["/path/to/haskell-spake2-interop-entrypoint","B","abc"] 54 | A's key: 8a2e19664f0a2bc6e446d2c44900c67604fe42f6d7e0a1328a5253b21f4131a5 55 | B's key: 8a2e19664f0a2bc6e446d2c44900c67604fe42f6d7e0a1328a5253b21f4131a5 56 | Session keys match. 57 | 58 | **Note**: if you want to run ``runhaskell`` with ``stack``, 59 | you will need to invoke it like:: 60 | 61 | stack runhaskell TestInterop.hs -- ./python-spake2-interop-entrypoint.hs A abc -- /path/to/haskell-spake2-interop-entrypoint B abc 62 | 63 | The above results are genuine, 64 | and demonstrate that the Haskell SPAKE2 implementation *does* work. 65 | Specifically, that it interoperates with python-spake2. 66 | 67 | Contributing 68 | ============ 69 | 70 | We use `stack `_ for building and testing. 71 | 72 | High-quality documentation with examples is very strongly encouraged, 73 | because this stuff is pretty hard to figure out, and we need all the help we can get. 74 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cmd/interop-entrypoint/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | -- | Entrypoint for testing interoperability. 4 | -- 5 | -- Interoperability harness lives at 6 | -- 7 | -- Any entry point for the harness needs to: 8 | -- - take everything it needs as command-line parameters 9 | -- - print the outbound message to stdout, base16-encoded 10 | -- - read the inbound message from stdin, base16-encoded 11 | -- - print the session key, base16-encoded 12 | -- - terminate 13 | -- 14 | -- Much of the code in here will probably move to the library as we figure out 15 | -- what we need to do to implement the protocol properly. 16 | 17 | module Main (main) where 18 | 19 | import Protolude hiding (group, toS) 20 | import Protolude.Conv (toS) 21 | 22 | import Crypto.Hash (SHA256(..)) 23 | import Data.ByteArray.Encoding (convertFromBase, convertToBase, Base(Base16)) 24 | import Data.String (String) 25 | import Options.Applicative 26 | import System.IO (hFlush, hGetLine) 27 | 28 | import qualified Crypto.Spake2 as Spake2 29 | import Crypto.Spake2 30 | ( Password 31 | , Protocol 32 | , SideID(..) 33 | , makeSymmetricProtocol 34 | , makeAsymmetricProtocol 35 | , makePassword 36 | , spake2Exchange 37 | ) 38 | import Crypto.Spake2.Group (AbelianGroup, Group(..)) 39 | import Crypto.Spake2.Groups (Ed25519(..)) 40 | 41 | 42 | data Config = Config Side Password deriving (Eq, Ord) 43 | 44 | data Side = SideA | SideB | Symmetric deriving (Eq, Ord, Show) 45 | 46 | configParser :: Parser Config 47 | configParser = 48 | Config 49 | <$> argument sideParser (metavar "SIDE") 50 | <*> argument passwordParser (metavar "PASSWORD") 51 | where 52 | sideParser = eitherReader $ \s -> 53 | case s of 54 | "A" -> pure SideA 55 | "B" -> pure SideB 56 | "Symmetric" -> pure Symmetric 57 | unknown -> throwError $ "Unrecognized side: " <> unknown 58 | passwordParser = makePassword . toS @String <$> str 59 | 60 | -- | Terminate the test with a failure, printing a message to stderr. 61 | abort :: HasCallStack => Text -> IO () 62 | abort message = do 63 | hPutStrLn stderr ("ERROR: " <> message) 64 | exitWith (ExitFailure 1) 65 | 66 | 67 | runInteropTest 68 | :: (HasCallStack, AbelianGroup group) 69 | => Protocol group SHA256 70 | -> Password 71 | -> Handle 72 | -> Handle 73 | -> IO () 74 | runInteropTest protocol password inH outH = do 75 | sessionKey' <- spake2Exchange protocol password output input 76 | case sessionKey' of 77 | Left err -> abort $ show err 78 | Right sessionKey -> output sessionKey 79 | where 80 | output :: ByteString -> IO () 81 | output message = do 82 | hPutStrLn outH (convertToBase Base16 message :: ByteString) 83 | hFlush outH 84 | 85 | input :: IO (Either Text ByteString) 86 | input = do 87 | line <- hGetLine inH 88 | case convertFromBase Base16 (toS line :: ByteString) of 89 | Left err -> pure . Left . toS $ "Could not decode line (reason: " <> err <> "): " <> show line 90 | Right bytes -> pure (Right bytes) 91 | 92 | 93 | makeProtocolFromSide :: Side -> Protocol Ed25519 SHA256 94 | makeProtocolFromSide side = 95 | case side of 96 | SideA -> makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideA 97 | SideB -> makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideB 98 | Symmetric -> makeSymmetricProtocol hashAlg group s idSymmetric 99 | where 100 | hashAlg = SHA256 101 | group = Ed25519 102 | m = arbitraryElement group ("M" :: ByteString) 103 | n = arbitraryElement group ("N" :: ByteString) 104 | s = arbitraryElement group ("symmetric" :: ByteString) 105 | idA = SideID "" 106 | idB = SideID "" 107 | idSymmetric = SideID "" 108 | 109 | main :: IO () 110 | main = do 111 | Config side password <- execParser opts 112 | let protocol = makeProtocolFromSide side 113 | runInteropTest protocol password stdin stdout 114 | exitSuccess 115 | where 116 | opts = info (helper <*> configParser) 117 | (fullDesc <> 118 | header "interop-entrypoint - tool to help test SPAKE2 interop") 119 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-compat": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1668681692, 7 | "narHash": "sha256-Ht91NGdewz8IQLtWZ9LCeNXMSXHUss+9COoqu6JLmXU=", 8 | "owner": "edolstra", 9 | "repo": "flake-compat", 10 | "rev": "009399224d5e398d03b22badca40a37ac85412a1", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "edolstra", 15 | "repo": "flake-compat", 16 | "type": "github" 17 | } 18 | }, 19 | "flake-utils": { 20 | "locked": { 21 | "lastModified": 1667395993, 22 | "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", 23 | "owner": "numtide", 24 | "repo": "flake-utils", 25 | "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", 26 | "type": "github" 27 | }, 28 | "original": { 29 | "owner": "numtide", 30 | "repo": "flake-utils", 31 | "type": "github" 32 | } 33 | }, 34 | "flake-utils_2": { 35 | "locked": { 36 | "lastModified": 1667395993, 37 | "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", 38 | "owner": "numtide", 39 | "repo": "flake-utils", 40 | "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", 41 | "type": "github" 42 | }, 43 | "original": { 44 | "owner": "numtide", 45 | "repo": "flake-utils", 46 | "type": "github" 47 | } 48 | }, 49 | "gitignore": { 50 | "inputs": { 51 | "nixpkgs": [ 52 | "hs-flake-utils", 53 | "pre-commit-hooks", 54 | "nixpkgs" 55 | ] 56 | }, 57 | "locked": { 58 | "lastModified": 1660459072, 59 | "narHash": "sha256-8DFJjXG8zqoONA1vXtgeKXy68KdJL5UaXR8NtVMUbx8=", 60 | "owner": "hercules-ci", 61 | "repo": "gitignore.nix", 62 | "rev": "a20de23b925fd8264fd7fad6454652e142fd7f73", 63 | "type": "github" 64 | }, 65 | "original": { 66 | "owner": "hercules-ci", 67 | "repo": "gitignore.nix", 68 | "type": "github" 69 | } 70 | }, 71 | "hs-flake-utils": { 72 | "inputs": { 73 | "flake-utils": "flake-utils_2", 74 | "nixpkgs": [ 75 | "nixpkgs" 76 | ], 77 | "pre-commit-hooks": "pre-commit-hooks" 78 | }, 79 | "locked": { 80 | "lastModified": 1673454489, 81 | "narHash": "sha256-LsOintvQ4n3QPkI5MA+IhmlLlH5BVzL2xqT/h5U5K7w=", 82 | "ref": "main", 83 | "rev": "4feccf13501960b92e1d9d73bf6e046b36861af0", 84 | "revCount": 4, 85 | "type": "git", 86 | "url": "https://whetstone.private.storage/jcalderone/hs-flake-utils.git" 87 | }, 88 | "original": { 89 | "ref": "main", 90 | "type": "git", 91 | "url": "https://whetstone.private.storage/jcalderone/hs-flake-utils.git" 92 | } 93 | }, 94 | "nixpkgs": { 95 | "locked": { 96 | "lastModified": 1670543317, 97 | "narHash": "sha256-4mMR56rtxKr+Gwz399jFr4i76SQZxsLWxxyfQlPXRm0=", 98 | "owner": "nixos", 99 | "repo": "nixpkgs", 100 | "rev": "7a6a010c3a1d00f8470a5ca888f2f927f1860a19", 101 | "type": "github" 102 | }, 103 | "original": { 104 | "owner": "nixos", 105 | "ref": "nixos-22.11", 106 | "repo": "nixpkgs", 107 | "type": "github" 108 | } 109 | }, 110 | "nixpkgs-stable": { 111 | "locked": { 112 | "lastModified": 1671271954, 113 | "narHash": "sha256-cSvu+bnvN08sOlTBWbBrKaBHQZq8mvk8bgpt0ZJ2Snc=", 114 | "owner": "NixOS", 115 | "repo": "nixpkgs", 116 | "rev": "d513b448cc2a6da2c8803e3c197c9fc7e67b19e3", 117 | "type": "github" 118 | }, 119 | "original": { 120 | "owner": "NixOS", 121 | "ref": "nixos-22.05", 122 | "repo": "nixpkgs", 123 | "type": "github" 124 | } 125 | }, 126 | "pre-commit-hooks": { 127 | "inputs": { 128 | "flake-compat": "flake-compat", 129 | "flake-utils": [ 130 | "hs-flake-utils", 131 | "flake-utils" 132 | ], 133 | "gitignore": "gitignore", 134 | "nixpkgs": [ 135 | "hs-flake-utils", 136 | "nixpkgs" 137 | ], 138 | "nixpkgs-stable": "nixpkgs-stable" 139 | }, 140 | "locked": { 141 | "lastModified": 1673281605, 142 | "narHash": "sha256-v6U0G3pJe0YaIuD1Ijhz86EhTgbXZ4f/2By8sLqFk4c=", 143 | "owner": "cachix", 144 | "repo": "pre-commit-hooks.nix", 145 | "rev": "f8992fb404c7e79638192a10905b7ea985818050", 146 | "type": "github" 147 | }, 148 | "original": { 149 | "owner": "cachix", 150 | "repo": "pre-commit-hooks.nix", 151 | "type": "github" 152 | } 153 | }, 154 | "root": { 155 | "inputs": { 156 | "flake-utils": "flake-utils", 157 | "hs-flake-utils": "hs-flake-utils", 158 | "nixpkgs": "nixpkgs" 159 | } 160 | } 161 | }, 162 | "root": "root", 163 | "version": 7 164 | } 165 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "spake2"; 3 | 4 | inputs = { 5 | # Nix Inputs 6 | nixpkgs.url = github:nixos/nixpkgs/?ref=nixos-22.11; 7 | flake-utils.url = github:numtide/flake-utils; 8 | hs-flake-utils.url = "git+https://whetstone.private.storage/jcalderone/hs-flake-utils.git?ref=main"; 9 | hs-flake-utils.inputs.nixpkgs.follows = "nixpkgs"; 10 | }; 11 | 12 | outputs = { 13 | self, 14 | nixpkgs, 15 | flake-utils, 16 | hs-flake-utils, 17 | }: let 18 | ulib = flake-utils.lib; 19 | in 20 | ulib.eachSystem ["x86_64-linux"] (system: let 21 | hslib = hs-flake-utils.lib { 22 | pkgs = nixpkgs.legacyPackages.${system}; 23 | src = ./.; 24 | compilerVersion = "ghc8107"; 25 | packageName = "spake2"; 26 | }; 27 | in { 28 | checks = hslib.checks {}; 29 | devShells = hslib.devShells { 30 | extraBuildInputs = pkgs: [ 31 | (pkgs.python310.withPackages (ps: [ps.spake2 ps.attrs])) 32 | ]; 33 | }; 34 | packages = hslib.packages {}; 35 | }); 36 | } 37 | -------------------------------------------------------------------------------- /requirements.txt: -------------------------------------------------------------------------------- 1 | # These are Python requirements for our interoperability tests. 2 | spake2==0.8 3 | attrs==17.3.0 4 | -------------------------------------------------------------------------------- /spake2.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.2. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: spake2 8 | version: 0.4.3 9 | synopsis: Implementation of the SPAKE2 Password-Authenticated Key Exchange algorithm 10 | description: This library implements the SPAKE2 password-authenticated key exchange 11 | ("PAKE") algorithm. This allows two parties, who share a weak password, to 12 | safely derive a strong shared secret (and therefore build an 13 | encrypted+authenticated channel). 14 | category: Crypto 15 | homepage: https://github.com/LeastAuthority/haskell-spake2#readme 16 | bug-reports: https://github.com/LeastAuthority/haskell-spake2/issues 17 | author: Jonathan M. Lange 18 | maintainer: Least Authority TFA GmbH 19 | license: Apache 20 | license-file: LICENSE 21 | build-type: Simple 22 | extra-source-files: 23 | CHANGELOG.md 24 | data-files: 25 | tests/python/spake2_exchange.py 26 | 27 | source-repository head 28 | type: git 29 | location: https://github.com/LeastAuthority/haskell-spake2 30 | 31 | library 32 | hs-source-dirs: 33 | src 34 | default-extensions: NoImplicitPrelude OverloadedStrings 35 | ghc-options: -Wall -Wno-type-defaults 36 | build-depends: 37 | base >=4.9 && <5 38 | , bytestring 39 | , cryptonite 40 | , memory 41 | , protolude >=0.3 && <0.4 42 | exposed-modules: 43 | Crypto.Spake2 44 | Crypto.Spake2.Group 45 | Crypto.Spake2.Groups 46 | Crypto.Spake2.Groups.Ed25519 47 | Crypto.Spake2.Groups.IntegerGroup 48 | Crypto.Spake2.Math 49 | Crypto.Spake2.Util 50 | other-modules: 51 | Paths_spake2 52 | default-language: Haskell2010 53 | 54 | executable haskell-spake2-interop-entrypoint 55 | main-is: Main.hs 56 | other-modules: 57 | Paths_spake2 58 | hs-source-dirs: 59 | cmd/interop-entrypoint 60 | default-extensions: NoImplicitPrelude OverloadedStrings 61 | ghc-options: -Wall -Wno-type-defaults -threaded 62 | build-depends: 63 | base >=4.9 && <5 64 | , cryptonite 65 | , memory 66 | , optparse-applicative 67 | , protolude >=0.3 && <0.4 68 | , spake2 69 | default-language: Haskell2010 70 | 71 | test-suite tasty 72 | type: exitcode-stdio-1.0 73 | main-is: Tasty.hs 74 | hs-source-dirs: 75 | tests 76 | default-extensions: NoImplicitPrelude OverloadedStrings 77 | ghc-options: -Wall -Wno-type-defaults 78 | build-depends: 79 | QuickCheck 80 | , aeson 81 | , base >=4.9 && <5 82 | , bytestring 83 | , cryptonite 84 | , memory 85 | , process 86 | , protolude >=0.3 && <0.4 87 | , spake2 88 | , tasty 89 | , hspec >= 2.10 && <3 90 | , tasty-hspec 91 | , hspec-expectations >= 0.8.2 && <0.9 92 | other-modules: 93 | Groups 94 | Integration 95 | Spake2 96 | Paths_spake2 97 | default-language: Haskell2010 98 | -------------------------------------------------------------------------------- /src/Crypto/Spake2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | 4 | {-| 5 | Module: Crypto.Spake2 6 | Description: Implementation of SPAKE2 key exchange protocol 7 | 8 | Say that you and someone else share a secret password, and you want to use 9 | this password to arrange some secure channel of communication. You want: 10 | 11 | * to know that the other party also knows the secret password (maybe 12 | they're an imposter!) 13 | * the password to be secure against offline dictionary attacks 14 | * probably some other things 15 | 16 | SPAKE2 is an algorithm for agreeing on a key exchange that meets these 17 | criteria. See [Simple Password-Based Encrypted Key Exchange 18 | Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf) by 19 | Michel Abdalla and David Pointcheval for more details. 20 | 21 | == How it works 22 | 23 | === Preliminaries 24 | 25 | Before exchanging, two nodes need to agree on the following, out-of-band: 26 | 27 | In general: 28 | 29 | * hash algorithm, \(H\) 30 | * group to use, \(G\) 31 | * arbitrary members of group to use for blinding 32 | * a means of converting this password to a scalar of group 33 | 34 | For a specific exchange: 35 | 36 | * whether the connection is symmetric or asymmetric 37 | * the IDs of the respective sides 38 | * a shared, secret password in bytes 39 | 40 | #protocol# 41 | 42 | === Protocol 43 | 44 | ==== How we map the password to a scalar 45 | 46 | Use HKDF expansion (see 'expandData') to expand the password by 16 bytes, 47 | using an empty salt, and "SPAKE2 pw" as the info. 48 | 49 | Then, use a group-specific mapping from bytes to scalars. 50 | Since scalars are normally isomorphic to integers, 51 | this will normally be a matter of converting the bytes to an integer 52 | using standard deserialization 53 | and then turning the integer into a scalar. 54 | 55 | ==== How we exchange information 56 | 57 | See 'Crypto.Spake2.Math' for details on the mathematics of the exchange. 58 | 59 | ==== How python-spake2 works 60 | 61 | - Message to other side is prepended with a single character, @A@, @B@, or 62 | @S@, to indicate which side it came from 63 | - The hash function for generating the session key has a few interesting properties: 64 | - uses SHA256 for hashing 65 | - does not include password or IDs directly, but rather uses /their/ SHA256 66 | digests as inputs to the hash 67 | - for the symmetric version, it sorts \(X^{\star}\) and \(Y^{\star}\), 68 | because neither side knows which is which 69 | - By default, the ID of either side is the empty bytestring 70 | 71 | == Open questions 72 | 73 | * how does endianness come into play? 74 | * what is Shallue-Woestijne-Ulas and why is it relevant? 75 | 76 | == References 77 | 78 | * [Javascript implementation](https://github.com/bitwiseshiftleft/sjcl/pull/273/), includes long, possibly relevant discussion 79 | * [Python implementation](https://github.com/warner/python-spake2) 80 | * [SPAKE2 random elements](http://www.lothar.com/blog/54-spake2-random-elements/) - blog post by warner about choosing \(M\) and \(N\) 81 | * [Simple Password-Based Encrypted Key Exchange Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf) by Michel Abdalla and David Pointcheval 82 | * [draft-irtf-cfrg-spake2-03](https://tools.ietf.org/html/draft-irtf-cfrg-spake2-03) - expired IRTF draft for SPAKE2 83 | 84 | -} 85 | 86 | module Crypto.Spake2 87 | ( Password 88 | , makePassword 89 | -- * The SPAKE2 protocol 90 | , Protocol 91 | , makeAsymmetricProtocol 92 | , makeSymmetricProtocol 93 | , spake2Exchange 94 | , startSpake2 95 | , Math.computeOutboundMessage 96 | , Math.generateKeyMaterial 97 | , extractElement 98 | , MessageError 99 | , formatError 100 | , elementToMessage 101 | , createSessionKey 102 | , SideID(..) 103 | , WhichSide(..) 104 | ) where 105 | 106 | import Protolude hiding (group) 107 | 108 | import Crypto.Error (CryptoError, CryptoFailable(..)) 109 | import Crypto.Hash (HashAlgorithm, hashWith) 110 | import Crypto.Random.Types (MonadRandom(..)) 111 | import Data.ByteArray (ByteArrayAccess) 112 | import qualified Data.ByteArray as ByteArray 113 | import qualified Data.ByteString as ByteString 114 | 115 | import Crypto.Spake2.Group (AbelianGroup(..), Group(..), decodeScalar, scalarSizeBytes) 116 | import qualified Crypto.Spake2.Math as Math 117 | import Crypto.Spake2.Util (expandData) 118 | 119 | 120 | -- | Shared secret password used to negotiate the connection. 121 | -- 122 | -- Constructor deliberately not exported, 123 | -- so that once a 'Password' has been created, the actual password cannot be retrieved by other modules. 124 | -- 125 | -- Construct with 'makePassword'. 126 | newtype Password = Password ByteString deriving (Eq, Ord) 127 | 128 | -- | Construct a password. 129 | makePassword :: ByteString -> Password 130 | makePassword = Password 131 | 132 | -- | Bytes that identify a side of the protocol 133 | newtype SideID = SideID { unSideID :: ByteString } deriving (Eq, Ord, Show) 134 | 135 | -- | Convert a user-supplied password into a scalar on a group. 136 | passwordToScalar :: AbelianGroup group => group -> Password -> Scalar group 137 | passwordToScalar group password = 138 | decodeScalar group oversized 139 | where 140 | oversized = expandPassword password (scalarSizeBytes group + 16) :: ByteString 141 | expandPassword (Password bytes) = expandData info bytes 142 | -- This needs to be exactly "SPAKE2 pw" 143 | -- See 144 | info = "SPAKE2 pw" 145 | 146 | -- | Turn an element into a message from this side of the protocol. 147 | elementToMessage :: Group group => Protocol group hashAlgorithm -> Element group -> ByteString 148 | elementToMessage protocol element = prefix <> encodeElement (group protocol) element 149 | where 150 | prefix = 151 | case relation protocol of 152 | Symmetric _ -> "S" 153 | Asymmetric{us=SideA} -> "A" 154 | Asymmetric{us=SideB} -> "B" 155 | 156 | -- | An error that occurs when interpreting messages from the other side of the exchange. 157 | data MessageError e 158 | = EmptyMessage -- ^ We received an empty bytestring. 159 | | UnexpectedPrefix Word8 Word8 160 | -- ^ The bytestring had an unexpected prefix. 161 | -- We expect the prefix to be @A@ if the other side is side A, 162 | -- @B@ if they are side B, 163 | -- or @S@ if the connection is symmetric. 164 | -- First argument is received prefix, second is expected. 165 | | BadCrypto CryptoError ByteString 166 | -- ^ Message could not be decoded to an element of the group. 167 | -- This can indicate either an error in serialization logic, 168 | -- or in mathematics. 169 | | UnknownError e 170 | -- ^ An error arising from the "receive" action in 'spake2Exchange'. 171 | -- Since 0.4.0 172 | deriving (Eq, Show) 173 | 174 | -- | Turn a 'MessageError' into human-readable text. 175 | formatError :: Show e => MessageError e -> Text 176 | formatError EmptyMessage = "Other side sent us an empty message" 177 | formatError (UnexpectedPrefix got expected) = "Other side claims to be " <> show (chr (fromIntegral got)) <> ", expected " <> show (chr (fromIntegral expected)) 178 | formatError (BadCrypto err message) = "Could not decode message (" <> show message <> ") to element: " <> show err 179 | formatError (UnknownError err) = "Error receiving message from other side: " <> show err 180 | 181 | -- | Extract an element on the group from an incoming message. 182 | -- 183 | -- Returns a 'MessageError' if we cannot decode the message, 184 | -- or the other side does not appear to be the expected other side. 185 | -- 186 | -- TODO: Need to protect against reflection attack at some point. 187 | extractElement :: Group group => Protocol group hashAlgorithm -> ByteString -> Either (MessageError error) (Element group) 188 | extractElement protocol message = 189 | case ByteString.uncons message of 190 | Nothing -> throwError EmptyMessage 191 | Just (prefix, msg) 192 | | prefix /= theirPrefix (relation protocol) -> throwError $ UnexpectedPrefix prefix (theirPrefix (relation protocol)) 193 | | otherwise -> 194 | case decodeElement (group protocol) msg of 195 | CryptoFailed err -> throwError (BadCrypto err msg) 196 | CryptoPassed element -> pure element 197 | 198 | 199 | -- | One side of the SPAKE2 protocol. 200 | data Side group 201 | = Side 202 | { sideID :: SideID -- ^ Bytes identifying this side 203 | , blind :: Element group -- ^ Arbitrarily chosen element in the group 204 | -- used by this side to blind outgoing messages. 205 | } 206 | 207 | -- | Which side we are. 208 | data WhichSide = SideA | SideB deriving (Eq, Ord, Show, Bounded, Enum) 209 | 210 | -- | Relation between two sides in SPAKE2. 211 | -- Can be either symmetric (both sides are the same), or asymmetric. 212 | data Relation group 213 | = Asymmetric 214 | { sideA :: Side group -- ^ Side A. Both sides need to agree who side A is. 215 | , sideB :: Side group -- ^ Side B. Both sides need to agree who side B is. 216 | , us :: WhichSide -- ^ Which side we are 217 | } 218 | | Symmetric 219 | { bothSides :: Side group -- ^ Description used by both sides. 220 | } 221 | 222 | theirPrefix :: Relation a -> Word8 223 | theirPrefix relation = 224 | fromIntegral . ord $ case relation of 225 | Asymmetric{us=SideA} -> 'B' 226 | Asymmetric{us=SideB} -> 'A' 227 | Symmetric{} -> 'S' 228 | 229 | -- | Everything required for the SPAKE2 protocol. 230 | -- 231 | -- Both sides must agree on these values for the protocol to work. 232 | -- This /mostly/ means value equality, except for 'Relation.us', 233 | -- where each side must have complementary values. 234 | -- 235 | -- Construct with 'makeAsymmetricProtocol' or 'makeSymmetricProtocol'. 236 | data Protocol group hashAlgorithm 237 | = Protocol 238 | { group :: group -- ^ The group to use for encryption 239 | , hashAlgorithm :: hashAlgorithm -- ^ Hash algorithm used for generating the session key 240 | , relation :: Relation group -- ^ How the two sides relate to each other 241 | } 242 | 243 | -- | Construct an asymmetric SPAKE2 protocol. 244 | makeAsymmetricProtocol :: hashAlgorithm -> group -> Element group -> Element group -> SideID -> SideID -> WhichSide -> Protocol group hashAlgorithm 245 | makeAsymmetricProtocol hashAlgorithm group blindA blindB sideA sideB whichSide = 246 | Protocol 247 | { group = group 248 | , hashAlgorithm = hashAlgorithm 249 | , relation = Asymmetric 250 | { sideA = Side { sideID = sideA, blind = blindA } 251 | , sideB = Side { sideID = sideB, blind = blindB } 252 | , us = whichSide 253 | } 254 | } 255 | 256 | -- | Construct a symmetric SPAKE2 protocol. 257 | makeSymmetricProtocol :: hashAlgorithm -> group -> Element group -> SideID -> Protocol group hashAlgorithm 258 | makeSymmetricProtocol hashAlgorithm group blind id = 259 | Protocol 260 | { group = group 261 | , hashAlgorithm = hashAlgorithm 262 | , relation = Symmetric Side { sideID = id, blind = blind } 263 | } 264 | 265 | -- | Get the parameters for the mathematical part of SPAKE2 from the protocol specification. 266 | getParams :: Protocol group hashAlgorithm -> Math.Params group 267 | getParams Protocol{group, relation} = 268 | case relation of 269 | Symmetric{bothSides} -> mkParams bothSides bothSides 270 | Asymmetric{sideA, sideB, us} -> 271 | case us of 272 | SideA -> mkParams sideA sideB 273 | SideB -> mkParams sideB sideA 274 | 275 | where 276 | mkParams ours theirs = 277 | Math.Params 278 | { Math.group = group 279 | , Math.ourBlind = blind ours 280 | , Math.theirBlind = blind theirs 281 | } 282 | 283 | -- | Perform an entire SPAKE2 exchange. 284 | -- 285 | -- Given a SPAKE2 protocol that has all of the parameters for this exchange, 286 | -- generate a one-off message from this side and receive a one off message 287 | -- from the other. 288 | -- 289 | -- Once we are done, return a key shared between both sides for a single 290 | -- session. 291 | -- 292 | -- Note: as per the SPAKE2 definition, the session key is not guaranteed 293 | -- to actually /work/. If the other side has failed to authenticate, you will 294 | -- still get a session key. Therefore, you must exchange some other message 295 | -- that has been encrypted using this key in order to confirm that the session 296 | -- key is indeed shared. 297 | -- 298 | -- Note: the "send" and "receive" actions are performed 'concurrently'. If you 299 | -- have ordering requirements, consider using a 'TVar' or 'MVar' to coordinate, 300 | -- or implementing your own equivalent of 'spake2Exchange'. 301 | -- 302 | -- If the message received from the other side cannot be parsed, return a 303 | -- 'MessageError'. 304 | -- 305 | -- Since 0.4.0. 306 | spake2Exchange 307 | :: (AbelianGroup group, HashAlgorithm hashAlgorithm) 308 | => Protocol group hashAlgorithm 309 | -- ^ A 'Protocol' with all the parameters for the exchange. These parameters 310 | -- must be shared by both sides. Construct with 'makeAsymmetricProtocol' or 311 | -- 'makeSymmetricProtocol'. 312 | -> Password 313 | -- ^ The password shared between both sides. Construct with 'makePassword'. 314 | -> (ByteString -> IO ()) 315 | -- ^ An action to send a message. The 'ByteString' parameter is this side's 316 | -- SPAKE2 element, encoded using the group encoding, prefixed according to 317 | -- the parameters in the 'Protocol'. 318 | -> IO (Either error ByteString) 319 | -- ^ An action to receive a message. The 'ByteString' generated ought to be 320 | -- the protocol-prefixed, group-encoded version of the other side's SPAKE2 321 | -- element. 322 | -> IO (Either (MessageError error) ByteString) 323 | -- ^ Either the shared session key or an error indicating we couldn't parse 324 | -- the other side's message. 325 | spake2Exchange protocol password send receive = do 326 | exchange <- startSpake2 protocol password 327 | let outboundElement = Math.computeOutboundMessage exchange 328 | let outboundMessage = elementToMessage protocol outboundElement 329 | (_, inboundMessage) <- concurrently (send outboundMessage) receive 330 | pure $ do 331 | inboundMessage' <- first UnknownError inboundMessage 332 | inboundElement <- extractElement protocol inboundMessage' 333 | let keyMaterial = Math.generateKeyMaterial exchange inboundElement 334 | pure (createSessionKey protocol inboundElement outboundElement keyMaterial password) 335 | 336 | -- | Commence a SPAKE2 exchange. 337 | startSpake2 338 | :: (MonadRandom randomly, AbelianGroup group) 339 | => Protocol group hashAlgorithm 340 | -> Password 341 | -> randomly (Math.Spake2Exchange group) 342 | startSpake2 protocol password = 343 | Math.startSpake2 Math.Spake2 { Math.params = getParams protocol 344 | , Math.password = passwordToScalar (group protocol) password 345 | } 346 | 347 | -- | Create a session key based on the output of SPAKE2. 348 | -- 349 | -- \[SK \leftarrow H(A, B, X^{\star}, Y^{\star}, K, pw)\] 350 | -- 351 | -- Including \(pw\) in the session key is what makes this SPAKE2, not SPAKE1. 352 | -- 353 | -- __Note__: In spake2 0.3 and earlier, The \(X^{\star}\) and \(Y^{\star}\) 354 | -- were expected to be from side A and side B respectively. Since spake2 0.4, 355 | -- they are the outbound and inbound elements respectively. This fixes an 356 | -- interoperability concern with the Python library, and reduces the burden on 357 | -- the caller. Apologies for the possibly breaking change to any users of 358 | -- older versions of spake2. 359 | createSessionKey 360 | :: (Group group, HashAlgorithm hashAlgorithm) 361 | => Protocol group hashAlgorithm -- ^ The protocol used for this exchange 362 | -> Element group -- ^ The outbound message, generated by this, \(X^{\star}\), or either side if symmetric 363 | -> Element group -- ^ The inbound message, generated by the other side, \(Y^{\star}\), or either side if symmetric 364 | -> Element group -- ^ The calculated key material, \(K\) 365 | -> Password -- ^ The shared secret password 366 | -> ByteString -- ^ A session key to use for further communication 367 | createSessionKey Protocol{group, hashAlgorithm, relation} outbound inbound k (Password password) = 368 | hashDigest transcript 369 | 370 | where 371 | -- The protocol expects that when we include the hash of various 372 | -- components (e.g. the password) as input for the session key hash, 373 | -- that we use the *byte* representation of these elements. 374 | hashDigest :: ByteArrayAccess input => input -> ByteString 375 | hashDigest thing = ByteArray.convert (hashWith hashAlgorithm thing) 376 | 377 | transcript = 378 | case relation of 379 | Asymmetric{sideA, sideB, us} -> 380 | let (x, y) = case us of 381 | SideA -> (inbound, outbound) 382 | SideB -> (outbound, inbound) 383 | in mconcat [ hashDigest password 384 | , hashDigest (unSideID (sideID sideA)) 385 | , hashDigest (unSideID (sideID sideB)) 386 | , encodeElement group x 387 | , encodeElement group y 388 | , encodeElement group k 389 | ] 390 | Symmetric{bothSides} -> 391 | mconcat [ hashDigest password 392 | , hashDigest (unSideID (sideID bothSides)) 393 | , symmetricElements 394 | , encodeElement group k 395 | ] 396 | 397 | symmetricElements = 398 | let [ firstMessage, secondMessage ] = sort [ encodeElement group inbound, encodeElement group outbound ] 399 | in firstMessage <> secondMessage 400 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Group.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-| 3 | Module: Crypto.Spake2.Group 4 | Description: Interfaces for mathematical groups 5 | -} 6 | module Crypto.Spake2.Group 7 | ( AbelianGroup(..) 8 | , Group(..) 9 | , decodeScalar 10 | , elementSizeBytes 11 | , scalarSizeBytes 12 | , KeyPair(..) 13 | ) where 14 | 15 | import Protolude hiding (group, length) 16 | 17 | import Crypto.Error (CryptoFailable(..)) 18 | import Crypto.Random.Types (MonadRandom(..)) 19 | import Data.ByteArray (ByteArray, ByteArrayAccess(..)) 20 | 21 | import Crypto.Spake2.Util (bytesToNumber) 22 | 23 | 24 | -- | A mathematical group intended to be used with SPAKE2. 25 | class Group group where 26 | -- | An element of the group. 27 | type Element group :: Type 28 | 29 | -- | Group addition. 30 | -- 31 | -- prop> \x y z -> elementAdd group (elementAdd group x y) z == elementAdd group x (elementAdd group y z) 32 | elementAdd :: group -> Element group -> Element group -> Element group 33 | 34 | -- | Inverse with respect to group addition. 35 | -- 36 | -- prop> \x -> (elementAdd group x (elementNegate group x)) == groupIdentity 37 | -- prop> \x -> (elementNegate group (elementNegate group x)) == x 38 | elementNegate :: group -> Element group -> Element group 39 | 40 | -- | Subtract one element from another. 41 | -- 42 | -- prop> \x y -> (elementSubtract group x y) == (elementAdd group x (elementNegate group y)) 43 | elementSubtract :: group -> Element group -> Element group -> Element group 44 | elementSubtract group x y = elementAdd group x (elementNegate group y) 45 | 46 | -- | Identity of the group. 47 | -- 48 | -- Note [Added for completeness] 49 | -- 50 | -- prop> \x -> (elementAdd group x groupIdentity) == x 51 | -- prop> \x -> (elementAdd group groupIdentity x) == x 52 | groupIdentity :: group -> Element group 53 | 54 | -- | Encode an element of the group into bytes. 55 | -- 56 | -- Note [Byte encoding in Group] 57 | -- 58 | -- prop> \x -> decodeElement group (encodeElement group x) == CryptoPassed x 59 | encodeElement :: ByteArray bytes => group -> Element group -> bytes 60 | 61 | -- | Decode an element into the group from some bytes. 62 | -- 63 | -- Note [Byte encoding in Group] 64 | decodeElement :: ByteArray bytes => group -> bytes -> CryptoFailable (Element group) 65 | 66 | -- | Size of elements, in bits 67 | elementSizeBits :: group -> Int 68 | 69 | -- | Deterministically create an arbitrary element from a seed bytestring. 70 | -- 71 | -- __XXX__: jml would much rather this take a scalar, an element, or even an integer, rather than bytes 72 | -- because bytes mean that the group instances have to know about hash algorithms and HKDF. 73 | -- If the IntegerGroup class in SPAKE2 also oversized its input, 74 | -- then it and the ed25519 implementation would have identical decoding. 75 | arbitraryElement :: ByteArrayAccess bytes => group -> bytes -> Element group 76 | 77 | 78 | -- | A group where 'elementAdd' is commutative. 79 | -- 80 | -- That is, where 81 | -- 82 | -- prop> \x y -> elementAdd group x y == elementAdd group y x 83 | -- 84 | -- This property leads to a natural \(\mathbb{Z}\)-module, 85 | -- where scalar multiplication is defined as repeatedly calling `elementAdd`. 86 | -- 87 | -- === Definitions 88 | -- 89 | -- Warning: this gets algebraic. 90 | -- 91 | -- A /module/ is a ring \(R\) together with an abelian group \((G, +)\), 92 | -- and a new operator \(\cdot\) (i.e. scalar multiplication) 93 | -- such that: 94 | -- 95 | -- 1. \(r \cdot (x + y) = r \cdot x + r \cdot y\) 96 | -- 2. \((r + s) \cdot x = r \cdot x + s \cdot x\) 97 | -- 3. \((rs) \cdot x = r \cdot (s \cdot x)\) 98 | -- 4. \(1_R \cdot x = x\) 99 | -- 100 | -- for all \(x, y\) in \(G\), and \(r, s\) in \(R\), 101 | -- where \(1_R\) is the identity of the ring. 102 | -- 103 | -- A /ring/ \(R, +, \cdot\) a set \(R\) with two operators such that: 104 | -- 105 | -- 1. \(R\) is an abelian group under \(+\) 106 | -- 2. \(R\) is a monoid under \(\cdot\) 107 | -- 3. \(cdot\) is _distributive_ with respect to \(+\). That is, 108 | -- 1. \(a \cdot (b + c) = (a \cdot b) + (a \cdot c) (left distributivity) 109 | -- 2. \((b + c) \cdot a) = (b \cdot a) + (c \cdot a) (right distributivity) 110 | -- 111 | -- Note we have to define left & right distributivity, 112 | -- because \(\cdot\) might not be commutative. 113 | -- 114 | -- A /monoid/ is a group without the notion of inverse. See Haskell's 'Monoid' typeclass. 115 | -- 116 | -- A \(\mathbb{Z}\)-module is a module where the ring \(R\) 117 | -- is the integers with normal addition and multiplication. 118 | class Group group => AbelianGroup group where 119 | -- | A scalar for this group. 120 | -- Mathematically equivalent to an integer, 121 | -- but possibly stored differently for computational reasons. 122 | type Scalar group :: Type 123 | 124 | -- | Multiply an element of the group with respect to a scalar. 125 | -- 126 | -- This is equivalent to adding the element to itself N times, where N is a scalar. 127 | -- The default implementation does exactly that. 128 | scalarMultiply :: group -> Scalar group -> Element group -> Element group 129 | scalarMultiply group scalar element = 130 | scalarMultiply' (scalarToInteger group scalar) element 131 | where 132 | scalarMultiply' 0 _ = groupIdentity group 133 | scalarMultiply' n x = elementAdd group x (scalarMultiply' (n - 1) x) 134 | 135 | -- | Get the scalar that corresponds to an integer. 136 | -- 137 | -- Note [Added for completeness] 138 | -- 139 | -- prop> \x -> scalarToInteger group (integerToScalar group x) == x 140 | integerToScalar :: group -> Integer -> Scalar group 141 | 142 | -- | Get the integer that corresponds to a scalar. 143 | -- 144 | -- Note [Added for completeness] 145 | -- 146 | -- prop> \x -> integerToScalar group (scalarToInteger group x) == x 147 | scalarToInteger :: group -> Scalar group -> Integer 148 | 149 | -- | Size of scalars, in bits 150 | scalarSizeBits :: group -> Int 151 | 152 | -- | Encode a scalar into bytes. 153 | -- | Generate a new random element of the group, with corresponding scalar. 154 | generateElement :: MonadRandom randomly => group -> randomly (KeyPair group) 155 | 156 | 157 | -- | Map some arbitrary bytes into a scalar in a group. 158 | decodeScalar :: (ByteArrayAccess bytes, AbelianGroup group) => group -> bytes -> Scalar group 159 | decodeScalar group bytes = integerToScalar group (bytesToNumber bytes) 160 | 161 | -- | Size of elements in a group, in bits. 162 | elementSizeBytes :: Group group => group -> Int 163 | elementSizeBytes group = (elementSizeBits group + 7) `div` 8 164 | 165 | -- | Size of scalars in a group, in bytes. 166 | scalarSizeBytes :: AbelianGroup group => group -> Int 167 | scalarSizeBytes group = (scalarSizeBits group + 7) `div` 8 168 | 169 | -- | A group key pair composed of the private part (a scalar) 170 | -- and a public part (associated group element). 171 | data KeyPair group 172 | = KeyPair 173 | { keyPairPublic :: !(Element group) 174 | , keyPairPrivate :: !(Scalar group) 175 | } 176 | 177 | {- 178 | Note [Algebra] 179 | ~~~~~~~~~~~~~~ 180 | 181 | * Perhaps we should call 'AbelianGroup' 'ZModule' or similar? 182 | * A "proper" implementation would no doubt have a Ring typeclass 183 | and then a new Module typeclass that somehow composed a Ring and an AbelianGroup. 184 | This seems unnecessary for our implementation needs, 185 | and is perhaps best left to those who know something about designing algebraic libraries. 186 | * Cyclic groups are necessarily abelian. 187 | 188 | -} 189 | 190 | {- 191 | Note [Byte encoding in Group] 192 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 193 | 194 | jml is unsure whether it is a good idea to put encode/decode methods in the 'Group' typeclass. 195 | 196 | Reasons for: 197 | 198 | * cryptonite does it with 'EllipticCurve' 199 | * warner does it with spake2.groups 200 | * you just need to send different stuff over the wire for elliptic curve groups 201 | than integer modulo groups 202 | 203 | Reasons against: 204 | 205 | * mathematical structure of groups has no connection to serialization 206 | * might want multiple encodings for same mathematical group 207 | (this seems unlikely) 208 | 209 | We're keeping encode/decode in for now. 210 | Later, we might want to split it out into a different typeclass, 211 | perhaps one that inherits from the base 'Group' class. 212 | 213 | -} 214 | 215 | {- 216 | Note [Added for completeness] 217 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 218 | 219 | Several methods were added to 'Group' out of a desire for mathematical completeness 220 | rather than necessity for implementing SPAKE2. 221 | 222 | These include: 223 | 224 | * 'groupIdentity' -- because groups have identities (just like semigroups) 225 | * 'scalarToInteger' and 'integerToScalar' -- because scalars are mathematically integers 226 | * 'encodeScalar' -- because having an inverse of 'decodeScalar' makes it easier to test 227 | 228 | -} 229 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Groups.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Crypto.Spake2.Groups 3 | Description: Implementation of various mathematical groups 4 | 5 | Each of these implements the 'Crypto.Spake2.Group.Group' typeclass. 6 | -} 7 | module Crypto.Spake2.Groups 8 | ( Ed25519.Ed25519(..) 9 | , IntegerGroup.IntegerGroup(..) 10 | , IntegerGroup.makeIntegerGroup 11 | , IntegerGroup.i1024 12 | ) where 13 | 14 | import qualified Crypto.Spake2.Groups.Ed25519 as Ed25519 15 | import qualified Crypto.Spake2.Groups.IntegerGroup as IntegerGroup 16 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Groups/Ed25519.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DuplicateRecordFields #-} 4 | {-# LANGUAGE NamedFieldPuns #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-| 7 | Module: Crypto.Spake2.Groups.Ed25519 8 | Description: Ed25519 group for SPAKE2 9 | 10 | Derived from @ed25519_basic.py@ in [python-spake2](https://github.com/warner/python-spake2), 11 | in turn derived from the slow, reference, Python implementation at 12 | 13 | -} 14 | module Crypto.Spake2.Groups.Ed25519 15 | ( Ed25519(..) 16 | -- * Exported for testing 17 | , l 18 | , generator 19 | ) where 20 | 21 | import Protolude hiding (group) 22 | 23 | import Crypto.Error (CryptoFailable(..), CryptoError(..)) 24 | import Crypto.Number.Generate (generateMax) 25 | import Crypto.Number.ModArithmetic (expSafe, inverseCoprimes) 26 | import Crypto.Number.Serialize (i2osp, os2ip) 27 | import Data.ByteArray (ByteArray, ByteArrayAccess) 28 | import qualified Data.ByteArray as ByteArray 29 | import qualified Data.List as List 30 | 31 | import Crypto.Spake2.Group (AbelianGroup(..), Group(..), KeyPair(..), scalarSizeBytes) 32 | import Crypto.Spake2.Util (bytesToNumber, expandArbitraryElementSeed) 33 | 34 | {- 35 | Note [Ed25519 vs curve25519] 36 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 37 | 38 | As best as jml can tell, 39 | 40 | * X25519 is Elliptic Curve Diffie-Hellman (ECDH) over Curve25519 41 | * Ed25519 is Edwards-curve Digital Signature Algorithm (EdDSA) over Curve25519 42 | 43 | (quoted from a [StackOverflow answer](https://crypto.stackexchange.com/questions/27866/why-curve25519-for-encryption-but-ed25519-for-signatures)) 44 | 45 | This means the underlying curve is the same, 46 | and Ed25519 is the use of that curve in signing, 47 | and X25519 is the curve used in key exchange. 48 | 49 | Complicated by the fact that Curve25519 /used/ to be the name of ECDH over Curve25519. 50 | 51 | Since our primary goal is Python interoperability, 52 | we are going to implement an analogue of the Python code here, 53 | and call it Ed25519. 54 | 55 | Once that is done, we can explore using Cryptonite's Curve25519 logic, 56 | ideally demonstrating its equivalence with some automated tests. 57 | 58 | 59 | 60 | -} 61 | 62 | data Ed25519 = Ed25519 deriving (Eq, Show) 63 | 64 | instance Group Ed25519 where 65 | type Element Ed25519 = ExtendedPoint 'Member 66 | 67 | elementAdd _ x y = addExtendedPoints x y 68 | elementNegate _ x = negateExtendedPoint x 69 | groupIdentity _ = assertInGroup extendedZero 70 | 71 | encodeElement _ x = encodeAffinePoint (extendedToAffine' x) 72 | decodeElement _ bytes = toCryptoFailable $ do 73 | extended <- affineToExtended <$> decodeAffinePoint bytes 74 | ensureInGroup extended 75 | 76 | elementSizeBits _ = 255 77 | 78 | arbitraryElement group bytes = 79 | let seed = expandArbitraryElementSeed bytes (scalarSizeBytes group + 16) :: ByteString 80 | y = bytesToNumber seed `mod` q 81 | in 82 | List.head [ element | Right element <- map makeGroupMember [y..] ] 83 | 84 | instance AbelianGroup Ed25519 where 85 | type Scalar Ed25519 = Integer 86 | 87 | scalarMultiply _ n x = safeScalarMultiply n x 88 | 89 | integerToScalar _ x = x 90 | scalarToInteger _ x = x 91 | 92 | scalarSizeBits _ = 255 93 | 94 | generateElement group = do 95 | scalar <- generateMax l 96 | let element = scalarMultiply group scalar generator 97 | pure (KeyPair element scalar) 98 | 99 | 100 | -- | Errors that can occur within the group. 101 | data Error 102 | = NotOnCurve Integer Integer 103 | | NotInGroup (ExtendedPoint 'Unknown) 104 | | LowOrderPoint (ExtendedPoint 'Unknown) 105 | deriving (Eq, Show) 106 | 107 | -- | Translate internal errors into CryptoFailable. 108 | toCryptoFailable :: Either Error a -> CryptoFailable a 109 | toCryptoFailable (Right r) = pure r 110 | toCryptoFailable (Left _) = CryptoFailed CryptoError_PointCoordinatesInvalid 111 | 112 | -- | Guarantee an element is in the Ed25519 subgroup. 113 | ensureInGroup :: ExtendedPoint 'Unknown -> Either Error (ExtendedPoint 'Member) 114 | ensureInGroup element@ExtendedPoint{x, y, z, t} = 115 | if isExtendedZero (safeScalarMultiply l element) 116 | then pure ExtendedPoint { x = x, y = y, z = z, t = t} 117 | else throwError $ NotInGroup element 118 | 119 | -- | Assert that an element is the Ed25519 subgroup. 120 | -- 121 | -- Panics if it is not. 122 | assertInGroup :: HasCallStack => ExtendedPoint 'Unknown -> ExtendedPoint 'Member 123 | assertInGroup element = 124 | -- XXX: Should we force evaluation of this? We mostly use it only for 125 | -- constants. 126 | case ensureInGroup element of 127 | Left err -> panic $ "Element not in group (" <> show err <> "): " <> show element 128 | Right x -> x 129 | 130 | -- TODO: Document this. 131 | -- Guess: the size of the subgroup? the group? 132 | q :: Integer 133 | q = 2 ^ 255 - 19 -- XXX: force eval? 134 | 135 | -- | The order of the group represented by 'Ed25519'. 136 | -- 137 | -- Note that this is a subgroup of the underlying elliptic curve. 138 | l :: Integer 139 | l = 2 ^ 252 + 27742317777372353535851937790883648493 140 | 141 | -- TODO document this 142 | dConst :: Integer 143 | dConst = (-121665 * inv 121666) `mod` q -- XXX: force eval? 144 | 145 | -- TODO document this 146 | i :: Integer 147 | i = expSafe 2 ((q-1) `div` 4) q -- XXX: force eval 148 | 149 | -- | The generator for the (sub)group represented by 'Ed25519'. 150 | generator :: Element Ed25519 151 | generator = assertInGroup $ affineToExtended b 152 | where 153 | b = case makeAffinePoint (x `mod` q) (y `mod` q) of 154 | Left err -> panic $ "Generator is not affine point: " <> show err 155 | Right r -> r 156 | x = xRecover y 157 | y = 4 * inv 5 158 | 159 | -- | Calculate the inverse of @x@ modulo 'q'. 160 | -- 161 | -- Assumes that @x@ is coprime with 'q' and non-zero. 162 | -- Will raise an exception if either of these assumptions is false. 163 | -- 164 | -- prop> \x -> (x * inv x) `mod` q == 1 165 | inv :: Integer -> Integer 166 | inv x = inverseCoprimes x q 167 | 168 | xRecover :: Integer -> Integer 169 | xRecover y = 170 | let x'' = (y * y - 1) * inv(dConst * y * y + 1) 171 | x' = expSafe x'' ((q + 3) `div` 8) q 172 | x = if (x' * x' - x'') `mod` q /= 0 173 | then (x' * i) `mod` q 174 | else x' 175 | in 176 | if even x then x else q - x 177 | 178 | 179 | -- | Whether or not an extended point is a member of Ed25519. 180 | data GroupMembership = Unknown | Member 181 | 182 | -- | A point that might be a member of Ed25519. 183 | -- Note: [Extended coordinates] 184 | data ExtendedPoint (groupMembership :: GroupMembership) 185 | = ExtendedPoint 186 | { x :: !Integer 187 | , y :: !Integer 188 | , z :: !Integer 189 | , t :: !Integer 190 | } deriving (Show) 191 | 192 | -- XXX: jml unsure about overriding equality like this. 193 | -- Note: [Extended coordinates] 194 | instance Eq (ExtendedPoint a) where 195 | point1 == point2 = extendedToAffine' point1 == extendedToAffine' point2 196 | 197 | -- | Zero in the extended coordinate space. 198 | -- 199 | -- > affineZero = AffinePoint{x = 0, y = 1} 200 | -- > extendedZero == affineToExtended affineZero 201 | -- 202 | -- Note: [Extended coordinates] 203 | extendedZero :: ExtendedPoint a 204 | extendedZero = ExtendedPoint {x = 0, y = 1, z = 1, t = 0} 205 | 206 | -- | Check if a point is equivalent to zero. 207 | -- 208 | -- jml is unsure, but this probably exists because it might be faster than 209 | -- mapping to affine space and checking for equality. 210 | -- 211 | -- Note: [Extended coordinates] 212 | isExtendedZero :: ExtendedPoint irrelevant -> Bool 213 | isExtendedZero ExtendedPoint{x, y, z} = x == 0 && y' == z' && y' /= 0 214 | where 215 | y' = y `mod` q 216 | z' = z `mod` q 217 | 218 | -- | Add two extended points. 219 | -- 220 | -- The points don't have to be in the Ed25519 subgroup, and we can't say 221 | -- anything about whether the result will be. 222 | -- 223 | -- add-2008-hwcd-3 224 | addExtendedPoints :: ExtendedPoint a -> ExtendedPoint a -> ExtendedPoint a 225 | addExtendedPoints ExtendedPoint{x = x1, y = y1, z = z1, t = t1} ExtendedPoint{x = x2, y = y2, z = z2, t = t2} = 226 | ExtendedPoint{x = x3, y = y3, z = z3, t = t3} 227 | where 228 | -- X3 = (E*F) % Q 229 | x3 = (e * f) `mod` q 230 | -- Y3 = (G*H) % Q 231 | y3 = (g * h) `mod` q 232 | -- Z3 = (F*G) % Q 233 | z3 = (f * g) `mod` q 234 | -- T3 = (E*H) % Q 235 | t3 = (e * h) `mod` q 236 | 237 | -- E = (B-A) % Q 238 | e = (b - a) `mod` q 239 | -- F = (D-C) % Q 240 | f = (d' - c) `mod` q 241 | -- G = (D+C) % Q 242 | g = (d' + c) `mod` q 243 | -- H = (B+A) % Q 244 | h = (b + a) `mod` q 245 | 246 | -- A = ((Y1-X1)*(Y2-X2)) % Q 247 | a = ((y1 - x1) * (y2 - x2)) `mod` q 248 | -- B = ((Y1+X1)*(Y2+X2)) % Q 249 | b = ((y1 + x1) * (y2 + x2)) `mod` q 250 | -- C = T1*(2*d)*T2 % Q 251 | c = (t1 * (2 * dConst) * t2) `mod` q 252 | -- D = Z1*2*Z2 % Q 253 | d' = (z1 * 2 * z2) `mod` q 254 | 255 | -- | Double an extended point. 256 | -- 257 | -- dbl-2008-hwcd 258 | doubleExtendedPoint :: ExtendedPoint preserving -> ExtendedPoint preserving 259 | doubleExtendedPoint ExtendedPoint{x = x1, y = y1, z = z1} = 260 | ExtendedPoint{x= x3, y = y3, z = z3, t = t3} 261 | where 262 | -- X3 = (E*F) % Q 263 | x3 = (e * f) `mod` q 264 | -- Y3 = (G*H) % Q 265 | y3 = (g * h) `mod` q 266 | -- Z3 = (F*G) % Q 267 | z3 = (f * g) `mod` q 268 | -- T3 = (E*H) % Q 269 | t3 = (e * h) `mod` q 270 | 271 | -- E = (J*J-A-B) % Q 272 | e = (j * j - a -b) `mod` q 273 | -- F = (G-C) % Q 274 | f = (g - c) `mod` q 275 | -- G = (D+B) % Q 276 | g = (d' + b) `mod` q 277 | -- H = (D-B) % Q 278 | h = (d' - b) `mod` q 279 | 280 | -- A = (X1*X1) 281 | a = x1 * x1 282 | -- B = (Y1*Y1) 283 | b = y1 * y1 284 | -- C = (2*Z1*Z1) 285 | c = 2 * z1 * z1 286 | -- D = (-A) % Q 287 | d' = (-a) `mod` q 288 | -- J = (X1+Y1) % Q 289 | j = (x1 + y1) `mod` q 290 | 291 | -- | Negate an extended point. 292 | negateExtendedPoint :: ExtendedPoint preserving -> ExtendedPoint preserving 293 | negateExtendedPoint ExtendedPoint{x = x1, y = y1, z = z1, t = t1} = 294 | ExtendedPoint{x= q - x1, y = y1, z = z1, t = q - t1} 295 | 296 | -- | Multiply a point (might be in the group, might not) by a scalar. 297 | safeScalarMultiply :: Integer -> ExtendedPoint a -> ExtendedPoint a 298 | safeScalarMultiply n = scalarMultiplyExtendedPoint addExtendedPoints n 299 | 300 | -- | Scalar multiplication parametrised by addition. 301 | scalarMultiplyExtendedPoint :: (ExtendedPoint a -> ExtendedPoint a -> ExtendedPoint a) -> Integer -> ExtendedPoint a -> ExtendedPoint a 302 | scalarMultiplyExtendedPoint _ 0 _ = extendedZero 303 | scalarMultiplyExtendedPoint add n x 304 | | even n = doubleExtendedPoint (scalarMultiplyExtendedPoint add (n `div` 2) x) 305 | | n == 1 = x 306 | | n <= 0 = panic $ "Unexpected negative multiplier: " <> show n 307 | | otherwise = add x (scalarMultiplyExtendedPoint add (n - 1) x) 308 | 309 | 310 | -- | Attempt to create a member of Ed25519 from an affine @y@ coordinate. 311 | makeGroupMember :: Integer -> Either Error (Element Ed25519) 312 | makeGroupMember y = do 313 | point <- affineToExtended <$> makeAffinePoint (xRecover y) y 314 | let point8 = safeScalarMultiply 8 point 315 | if isExtendedZero point8 316 | then throwError $ LowOrderPoint point 317 | else ensureInGroup point8 318 | 319 | {- 320 | Note: [Arbitrary point generation] 321 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 322 | 323 | This is cribbed from warner's notes in python-spake2: 324 | 325 | 326 | * only about 50% of Y coordinates map to valid curve points 327 | * even if the point is on our curve, it may not be in our particular (order=l) subgroup 328 | The curve has order 8*L, so an arbitrary point could have order 1,2,4,8,1*L,2*L,4*L,8*L 329 | (everything which divides the group order) 330 | * 50% of random points will have order 8*L, 331 | 25% will have order 4*L, 332 | 13% order 2*L, 333 | 13% will have our desired order 1*L 334 | (and a vanishingly small fraction will have 1/2/4/8). 335 | * If we multiply any of the 8*L points by 2, we're sure to get an 4*L point 336 | (and multiplying a 4*L point by 2 gives us a 2*L point, and so on). 337 | * Multiplying a 1*L point by 2 gives us a different 1*L point. 338 | So multiplying by 8 gets us from almost any point into a uniform point on the correct 1*L subgroup. 339 | * We might still get really unlucky and pick one of the 8 low-order points. 340 | Multiplying by 8 will get us to the identity (Zero), which we check for explicitly. 341 | * Double check that *this* point (8 * P) is in the right subgroup. 342 | 343 | That final check is a Python assertion, 344 | which would crash the program if incorrect. 345 | For programming convenience, I just skip these values. 346 | 347 | The 'order' of a point \(x\) is the number \(n\) such that: 348 | 'scalarMultiply group (integerToScalar group n) x == groupIdentity group' 349 | 350 | Note this is different from the order of a /group/, 351 | which for finite groups is the number of elements in the group. 352 | 353 | -} 354 | 355 | -- TODO: Document this 356 | data AffinePoint 357 | = AffinePoint 358 | { x :: !Integer 359 | , y :: !Integer 360 | } deriving (Eq, Show) 361 | 362 | -- | Construct an affine point that is on Curve25519. 363 | makeAffinePoint :: Integer -> Integer -> Either Error AffinePoint 364 | makeAffinePoint x y 365 | | isOnCurve x y = pure AffinePoint { x = x, y = y } 366 | | otherwise = throwError $ NotOnCurve x y 367 | where 368 | isOnCurve x' y' = ((-x') * x' + y' * y' - 1 - dConst * x' * x' * y' * y') `mod` q == 0 369 | 370 | -- | Encode an 'AffinePoint' into bytes. 371 | -- 372 | -- MSB of the output is whether or not @x@ is even (i.e. @x .&. 1@), 373 | -- teh rest of the output is little-endian @y@. 374 | encodeAffinePoint :: (ByteArray bytes, ByteArrayAccess bytes) => AffinePoint -> bytes 375 | encodeAffinePoint AffinePoint{x, y} 376 | | even x = numberToLitteEndianBytes y 377 | | otherwise = numberToLitteEndianBytes (y + shift 1 255) 378 | 379 | decodeAffinePoint :: (ByteArray bytes, ByteArrayAccess bytes) => bytes -> Either Error AffinePoint 380 | decodeAffinePoint bytes = 381 | let unclamped = littleEndianBytesToNumber bytes 382 | clamp = shift 1 255 - 1 383 | y = unclamped .&. clamp 384 | x = xRecover y 385 | x' = if x .&. 1 == unclamped .&. shift 1 255 then x else q - x 386 | in makeAffinePoint x' y 387 | 388 | 389 | numberToLitteEndianBytes :: ByteArray bytes => Integer -> bytes 390 | numberToLitteEndianBytes n = ByteArray.pack (reverse (ByteArray.unpack (i2osp n :: ByteString))) 391 | 392 | littleEndianBytesToNumber :: (ByteArray bytes, ByteArrayAccess bytes) => bytes -> Integer 393 | littleEndianBytesToNumber bytes = os2ip (ByteArray.pack (reverse (ByteArray.unpack bytes)) :: ByteString) 394 | 395 | {- 396 | Note: [Extended coordinates] 397 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 398 | 399 | jml only partly understands these. Here's that understanding. 400 | 401 | The underlying elliptic curve is two-dimensional. 402 | These are the AffinePoints. 403 | We project that curve into a 4-dimensional space, 404 | i.e. to the ExtendedPoints. 405 | 406 | Doing so makes some of the arithmetic faster. 407 | But ultimately, the values we are interested in are the affine points. 408 | 409 | Thus, even if two ExtendedPoints have differing values internally, 410 | they might be equivalent with respect to the Ed25519 group. 411 | 412 | That is, 413 | the affine points form a group 414 | the extended points form a group 415 | you can get a subgroup of the extended points group isomorphic to the affine points group 416 | by using "maps to the same affine point" as an equivalence relation. 417 | 418 | The Python version goes to some lengths to avoid doing calculations with zero. 419 | In an earlier revision, I preserved that behaviour, 420 | however, I have since removed it, 421 | as we have no performance data, 422 | and it adds extra complexity. 423 | 424 | This URL might help: 425 | http://www.hyperelliptic.org/EFD/g1p/auto-twisted-extended-1.html 426 | -} 427 | 428 | affineToExtended :: AffinePoint -> ExtendedPoint 'Unknown 429 | affineToExtended AffinePoint{x, y} = 430 | ExtendedPoint 431 | { x = x `mod` q 432 | , y = y `mod` q 433 | , z = 1 434 | , t = (x * y) `mod` q 435 | } 436 | 437 | extendedToAffine' :: ExtendedPoint a -> AffinePoint 438 | extendedToAffine' ExtendedPoint{x, y, z} = 439 | case makeAffinePoint x' y' of 440 | Left err -> panic $ "Could not make affine point: " <> show err 441 | Right r -> r 442 | where 443 | x' = (x * inv z) `mod` q 444 | y' = (y * inv z) `mod` q 445 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Groups/IntegerGroup.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-| 5 | Module: Crypto.Spake2.Groups.IntegerGroup 6 | Description: Multiplicative group of integers modulo \(n\) 7 | -} 8 | module Crypto.Spake2.Groups.IntegerGroup 9 | ( IntegerGroup(..) 10 | , makeIntegerGroup 11 | , i1024 12 | ) where 13 | 14 | import Protolude hiding (group, length) 15 | 16 | import Crypto.Error (CryptoFailable(..), CryptoError(..)) 17 | import Crypto.Number.Basic (numBits) 18 | import Crypto.Number.Generate (generateMax) 19 | import Crypto.Number.ModArithmetic (expSafe) 20 | 21 | import Crypto.Spake2.Group 22 | ( AbelianGroup(..) 23 | , Group(..) 24 | , KeyPair(..) 25 | , elementSizeBytes 26 | ) 27 | import Crypto.Spake2.Util 28 | ( expandArbitraryElementSeed 29 | , bytesToNumber 30 | , unsafeNumberToBytes 31 | ) 32 | 33 | -- | A finite group of integers with respect to multiplication modulo the group order. 34 | -- 35 | -- Construct with 'makeIntegerGroup'. 36 | data IntegerGroup 37 | = IntegerGroup 38 | { order :: !Integer 39 | , subgroupOrder :: !Integer 40 | , generator :: !Integer 41 | } deriving (Eq, Show) 42 | 43 | -- | Construct an 'IntegerGroup'. 44 | -- 45 | -- Will fail if generator is '1', 46 | -- since having the identity for a generator means the subgroup is the entire group. 47 | -- 48 | -- TODO: Find other things to check for validity. 49 | makeIntegerGroup :: Integer -> Integer -> Integer -> Maybe IntegerGroup 50 | makeIntegerGroup _ _ 1 = Nothing 51 | makeIntegerGroup order subgroupOrder generator = Just (IntegerGroup order subgroupOrder generator) 52 | 53 | 54 | instance Group IntegerGroup where 55 | type Element IntegerGroup = Integer 56 | 57 | elementAdd group x y = (x * y) `mod` order group 58 | -- At a guess, negation is scalar multiplication where the scalar is -1 59 | elementNegate group x = expSafe x (subgroupOrder group - 1) (order group) 60 | groupIdentity _ = 1 61 | encodeElement group = unsafeNumberToBytes (elementSizeBytes group) 62 | decodeElement group bytes = 63 | case bytesToNumber bytes of 64 | x 65 | | x <= 0 || x >= order group -> CryptoFailed CryptoError_PointSizeInvalid 66 | | expSafe x (subgroupOrder group) (order group) /= groupIdentity group -> CryptoFailed CryptoError_PointCoordinatesInvalid 67 | | otherwise -> CryptoPassed x 68 | elementSizeBits group = numBits (order group) 69 | arbitraryElement group seed = 70 | let processedSeed = expandArbitraryElementSeed seed (elementSizeBytes group) :: ByteString 71 | p = order group 72 | q = subgroupOrder group 73 | r = (p - 1) `div` q 74 | h = bytesToNumber processedSeed `mod` p 75 | in expSafe h r p 76 | 77 | 78 | instance AbelianGroup IntegerGroup where 79 | type Scalar IntegerGroup = Integer 80 | 81 | scalarMultiply group n x = expSafe x (n `mod` subgroupOrder group) (order group) 82 | integerToScalar group x = x `mod` subgroupOrder group 83 | scalarToInteger _ n = n 84 | 85 | generateElement group = do 86 | scalar <- generateMax (subgroupOrder group) 87 | let element = scalarMultiply group scalar (generator group) 88 | pure (KeyPair element scalar) 89 | scalarSizeBits group = numBits (subgroupOrder group) 90 | 91 | 92 | -- | 1024 bit integer group. 93 | -- 94 | -- Originally from http://haofeng66.googlepages.com/JPAKEDemo.java, 95 | -- via [python-spake2](https://github.com/warner/python-spake2). 96 | i1024 :: IntegerGroup 97 | i1024 = 98 | IntegerGroup 99 | { order = 0xE0A67598CD1B763BC98C8ABB333E5DDA0CD3AA0E5E1FB5BA8A7B4EABC10BA338FAE06DD4B90FDA70D7CF0CB0C638BE3341BEC0AF8A7330A3307DED2299A0EE606DF035177A239C34A912C202AA5F83B9C4A7CF0235B5316BFC6EFB9A248411258B30B839AF172440F32563056CB67A861158DDD90E6A894C72A5BBEF9E286C6B 100 | , subgroupOrder = 0xE950511EAB424B9A19A2AEB4E159B7844C589C4F 101 | , generator = 0xD29D5121B0423C2769AB21843E5A3240FF19CACC792264E3BB6BE4F78EDD1B15C4DFF7F1D905431F0AB16790E1F773B5CE01C804E509066A9919F5195F4ABC58189FD9FF987389CB5BEDF21B4DAB4F8B76A055FFE2770988FE2EC2DE11AD92219F0B351869AC24DA3D7BA87011A701CE8EE7BFE49486ED4527B7186CA4610A75 102 | } 103 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Math.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | 4 | {-| 5 | Module: Crypto.Spake2.Math 6 | Description: The mathematical implementation of SPAKE2. 7 | 8 | This module ignores everything about networks, bytes, encoding, hash functions, and so forth. 9 | All it does is provide the mathematical building blocks for SPAKE2, 10 | as per [Simple Password-Based Encrypted Key Exchange Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf) 11 | by Michel Abdalla and David Pointcheval. 12 | 13 | == How it works 14 | 15 | === Preliminaries 16 | 17 | Let's say we have two users, user A and user B. 18 | They have already agreed on the following public information: 19 | 20 | * cyclic group, \(G\) of prime order, \(p\) 21 | * generating element \(g \in G\), such that \(g \neq 1\) 22 | * hash algorithm to use, \(H\) 23 | 24 | If the connection is asymmetric 25 | (e.g. if user A is a client and user B is a server), 26 | then they will also have: 27 | 28 | * two arbitrary elements in \(M, N \in G\), where \(M\) is associated with 29 | user A and \(N\) with user B. 30 | 31 | If the connection is symmetric 32 | (e.g. if user A and B are arbitrary peers), 33 | then they will instead have: 34 | 35 | * a single arbitrary element \(S \in G\) 36 | 37 | The discrete log of these arbitrary elements must be difficult to guess. 38 | 39 | And, they also have a secret password, 40 | which in practice will be an arbitrary byte string, 41 | but for the purposes of this module is an arbitrary /scalar/ in the group 42 | that is a shared secret between both parties 43 | (see "Crypto.Spake2.Groups" for more information on scalars). 44 | 45 | === The protocol 46 | 47 | /This is derived from the paper linked above./ 48 | 49 | One side, A, initiates the exchange. 50 | They draw a random scalar, \(x\), and matching element, \(X\), from the group. 51 | They then "blind" \(X\) by adding it to \(M\) multiplied by the password in scalar form. 52 | Call this \(X^{\star}\). 53 | 54 | \[X^{\star} \leftarrow X \cdot M^{pw}\] 55 | 56 | to the other side, side B. 57 | 58 | Side B does the same thing, 59 | except they use \(N\) instead of \(M\) to blind the result, 60 | and they call it \(Y\) instead of \(X\). 61 | 62 | \[Y^{\star} \leftarrow Y \cdot N^{pw}\] 63 | 64 | After side A receives \(Y^{\star}\), 65 | it calculates \(K_A\), 66 | which is the last missing input in calculating the session key. 67 | 68 | \[K_A \leftarrow (Y^{\star}/N^{pw})^x\] 69 | 70 | That is, \(K_A\) is \(Y^{\star}\) subtracted from \(N\) scalar multiplied by \(pw\), 71 | all of which is scalar multiplied by \(x\). 72 | 73 | Side B likewise calculates: 74 | 75 | \[K_B \leftarrow (X^{\star}/M^{pw})^y\] 76 | 77 | If both parties were honest and knew the password, 78 | the keys will be the same on both sides. 79 | That is: 80 | 81 | \[K_A = K_B\] 82 | 83 | === How to use the keys 84 | 85 | The keys \(K_A\) and \(K_B\) are not enough to securely encrypt a session. 86 | They must be used as input to create a session key. 87 | 88 | Constructing a session key is beyond the scope of this module. 89 | See 'createSessionKey' for more information. 90 | 91 | -} 92 | 93 | module Crypto.Spake2.Math 94 | ( Spake2(..) 95 | , Params(..) 96 | , startSpake2 97 | , Spake2Exchange 98 | , computeOutboundMessage 99 | , generateKeyMaterial 100 | ) where 101 | 102 | import Protolude hiding (group) 103 | 104 | import Crypto.Random.Types (MonadRandom(..)) 105 | 106 | import Crypto.Spake2.Group (AbelianGroup(..), Group(..), KeyPair(..)) 107 | 108 | -- | The parameters of the SPAKE2 protocol. The other side needs to be using 109 | -- the same values, but with swapped values for 'ourBlind' and 'theirBlind'. 110 | data Params group 111 | = Params 112 | { group :: group -- ^ The cyclic group used for encrypting keys 113 | , ourBlind :: Element group -- ^ The "blind" we use when sending out values. Side A refers to this as \(M\) in the protocol description. 114 | , theirBlind :: Element group -- ^ The "blind" the other side uses when sending values. Side A refers to this as \(N\) in the protocol description. 115 | } 116 | 117 | -- | An instance of the SPAKE2 protocol. This represents one side of the protocol. 118 | data Spake2 group 119 | = Spake2 120 | { params :: Params group 121 | , password :: Scalar group 122 | } 123 | 124 | -- | A SPAKE2 exchange that has been initiated. 125 | data Spake2Exchange group 126 | = Started 127 | { spake2 :: Spake2 group -- ^ Description of the specific instance of the 128 | -- SPAKE2 protocol we are using. Parameters, 129 | -- password, and group must be the same for this to 130 | -- work. 131 | , xy :: KeyPair group -- ^ Arbitrary element and scalar chosen by this side of the exchange. 132 | -- It is kept secret, and is only used to negotiate an exchange. 133 | -- A "blinded" form is sent to the other side of the protocol. 134 | } 135 | 136 | -- | Initiate the SPAKE2 exchange. Generates a secret (@xy@) that will be held 137 | -- by this side, and transmitted to the other side in "blinded" form. 138 | startSpake2 :: (AbelianGroup group, MonadRandom randomly) => Spake2 group -> randomly (Spake2Exchange group) 139 | startSpake2 spake2' = Started spake2' <$> generateElement (group . params $ spake2') 140 | 141 | -- | Determine the element (either \(X^{\star}\) or \(Y^{\star}\)) to send to the other side. 142 | computeOutboundMessage :: AbelianGroup group => Spake2Exchange group -> Element group 143 | computeOutboundMessage Started{spake2 = Spake2{params = Params{group, ourBlind}, password}, xy} = 144 | elementAdd group (keyPairPublic xy) (scalarMultiply group password ourBlind) 145 | 146 | -- | Generate key material, \(K\), given a message from the other side (either 147 | -- \(Y^{\star}\) or \(X^{\star}\)). 148 | -- 149 | -- This key material is the last piece of input required to make the session 150 | -- key, \(SK\), which should be generated as: 151 | -- 152 | -- \[SK \leftarrow H(A, B, X^{\star}, Y^{\star}, K, pw)\] 153 | -- 154 | -- Where: 155 | -- 156 | -- * \(H\) is a hash function 157 | -- * \(A\) identifies the initiating side 158 | -- * \(B\) identifies the receiving side 159 | -- * \(X^{star}\) is the outbound message from the initiating side 160 | -- * \(Y^{star}\) is the outbound message from the receiving side 161 | -- * \(K\) is the result of this function 162 | -- * \(pw\) is the password (this is what makes it SPAKE2, not SPAKE1) 163 | generateKeyMaterial 164 | :: AbelianGroup group 165 | => Spake2Exchange group -- ^ An initiated SPAKE2 exchange 166 | -> Element group -- ^ The outbound message from the other side (i.e. inbound to us) 167 | -> Element group -- ^ The final piece of key material to generate the session key. 168 | generateKeyMaterial Started{spake2 = Spake2{params = Params{group, theirBlind}, password}, xy} inbound = 169 | scalarMultiply group (keyPairPrivate xy) (elementSubtract group inbound (scalarMultiply group password theirBlind)) 170 | -------------------------------------------------------------------------------- /src/Crypto/Spake2/Util.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Crypto.Spake2.Util 3 | Description: Miscellany. Mostly to do with serialization. 4 | -} 5 | module Crypto.Spake2.Util 6 | ( expandData 7 | , expandArbitraryElementSeed 8 | , bytesToNumber 9 | , numberToBytes 10 | , unsafeNumberToBytes 11 | ) where 12 | 13 | import Protolude 14 | 15 | import Crypto.Hash.Algorithms (SHA256) 16 | import Crypto.Number.Serialize (os2ip, i2ospOf, i2ospOf_) 17 | import qualified Crypto.KDF.HKDF as HKDF 18 | import Data.ByteArray (ByteArray, ByteArrayAccess(..)) 19 | 20 | -- | Take an arbitrary sequence of bytes and expand it to be the given number 21 | -- of bytes. Do this by extracting a pseudo-random key and expanding it using 22 | -- HKDF. 23 | expandData :: (ByteArrayAccess input, ByteArray output) => ByteString -> input -> Int -> output 24 | expandData info input size = 25 | HKDF.expand prk info size 26 | where 27 | prk :: HKDF.PRK SHA256 28 | prk = HKDF.extract salt input 29 | 30 | -- XXX: I'm no crypto expert, but hard-coding an empty string as a salt 31 | -- seems kind of weird. 32 | salt :: ByteString 33 | salt = "" 34 | 35 | -- | Given a seed value for an arbitrary element (see 'arbitraryElement'), 36 | -- expand it to be of the given length. 37 | expandArbitraryElementSeed :: (ByteArrayAccess ikm, ByteArray out) => ikm -> Int -> out 38 | expandArbitraryElementSeed = 39 | -- NOTE: This must be exactly this string in order to interoperate with python-spake2 40 | expandData "SPAKE2 arbitrary element" 41 | 42 | 43 | -- | Serialize a number according to the SPAKE2 protocol. 44 | -- 45 | -- Just kidding, there isn't a SPAKE2 protocol. 46 | -- This just matches the Python implementation. 47 | -- 48 | -- Inverse of 'bytesToNumber'. 49 | numberToBytes :: ByteArray bytes => Int -> Integer -> Maybe bytes 50 | numberToBytes = i2ospOf 51 | 52 | -- | Serialize a number according to the SPAKE2 protocol. 53 | -- 54 | -- Panics if the number is too big to fit into the given number of bytes. 55 | unsafeNumberToBytes :: ByteArray bytes => Int -> Integer -> bytes 56 | unsafeNumberToBytes = i2ospOf_ 57 | 58 | 59 | -- | Deserialize a number according to the SPAKE2 protocol. 60 | -- 61 | -- Just kidding, there isn't a SPAKE2 protocol. 62 | -- This just matches the Python implementation. 63 | -- 64 | -- Inverse of 'numberToBytes'. 65 | bytesToNumber :: ByteArrayAccess bytes => bytes -> Integer 66 | bytesToNumber = os2ip 67 | -------------------------------------------------------------------------------- /tests/Groups.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | module Groups (tests) where 4 | 5 | import Protolude hiding (group) 6 | 7 | import Crypto.Error (CryptoFailable(..)) 8 | import Test.QuickCheck (Gen, (===), arbitrary, forAll, property) 9 | import Test.Tasty (TestTree) 10 | import Test.Tasty.Hspec (testSpec) 11 | 12 | import Test.Hspec (Spec, describe, it) 13 | import Test.Hspec.Expectations (shouldBe) 14 | 15 | import Crypto.Spake2.Group (AbelianGroup(..), Group(..)) 16 | import Crypto.Spake2.Groups 17 | ( IntegerGroup(..) 18 | , Ed25519(..) 19 | , i1024) 20 | import qualified Crypto.Spake2.Groups.Ed25519 as Ed25519 21 | import qualified Crypto.Spake2.Groups.IntegerGroup as IntegerGroup 22 | 23 | tests :: IO TestTree 24 | tests = testSpec "Groups" $ do 25 | describe "integer group" $ 26 | allGroupProperties i1024 (makeScalar (subgroupOrder i1024)) (IntegerGroup.generator i1024) 27 | describe "Ed25519" $ 28 | allGroupProperties Ed25519 (makeScalar Ed25519.l) Ed25519.generator 29 | 30 | allGroupProperties 31 | :: (Show (Scalar group), Show (Element group), Eq (Scalar group), Eq (Element group), AbelianGroup group) 32 | => group 33 | -> Gen (Scalar group) 34 | -> Element group 35 | -> Spec 36 | allGroupProperties group scalars base = do 37 | describe "is a group" $ groupProperties group (makeElement group scalars base) 38 | describe "is an abelian group" $ abelianGroupProperties group scalars base 39 | 40 | groupProperties 41 | :: (Group group, Eq (Element group), Show (Element group)) 42 | => group 43 | -> Gen (Element group) 44 | -> Spec 45 | groupProperties group elements = do 46 | it "addition is associative" $ property $ 47 | forAll (triples elements) $ \(x, y, z) -> elementAdd group (elementAdd group x y) z === elementAdd group x (elementAdd group y z) 48 | 49 | it "addition with inverse yields identity" $ property $ 50 | forAll elements $ \x -> elementAdd group x (elementNegate group x) === groupIdentity group 51 | 52 | it "double negative is no-op" $ property $ 53 | forAll elements $ \x -> elementNegate group (elementNegate group x) === x 54 | 55 | it "identity is its own inverse" $ 56 | elementNegate group (groupIdentity group) `shouldBe` groupIdentity group 57 | 58 | it "subtraction is negated addition" $ property $ 59 | forAll (pairs elements) $ \(x, y) -> elementSubtract group x y === elementAdd group x (elementNegate group y) 60 | 61 | it "right-hand addition with identity yields original" $ property $ 62 | forAll elements $ \x -> elementAdd group x (groupIdentity group) === x 63 | 64 | it "left-hand addition with identity yields original" $ property $ 65 | forAll elements $ \x -> elementAdd group (groupIdentity group) x === x 66 | 67 | it "element codec roundtrips" $ property $ 68 | forAll elements $ \x -> let bytes = encodeElement group x :: ByteString 69 | in decodeElement group bytes == CryptoPassed x 70 | 71 | 72 | abelianGroupProperties 73 | :: (AbelianGroup group, Eq (Element group), Eq (Scalar group), Show (Element group), Show (Scalar group)) 74 | => group 75 | -> Gen (Scalar group) 76 | -> Element group 77 | -> Spec 78 | abelianGroupProperties group scalars base = do 79 | it "addition is commutative" $ property $ 80 | forAll (pairs elements) $ \(x, y) -> elementAdd group x y === elementAdd group y x 81 | 82 | it "scalar to integer roundtrips" $ property $ 83 | forAll scalars $ \n -> integerToScalar group (scalarToInteger group n) === n 84 | 85 | it "integer to scalar conversion" $ property $ 86 | -- Doesn't roundtrip per se, because negative integers (for example) get 87 | -- turned into scalars within the subgroup range, losing the original 88 | -- information. 89 | \i -> integerToScalar group (scalarToInteger group (integerToScalar group i)) === integerToScalar group i 90 | 91 | it "scalar multiply by 0 is identity" $ property $ 92 | forAll elements $ \x -> scalarMultiply group (integerToScalar group 0) x === groupIdentity group 93 | 94 | it "scalar multiply by 1 is original" $ property $ 95 | forAll elements $ \x -> scalarMultiply group (integerToScalar group 1) x === x 96 | 97 | it "scalar multiply by 2 is equivalent to addition" $ property $ 98 | forAll elements $ \x -> scalarMultiply group (integerToScalar group 2) x === elementAdd group x x 99 | 100 | where 101 | elements = makeElement group scalars base 102 | 103 | -- | Generate pairs of a thing. 104 | pairs :: Gen a -> Gen (a, a) 105 | pairs gen = do 106 | x <- gen 107 | y <- gen 108 | pure (x, y) 109 | 110 | -- | Generate triples of a thing. 111 | triples :: Gen a -> Gen (a, a, a) 112 | triples gen = do 113 | x <- gen 114 | y <- gen 115 | z <- gen 116 | pure (x, y, z) 117 | 118 | makeScalar :: Integer -> Gen Integer 119 | makeScalar k = do 120 | i <- arbitrary 121 | pure $ i `mod` k 122 | 123 | makeElement :: AbelianGroup group => group -> Gen (Scalar group) -> Element group -> Gen (Element group) 124 | makeElement group scalars base = do 125 | scalar <- scalars 126 | pure (scalarMultiply group scalar base) 127 | -------------------------------------------------------------------------------- /tests/Integration.hs: -------------------------------------------------------------------------------- 1 | module Integration (tests) where 2 | 3 | import Protolude hiding (stdin, stdout, toS) 4 | import Protolude.Conv (toS) 5 | 6 | import Crypto.Hash (SHA256(..)) 7 | import Data.ByteArray.Encoding (convertFromBase, convertToBase, Base(Base16)) 8 | import qualified Data.ByteString as ByteString 9 | import qualified Data.ByteString.Char8 as Char8 10 | import qualified System.IO as IO 11 | import qualified System.Process as Process 12 | import Test.Tasty (TestTree) 13 | import Test.Tasty.Hspec (testSpec) 14 | 15 | import Test.Hspec (describe, it) 16 | import Test.Hspec.Expectations (shouldBe) 17 | 18 | 19 | import qualified Crypto.Spake2 as Spake2 20 | import Crypto.Spake2.Group (Group(arbitraryElement)) 21 | import Crypto.Spake2.Groups (Ed25519(..)) 22 | 23 | import qualified Paths_spake2 24 | 25 | tests :: IO TestTree 26 | tests = testSpec "Integration" $ 27 | describe "python-spake2" $ do 28 | it "Generates the same SPAKE2 session key (symmetric)" $ do 29 | let sideID = "treebeard" 30 | let password = "mellon" 31 | let protocol = Spake2.makeSymmetricProtocol SHA256 Ed25519 blindS (Spake2.SideID sideID) 32 | exchangeWithPython protocol password 33 | [ "--side=S" 34 | , "--side-id=" <> toS sideID 35 | ] 36 | 37 | it "Generates the same SPAKE2 session key (asymmetric, we are side B)" $ do 38 | let ourSideID = "alliance" 39 | let theirSideID = "horde" 40 | let password = "mellon" 41 | let protocol = Spake2.makeAsymmetricProtocol SHA256 Ed25519 blindA blindB (Spake2.SideID theirSideID) (Spake2.SideID ourSideID) Spake2.SideB 42 | exchangeWithPython protocol password 43 | [ "--side=A" 44 | , "--side-id=" <> toS theirSideID 45 | , "--other-side-id=" <> toS ourSideID 46 | ] 47 | 48 | it "Generates the same SPAKE2 session key (asymmetric, we are side A)" $ do 49 | let ourSideID = "alliance" 50 | let theirSideID = "horde" 51 | let password = "mellon" 52 | let protocol = Spake2.makeAsymmetricProtocol SHA256 Ed25519 blindA blindB (Spake2.SideID ourSideID) (Spake2.SideID theirSideID) Spake2.SideA 53 | exchangeWithPython protocol password 54 | [ "--side=B" 55 | , "--side-id=" <> toS theirSideID 56 | , "--other-side-id=" <> toS ourSideID 57 | ] 58 | 59 | where 60 | send h x = Char8.hPutStrLn h (convertToBase Base16 x) 61 | receive h = convertFromBase Base16 <$> ByteString.hGetLine h 62 | blindA = arbitraryElement Ed25519 ("M" :: ByteString) 63 | blindB = arbitraryElement Ed25519 ("N" :: ByteString) 64 | blindS = arbitraryElement Ed25519 ("symmetric" :: ByteString) 65 | 66 | exchangeWithPython protocol password args = do 67 | scriptExe <- Paths_spake2.getDataFileName "tests/python/spake2_exchange.py" 68 | let testScript = (Process.proc "python" (scriptExe:("--code=" <> toS password):args)) 69 | { Process.std_in = Process.CreatePipe 70 | , Process.std_out = Process.CreatePipe 71 | , Process.std_err = Process.Inherit -- So we get stack traces printed during test runs. 72 | } 73 | Process.withCreateProcess testScript $ 74 | \(Just stdin) (Just stdout) _stderr ph -> do 75 | -- The inter-process protocol is line-based. 76 | IO.hSetBuffering stdin IO.LineBuffering 77 | IO.hSetBuffering stdout IO.LineBuffering 78 | IO.hSetBuffering stderr IO.LineBuffering 79 | (do Right sessionKey <- Spake2.spake2Exchange protocol (Spake2.makePassword password) (send stdin) (receive stdout) 80 | theirSpakeKey <- ByteString.hGetLine stdout 81 | theirSpakeKey `shouldBe` convertToBase Base16 sessionKey) `finally` Process.waitForProcess ph 82 | -------------------------------------------------------------------------------- /tests/Spake2.hs: -------------------------------------------------------------------------------- 1 | module Spake2 (tests) where 2 | 3 | import Protolude hiding (group) 4 | import Test.Tasty (TestTree) 5 | import Test.Tasty.Hspec (testSpec) 6 | 7 | import Test.Hspec (describe, it) 8 | import Test.Hspec.Expectations (shouldBe, shouldNotBe) 9 | 10 | 11 | import Crypto.Hash (SHA256(..)) 12 | import qualified Crypto.Spake2 as Spake2 13 | import qualified Crypto.Spake2.Group as Group 14 | import Crypto.Spake2.Groups (Ed25519(..)) 15 | 16 | tests :: IO TestTree 17 | tests = testSpec "Spake2" $ do 18 | describe "Asymmetric protocol" $ do 19 | it "Produces matching session keys when passwords match" $ do 20 | let password = Spake2.makePassword "abc" 21 | let idA = Spake2.SideID "side-a" 22 | let idB = Spake2.SideID "side-b" 23 | let protocolA = defaultAsymmetricProtocol idA idB Spake2.SideA 24 | let protocolB = defaultAsymmetricProtocol idA idB Spake2.SideB 25 | (Right aSessionKey, Right bSessionKey) <- (protocolA, password) `versus` (protocolB, password) 26 | aSessionKey `shouldBe` bSessionKey 27 | 28 | it "Produces differing session keys when passwords do not match" $ do 29 | let password1 = Spake2.makePassword "abc" 30 | let password2 = Spake2.makePassword "cba" 31 | let idA = Spake2.SideID "" 32 | let idB = Spake2.SideID "" 33 | let protocolA = defaultAsymmetricProtocol idA idB Spake2.SideA 34 | let protocolB = defaultAsymmetricProtocol idA idB Spake2.SideB 35 | (Right aSessionKey, Right bSessionKey) <- (protocolA, password1) `versus` (protocolB, password2) 36 | aSessionKey `shouldNotBe` bSessionKey 37 | 38 | describe "Symmetric protocol" $ do 39 | it "Produces matching session keys when passwords match" $ do 40 | let password = Spake2.makePassword "abc" 41 | let protocol = defaultSymmetricProtocol (Spake2.SideID "") 42 | (Right sessionKey1, Right sessionKey2) <- (protocol, password) `versus` (protocol, password) 43 | sessionKey1 `shouldBe` sessionKey2 44 | 45 | it "Produces differing session keys when passwords do not match" $ do 46 | let password1 = Spake2.makePassword "abc" 47 | let password2 = Spake2.makePassword "cba" 48 | let protocol = defaultSymmetricProtocol (Spake2.SideID "") 49 | (Right sessionKey1, Right sessionKey2) <- (protocol, password1) `versus` (protocol, password2) 50 | sessionKey1 `shouldNotBe` sessionKey2 51 | 52 | where 53 | defaultAsymmetricProtocol = Spake2.makeAsymmetricProtocol SHA256 group m n 54 | m = Group.arbitraryElement group ("M" :: ByteString) 55 | n = Group.arbitraryElement group ("N" :: ByteString) 56 | 57 | defaultSymmetricProtocol = Spake2.makeSymmetricProtocol SHA256 group s 58 | s = Group.arbitraryElement group ("symmetric" :: ByteString) 59 | 60 | group = Ed25519 61 | 62 | -- | Run protocol A with password A against protocol B with password B. 63 | versus (protocolA, passwordA) (protocolB, passwordB) = do 64 | aOutVar <- newEmptyMVar 65 | bOutVar <- newEmptyMVar 66 | concurrently 67 | (Spake2.spake2Exchange protocolA passwordA (putMVar aOutVar) (Right <$> readMVar bOutVar)) 68 | (Spake2.spake2Exchange protocolB passwordB (putMVar bOutVar) (Right <$> readMVar aOutVar)) 69 | -------------------------------------------------------------------------------- /tests/Tasty.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | import Protolude 6 | 7 | import Test.Tasty (defaultMain, testGroup) 8 | 9 | import qualified Spake2 10 | import qualified Groups 11 | import qualified Integration 12 | 13 | main :: IO () 14 | main = sequence tests >>= defaultMain . testGroup "Spake2" 15 | where 16 | tests = 17 | [ Spake2.tests 18 | , Groups.tests 19 | , Integration.tests 20 | ] 21 | -------------------------------------------------------------------------------- /tests/python/spake2_exchange.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | """Exchange SPAKE2 keys and print out the session key. 3 | 4 | Assumes symmetric exchange and uses the default SPAKE2 parameters. 5 | """ 6 | import argparse 7 | from binascii import hexlify, unhexlify 8 | import attr 9 | import sys 10 | 11 | from spake2 import SPAKE2_A, SPAKE2_B, SPAKE2_Symmetric 12 | 13 | 14 | def main(): 15 | parser = argparse.ArgumentParser(prog='version_exchange') 16 | parser.add_argument( 17 | '--code', dest='code', type=str, 18 | help='Password to use to connect to other side') 19 | parser.add_argument( 20 | '--side-id', dest='side_id', type=str, 21 | help='Identifier for this side of the exchange') 22 | parser.add_argument( 23 | '--side', dest='side', choices=['A', 'B', 'S'], 24 | help=('Which side this represents. ' 25 | 'Decides whether we use symmetric or asymmetric variant.')) 26 | parser.add_argument( 27 | '--other-side-id', dest='other_side_id', type=str, 28 | help=('Identifier for other side of the exchange. ' 29 | 'Only necessary for asymmetric variants.')) 30 | params = parser.parse_args(sys.argv[1:]) 31 | transport = Transport(input_stream=sys.stdin, output_stream=sys.stdout) 32 | protocol = get_protocol( 33 | params.code, params.side, params.side_id, params.other_side_id) 34 | run_exchange(transport, protocol) 35 | 36 | 37 | def get_protocol(code, side, side_id, other_side_id): 38 | code = code.encode('utf8') 39 | side_id = side_id.encode('utf8') 40 | if side == 'S': 41 | return SPAKE2_Symmetric(code, idSymmetric=side_id) 42 | other_side_id = other_side_id.encode('utf8') 43 | if side == 'A': 44 | return SPAKE2_A(code, idA=side_id, idB=other_side_id) 45 | elif side == 'B': 46 | return SPAKE2_B(code, idA=other_side_id, idB=side_id) 47 | else: 48 | raise AssertionError('Invalid side: %r' % (side,)) 49 | 50 | 51 | def run_exchange(transport, protocol): 52 | # Send the SPAKE2 message 53 | outbound = protocol.start() 54 | transport.send_line(hexlify(outbound)) 55 | 56 | # Receive SPAKE2 message 57 | pake_msg = transport.receive_line() 58 | inbound = unhexlify(pake_msg) 59 | spake_key = protocol.finish(inbound) 60 | transport.send_line(hexlify(spake_key)) 61 | 62 | 63 | @attr.s 64 | class Transport(object): 65 | input_stream = attr.ib() 66 | output_stream = attr.ib() 67 | 68 | def send_line(self, line): 69 | self.output_stream.write(line.rstrip().decode("utf8")) 70 | self.output_stream.write('\n') 71 | self.output_stream.flush() 72 | 73 | def receive_line(self): 74 | return self.input_stream.readline().strip() 75 | 76 | 77 | if __name__ == '__main__': 78 | main() 79 | --------------------------------------------------------------------------------