mirror of
https://github.com/logos-storage/transport-over-mix.git
synced 2026-05-19 19:39:35 +00:00
120 lines
3.2 KiB
Haskell
120 lines
3.2 KiB
Haskell
|
|
-- | The cyclic subgroup of Curve25519
|
|
--
|
|
-- Curve25519 is the Montgomery curve defined by
|
|
--
|
|
-- > y^2 = x^3 + 486662*x^2 + x
|
|
--
|
|
-- over the prime field @p = 2^255 - 19@
|
|
--
|
|
-- See <https://cr.yp.to/ecdh/curve25519-20060209.pdf>
|
|
--
|
|
-- Note: In the @X = x/z@ representation, we can do efficient doubling and
|
|
-- efficient scalar multiplication, but not clear how to do addition.
|
|
--
|
|
-- But we are only using X25519 (Diffie-Hellman), no signatures
|
|
--
|
|
|
|
{-# LANGUAGE Strict #-}
|
|
module Crypto.X25519.Elliptic where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Data.Bits
|
|
|
|
import Crypto.X25519.BaseField
|
|
import Crypto.X25519.ScalarField
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
constA, constA' :: Fp
|
|
constA = Fp 486662
|
|
constA' = Fp 121665 -- (A-2) / 4
|
|
|
|
-- | We only store the @x@ coordinate, with @z=1@ being implicit
|
|
newtype G
|
|
= Gx Fp
|
|
deriving (Eq,Show)
|
|
|
|
xcoordAsInteger :: G -> Integer
|
|
xcoordAsInteger (Gx x) = fromFp x
|
|
|
|
-- | We store both the @x@ and $z$ coordinates
|
|
data G'
|
|
= Gxz !Fp !Fp
|
|
deriving (Eq,Show)
|
|
|
|
toProj :: G -> G'
|
|
toProj (Gx x) = Gxz x 1
|
|
|
|
fromProj :: G' -> G
|
|
fromProj (Gxz x z) = Gx (x/z)
|
|
|
|
basePoint :: G
|
|
basePoint = Gx 9
|
|
|
|
basePoint' :: G'
|
|
basePoint' = Gxz 9 1
|
|
|
|
inf :: G'
|
|
inf = Gxz 1 0
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
affDouble :: G -> G
|
|
affDouble = fromProj . projDouble . toProj
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
projDouble :: G' -> G'
|
|
projDouble (Gxz x z) = Gxz x2 z2 where
|
|
u = (x-z) * (x-z)
|
|
v = (x+z) * (x+z)
|
|
x2 = u * v
|
|
m2 = v - u
|
|
z2 = m2 * (v + constA' * m2)
|
|
|
|
-- | Given Q, Q' and Q-Q' (assuming not 0 or inf), we compute Q+Q'
|
|
projLadderStep :: G' -> G' -> G -> G'
|
|
projLadderStep (Gxz x z ) (Gxz x' z') (Gx x1) = Gxz x3 z3 where
|
|
u = (x - z) * (x' + z')
|
|
v = (x + z) * (x' - z')
|
|
x3 = (u + v) * (u + v) -- * z1 = 1
|
|
z3 = (u - v) * (u - v) * x1
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
(**) :: Fq -> G -> G
|
|
(**) expo base = scalarMul (fromFq expo) base
|
|
|
|
scalarMul :: Integer -> G -> G
|
|
scalarMul expo base = fromProj $ montgomeryLadder expo base
|
|
|
|
montgomeryLadder :: Integer -> G -> G'
|
|
montgomeryLadder expo base = fst (go expo) where
|
|
-- returns (n*base, (n+1)*base)
|
|
go :: Integer -> (G', G')
|
|
go 0 = (inf , toProj base)
|
|
go n = case n .&. 1 of
|
|
0 -> (projDouble a , ladderStep a b) -- 2k = 2*k ; 2k+1 = k + (k+1)
|
|
1 -> (ladderStep a b , projDouble b ) -- 2k+1 = k + (k+1) ; 2k+2 = 2*(k+1)
|
|
where
|
|
(a,b) = go (shiftR n 1)
|
|
|
|
ladderStep a b = projLadderStep a b base
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
sanityCheck :: Bool
|
|
sanityCheck = (scalarMul priv basePoint == pub) where
|
|
priv = 34637982121745647379369242364578736860238507147912635042240559108083448531832
|
|
pub = Gx 24771927253352877576321681419849838916408500873060548523943816650212634100610
|
|
|
|
{-
|
|
-- test case:
|
|
priv = 34637982121745647379369242364578736860238507147912635042240559108083448531832
|
|
pub = 24771927253352877576321681419849838916408500873060548523943816650212634100610
|
|
-}
|
|
|
|
--------------------------------------------------------------------------------
|