packages feed

spake2 (empty) → 0.1.0

raw patch · 15 files changed

+1869/−0 lines, 15 filesdep +QuickCheckdep +basedep +base16-bytestringsetup-changed

Dependencies added: QuickCheck, base, base16-bytestring, bytestring, cryptonite, memory, optparse-applicative, protolude, spake2, tasty, tasty-hspec

Files

+ LICENSE view
@@ -0,0 +1,163 @@+Apache License++Version 2.0, January 2004++http://www.apache.org/licenses/++TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++1. Definitions.++"License" shall mean the terms and conditions for use, reproduction, and+distribution as defined by Sections 1 through 9 of this document.++"Licensor" shall mean the copyright owner or entity authorized by the+copyright owner that is granting the License.++"Legal Entity" shall mean the union of the acting entity and all other+entities that control, are controlled by, or are under common control with+that entity. For the purposes of this definition, "control" means (i) the+power, direct or indirect, to cause the direction or management of such+entity, whether by contract or otherwise, or (ii) ownership of fifty percent+(50%) or more of the outstanding shares, or (iii) beneficial ownership of such+entity.++"You" (or "Your") shall mean an individual or Legal Entity exercising+permissions granted by this License.++"Source" form shall mean the preferred form for making modifications,+including but not limited to software source code, documentation source, and+configuration files.++"Object" form shall mean any form resulting from mechanical transformation or+translation of a Source form, including but not limited to compiled object+code, generated documentation, and conversions to other media types.++"Work" shall mean the work of authorship, whether in Source or Object form,+made available under the License, as indicated by a copyright notice that is+included in or attached to the work (an example is provided in the Appendix+below).++"Derivative Works" shall mean any work, whether in Source or Object form, that+is based on (or derived from) the Work and for which the editorial revisions,+annotations, elaborations, or other modifications represent, as a whole, an+original work of authorship. For the purposes of this License, Derivative+Works shall not include works that remain separable from, or merely link (or+bind by name) to the interfaces of, the Work and Derivative Works thereof.++"Contribution" shall mean any work of authorship, including the original+version of the Work and any modifications or additions to that Work or+Derivative Works thereof, that is intentionally submitted to Licensor for+inclusion in the Work by the copyright owner or by an individual or Legal+Entity authorized to submit on behalf of the copyright owner. For the purposes+of this definition, "submitted" means any form of electronic, verbal, or+written communication sent to the Licensor or its representatives, including+but not limited to communication on electronic mailing lists, source code+control systems, and issue tracking systems that are managed by, or on behalf+of, the Licensor for the purpose of discussing and improving the Work, but+excluding communication that is conspicuously marked or otherwise designated+in writing by the copyright owner as "Not a Contribution."++"Contributor" shall mean Licensor and any individual or Legal Entity on behalf+of whom a Contribution has been received by Licensor and subsequently+incorporated within the Work.++2. Grant of Copyright License. Subject to the terms and conditions of this+License, each Contributor hereby grants to You a perpetual, worldwide,+non-exclusive, no-charge, royalty-free, irrevocable copyright license to+reproduce, prepare Derivative Works of, publicly display, publicly perform,+sublicense, and distribute the Work and such Derivative Works in Source or+Object form.++3. Grant of Patent License. Subject to the terms and conditions of this+License, each Contributor hereby grants to You a perpetual, worldwide,+non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this+section) patent license to make, have made, use, offer to sell, sell, import,+and otherwise transfer the Work, where such license applies only to those+patent claims licensable by such Contributor that are necessarily infringed by+their Contribution(s) alone or by combination of their Contribution(s) with+the Work to which such Contribution(s) was submitted. If You institute patent+litigation against any entity (including a cross-claim or counterclaim in a+lawsuit) alleging that the Work or a Contribution incorporated within the Work+constitutes direct or contributory patent infringement, then any patent+licenses granted to You under this License for that Work shall terminate as of+the date such litigation is filed.++4. Redistribution. You may reproduce and distribute copies of the Work or+Derivative Works thereof in any medium, with or without modifications, and in+Source or Object form, provided that You meet the following conditions:++You must give any other recipients of the Work or Derivative Works a copy of+this License; and++You must cause any modified files to carry prominent notices stating that You+changed the files; and++You must retain, in the Source form of any Derivative Works that You+distribute, all copyright, patent, trademark, and attribution notices from the+Source form of the Work, excluding those notices that do not pertain to any+part of the Derivative Works; and++If the Work includes a "NOTICE" text file as part of its distribution, then+any Derivative Works that You distribute must include a readable copy of the+attribution notices contained within such NOTICE file, excluding those notices+that do not pertain to any part of the Derivative Works, in at least one of+the following places: within a NOTICE text file distributed as part of the+Derivative Works; within the Source form or documentation, if provided along+with the Derivative Works; or, within a display generated by the Derivative+Works, if and wherever such third-party notices normally appear. The contents+of the NOTICE file are for informational purposes only and do not modify the+License. You may add Your own attribution notices within Derivative Works that+You distribute, alongside or as an addendum to the NOTICE text from the Work,+provided that such additional attribution notices cannot be construed as+modifying the License.++You may add Your own copyright statement to Your modifications and may provide+additional or different license terms and conditions for use, reproduction, or+distribution of Your modifications, or for any such Derivative Works as a+whole, provided Your use, reproduction, and distribution of the Work otherwise+complies with the conditions stated in this License.++5. Submission of Contributions. Unless You explicitly state otherwise, any+Contribution intentionally submitted for inclusion in the Work by You to the+Licensor shall be under the terms and conditions of this License, without any+additional terms or conditions. Notwithstanding the above, nothing herein+shall supersede or modify the terms of any separate license agreement you may+have executed with Licensor regarding such Contributions.++6. Trademarks. This License does not grant permission to use the trade names,+trademarks, service marks, or product names of the Licensor, except as+required for reasonable and customary use in describing the origin of the Work+and reproducing the content of the NOTICE file.++7. Disclaimer of Warranty. Unless required by applicable law or agreed to in+writing, Licensor provides the Work (and each Contributor provides its+Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY+KIND, either express or implied, including, without limitation, any warranties+or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+PARTICULAR PURPOSE. You are solely responsible for determining the+appropriateness of using or redistributing the Work and assume any risks+associated with Your exercise of permissions under this License.++8. Limitation of Liability. In no event and under no legal theory, whether in+tort (including negligence), contract, or otherwise, unless required by+applicable law (such as deliberate and grossly negligent acts) or agreed to in+writing, shall any Contributor be liable to You for damages, including any+direct, indirect, special, incidental, or consequential damages of any+character arising as a result of this License or out of the use or inability+to use the Work (including but not limited to damages for loss of goodwill,+work stoppage, computer failure or malfunction, or any and all other+commercial damages or losses), even if such Contributor has been advised of+the possibility of such damages.++9. Accepting Warranty or Additional Liability. While redistributing the Work+or Derivative Works thereof, You may choose to offer, and charge a fee for,+acceptance of support, warranty, indemnity, or other liability obligations+and/or rights consistent with this License. However, in accepting such+obligations, You may act only on Your own behalf and on Your sole+responsibility, not on behalf of any other Contributor, and only if You agree+to indemnify, defend, and hold each Contributor harmless for any liability+incurred by, or claims asserted against, such Contributor by reason of your+accepting any such warranty or additional liability.++END OF TERMS AND CONDITIONS
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cmd/interop-entrypoint/Main.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Entrypoint for testing interoperability.+--+-- Interoperability harness lives at <https://github.com/leastauthority/spake2-interop-test>+--+-- Any entry point for the harness needs to:+--  - take everything it needs as command-line parameters+--  - print the outbound message to stdout, base16-encoded+--  - read the inbound message from stdin, base16-encoded+--  - print the session key, base16-encoded+--  - terminate+--+-- Much of the code in here will probably move to the library as we figure out+-- what we need to do to implement the protocol properly.++module Main (main) where++import Protolude hiding (group)++import Crypto.Hash (SHA256(..))+import qualified Data.ByteString.Base16 as Base16+import Options.Applicative+import System.IO (hFlush, hGetLine, hPutStrLn)++import qualified Crypto.Spake2 as Spake2+import Crypto.Spake2+  ( Password+  , Protocol+  , SideID(..)+  , makeSymmetricProtocol+  , makeAsymmetricProtocol+  , createSessionKey+  , makePassword+  , computeOutboundMessage+  , generateKeyMaterial+  , extractElement+  , startSpake2+  , elementToMessage+  , formatError+  )+import Crypto.Spake2.Group (Group(..))+import Crypto.Spake2.Groups (Ed25519(..))+++data Config = Config Side Password deriving (Eq, Ord)++data Side = SideA | SideB | Symmetric deriving (Eq, Ord, Show)++configParser :: Parser Config+configParser =+  Config+    <$> argument sideParser (metavar "SIDE")+    <*> argument passwordParser (metavar "PASSWORD")+  where+    sideParser = eitherReader $ \s ->+      case s of+        "A" -> pure SideA+        "B" -> pure SideB+        "Symmetric" -> pure Symmetric+        unknown -> throwError $ "Unrecognized side: " <> unknown+    passwordParser = makePassword . toS <$> str+++-- | Terminate the test with a failure, printing a message to stderr.+abort :: HasCallStack => Text -> IO ()+abort message = do+  hPutStrLn stderr $ toS ("ERROR: " <> message)+  exitWith (ExitFailure 1)+++runInteropTest+  :: (HasCallStack, Group group)+  => Protocol group SHA256+  -> Password+  -> Handle+  -> Handle+  -> IO ()+runInteropTest protocol password inH outH = do+  spake2 <- startSpake2 protocol password+  let outElement = computeOutboundMessage spake2+  output (elementToMessage protocol outElement)+  line <- hGetLine inH+  let inMsg = parseHex (toS line)+  case inMsg of+    Left err -> abort err+    Right inMsgBytes ->+      case extractElement protocol inMsgBytes of+        Left err -> abort $ "Could not handle incoming message (line = " <> show line <> ", msgBytes = " <>  show inMsgBytes <> "): " <> formatError err+        Right inElement -> do+          -- TODO: This is wrong, because it doesn't handle A/B properly.+          let key = generateKeyMaterial spake2 inElement+          let sessionKey = createSessionKey protocol inElement outElement key password+          output sessionKey++  where+    output message = do+      hPutStrLn outH (toS (Base16.encode message))+      hFlush outH++    parseHex line =+      case Base16.decode line of+        (bytes, "") -> Right bytes+        _ -> Left ("Could not decode line: " <> show line)+++makeProtocolFromSide :: Side -> Protocol Ed25519 SHA256+makeProtocolFromSide side =+  case side of+    SideA -> makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideA+    SideB -> makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideB+    Symmetric -> makeSymmetricProtocol hashAlg group s idSymmetric+  where+    hashAlg = SHA256+    group = Ed25519+    m = arbitraryElement group ("M" :: ByteString)+    n = arbitraryElement group ("N" :: ByteString)+    s = arbitraryElement group ("S" :: ByteString)+    idA = SideID ""+    idB = SideID ""+    idSymmetric = SideID ""++main :: IO ()+main = do+  Config side password <- execParser opts+  let protocol = makeProtocolFromSide side+  runInteropTest protocol password stdin stdout+  exitSuccess+  where+    opts = info (helper <*> configParser)+           (fullDesc <>+            header "interop-entrypoint - tool to help test SPAKE2 interop")
+ spake2.cabal view
@@ -0,0 +1,80 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           spake2+version:        0.1.0+synopsis:       Implementation of the SPAKE2 Password-Authenticated Key Exchange algorithm+description:    This library implements the SPAKE2 password-authenticated key exchange+                ("PAKE") algorithm. This allows two parties, who share a weak password, to+                safely derive a strong shared secret (and therefore build an+                encrypted+authenticated channel).+category:       Crypto+homepage:       https://github.com/jml/haskell-spake2#readme+bug-reports:    https://github.com/jml/haskell-spake2/issues+maintainer:     Jonathan M. Lange <jml@mumak.net>+license:        Apache+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/jml/haskell-spake2++library+  hs-source-dirs:+      src+  default-extensions: NoImplicitPrelude OverloadedStrings+  ghc-options: -Wall -Wno-type-defaults+  build-depends:+      base >= 4.9 && < 5+    , protolude+    , bytestring+    , cryptonite+    , memory+  exposed-modules:+      Crypto.Spake2+      Crypto.Spake2.Group+      Crypto.Spake2.Groups+      Crypto.Spake2.Groups.Ed25519+      Crypto.Spake2.Groups.IntegerAddition+      Crypto.Spake2.Groups.IntegerGroup+      Crypto.Spake2.Math+      Crypto.Spake2.Util+  default-language: Haskell2010++executable haskell-spake2-interop-entrypoint+  main-is: Main.hs+  hs-source-dirs:+      cmd/interop-entrypoint+  default-extensions: NoImplicitPrelude OverloadedStrings+  ghc-options: -Wall -Wno-type-defaults -threaded+  build-depends:+      base >= 4.9 && < 5+    , protolude+    , base16-bytestring+    , cryptonite+    , optparse-applicative+    , spake2+  default-language: Haskell2010++test-suite tasty+  type: exitcode-stdio-1.0+  main-is: Tasty.hs+  hs-source-dirs:+      tests+  default-extensions: NoImplicitPrelude OverloadedStrings+  ghc-options: -Wall -Wno-type-defaults+  build-depends:+      base >= 4.9 && < 5+    , protolude+    , cryptonite+    , QuickCheck+    , spake2+    , tasty+    , tasty-hspec+  other-modules:+      Groups+      Spake2+  default-language: Haskell2010
+ src/Crypto/Spake2.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE NamedFieldPuns #-}++{-|+Module: Crypto.Spake2+Description: Implementation of SPAKE2 key exchange protocol++Say that you and someone else share a secret password, and you want to use+this password to arrange some secure channel of communication. You want:++ * to know that the other party also knows the secret password (maybe+   they're an imposter!)+ * the password to be secure against offline dictionary attacks+ * probably some other things++SPAKE2 is an algorithm for agreeing on a key exchange that meets these+criteria. See [Simple Password-Based Encrypted Key Exchange+Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf) by+Michel Abdalla and David Pointcheval for more details.++== How it works++=== Preliminaries++Before exchanging, two nodes need to agree on the following, out-of-band:++In general:++* hash algorithm, \(H\)+* group to use, \(G\)+* arbitrary members of group to use for blinding+* a means of converting this password to a scalar of group++For a specific exchange:++* whether the connection is symmetric or asymmetric+* the IDs of the respective sides+* a shared, secret password in bytes++#protocol#++=== Protocol++==== How we map the password to a scalar++Use HKDF expansion (see 'expandData') to expand the password by 16 bytes,+using an empty salt, and "SPAKE2 pw" as the info.++Then, use a group-specific mapping from bytes to scalars.+Since scalars are normally isomorphic to integers,+this will normally be a matter of converting the bytes to an integer+using standard deserialization+and then turning the integer into a scalar.++==== How we exchange information++See 'Crypto.Spake2.Math' for details on the mathematics of the exchange.++==== How python-spake2 works++- Message to other side is prepended with a single character, @A@, @B@, or+  @S@, to indicate which side it came from+- The hash function for generating the session key has a few interesting properties:+    - uses SHA256 for hashing+    - does not include password or IDs directly, but rather uses /their/ SHA256+      digests as inputs to the hash+    - for the symmetric version, it sorts \(X^{\star}\) and \(Y^{\star}\),+      because neither side knows which is which+- By default, the ID of either side is the empty bytestring++== Open questions++* how does endianness come into play?+* what is Shallue-Woestijne-Ulas and why is it relevant?++== References++* [Javascript implementation](https://github.com/bitwiseshiftleft/sjcl/pull/273/), includes long, possibly relevant discussion+* [Python implementation](https://github.com/warner/python-spake2)+* [SPAKE2 random elements](http://www.lothar.com/blog/54-spake2-random-elements/) - blog post by warner about choosing \(M\) and \(N\)+* [Simple Password-Based Encrypted Key Exchange Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf) by Michel Abdalla and David Pointcheval+* [draft-irtf-cfrg-spake2-03](https://tools.ietf.org/html/draft-irtf-cfrg-spake2-03) - expired IRTF draft for SPAKE2++-}++module Crypto.Spake2+  ( something+  , Password+  , makePassword+  -- * The SPAKE2 protocol+  , Protocol+  , makeAsymmetricProtocol+  , makeSymmetricProtocol+  , startSpake2+  , Math.computeOutboundMessage+  , Math.generateKeyMaterial+  , extractElement+  , MessageError+  , formatError+  , elementToMessage+  , createSessionKey+  , SideID(..)+  , WhichSide(..)+  ) where++import Protolude hiding (group)++import Crypto.Error (CryptoError, CryptoFailable(..))+import Crypto.Hash (HashAlgorithm, hashWith)+import Crypto.Random.Types (MonadRandom(..))+import Data.ByteArray (ByteArrayAccess, ByteArray)+import qualified Data.ByteArray as ByteArray+import qualified Data.ByteString as ByteString++import Crypto.Spake2.Group (Group(..), decodeScalar, scalarSizeBytes)+import qualified Crypto.Spake2.Math as Math+import Crypto.Spake2.Util (expandData)+++-- | Do-nothing function so that we have something to import in our tests.+-- TODO: Actually test something genuine and then remove this.+something :: a -> a+something x = x++-- | Shared secret password used to negotiate the connection.+--+-- Constructor deliberately not exported,+-- so that once a 'Password' has been created, the actual password cannot be retrieved by other modules.+--+-- Construct with 'makePassword'.+newtype Password = Password ByteString deriving (Eq, Ord)++-- | Construct a password.+makePassword :: ByteString -> Password+makePassword = Password++-- | Bytes that identify a side of the protocol+newtype SideID = SideID { unSideID :: ByteString } deriving (Eq, Ord, Show)++-- | Convert a user-supplied password into a scalar on a group.+passwordToScalar :: Group group => group -> Password -> Scalar group+passwordToScalar group password =+  let oversized = expandPassword password (scalarSizeBytes group + 16) :: ByteString+  in decodeScalar group oversized++-- | Expand a password using HKDF so that it has a certain number of bytes.+--+-- TODO: jml cannot remember why you might want to call this.+expandPassword :: ByteArray output => Password -> Int -> output+expandPassword (Password bytes) numBytes = expandData info bytes numBytes+  where+    -- This needs to be exactly "SPAKE2 pw"+    -- See <https://github.com/bitwiseshiftleft/sjcl/pull/273/#issuecomment-185251593>+    info = "SPAKE2 pw"++-- | Turn an element into a message from this side of the protocol.+elementToMessage :: Group group => Protocol group hashAlgorithm -> Element group -> ByteString+elementToMessage protocol element = prefix <> encodeElement (group protocol) element+  where+    prefix =+      case relation protocol of+        Symmetric _ -> "S"+        Asymmetric{us=SideA} -> "A"+        Asymmetric{us=SideB} -> "B"++-- | An error that occurs when interpreting messages from the other side of the exchange.+data MessageError+  = EmptyMessage -- ^ We received an empty bytestring.+  | UnexpectedPrefix Word8 Word8+    -- ^ The bytestring had an unexpected prefix.+    -- We expect the prefix to be @A@ if the other side is side A,+    -- @B@ if they are side B,+    -- or @S@ if the connection is symmetric.+    -- First argument is received prefix, second is expected.+  | BadCrypto CryptoError ByteString+    -- ^ Message could not be decoded to an element of the group.+    -- This can indicate either an error in serialization logic,+    -- or in mathematics.+  deriving (Eq, Show)++-- | Turn a 'MessageError' into human-readable text.+formatError :: MessageError -> Text+formatError EmptyMessage = "Other side sent us an empty message"+formatError (UnexpectedPrefix got expected) = "Other side claims to be " <> show (chr (fromIntegral got)) <> ", expected " <> show (chr (fromIntegral expected))+formatError (BadCrypto err message) = "Could not decode message (" <> show message <> ") to element: " <> show err++-- | Extract an element on the group from an incoming message.+--+-- Returns a 'MessageError' if we cannot decode the message,+-- or the other side does not appear to be the expected other side.+--+-- TODO: Need to protect against reflection attack at some point.+extractElement :: Group group => Protocol group hashAlgorithm -> ByteString -> Either MessageError (Element group)+extractElement protocol message =+  case ByteString.uncons message of+    Nothing -> throwError EmptyMessage+    Just (prefix, msg)+      | prefix /= theirPrefix (relation protocol) -> throwError $ UnexpectedPrefix prefix (theirPrefix (relation protocol))+      | otherwise ->+        case decodeElement (group protocol) msg of+          CryptoFailed err -> throwError (BadCrypto err msg)+          CryptoPassed element -> pure element+++-- | One side of the SPAKE2 protocol.+data Side group+  = Side+  { sideID :: SideID -- ^ Bytes identifying this side+  , blind :: Element group -- ^ Arbitrarily chosen element in the group+                           -- used by this side to blind outgoing messages.+  }++-- | Which side we are.+data WhichSide = SideA | SideB deriving (Eq, Ord, Show, Bounded, Enum)++-- | Relation between two sides in SPAKE2.+-- Can be either symmetric (both sides are the same), or asymmetric.+--+-- XXX: Maybe too generic? Could reasonably replace 'a' with 'Side group'.+data Relation a+  = Asymmetric+  { sideA :: a -- ^ Side A. Both sides need to agree who side A is.+  , sideB :: a -- ^ Side B. Both sides need to agree who side B is.+  , us :: WhichSide -- ^ Which side we are+  }+  | Symmetric+  { bothSides :: a -- ^ Description used by both sides.+  }++theirPrefix :: Relation a -> Word8+theirPrefix relation =+  fromIntegral . ord $ case relation of+                         Asymmetric{us=SideA} -> 'B'+                         Asymmetric{us=SideB} -> 'A'+                         Symmetric{} -> 'S'++-- | Everything required for the SPAKE2 protocol.+--+-- Both sides must agree on these values for the protocol to work.+-- This /mostly/ means value equality, except for 'Relation.us',+-- where each side must have complementary values.+--+-- Construct with 'makeAsymmetricProtocol' or 'makeSymmetricProtocol'.+data Protocol group hashAlgorithm+  = Protocol+  { group :: group -- ^ The group to use for encryption+  , hashAlgorithm :: hashAlgorithm -- ^ Hash algorithm used for generating the session key+  , relation :: Relation (Side group)  -- ^ How the two sides relate to each other+  }++-- | Construct an asymmetric SPAKE2 protocol.+makeAsymmetricProtocol :: hashAlgorithm -> group -> Element group -> Element group -> SideID -> SideID -> WhichSide -> Protocol group hashAlgorithm+makeAsymmetricProtocol hashAlgorithm group blindA blindB sideA sideB whichSide =+  Protocol+  { group = group+  , hashAlgorithm = hashAlgorithm+  , relation = Asymmetric+               { sideA = Side { sideID = sideA, blind = blindA }+               , sideB = Side { sideID = sideB, blind = blindB }+               , us = whichSide+               }+  }++-- | Construct a symmetric SPAKE2 protocol.+makeSymmetricProtocol :: hashAlgorithm -> group -> Element group -> SideID -> Protocol group hashAlgorithm+makeSymmetricProtocol hashAlgorithm group blind id =+  Protocol+  { group = group+  , hashAlgorithm = hashAlgorithm+  , relation = Symmetric Side { sideID = id, blind = blind }+  }++-- | Get the parameters for the mathematical part of SPAKE2 from the protocol specification.+getParams :: Protocol group hashAlgorithm -> Math.Params group+getParams Protocol{group, relation} =+  case relation of+    Symmetric{bothSides} -> mkParams bothSides bothSides+    Asymmetric{sideA, sideB, us} ->+      case us of+        SideA -> mkParams sideA sideB+        SideB -> mkParams sideB sideA++  where+    mkParams ours theirs =+      Math.Params+      { Math.group = group+      , Math.ourBlind = blind ours+      , Math.theirBlind = blind theirs+      }++-- | Commence a SPAKE2 exchange.+startSpake2+  :: (MonadRandom randomly, Group group)+  => Protocol group hashAlgorithm+  -> Password+  -> randomly (Math.Spake2Exchange group)+startSpake2 protocol password =+  Math.startSpake2 Math.Spake2 { Math.params = getParams protocol+                               , Math.password = passwordToScalar (group protocol) password+                               }++-- | Create a session key based on the output of SPAKE2.+--+-- \[SK \leftarrow H(A, B, X^{\star}, Y^{\star}, K, pw)\]+--+-- Including \(pw\) in the session key is what makes this SPAKE2, not SPAKE1.+createSessionKey+  :: (Group group, HashAlgorithm hashAlgorithm)+  => Protocol group hashAlgorithm  -- ^ The protocol used for this exchange+  -> Element group  -- ^ The message from side A, \(X^{\star}\), or either side if symmetric+  -> Element group  -- ^ The message from side B, \(Y^{\star}\), or either side if symmetric+  -> Element group  -- ^ The calculated key material, \(K\)+  -> Password  -- ^ The shared secret password+  -> ByteString  -- ^ A session key to use for further communication+createSessionKey Protocol{group, hashAlgorithm, relation} x y k (Password password) =+  hashDigest transcript++  where+    -- The protocol expects that when we include the hash of various+    -- components (e.g. the password) as input for the session key hash,+    -- that we use the *byte* representation of these elements.+    hashDigest :: ByteArrayAccess input => input -> ByteString+    hashDigest thing = ByteArray.convert (hashWith hashAlgorithm thing)++    transcript =+      case relation of+        Asymmetric{sideA, sideB} -> mconcat [ hashDigest password+                                            , hashDigest (unSideID (sideID sideA))+                                            , hashDigest (unSideID (sideID sideB))+                                            , encodeElement group x+                                            , encodeElement group y+                                            , encodeElement group k+                                            ]+        Symmetric{bothSides} -> mconcat [ hashDigest password+                                        , hashDigest (unSideID (sideID bothSides))+                                        , symmetricElements+                                        , encodeElement group k+                                        ]++    symmetricElements =+      let [ firstMessage, secondMessage ] = sort [ encodeElement group x, encodeElement group y ]+      in firstMessage <> secondMessage
+ src/Crypto/Spake2/Group.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE TypeFamilies #-}+{-|+Module: Crypto.Spake2.Group+Description: Interface for mathematical groups+-}+module Crypto.Spake2.Group+  ( Group(..)+  , decodeScalar+  , elementSizeBytes+  , scalarSizeBytes+  , KeyPair(..)+  ) where++import Protolude hiding (group, length)++import Crypto.Error (CryptoFailable(..))+import Crypto.Random.Types (MonadRandom(..))+import Data.ByteArray (ByteArray, ByteArrayAccess(..))++import Crypto.Spake2.Util (bytesToNumber)++-- | A mathematical group intended to be used with SPAKE2.+--+-- Notes:+--+--  * This is a much richer interface than one would expect from a group purely derived from abstract algebra+--  * jml thinks this is relevant to all Diffie-Hellman cryptography,+--    but too ignorant to say for sure+--  * Is this group automatically abelian? cyclic?+--    Must it have these properties?+class Group group where+  -- | An element of the group.+  type Element group :: *++  -- | A scalar for this group.+  -- Mathematically equivalent to an integer,+  -- but possibly stored differently for computational reasons.+  type Scalar group :: *++  -- | Group addition.+  --+  -- prop> \x y z -> elementAdd group (elementAdd group x y) z == elementAdd group x (elementAdd group y z)+  elementAdd :: group -> Element group -> Element group -> Element group++  -- | Inverse with respect to group addition.+  --+  -- prop> \x -> (elementAdd group x (elementNegate group x)) == groupIdentity+  -- prop> \x -> (elementNegate group (elementNegate group x)) == x+  elementNegate :: group -> Element group -> Element group++  -- | Subtract one element from another.+  --+  -- prop> \x y -> (elementSubtract group x y) == (elementAdd group x (elementNegate group y))+  elementSubtract :: group -> Element group -> Element group -> Element group+  elementSubtract group x y = elementAdd group x (elementNegate group y)++  -- | Identity of the group.+  --+  -- Note [Added for completeness]+  --+  -- prop> \x -> (elementAdd group x groupIdentity) == x+  -- prop> \x -> (elementAdd group groupIdentity x) == x+  groupIdentity :: group -> Element group++  -- | Multiply an element of the group with respect to a scalar.+  --+  -- This is equivalent to adding the element to itself N times, where N is a scalar.+  scalarMultiply :: group -> Scalar group -> Element group -> Element group++  -- | Get the scalar that corresponds to an integer.+  --+  -- Note [Added for completeness]+  --+  -- prop> \x -> scalarToInteger group (integerToScalar group x) == x+  integerToScalar :: group -> Integer -> Scalar group++  -- | Get the integer that corresponds to a scalar.+  --+  -- Note [Added for completeness]+  --+  -- prop> \x -> integerToScalar group (scalarToInteger group x) == x+  scalarToInteger :: group -> Scalar group -> Integer++  -- | Encode an element of the group into bytes.+  --+  -- Note [Byte encoding in Group]+  --+  -- prop> \x -> decodeElement group (encodeElement group x) == CryptoPassed x+  encodeElement :: ByteArray bytes => group -> Element group -> bytes++  -- | Decode an element into the group from some bytes.+  --+  -- Note [Byte encoding in Group]+  decodeElement :: ByteArray bytes => group -> bytes -> CryptoFailable (Element group)++  -- | Encode a scalar into bytes.+  -- | Generate a new random element of the group, with corresponding scalar.+  generateElement :: MonadRandom randomly => group -> randomly (KeyPair group)++  -- | Size of elements, in bits+  elementSizeBits :: group -> Int++  -- | Size of scalars, in bits+  scalarSizeBits :: group -> Int++  -- | Deterministically create an arbitrary element from a seed bytestring.+  --+  -- __XXX__: jml would much rather this take a scalar, an element, or even an integer, rather than bytes+  -- because bytes mean that the group instances have to know about hash algorithms and HKDF.+  -- If the IntegerGroup class in SPAKE2 also oversized its input,+  -- then it and the ed25519 implementation would have identical decoding.+  arbitraryElement :: ByteArrayAccess bytes => group -> bytes -> Element group+++-- | Map some arbitrary bytes into a scalar in a group.+decodeScalar :: (ByteArrayAccess bytes, Group group) => group -> bytes -> Scalar group+decodeScalar group bytes = integerToScalar group (bytesToNumber bytes)++-- | Size of elements in a group, in bits.+elementSizeBytes :: Group group => group -> Int+elementSizeBytes group = (elementSizeBits group + 7) `div` 8++-- | Size of scalars in a group, in bytes.+scalarSizeBytes :: Group group => group -> Int+scalarSizeBytes group = (scalarSizeBits group + 7) `div` 8++-- | A group key pair composed of the private part (a scalar)+-- and a public part (associated group element).+data KeyPair group+  = KeyPair+  { keyPairPublic :: !(Element group)+  , keyPairPrivate :: !(Scalar group)+  }++{-+Note [Byte encoding in Group]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++jml is unsure whether it is a good idea to put encode/decode methods in the 'Group' typeclass.++Reasons for:++ * cryptonite does it with 'EllipticCurve'+ * warner does it with spake2.groups++Reasons against:++ * mathematical structure of groups has no connection to serialization+ * might want multiple encodings for same mathematical group++Including for now on the assumption that I'm ignorant.++TODO: Revisit decision to put byte encoding in Group after we've done a couple of implementations+-}++{-+Note [Added for completeness]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Several methods were added to 'Group' out of a desire for mathematical completeness+rather than necessity for implementing SPAKE2.++These include:++ * 'groupIdentity' -- because groups have identities (just like semigroups)+ * 'scalarToInteger' and 'integerToScalar' -- because scalars are mathematically integers+ * 'encodeScalar' -- because having an inverse of 'decodeScalar' makes it easier to test++-}
+ src/Crypto/Spake2/Groups.hs view
@@ -0,0 +1,18 @@+{-|+Module: Crypto.Spake2.Groups+Description: Implementation of various mathematical groups++Each of these implements the 'Crypto.Spake2.Group.Group' typeclass.+-}+module Crypto.Spake2.Groups+  ( Ed25519.Ed25519(..)+  , IntegerGroup.IntegerGroup(..)+  , IntegerGroup.makeIntegerGroup+  , IntegerGroup.i1024+  -- * For testing only+  , IntegerAddition.IntegerAddition(..)+  ) where++import qualified Crypto.Spake2.Groups.Ed25519 as Ed25519+import qualified Crypto.Spake2.Groups.IntegerAddition as IntegerAddition+import qualified Crypto.Spake2.Groups.IntegerGroup as IntegerGroup
+ src/Crypto/Spake2/Groups/Ed25519.hs view
@@ -0,0 +1,433 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies #-}+{-|+Module: Crypto.Spake2.Groups.Ed25519+Description: Ed25519 group for SPAKE2++Derived from @ed25519_basic.py@ in [python-spake2](https://github.com/warner/python-spake2),+in turn derived from the slow, reference, Python implementation at+<http://ed25519.cr.yp.to/python/ed25519.py>+-}+module Crypto.Spake2.Groups.Ed25519+  ( Ed25519(..)+  -- * Exported for testing+  , l+  , generator+  ) where++import Protolude hiding (clamp, group, zero)++import Crypto.Error (CryptoFailable(..), CryptoError(..))+import Crypto.Number.Generate (generateMax)+import Crypto.Number.ModArithmetic (expSafe, inverseCoprimes)+import Crypto.Number.Serialize (i2osp, os2ip)+import Data.ByteArray (ByteArray, ByteArrayAccess)+import qualified Data.ByteArray as ByteArray+import qualified Data.List as List++import Crypto.Spake2.Group (Group(..), KeyPair(..), scalarSizeBytes)+import Crypto.Spake2.Util (bytesToNumber, expandArbitraryElementSeed)++{-+Note [Ed25519 vs curve25519]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~++As best as jml can tell,++* X25519 is Elliptic Curve Diffie-Hellman (ECDH) over Curve25519+* Ed25519 is Edwards-curve Digital Signature Algorithm (EdDSA) over Curve25519++(quoted from a [StackOverflow answer](https://crypto.stackexchange.com/questions/27866/why-curve25519-for-encryption-but-ed25519-for-signatures))++This means the underlying curve is the same,+and Ed25519 is the use of that curve in signing,+and X25519 is the curve used in key exchange.++Complicated by the fact that Curve25519 /used/ to be the name of ECDH over Curve25519.++Since our primary goal is Python interoperability,+we are going to implement an analogue of the Python code here,+and call it Ed25519.++Once that is done, we can explore using Cryptonite's Curve25519 logic,+ideally demonstrating its equivalence with some automated tests.++<https://security.stackexchange.com/questions/50878/ecdsa-vs-ecdh-vs-ed25519-vs-curve25519>+<https://crypto.stackexchange.com/questions/27866/why-curve25519-for-encryption-but-ed25519-for-signatures>+-}++data Ed25519 = Ed25519 deriving (Eq, Show)++instance Group Ed25519 where+  type Scalar Ed25519 = Integer+  type Element Ed25519 = ExtendedPoint 'Member++  elementAdd _ x y = addExtendedPoints x y+  elementNegate group = scalarMultiply group (l - 1)+  groupIdentity _ = assertInGroup extendedZero+  scalarMultiply _ n x = safeScalarMultiply n x++  integerToScalar _ x = x+  scalarToInteger _ x = x++  encodeElement _ x = encodeAffinePoint (extendedToAffine' x)+  decodeElement _ bytes = toCryptoFailable $ do+    affine <- decodeAffinePoint bytes+    let extended = affineToExtended affine+    ensureInGroup extended++  generateElement group = do+    scalar <- generateMax l+    let element = scalarMultiply group scalar generator+    pure (KeyPair element scalar)++  elementSizeBits _ = 255+  scalarSizeBits _ = 255++  arbitraryElement group bytes =+    let seed = expandArbitraryElementSeed bytes (scalarSizeBytes group + 16) :: ByteString+        y = bytesToNumber seed `mod` q+    in+    List.head [ element | Right element <- map makeGroupMember [y..] ]++-- | Errors that can occur within the group.+data Error+  = NotOnCurve Integer Integer+  | NotInGroup (ExtendedPoint 'Unknown)+  | LowOrderPoint (ExtendedPoint 'Unknown)+  deriving (Eq, Show)++-- | Translate internal errors into CryptoFailable.+toCryptoFailable :: Either Error a -> CryptoFailable a+toCryptoFailable (Right r) = pure r+toCryptoFailable (Left _) = CryptoFailed CryptoError_PointCoordinatesInvalid++-- | Guarantee an element is in the Ed25519 subgroup.+ensureInGroup :: ExtendedPoint 'Unknown -> Either Error (ExtendedPoint 'Member)+ensureInGroup element@ExtendedPoint{x, y, z, t} =+  if isExtendedZero (safeScalarMultiply l element)+  then pure ExtendedPoint { x = x, y = y, z = z, t = t}+  else  throwError $ NotInGroup element++-- | Assert that an element is the Ed25519 subgroup.+--+-- Panics if it is not.+assertInGroup :: HasCallStack => ExtendedPoint 'Unknown -> ExtendedPoint 'Member+assertInGroup element =+  -- XXX: Should we force evaluation of this? We mostly use it only for+  -- constants.+  case ensureInGroup element of+    Left err -> panic $ "Element not in group (" <> show err <> "): " <> show element+    Right x -> x++-- TODO: Document this.+-- Guess: the size of the subgroup? the group?+q :: Integer+q = 2 ^ 255 - 19  -- XXX: force eval?++-- | The order of the group represented by 'Ed25519'.+--+-- Note that this is a subgroup of the underlying elliptic curve.+l :: Integer+l = 2 ^ 252 + 27742317777372353535851937790883648493++-- TODO document this+dConst :: Integer+dConst = -121665 * inv 121666  -- XXX: force eval?++-- TODO document this+i :: Integer+i = expSafe 2 ((q-1) `div` 4) q  -- XXX: force eval++-- | The generator for the (sub)group represented by 'Ed25519'.+generator :: Element Ed25519+generator = assertInGroup $ affineToExtended b+  where+    b = case makeAffinePoint (x `mod` q) (y `mod` q) of+          Left err -> panic $ "Generator is not affine point: " <> show err+          Right r -> r+    x = xRecover y+    y = 4 * inv 5++-- | Calculate the inverse of @x@ modulo 'q'.+--+-- Assumes that @x@ is coprime with 'q' and non-zero.+-- Will raise an exception if either of these assumptions is false.+--+-- prop> \x -> (x * inv x) `mod` q == 1+inv :: Integer -> Integer+inv x = inverseCoprimes x q++xRecover :: Integer -> Integer+xRecover y =+  let x'' = (y * y - 1) * inv(dConst * y * y + 1)+      x' = expSafe x'' ((q + 3) `div` 8) q+      x = if (x' * x' - x'') `mod` q /= 0+          then (x' * i) `mod` q+          else x'+  in+    if even x then x else q - x+++-- | Whether or not an extended point is a member of Ed25519.+data GroupMembership = Unknown | Member++-- | A point that might be a member of Ed25519.+-- Note: [Extended coordinates]+data ExtendedPoint (groupMembership :: GroupMembership)+  = ExtendedPoint+  { x :: !Integer+  , y :: !Integer+  , z :: !Integer+  , t :: !Integer+  } deriving (Show)++-- XXX: jml unsure about overriding equality like this.+-- Note: [Extended coordinates]+instance Eq (ExtendedPoint a) where+  point1 == point2 = extendedToAffine' point1 == extendedToAffine' point2++-- | Zero in the extended coordinate space.+--+-- > affineZero = AffinePoint{x = 0, y = 1}+-- > extendedZero == affineToExtended affineZero+--+-- Note: [Extended coordinates]+extendedZero :: ExtendedPoint a+extendedZero = ExtendedPoint {x = 0, y = 1, z = 1, t = 0}++-- | Check if a point is equivalent to zero.+--+-- jml is unsure, but this probably exists because it might be faster than+-- mapping to affine space and checking for equality.+--+-- Note: [Extended coordinates]+isExtendedZero :: ExtendedPoint irrelevant -> Bool+isExtendedZero ExtendedPoint{x, y, z} = x == 0 && y' == z' && y' /= 0+  where+    y' = y `mod` q+    z' = z `mod` q++-- | Add two extended points.+--+-- The points don't have to be in the Ed25519 subgroup, and we can't say+-- anything about whether the result will be.+--+-- add-2008-hwcd-3+addExtendedPoints :: ExtendedPoint a -> ExtendedPoint a -> ExtendedPoint a+addExtendedPoints ExtendedPoint{x = x1, y = y1, z = z1, t = t1} ExtendedPoint{x = x2, y = y2, z = z2, t = t2} =+  ExtendedPoint{x = x3, y = y3, z = z3, t = t3}+  where+    -- X3 = (E*F) % Q+    x3 = (e * f) `mod` q+    -- Y3 = (G*H) % Q+    y3 = (g * h) `mod` q+    -- Z3 = (F*G) % Q+    z3 = (f * g) `mod` q+    -- T3 = (E*H) % Q+    t3 = (e * h) `mod` q++    -- E = (B-A) % Q+    e = (b - a) `mod` q+    -- F = (D-C) % Q+    f = (d' - c) `mod` q+    -- G = (D+C) % Q+    g = (d' + c) `mod` q+    -- H = (B+A) % Q+    h = (b + a) `mod` q++    -- A = ((Y1-X1)*(Y2-X2)) % Q+    a = ((y1 - x1) * (y2 - x2)) `mod` q+    -- B = ((Y1+X1)*(Y2+X2)) % Q+    b = ((y1 + x1) * (y2 + x2)) `mod` q+    -- C = T1*(2*d)*T2 % Q+    c = (t1 * (2 * dConst) * t2) `mod` q+    -- D = Z1*2*Z2 % Q+    d' = (z1 * 2 * z2) `mod` q++-- | Double an extended point.+--+-- dbl-2008-hwcd+doubleExtendedPoint :: ExtendedPoint preserving -> ExtendedPoint preserving+doubleExtendedPoint ExtendedPoint{x = x1, y = y1, z = z1} =+  ExtendedPoint{x= x3, y = y3, z = z3, t = t3}+  where+    -- X3 = (E*F) % Q+    x3 = (e * f) `mod` q+    -- Y3 = (G*H) % Q+    y3 = (g * h) `mod` q+    -- Z3 = (F*G) % Q+    z3 = (f * g) `mod` q+    -- T3 = (E*H) % Q+    t3 = (e * h) `mod` q++    -- E = (J*J-A-B) % Q+    e = (j * j - a -b) `mod` q+    -- F = (G-C) % Q+    f = (g - c) `mod` q+    -- G = (D+B) % Q+    g = (d' + b) `mod` q+    -- H = (D-B) % Q+    h = (d' - b) `mod` q++    -- A = (X1*X1)+    a = x1 * x1+    -- B = (Y1*Y1)+    b = y1 * y1+    -- C = (2*Z1*Z1)+    c = 2 * z1 * z1+    -- D = (-A) % Q+    d' = (-a) `mod` q+    -- J = (X1+Y1) % Q+    j = (x1 + y1) `mod` q++-- | Multiply a point (might be in the group, might not) by a scalar.+safeScalarMultiply :: Integer -> ExtendedPoint a -> ExtendedPoint a+safeScalarMultiply n = scalarMultiplyExtendedPoint addExtendedPoints n++-- | Scalar multiplication parametrised by addition.+scalarMultiplyExtendedPoint :: (ExtendedPoint a -> ExtendedPoint a -> ExtendedPoint a) -> Integer -> ExtendedPoint a -> ExtendedPoint a+scalarMultiplyExtendedPoint _ 0 _    = extendedZero+scalarMultiplyExtendedPoint add n x+  | n >= l    = scalarMultiplyExtendedPoint add (n `mod` l) x+  | even n    = doubleExtendedPoint (scalarMultiplyExtendedPoint add (n `div` 2) x)+  | n == 1    = x+  | n <= 0    = panic $ "Unexpected negative multiplier: " <> show n+  | otherwise = add x (scalarMultiplyExtendedPoint add (n - 1) x)+++-- | Attempt to create a member of Ed25519 from an affine @y@ coordinate.+makeGroupMember :: Integer -> Either Error (Element Ed25519)+makeGroupMember y = do+  -- XXX: Similar to decodeElement. Can we share code?+  point <- affineToExtended <$> makeAffinePoint (xRecover y) y+  let point8 = safeScalarMultiply 8 point+  if isExtendedZero point8+    then throwError $ LowOrderPoint point+    else ensureInGroup point8++{-+Note: [Arbitrary point generation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++This is cribbed from warner's notes in python-spake2:+<https://github.com/warner/python-spake2/blob/05b9f968d37dc5419f0e6e20c9b65737de21a7e9/src/spake2/ed25519_basic.py#L291>++* only about 50% of Y coordinates map to valid curve points+* even if the point is on our curve, it may not be in our particular (order=l) subgroup+  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+  (everything which divides the group order)+* 50% of random points will have order 8*L,+  25% will have order 4*L,+  13% order 2*L,+  13% will have our desired order 1*L+  (and a vanishingly small fraction will have 1/2/4/8).+* If we multiply any of the 8*L points by 2, we're sure to get an 4*L point+  (and multiplying a 4*L point by 2 gives us a 2*L point, and so on).+* Multiplying a 1*L point by 2 gives us a different 1*L point.+  So multiplying by 8 gets us from almost any point into a uniform point on the correct 1*L subgroup.+* We might still get really unlucky and pick one of the 8 low-order points.+  Multiplying by 8 will get us to the identity (Zero), which we check for explicitly.+* Double check that *this* point (8 * P) is in the right subgroup.++That final check is a Python assertion,+which would crash the program if incorrect.+For programming convenience, I just skip these values.++jml doesn't know what is meant by the 'order' of a point.++-}++-- TODO: Document this+data AffinePoint+  = AffinePoint+  { x :: !Integer+  , y :: !Integer+  } deriving (Eq, Show)++-- | Construct an affine point that is on Curve25519.+makeAffinePoint :: Integer -> Integer -> Either Error AffinePoint+makeAffinePoint x y+  | isOnCurve x y = pure AffinePoint { x = x, y = y }+  | otherwise = throwError $ NotOnCurve x y+  where+    isOnCurve x' y' = ((-x') * x' + y' * y' - 1 - dConst * x' * x' * y' * y') `mod` q == 0++-- | Encode an 'AffinePoint' into bytes.+--+-- MSB of the output is whether or not @x@ is even (i.e. @x .&. 1@),+-- teh rest of the output is little-endian @y@.+encodeAffinePoint :: (ByteArray bytes, ByteArrayAccess bytes) => AffinePoint -> bytes+encodeAffinePoint AffinePoint{x, y}+  | even x = numberToLitteEndianBytes y+  | otherwise = numberToLitteEndianBytes (y + shift 1 255)++decodeAffinePoint :: (ByteArray bytes, ByteArrayAccess bytes) => bytes -> Either Error AffinePoint+decodeAffinePoint bytes =+  let unclamped = littleEndianBytesToNumber bytes+      clamp = shift 1 255 - 1+      y = unclamped .&. clamp+      x = xRecover y+      x' = if x .&. 1 == unclamped .&. shift 1 255 then x else q - x+  in makeAffinePoint x' y+++numberToLitteEndianBytes :: ByteArray bytes => Integer -> bytes+numberToLitteEndianBytes n = ByteArray.pack (reverse (ByteArray.unpack (i2osp n :: ByteString)))++littleEndianBytesToNumber :: (ByteArray bytes, ByteArrayAccess bytes) => bytes -> Integer+littleEndianBytesToNumber bytes = os2ip (ByteArray.pack (reverse (ByteArray.unpack bytes)) :: ByteString)++{-+Note: [Extended coordinates]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~++jml only partly understands these. Here's that understanding.++The underlying elliptic curve is two-dimensional.+These are the AffinePoints.+We project that curve into a 4-dimensional space,+i.e. to the ExtendedPoints.++Doing so makes some of the arithmetic faster.+But ultimately, the values we are interested in are the affine points.++Thus, even if two ExtendedPoints have differing values internally,+they might be equivalent with respect to the Ed25519 group.++That is,+the affine points form a group+the extended points form a group+you can get a subgroup of the extended points group isomorphic to the affine points group+by using "maps to the same affine point" as an equivalence relation.++The Python version goes to some lengths to avoid doing calculations with zero.+In an earlier revision, I preserved that behaviour,+however, I have since removed it,+as we have no performance data,+and it adds extra complexity.++This URL might help:+http://www.hyperelliptic.org/EFD/g1p/auto-twisted-extended-1.html+-}++affineToExtended :: AffinePoint -> ExtendedPoint 'Unknown+affineToExtended AffinePoint{x, y} =+  ExtendedPoint+  { x = x `mod` q+  , y = y `mod` q+  , z = 1+  , t = (x * y) `mod` q+  }++extendedToAffine' :: ExtendedPoint a -> AffinePoint+extendedToAffine' ExtendedPoint{x, y, z} =+  case makeAffinePoint x' y' of+    Left err -> panic $ "Could not make affine point: " <> show err+    Right r -> r+  where+    x' = (x * inv z) `mod` q+    y' = (y * inv z) `mod` q
+ src/Crypto/Spake2/Groups/IntegerAddition.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE TypeFamilies #-}+{-|+Module: Crypto.Spake2.Groups+Description: Additive group of integers modulo \(n\)++Do __NOT__ use this for anything cryptographic.+-}+module Crypto.Spake2.Groups.IntegerAddition+  ( IntegerAddition(..)+  ) where++import Protolude hiding (group, length)++import Crypto.Error (CryptoFailable(..))+import Crypto.Number.Basic (numBits)+import Crypto.Number.ModArithmetic (expSafe)+import Crypto.Random.Types (MonadRandom(..))++import Crypto.Spake2.Group+  ( Group(..)+  , KeyPair(..)+  , decodeScalar+  , elementSizeBytes+  , scalarSizeBytes+  )+import Crypto.Spake2.Util+  ( expandArbitraryElementSeed+  , bytesToNumber+  , unsafeNumberToBytes+  )++-- | Simple integer addition group.+--+-- Do __NOT__ use this for anything cryptographic.+newtype IntegerAddition = IntegerAddition { modulus :: Integer } deriving (Eq, Ord, Show)++instance Group IntegerAddition where+  type Element IntegerAddition = Integer+  type Scalar IntegerAddition = Integer++  elementAdd group x y = (x + y) `mod` modulus group+  elementNegate group x = negate x `mod` modulus group+  elementSubtract group x y = (x - y) `mod` modulus group+  groupIdentity _ = 0+  scalarMultiply group n x = (n * x) `mod` modulus group+  integerToScalar _ x = x+  scalarToInteger _ x = x+  encodeElement group x = unsafeNumberToBytes (elementSizeBytes group) (x `mod` modulus group)+  decodeElement _ bytes = CryptoPassed (bytesToNumber bytes)+  generateElement group = do+    scalarBytes <- getRandomBytes (scalarSizeBytes group)+    let scalar = decodeScalar group (scalarBytes :: ByteString)+    let element = scalarMultiply group scalar (groupIdentity group)+    pure (KeyPair element scalar)+  scalarSizeBits group = numBits (modulus group)  -- XXX: Incorrect value. Not sure what it should be.+  elementSizeBits group = numBits (modulus group) -- XXX: should be size of subgroup+  arbitraryElement group seed =+    let processedSeed = expandArbitraryElementSeed seed (elementSizeBytes group) :: ByteString+        r = (modulus group - 1) `div` modulus group -- XXX: should be size of subgroup+        h = bytesToNumber processedSeed `mod` modulus group+    in expSafe h r (modulus group)++
+ src/Crypto/Spake2/Groups/IntegerGroup.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies #-}+{-|+Module: Crypto.Spake2.Groups.IntegerGroup+Description: Multiplicative group of integers modulo \(n\)+-}+module Crypto.Spake2.Groups.IntegerGroup+  ( IntegerGroup(..)+  , makeIntegerGroup+  , i1024+  ) where++import Protolude hiding (group, length)++import Crypto.Error (CryptoFailable(..), CryptoError(..))+import Crypto.Number.Basic (numBits)+import Crypto.Number.Generate (generateMax)+import Crypto.Number.ModArithmetic (expSafe)++import Crypto.Spake2.Group+  ( Group(..)+  , KeyPair(..)+  , elementSizeBytes+  )+import Crypto.Spake2.Util+  ( expandArbitraryElementSeed+  , bytesToNumber+  , unsafeNumberToBytes+  )++-- | A finite group of integers with respect to multiplication modulo the group order.+--+-- Construct with 'makeIntegerGroup'.+data IntegerGroup+  = IntegerGroup+  { order :: !Integer+  , subgroupOrder :: !Integer+  , generator :: !Integer+  } deriving (Eq, Show)++-- | Construct an 'IntegerGroup'.+--+-- Will fail if generator is '1',+-- since having the identity for a generator means the subgroup is the entire group.+--+-- TODO: Find other things to check for validity.+makeIntegerGroup :: Integer -> Integer -> Integer -> Maybe IntegerGroup+makeIntegerGroup _ _ 1 = Nothing+makeIntegerGroup order subgroupOrder generator = Just (IntegerGroup order subgroupOrder generator)+++instance Group IntegerGroup where+  type Element IntegerGroup = Integer+  type Scalar IntegerGroup = Integer++  elementAdd group x y = (x * y) `mod` order group+  -- At a guess, negation is scalar multiplication where the scalar is -1+  elementNegate group x = expSafe x (subgroupOrder group - 1) (order group)+  groupIdentity _ = 1+  scalarMultiply group n x = expSafe x (n `mod` subgroupOrder group) (order group)+  integerToScalar group x = x `mod` subgroupOrder group  -- XXX: Should we instead fail?+  scalarToInteger _ n = n+  encodeElement group = unsafeNumberToBytes (elementSizeBytes group)+  decodeElement group bytes =+    case bytesToNumber bytes of+      x+        | x <= 0 || x >= order group -> CryptoFailed CryptoError_PointSizeInvalid+        | expSafe x (subgroupOrder group) (order group) /= groupIdentity group -> CryptoFailed CryptoError_PointCoordinatesInvalid+        | otherwise -> CryptoPassed x+  generateElement group = do+    scalar <- generateMax (subgroupOrder group)+    let element = scalarMultiply group scalar (generator group)+    pure (KeyPair element scalar)+  scalarSizeBits group = numBits (subgroupOrder group)+  elementSizeBits group = numBits (order group)+  arbitraryElement group seed =+    let processedSeed = expandArbitraryElementSeed seed (elementSizeBytes group) :: ByteString+        p = order group+        q = subgroupOrder group+        r = (p - 1) `div` q+        h = bytesToNumber processedSeed `mod` p+    in expSafe h r p++-- | 1024 bit integer group.+--+-- Originally from http://haofeng66.googlepages.com/JPAKEDemo.java,+-- via [python-spake2](https://github.com/warner/python-spake2).+i1024 :: IntegerGroup+i1024 =+  IntegerGroup+  { order = 0xE0A67598CD1B763BC98C8ABB333E5DDA0CD3AA0E5E1FB5BA8A7B4EABC10BA338FAE06DD4B90FDA70D7CF0CB0C638BE3341BEC0AF8A7330A3307DED2299A0EE606DF035177A239C34A912C202AA5F83B9C4A7CF0235B5316BFC6EFB9A248411258B30B839AF172440F32563056CB67A861158DDD90E6A894C72A5BBEF9E286C6B+  , subgroupOrder = 0xE950511EAB424B9A19A2AEB4E159B7844C589C4F+  , generator = 0xD29D5121B0423C2769AB21843E5A3240FF19CACC792264E3BB6BE4F78EDD1B15C4DFF7F1D905431F0AB16790E1F773B5CE01C804E509066A9919F5195F4ABC58189FD9FF987389CB5BEDF21B4DAB4F8B76A055FFE2770988FE2EC2DE11AD92219F0B351869AC24DA3D7BA87011A701CE8EE7BFE49486ED4527B7186CA4610A75+  }
+ src/Crypto/Spake2/Math.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}++{-|+Module: Crypto.Spake2.Math+Description: The mathematical implementation of SPAKE2.++This module ignores everything about networks, bytes, encoding, hash functions, and so forth.+All it does is provide the mathematical building blocks for SPAKE2,+as per [Simple Password-Based Encrypted Key Exchange Protocols](http://www.di.ens.fr/~pointche/Documents/Papers/2005_rsa.pdf)+by Michel Abdalla and David Pointcheval.++== How it works++=== Preliminaries++Let's say we have two users, user A and user B.+They have already agreed on the following public information:++ * cyclic group, \(G\) of prime order, \(p\)+ * generating element \(g \in G\), such that \(g \neq 1\)+ * hash algorithm to use, \(H\)++If the connection is asymmetric+(e.g. if user A is a client and user B is a server),+then they will also have:++ * two arbitrary elements in \(M, N \in G\), where \(M\) is associated with+   user A and \(N\) with user B.++If the connection is symmetric+(e.g. if user A and B are arbitrary peers),+then they will instead have:++ * a single arbitrary element \(S \in G\)++The discrete log of these arbitrary elements must be difficult to guess.++And, they also have a secret password,+which in practice will be an arbitrary byte string,+but for the purposes of this module is an arbitrary /scalar/ in the group+that is a shared secret between both parties+(see "Crypto.Spake2.Groups" for more information on scalars).++=== The protocol++/This is derived from the paper linked above./++One side, A, initiates the exchange.+They draw a random scalar, \(x\), and matching element, \(X\), from the group.+They then "blind" \(X\) by adding it to \(M\) multiplied by the password in scalar form.+Call this \(X^{\star}\).++\[X^{\star} \leftarrow X \cdot M^{pw}\]++to the other side, side B.++Side B does the same thing,+except they use \(N\) instead of \(M\) to blind the result,+and they call it \(Y\) instead of \(X\).++\[Y^{\star} \leftarrow Y \cdot N^{pw}\]++After side A receives \(Y^{\star}\),+it calculates \(K_A\),+which is the last missing input in calculating the session key.++\[K_A \leftarrow (Y^{\star}/N^{pw})^x\]++That is, \(K_A\) is \(Y^{\star}\) subtracted from \(N\) scalar multiplied by \(pw\),+all of which is scalar multiplied by \(x\).++Side B likewise calculates:++\[K_B \leftarrow (X^{\star}/M^{pw})^y\]++If both parties were honest and knew the password,+the keys will be the same on both sides.+That is:++\[K_A = K_B\]++=== How to use the keys++The keys \(K_A\) and \(K_B\) are not enough to securely encrypt a session.+They must be used as input to create a session key.++Constructing a session key is beyond the scope of this module.+See 'createSessionKey' for more information.++-}++module Crypto.Spake2.Math+  ( Spake2(..)  -- XXX: Not sure want to export innards but it disables "unused" warning+  , Params(..)  -- XXX: ditto+  , startSpake2+  , Spake2Exchange+  , computeOutboundMessage+  , generateKeyMaterial+  ) where++import Protolude hiding (group)++import Crypto.Random.Types (MonadRandom(..))++import Crypto.Spake2.Group (Group(..), KeyPair(..))++-- | The parameters of the SPAKE2 protocol. The other side needs to be using+-- the same values, but with swapped values for 'ourBlind' and 'theirBlind'.+data Params group+  = Params+  { group :: group -- ^ The cyclic group used for encrypting keys+  , ourBlind :: Element group -- ^ The "blind" we use when sending out values. Side A refers to this as \(M\) in the protocol description.+  , theirBlind :: Element group -- ^ The "blind" the other side uses when sending values. Side A refers to this as \(N\) in the protocol description.+  }++-- | An instance of the SPAKE2 protocol. This represents one side of the protocol.+data Spake2 group+  = Spake2+  { params :: Params group+  , password :: Scalar group+  }++-- | A SPAKE2 exchange that has been initiated.+data Spake2Exchange group+  = Started+  { spake2 :: Spake2 group -- ^ Description of the specific instance of the+                           -- SPAKE2 protocol we are using. Parameters,+                           -- password, and group must be the same for this to+                           -- work.+  , xy :: KeyPair group -- ^ Arbitrary element and scalar chosen by this side of the exchange.+                        -- It is kept secret, and is only used to negotiate an exchange.+                        -- A "blinded" form is sent to the other side of the protocol.+  }++-- | Initiate the SPAKE2 exchange. Generates a secret (@xy@) that will be held+-- by this side, and transmitted to the other side in "blinded" form.+startSpake2 :: (Group group, MonadRandom randomly) => Spake2 group -> randomly (Spake2Exchange group)+startSpake2 spake2' = Started spake2' <$> generateElement (group . params $ spake2')++-- | Determine the element (either \(X^{\star}\) or \(Y^{\star}\)) to send to the other side.+computeOutboundMessage :: Group group => Spake2Exchange group -> Element group+computeOutboundMessage Started{spake2 = Spake2{params = Params{group, ourBlind}, password}, xy} =+  elementAdd group (keyPairPublic xy) (scalarMultiply group password ourBlind)++-- | Generate key material, \(K\), given a message from the other side (either+-- \(Y^{\star}\) or \(X^{\star}\)).+--+-- This key material is the last piece of input required to make the session+-- key, \(SK\), which should be generated as:+--+--   \[SK \leftarrow H(A, B, X^{\star}, Y^{\star}, K, pw)\]+--+-- Where:+--+-- * \(H\) is a hash function+-- * \(A\) identifies the initiating side+-- * \(B\) identifies the receiving side+-- * \(X^{star}\) is the outbound message from the initiating side+-- * \(Y^{star}\) is the outbound message from the receiving side+-- * \(K\) is the result of this function+-- * \(pw\) is the password (this is what makes it SPAKE2, not SPAKE1)+generateKeyMaterial+  :: Group group+  => Spake2Exchange group  -- ^ An initiated SPAKE2 exchange+  -> Element group  -- ^ The outbound message from the other side (i.e. inbound to us)+  -> Element group -- ^ The final piece of key material to generate the session key.+generateKeyMaterial Started{spake2 = Spake2{params = Params{group, theirBlind}, password}, xy} inbound =+  scalarMultiply group (keyPairPrivate xy) (elementSubtract group inbound (scalarMultiply group password theirBlind))
+ src/Crypto/Spake2/Util.hs view
@@ -0,0 +1,70 @@+{-|+Module: Crypto.Spake2.Util+Description: Miscellany. Mostly to do with serialization.+-}+module Crypto.Spake2.Util+  ( expandData+  , expandArbitraryElementSeed+  , bytesToNumber+  , numberToBytes+  , unsafeNumberToBytes+  ) where++import Protolude++import Crypto.Hash.Algorithms (SHA256)+import Crypto.Number.Serialize (os2ip, i2ospOf, i2ospOf_)+import qualified Crypto.KDF.HKDF as HKDF+import Data.ByteArray (ByteArray, ByteArrayAccess(..))++-- TODO: memory package (a dependency of cryptonite) has+-- Data.ByteArray.Encoding, which does base16 encoding. Perhaps we should use+-- that rather than third-party base16-bytestring library.++-- | Take an arbitrary sequence of bytes and expand it to be the given number+-- of bytes. Do this by extracting a pseudo-random key and expanding it using+-- HKDF.+expandData :: (ByteArrayAccess input, ByteArray output) => ByteString -> input -> Int -> output+expandData info input size =+  HKDF.expand prk info size+  where+    prk :: HKDF.PRK SHA256+    prk = HKDF.extract salt input++    -- XXX: I'm no crypto expert, but hard-coding an empty string as a salt+    -- seems kind of weird.+    salt :: ByteString+    salt = ""++-- | Given a seed value for an arbitrary element (see 'arbitraryElement'),+-- expand it to be of the given length.+expandArbitraryElementSeed :: (ByteArrayAccess ikm, ByteArray out) => ikm -> Int -> out+expandArbitraryElementSeed =+  -- NOTE: This must be exactly this string in order to interoperate with python-spake2+  expandData "SPAKE2 arbitrary element"+++-- | Serialize a number according to the SPAKE2 protocol.+--+-- Just kidding, there isn't a SPAKE2 protocol.+-- This just matches the Python implementation.+--+-- Inverse of 'bytesToNumber'.+numberToBytes :: ByteArray bytes => Int -> Integer -> Maybe bytes+numberToBytes = i2ospOf++-- | Serialize a number according to the SPAKE2 protocol.+--+-- Panics if the number is too big to fit into the given number of bytes.+unsafeNumberToBytes :: ByteArray bytes => Int -> Integer -> bytes+unsafeNumberToBytes = i2ospOf_+++-- | Deserialize a number according to the SPAKE2 protocol.+--+-- Just kidding, there isn't a SPAKE2 protocol.+-- This just matches the Python implementation.+--+-- Inverse of 'numberToBytes'.+bytesToNumber :: ByteArrayAccess bytes => bytes -> Integer+bytesToNumber = os2ip
+ tests/Groups.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+module Groups (tests) where++import Protolude hiding (group)++import Crypto.Error (CryptoFailable(..))+import GHC.Base (String)+import Test.QuickCheck (Gen, (===), arbitrary, forAll, property)+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (Spec, testSpec, describe, it, shouldBe)++import Crypto.Spake2.Group (Group(..))+import Crypto.Spake2.Groups+  ( IntegerAddition(..)+  , IntegerGroup(..)+  , Ed25519(..)+  , i1024)+import qualified Crypto.Spake2.Groups.Ed25519 as Ed25519+import qualified Crypto.Spake2.Groups.IntegerGroup as IntegerGroup++tests :: IO TestTree+tests = testSpec "Groups" $ do+  groupProperties "integer addition modulo 7" (IntegerAddition 7) 1 (makeScalar 7)+  groupProperties "integer group" i1024 (IntegerGroup.generator i1024) (makeScalar (subgroupOrder i1024))+  groupProperties "Ed25519" Ed25519 Ed25519.generator (makeScalar Ed25519.l)+++makeScalar :: Integer -> Gen Integer+makeScalar k = do+  i <- arbitrary+  pure $ i `mod` k++makeElement :: Group group => group -> Gen (Scalar group) -> Element group -> Gen (Element group)+makeElement group scalars base = do+  scalar <- scalars+  pure (scalarMultiply group scalar base)++groupProperties+  :: (Group group, Eq (Element group), Eq (Scalar group), Show (Element group), Show (Scalar group))+  => String+  -> group+  -> Element group+  -> Gen (Scalar group)+  -> Spec+groupProperties name group base scalars = describe name $ do+  it "addition is associative" $ property $+    forAll triples $ \(x, y, z) -> elementAdd group (elementAdd group x y) z === elementAdd group x (elementAdd group y z)++  it "addition with inverse yields identity" $ property $+    forAll elements $ \x -> elementAdd group x (elementNegate group x) === groupIdentity group++  it "double negative is no-op" $ property $+    forAll elements $ \x -> elementNegate group (elementNegate group x) === x++  it "identity is its own inverse" $+    elementNegate group (groupIdentity group) `shouldBe` groupIdentity group++  it "subtraction is negated addition" $ property $+    forAll pairs $ \(x, y) -> elementSubtract group x y === elementAdd group x (elementNegate group y)++  it "right-hand addition with identity yields original" $ property $+    forAll elements $ \x -> elementAdd group x (groupIdentity group) === x++  it "left-hand addition with identity yields original" $ property $+    forAll elements $ \x -> elementAdd group (groupIdentity group) x === x++  it "element codec roundtrips" $ property $+    forAll elements $ \x -> let bytes = encodeElement group x :: ByteString+                            in decodeElement group bytes == CryptoPassed x++  it "scalar to integer roundtrips" $ property $+    forAll scalars $ \n -> integerToScalar group (scalarToInteger group n) === n++  it "integer to scalar conversion" $ property $+    -- Doesn't roundtrip per se, because negative integers (for example) get+    -- turned into scalars within the subgroup range, losing the original+    -- information.+    \i -> integerToScalar group (scalarToInteger group (integerToScalar group i)) === integerToScalar group i++  it "scalar multiply by 0 is identity" $ property $+    forAll elements $ \x -> scalarMultiply group (integerToScalar group 0) x === groupIdentity group++  it "scalar multiply by 1 is original" $ property $+    forAll elements $ \x -> scalarMultiply group (integerToScalar group 1) x === x++  it "scalar multiply by 2 is equivalent to addition" $ property $+    forAll elements $ \x -> scalarMultiply group (integerToScalar group 2) x === elementAdd group x x++  where+    elements = makeElement group scalars base++    pairs = do+      x <- elements+      y <- elements+      pure (x, y)++    triples = do+      x <- elements+      y <- elements+      z <- elements+      pure (x, y, z)
+ tests/Spake2.hs view
@@ -0,0 +1,13 @@+module Spake2 (tests) where++import Protolude+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec, describe, it, shouldBe)++import qualified Crypto.Spake2 as Spake2++tests :: IO TestTree+tests = testSpec "Spake2" $ do+  describe "something" $+    it "should do things" $+      Spake2.something (2 :: Int) `shouldBe` 2
+ tests/Tasty.hs view
@@ -0,0 +1,18 @@+module Main+  ( main+  ) where++import Protolude++import Test.Tasty (defaultMain, testGroup)++import qualified Spake2+import qualified Groups++main :: IO ()+main = sequence tests >>= defaultMain . testGroup "Spake2"+  where+    tests =+      [ Spake2.tests+      , Groups.tests+      ]