packages feed

spake2 0.1.0 → 0.2.0

raw patch · 13 files changed

+321/−224 lines, 13 filesdep −base16-bytestring

Dependencies removed: base16-bytestring

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Changelog++## 0.2.0 (2017-06-08)++* `Group` typeclass split into `Group` and `AbelianGroup` typeclasses++## 0.1.0 (2017-05-28)++Initial release
cmd/interop-entrypoint/Main.hs view
@@ -18,7 +18,7 @@ import Protolude hiding (group)  import Crypto.Hash (SHA256(..))-import qualified Data.ByteString.Base16 as Base16+import Data.ByteArray.Encoding (convertFromBase, convertToBase, Base(Base16)) import Options.Applicative import System.IO (hFlush, hGetLine, hPutStrLn) @@ -38,7 +38,7 @@   , elementToMessage   , formatError   )-import Crypto.Spake2.Group (Group(..))+import Crypto.Spake2.Group (AbelianGroup, Group(..)) import Crypto.Spake2.Groups (Ed25519(..))  @@ -69,7 +69,7 @@   runInteropTest-  :: (HasCallStack, Group group)+  :: (HasCallStack, AbelianGroup group)   => Protocol group SHA256   -> Password   -> Handle@@ -80,9 +80,9 @@   let outElement = computeOutboundMessage spake2   output (elementToMessage protocol outElement)   line <- hGetLine inH-  let inMsg = parseHex (toS line)+  let inMsg = parseHex (toS line :: ByteString)   case inMsg of-    Left err -> abort err+    Left err -> abort (toS err)     Right inMsgBytes ->       case extractElement protocol inMsgBytes of         Left err -> abort $ "Could not handle incoming message (line = " <> show line <> ", msgBytes = " <>  show inMsgBytes <> "): " <> formatError err@@ -94,13 +94,13 @@    where     output message = do-      hPutStrLn outH (toS (Base16.encode message))+      hPutStrLn outH (toS (convertToBase Base16 message :: ByteString))       hFlush outH      parseHex line =-      case Base16.decode line of-        (bytes, "") -> Right bytes-        _ -> Left ("Could not decode line: " <> show line)+      case convertFromBase Base16 line of+        Left err -> Left ("Could not decode line (reason: " <> err <> "): " <> show line)+        Right bytes -> Right bytes   makeProtocolFromSide :: Side -> Protocol Ed25519 SHA256
spake2.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           spake2-version:        0.1.0+version:        0.2.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@@ -18,6 +18,9 @@ build-type:     Simple cabal-version:  >= 1.10 +extra-source-files:+    CHANGELOG.md+ source-repository head   type: git   location: https://github.com/jml/haskell-spake2@@ -38,7 +41,6 @@       Crypto.Spake2.Group       Crypto.Spake2.Groups       Crypto.Spake2.Groups.Ed25519-      Crypto.Spake2.Groups.IntegerAddition       Crypto.Spake2.Groups.IntegerGroup       Crypto.Spake2.Math       Crypto.Spake2.Util@@ -53,8 +55,8 @@   build-depends:       base >= 4.9 && < 5     , protolude-    , base16-bytestring     , cryptonite+    , memory     , optparse-applicative     , spake2   default-language: Haskell2010
src/Crypto/Spake2.hs view
@@ -84,8 +84,7 @@ -}  module Crypto.Spake2-  ( something-  , Password+  ( Password   , makePassword   -- * The SPAKE2 protocol   , Protocol@@ -108,20 +107,15 @@ import Crypto.Error (CryptoError, CryptoFailable(..)) import Crypto.Hash (HashAlgorithm, hashWith) import Crypto.Random.Types (MonadRandom(..))-import Data.ByteArray (ByteArrayAccess, ByteArray)+import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as ByteString -import Crypto.Spake2.Group (Group(..), decodeScalar, scalarSizeBytes)+import Crypto.Spake2.Group (AbelianGroup(..), 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,@@ -138,17 +132,12 @@ 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 :: AbelianGroup 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+  decodeScalar group oversized   where+    oversized = expandPassword password (scalarSizeBytes group + 16) :: ByteString+    expandPassword (Password bytes) = expandData info bytes     -- This needs to be exactly "SPAKE2 pw"     -- See <https://github.com/bitwiseshiftleft/sjcl/pull/273/#issuecomment-185251593>     info = "SPAKE2 pw"@@ -215,16 +204,14 @@  -- | 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+data Relation group   = 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.+  { sideA :: Side group -- ^ Side A. Both sides need to agree who side A is.+  , sideB :: Side group -- ^ 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.+  { bothSides :: Side group -- ^ Description used by both sides.   }  theirPrefix :: Relation a -> Word8@@ -245,7 +232,7 @@   = 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+  , relation :: Relation group  -- ^ How the two sides relate to each other   }  -- | Construct an asymmetric SPAKE2 protocol.@@ -290,7 +277,7 @@  -- | Commence a SPAKE2 exchange. startSpake2-  :: (MonadRandom randomly, Group group)+  :: (MonadRandom randomly, AbelianGroup group)   => Protocol group hashAlgorithm   -> Password   -> randomly (Math.Spake2Exchange group)
src/Crypto/Spake2/Group.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE TypeFamilies #-} {-| Module: Crypto.Spake2.Group-Description: Interface for mathematical groups+Description: Interfaces for mathematical groups -} module Crypto.Spake2.Group-  ( Group(..)+  ( AbelianGroup(..)+  , Group(..)   , decodeScalar   , elementSizeBytes   , scalarSizeBytes@@ -19,24 +20,12 @@  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)@@ -62,10 +51,86 @@   -- prop> \x -> (elementAdd group groupIdentity x) == x   groupIdentity :: group -> Element group +  -- | 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)++  -- | Size of elements, in bits+  elementSizeBits :: 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+++-- | A group where 'elementAdd' is commutative.+--+-- That is, where+--+-- prop> \x y -> elementAdd group x y == elementAdd group y x+--+-- This property leads to a natural \(\mathbb{Z}\)-module,+-- where scalar multiplication is defined as repeatedly calling `elementAdd`.+--+-- === Definitions+--+-- Warning: this gets algebraic.+--+-- A /module/ is a ring \(R\) together with an abelian group \((G, +)\),+-- and a new operator \(\cdot\) (i.e. scalar multiplication)+-- such that:+--+-- 1. \(r \cdot (x + y) = r \cdot x + r \cdot y\)+-- 2. \((r + s) \cdot x = r \cdot x + s \cdot x\)+-- 3. \((rs) \cdot x = r \cdot (s \cdot x)\)+-- 4. \(1_R \cdot x = x\)+--+-- for all \(x, y\) in \(G\), and \(r, s\) in \(R\),+-- where \(1_R\) is the identity of the ring.+--+-- A /ring/ \(R, +, \cdot\) a set \(R\) with two operators such that:+--+-- 1. \(R\) is an abelian group under \(+\)+-- 2. \(R\) is a monoid under \(\cdot\)+-- 3. \(cdot\) is _distributive_ with respect to \(+\). That is,+--    1. \(a \cdot (b + c) = (a \cdot b) + (a \cdot c) (left distributivity)+--    2. \((b + c) \cdot a) = (b \cdot a) + (c \cdot a) (right distributivity)+--+-- Note we have to define left & right distributivity,+-- because \(\cdot\) might not be commutative.+--+-- A /monoid/ is a group without the notion of inverse. See Haskell's 'Monoid' typeclass.+--+-- A \(\mathbb{Z}\)-module is a module where the ring \(R\)+-- is the integers with normal addition and multiplication.+class Group group => AbelianGroup group where+  -- | A scalar for this group.+  -- Mathematically equivalent to an integer,+  -- but possibly stored differently for computational reasons.+  type Scalar 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.+  -- The default implementation does exactly that.   scalarMultiply :: group -> Scalar group -> Element group -> Element group+  scalarMultiply group scalar element =+    scalarMultiply' (scalarToInteger group scalar) element+    where+      scalarMultiply' 0 _ = groupIdentity group+      scalarMultiply' n x = elementAdd group x (scalarMultiply' (n - 1) x)    -- | Get the scalar that corresponds to an integer.   --@@ -81,39 +146,16 @@   -- 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)+  -- | Size of scalars, in bits+  scalarSizeBits :: group -> Int    -- | 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 :: (ByteArrayAccess bytes, AbelianGroup group) => group -> bytes -> Scalar group decodeScalar group bytes = integerToScalar group (bytesToNumber bytes)  -- | Size of elements in a group, in bits.@@ -121,7 +163,7 @@ elementSizeBytes group = (elementSizeBits group + 7) `div` 8  -- | Size of scalars in a group, in bytes.-scalarSizeBytes :: Group group => group -> Int+scalarSizeBytes :: AbelianGroup group => group -> Int scalarSizeBytes group = (scalarSizeBits group + 7) `div` 8  -- | A group key pair composed of the private part (a scalar)@@ -133,6 +175,19 @@   }  {-+Note [Algebra]+~~~~~~~~~~~~~~++* Perhaps we should call 'AbelianGroup' 'ZModule' or similar?+* A "proper" implementation would no doubt have a Ring typeclass+  and then a new Module typeclass that somehow composed a Ring and an AbelianGroup.+  This seems unnecessary for our implementation needs,+  and is perhaps best left to those who know something about designing algebraic libraries.+* Cyclic groups are necessarily abelian.++-}++{- Note [Byte encoding in Group] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -142,15 +197,19 @@   * cryptonite does it with 'EllipticCurve'  * warner does it with spake2.groups+ * you just need to send different stuff over the wire for elliptic curve groups+   than integer modulo groups  Reasons against:   * mathematical structure of groups has no connection to serialization  * might want multiple encodings for same mathematical group+   (this seems unlikely) -Including for now on the assumption that I'm ignorant.+We're keeping encode/decode in for now.+Later, we might want to split it out into a different typeclass,+perhaps one that inherits from the base 'Group' class. -TODO: Revisit decision to put byte encoding in Group after we've done a couple of implementations -}  {-
src/Crypto/Spake2/Groups.hs view
@@ -9,10 +9,7 @@   , 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
@@ -28,7 +28,7 @@ import qualified Data.ByteArray as ByteArray import qualified Data.List as List -import Crypto.Spake2.Group (Group(..), KeyPair(..), scalarSizeBytes)+import Crypto.Spake2.Group (AbelianGroup(..), Group(..), KeyPair(..), scalarSizeBytes) import Crypto.Spake2.Util (bytesToNumber, expandArbitraryElementSeed)  {-@@ -62,30 +62,18 @@ 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+    extended <- affineToExtended <$> decodeAffinePoint bytes     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@@ -93,6 +81,22 @@     in     List.head [ element | Right element <- map makeGroupMember [y..] ] +instance AbelianGroup Ed25519 where+  type Scalar Ed25519 = Integer++  scalarMultiply _ n x = safeScalarMultiply n x++  integerToScalar _ x = x+  scalarToInteger _ x = x++  scalarSizeBits _ = 255++  generateElement group = do+    scalar <- generateMax l+    let element = scalarMultiply group scalar generator+    pure (KeyPair element scalar)++ -- | Errors that can occur within the group. data Error   = NotOnCurve Integer Integer@@ -302,7 +306,6 @@ -- | 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@@ -337,7 +340,11 @@ 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.+The 'order' of a point \(x\) is the number \(n\) such that:+'scalarMultiply group (integerToScalar group n) x == groupIdentity group'++Note this is different from the order of a /group/,+which for finite groups is the number of elements in the group.  -}
− src/Crypto/Spake2/Groups/IntegerAddition.hs 
@@ -1,64 +0,0 @@-{-# 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
@@ -19,7 +19,8 @@ import Crypto.Number.ModArithmetic (expSafe)  import Crypto.Spake2.Group-  ( Group(..)+  ( AbelianGroup(..)+  , Group(..)   , KeyPair(..)   , elementSizeBytes   )@@ -52,15 +53,11 @@  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@@ -68,11 +65,6 @@         | 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@@ -81,6 +73,21 @@         r = (p - 1) `div` q         h = bytesToNumber processedSeed `mod` p     in expSafe h r p+++instance AbelianGroup IntegerGroup where+  type Scalar IntegerGroup = Integer++  scalarMultiply group n x = expSafe x (n `mod` subgroupOrder group) (order group)+  integerToScalar group x = x `mod` subgroupOrder group+  scalarToInteger _ n = n++  generateElement group = do+    scalar <- generateMax (subgroupOrder group)+    let element = scalarMultiply group scalar (generator group)+    pure (KeyPair element scalar)+  scalarSizeBits group = numBits (subgroupOrder group)+  -- | 1024 bit integer group. --
src/Crypto/Spake2/Math.hs view
@@ -91,8 +91,8 @@ -}  module Crypto.Spake2.Math-  ( Spake2(..)  -- XXX: Not sure want to export innards but it disables "unused" warning-  , Params(..)  -- XXX: ditto+  ( Spake2(..)+  , Params(..)   , startSpake2   , Spake2Exchange   , computeOutboundMessage@@ -103,7 +103,7 @@  import Crypto.Random.Types (MonadRandom(..)) -import Crypto.Spake2.Group (Group(..), KeyPair(..))+import Crypto.Spake2.Group (AbelianGroup(..), 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'.@@ -135,11 +135,11 @@  -- | 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 :: (AbelianGroup 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 :: AbelianGroup group => Spake2Exchange group -> Element group computeOutboundMessage Started{spake2 = Spake2{params = Params{group, ourBlind}, password}, xy} =   elementAdd group (keyPairPublic xy) (scalarMultiply group password ourBlind) @@ -161,7 +161,7 @@ -- * \(K\) is the result of this function -- * \(pw\) is the password (this is what makes it SPAKE2, not SPAKE1) generateKeyMaterial-  :: Group group+  :: AbelianGroup 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.
src/Crypto/Spake2/Util.hs view
@@ -17,10 +17,6 @@ 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.
tests/Groups.hs view
@@ -5,15 +5,13 @@ 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.Group (AbelianGroup(..), Group(..)) import Crypto.Spake2.Groups-  ( IntegerAddition(..)-  , IntegerGroup(..)+  ( IntegerGroup(..)   , Ed25519(..)   , i1024) import qualified Crypto.Spake2.Groups.Ed25519 as Ed25519@@ -21,31 +19,29 @@  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+  describe "integer group" $+    allGroupProperties i1024 (makeScalar (subgroupOrder i1024)) (IntegerGroup.generator i1024)+  describe "Ed25519" $+    allGroupProperties Ed25519 (makeScalar Ed25519.l) Ed25519.generator -makeElement :: Group group => group -> Gen (Scalar group) -> Element group -> Gen (Element group)-makeElement group scalars base = do-  scalar <- scalars-  pure (scalarMultiply group scalar base)+allGroupProperties+  :: (Show (Scalar group), Show (Element group), Eq (Scalar group), Eq (Element group), AbelianGroup group)+  => group+  -> Gen (Scalar group)+  -> Element group+  -> Spec+allGroupProperties group scalars base = do+  describe "is a group" $ groupProperties group (makeElement group scalars base)+  describe "is an abelian group" $ abelianGroupProperties group scalars base  groupProperties-  :: (Group group, Eq (Element group), Eq (Scalar group), Show (Element group), Show (Scalar group))-  => String-  -> group-  -> Element group-  -> Gen (Scalar group)+  :: (Group group, Eq (Element group), Show (Element group))+  => group+  -> Gen (Element group)   -> Spec-groupProperties name group base scalars = describe name $ do+groupProperties group elements = 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)+    forAll (triples elements) $ \(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@@ -57,7 +53,7 @@     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)+    forAll (pairs elements) $ \(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@@ -69,6 +65,17 @@     forAll elements $ \x -> let bytes = encodeElement group x :: ByteString                             in decodeElement group bytes == CryptoPassed x ++abelianGroupProperties+  :: (AbelianGroup group, Eq (Element group), Eq (Scalar group), Show (Element group), Show (Scalar group))+  => group+  -> Gen (Scalar group)+  -> Element group+  -> Spec+abelianGroupProperties group scalars base = do+  it "addition is commutative" $ property $+    forAll (pairs elements) $ \(x, y) -> elementAdd group x y === elementAdd group y x+   it "scalar to integer roundtrips" $ property $     forAll scalars $ \n -> integerToScalar group (scalarToInteger group n) === n @@ -90,13 +97,27 @@   where     elements = makeElement group scalars base -    pairs = do-      x <- elements-      y <- elements-      pure (x, y)+-- | Generate pairs of a thing.+pairs :: Gen a -> Gen (a, a)+pairs gen = do+  x <- gen+  y <- gen+  pure (x, y) -    triples = do-      x <- elements-      y <- elements-      z <- elements-      pure (x, y, z)+-- | Generate triples of a thing.+triples :: Gen a -> Gen (a, a, a)+triples gen = do+  x <- gen+  y <- gen+  z <- gen+  pure (x, y, z)++makeScalar :: Integer -> Gen Integer+makeScalar k = do+  i <- arbitrary+  pure $ i `mod` k++makeElement :: AbelianGroup group => group -> Gen (Scalar group) -> Element group -> Gen (Element group)+makeElement group scalars base = do+  scalar <- scalars+  pure (scalarMultiply group scalar base)
tests/Spake2.hs view
@@ -1,13 +1,89 @@ module Spake2 (tests) where -import Protolude+import Protolude hiding (group) import Test.Tasty (TestTree)-import Test.Tasty.Hspec (testSpec, describe, it, shouldBe)+import Test.Tasty.Hspec (testSpec, describe, it, shouldBe, shouldNotBe) +import Crypto.Hash (SHA256(..)) import qualified Crypto.Spake2 as Spake2+import qualified Crypto.Spake2.Group as Group+import Crypto.Spake2.Groups (Ed25519(..))  tests :: IO TestTree tests = testSpec "Spake2" $ do-  describe "something" $-    it "should do things" $-      Spake2.something (2 :: Int) `shouldBe` 2+  describe "Asymmetric protocol" $ do+    it "Produces matching session keys when passwords match" $ do+      let password = Spake2.makePassword "abc"+      let hashAlg = SHA256+      let group = Ed25519+      let m = Group.arbitraryElement group ("M" :: ByteString)+      let n = Group.arbitraryElement group ("N" :: ByteString)+      let idA = Spake2.SideID ""+      let idB = Spake2.SideID ""+      let protocolA = Spake2.makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideA+      let protocolB = Spake2.makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideB+      sideA <- Spake2.startSpake2 protocolA password+      sideB <- Spake2.startSpake2 protocolB password+      let aOut = Spake2.computeOutboundMessage sideA+      let bOut = Spake2.computeOutboundMessage sideB+      let aKey = Spake2.generateKeyMaterial sideA bOut+      let bKey = Spake2.generateKeyMaterial sideB aOut+      let aSessionKey = Spake2.createSessionKey protocolA aOut bOut aKey password+      let bSessionKey = Spake2.createSessionKey protocolA aOut bOut bKey password+      aSessionKey `shouldBe` bSessionKey+    it "Produces differing session keys when passwords do not match" $ do+      let password1 = Spake2.makePassword "abc"+      let password2 = Spake2.makePassword "cba"+      let hashAlg = SHA256+      let group = Ed25519+      let m = Group.arbitraryElement group ("M" :: ByteString)+      let n = Group.arbitraryElement group ("N" :: ByteString)+      let idA = Spake2.SideID ""+      let idB = Spake2.SideID ""+      let protocolA = Spake2.makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideA+      let protocolB = Spake2.makeAsymmetricProtocol hashAlg group m n idA idB Spake2.SideB+      sideA <- Spake2.startSpake2 protocolA password1+      sideB <- Spake2.startSpake2 protocolB password2+      let aOut = Spake2.computeOutboundMessage sideA+      let bOut = Spake2.computeOutboundMessage sideB+      let aKey = Spake2.generateKeyMaterial sideA bOut+      let bKey = Spake2.generateKeyMaterial sideB aOut+      let aSessionKey = Spake2.createSessionKey protocolA aOut bOut aKey password1+      let bSessionKey = Spake2.createSessionKey protocolA aOut bOut bKey password2+      aSessionKey `shouldNotBe` bSessionKey+  describe "Symmetric protocol" $ do+    it "Produces matching session keys when passwords match" $ do+      let password = Spake2.makePassword "abc"+      let hashAlg = SHA256+      let group = Ed25519+      let s = Group.arbitraryElement group ("M" :: ByteString)+      let idSymmetric = Spake2.SideID ""+      let protocol1 = Spake2.makeSymmetricProtocol hashAlg group s idSymmetric+      let protocol2 = Spake2.makeSymmetricProtocol hashAlg group s idSymmetric+      side1 <- Spake2.startSpake2 protocol1 password+      side2 <- Spake2.startSpake2 protocol2 password+      let out1 = Spake2.computeOutboundMessage side1+      let out2 = Spake2.computeOutboundMessage side2+      let key1 = Spake2.generateKeyMaterial side1 out2+      let key2 = Spake2.generateKeyMaterial side2 out1+      let sessionKey1 = Spake2.createSessionKey protocol1 out1 out2 key1 password+      let sessionKey2 = Spake2.createSessionKey protocol2 out1 out2 key2 password+      sessionKey1 `shouldBe` sessionKey2+    it "Produces differing session keys when passwords do not match" $ do+      let password1 = Spake2.makePassword "abc"+      let password2 = Spake2.makePassword "cba"+      let hashAlg = SHA256+      let group = Ed25519+      let s = Group.arbitraryElement group ("M" :: ByteString)+      let idSymmetric = Spake2.SideID ""+      let protocol1 = Spake2.makeSymmetricProtocol hashAlg group s idSymmetric+      let protocol2 = Spake2.makeSymmetricProtocol hashAlg group s idSymmetric+      side1 <- Spake2.startSpake2 protocol1 password1+      side2 <- Spake2.startSpake2 protocol2 password2+      let out1 = Spake2.computeOutboundMessage side1+      let out2 = Spake2.computeOutboundMessage side2+      let key1 = Spake2.generateKeyMaterial side1 out2+      let key2 = Spake2.generateKeyMaterial side2 out1+      let sessionKey1 = Spake2.createSessionKey protocol1 out1 out2 key1 password1+      let sessionKey2 = Spake2.createSessionKey protocol2 out1 out2 key2 password2+      sessionKey1 `shouldNotBe` sessionKey2