module Crypto.Spake2.Groups.Ed25519
( Ed25519(..)
, 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 (AbelianGroup(..), Group(..), KeyPair(..), scalarSizeBytes)
import Crypto.Spake2.Util (bytesToNumber, expandArbitraryElementSeed)
data Ed25519 = Ed25519 deriving (Eq, Show)
instance Group Ed25519 where
type Element Ed25519 = ExtendedPoint 'Member
elementAdd _ x y = addExtendedPoints x y
elementNegate group = scalarMultiply group (l 1)
groupIdentity _ = assertInGroup extendedZero
encodeElement _ x = encodeAffinePoint (extendedToAffine' x)
decodeElement _ bytes = toCryptoFailable $ do
extended <- affineToExtended <$> decodeAffinePoint bytes
ensureInGroup extended
elementSizeBits _ = 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..] ]
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)
data Error
= NotOnCurve Integer Integer
| NotInGroup (ExtendedPoint 'Unknown)
| LowOrderPoint (ExtendedPoint 'Unknown)
deriving (Eq, Show)
toCryptoFailable :: Either Error a -> CryptoFailable a
toCryptoFailable (Right r) = pure r
toCryptoFailable (Left _) = CryptoFailed CryptoError_PointCoordinatesInvalid
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
assertInGroup :: HasCallStack => ExtendedPoint 'Unknown -> ExtendedPoint 'Member
assertInGroup element =
case ensureInGroup element of
Left err -> panic $ "Element not in group (" <> show err <> "): " <> show element
Right x -> x
q :: Integer
q = 2 ^ 255 19
l :: Integer
l = 2 ^ 252 + 27742317777372353535851937790883648493
dConst :: Integer
dConst = 121665 * inv 121666
i :: Integer
i = expSafe 2 ((q1) `div` 4) q
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
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
data GroupMembership = Unknown | Member
data ExtendedPoint (groupMembership :: GroupMembership)
= ExtendedPoint
{ x :: !Integer
, y :: !Integer
, z :: !Integer
, t :: !Integer
} deriving (Show)
instance Eq (ExtendedPoint a) where
point1 == point2 = extendedToAffine' point1 == extendedToAffine' point2
extendedZero :: ExtendedPoint a
extendedZero = ExtendedPoint {x = 0, y = 1, z = 1, t = 0}
isExtendedZero :: ExtendedPoint irrelevant -> Bool
isExtendedZero ExtendedPoint{x, y, z} = x == 0 && y' == z' && y' /= 0
where
y' = y `mod` q
z' = z `mod` q
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) `mod` q
y3 = (g * h) `mod` q
z3 = (f * g) `mod` q
t3 = (e * h) `mod` q
e = (b a) `mod` q
f = (d' c) `mod` q
g = (d' + c) `mod` q
h = (b + a) `mod` q
a = ((y1 x1) * (y2 x2)) `mod` q
b = ((y1 + x1) * (y2 + x2)) `mod` q
c = (t1 * (2 * dConst) * t2) `mod` q
d' = (z1 * 2 * z2) `mod` q
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) `mod` q
y3 = (g * h) `mod` q
z3 = (f * g) `mod` q
t3 = (e * h) `mod` q
e = (j * j a b) `mod` q
f = (g c) `mod` q
g = (d' + b) `mod` q
h = (d' b) `mod` q
a = x1 * x1
b = y1 * y1
c = 2 * z1 * z1
d' = (a) `mod` q
j = (x1 + y1) `mod` q
safeScalarMultiply :: Integer -> ExtendedPoint a -> ExtendedPoint a
safeScalarMultiply n = scalarMultiplyExtendedPoint addExtendedPoints n
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)
makeGroupMember :: Integer -> Either Error (Element Ed25519)
makeGroupMember y = do
point <- affineToExtended <$> makeAffinePoint (xRecover y) y
let point8 = safeScalarMultiply 8 point
if isExtendedZero point8
then throwError $ LowOrderPoint point
else ensureInGroup point8
data AffinePoint
= AffinePoint
{ x :: !Integer
, y :: !Integer
} deriving (Eq, Show)
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
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)
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