-----------------------------------------------------------------------------
-- |
-- Module      :  Crypto.ECC.Ed25519.Internal.Ed25519
-- Copyright   :  (c) Marcel Fourné 20[14..]
-- License     :  BSD3
-- Maintainer  :  Marcel Fourné (haskell@marcelfourne.de)
-- Stability   :  alpha
-- Portability :  Bad
--
-- This module contain the internal functions. It's use should be limited to the Sign module, which exports certain types without constructors, so the timing attack surface is only over the verified functions.
-- In other words: If an external module imports this module or uses unsafecoerce, it may circumvent the verifications against timing attacks!
--
-- Short-time plan: custom field arithmetic
-- TODO: optimal const time inversion in 25519, see eccss-20130911b.pdf
-- TODO: convert code to portable, get rid of Integer
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -O2 -feager-blackholing #-}
{-# LANGUAGE Trustworthy, ScopedTypeVariables, NoImplicitPrelude #-}

module Crypto.ECC.Ed25519.Internal.Ed25519 where

import safe Prelude (Eq,Show,(==),Int,Bool,($),(-),otherwise,(<),(^),mod,Either(Left,Right),String,Integer,abs,id)
import safe qualified Data.Bits as B (shift,(.&.),(.|.),xor)
import safe qualified Prelude as P (fromInteger,toInteger)
import safe qualified Crypto.Fi as FP
import safe qualified Data.ByteString as BS
-- import safe qualified Data.ByteString.Lazy as BSL
-- import safe qualified Data.Digest.Pure.SHA as H
import qualified Crypto.Hash.SHA512 as H
import safe qualified Data.Word as W (Word8)

--  a point on the twisted Edwards curve, affine coordinates, neutral element (0,1)
-- | twisted Edwards curve point, extended point format (x,y,z,t), neutral element (0,1,1,0), c=1, a=-1 https://hyperelliptic.org/EFD/g1p/auto-twisted-extended-1.html, after "Twisted Edwards curves revisited" eprint 2008/522
newtype Point = Point (FP.FPrime,FP.FPrime,FP.FPrime,FP.FPrime) deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq,Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show)

-- | clear signal that everything is ok
data SigOK = SigOK deriving (Int -> SigOK -> ShowS
[SigOK] -> ShowS
SigOK -> String
(Int -> SigOK -> ShowS)
-> (SigOK -> String) -> ([SigOK] -> ShowS) -> Show SigOK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigOK] -> ShowS
$cshowList :: [SigOK] -> ShowS
show :: SigOK -> String
$cshow :: SigOK -> String
showsPrec :: Int -> SigOK -> ShowS
$cshowsPrec :: Int -> SigOK -> ShowS
Show,SigOK -> SigOK -> Bool
(SigOK -> SigOK -> Bool) -> (SigOK -> SigOK -> Bool) -> Eq SigOK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigOK -> SigOK -> Bool
$c/= :: SigOK -> SigOK -> Bool
== :: SigOK -> SigOK -> Bool
$c== :: SigOK -> SigOK -> Bool
Eq)

-- | Result of verifying a signature should only yield if it's good or bad, not more, but contains an error string if underlying primitives failed
type VerifyResult = Either String SigOK

-- | just a newtype for the public key  (string of 32 bytes, b=256 bit)
type PubKey = BS.ByteString

-- | just a newtype for the public key as a point on the Edwards curve
type PubKeyPoint = Point

-- | just a wrapper for the secret key (string of 32 bytes, b=256 bit)
newtype SecKey = SecKeyBytes BS.ByteString

-- | just a wrapper for the secret key as a number
newtype SecFPrime = SecNum FP.FPrime

-- | just a newtype for the signature (string of 2*32 bytes, b=256 bit)
type Signature = BS.ByteString

-- | just a newtype for the message
type Message = BS.ByteString

-- | just a newtype for the signature with appended message
type SignedMessage = BS.ByteString

-- | working on exactly 256 bits
b :: Int
b :: Int
b = Int
256
{-# INLINABLE b #-}

-- | the large prime
q :: FP.FPrime
-- q = FP.fromInteger b $ 2^(255::Integer) - 19
q :: FPrime
q = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
57896044618658097711785492504343953926634992332820282019728792003956564819949
{-# INLINABLE q #-}

-- | curve parameter l, the group order, f.e. needed to use Farmat's little theorem
l :: FP.FPrime
-- l = FP.addr q (FP.pow q (FP.fromInteger b 2) (FP.fromInteger b 252)) (FP.fromInteger b 27742317777372353535851937790883648493)
l :: FPrime
l = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
7237005577332262213973186563042994240857116359379907606001950938285454250989
{-# INLINABLE l #-}

-- | curve parameter d, non-square element, -(121665/121666)
d :: FP.FPrime
-- d = FP.mulr q (P.neg q $ FP.fromInteger b 121665) $ FP.inv q (FP.fromInteger b 121666)
d :: FPrime
d = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
37095705934669439343138083508754565189542113879843219016388785533085940283555
{-# INLINABLE d #-}

-- | sqrt (-1) on our curve
i :: FP.FPrime
-- i = FP.pow q 2 (FP.shift (FP.subr q q (FP.fromInteger b 1)) (-2))
i :: FPrime
i = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
19681161376707505956807079304988542015446066515923890162744021073123829784752
{-# INLINABLE i #-}

-- | wrapper for our hash function
h :: BS.ByteString -> BS.ByteString
-- h bs = BSL.toStrict $ H.bytestringDigest $ H.sha512 $ BSL.fromStrict bs
h :: ByteString -> ByteString
h = ByteString -> ByteString
H.hash
{-# INLINABLE h #-}

-- | the prehash function, id in PureEdDSA
ph :: BS.ByteString -> BS.ByteString
ph :: ByteString -> ByteString
ph = ByteString -> ByteString
forall a. a -> a
id
{-# INLINABLE ph #-}

-- | the y coordinate of the base point of the curve
by :: FP.FPrime
-- by = FP.mulr q (FP.fromInteger b 4) (FP.inv q $ FP.fromInteger b 5)
by :: FPrime
by = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
46316835694926478169428394003475163141307993866256225615783033603165251855960
{-# INLINABLE by #-}

-- | additive neutral element, really (0,Z,Z,0)
inf :: Point
inf :: Point
inf = (FPrime, FPrime, FPrime, FPrime) -> Point
Point (Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
0, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
1, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
1, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
0)
{-# INLINABLE inf #-}

-- | special form of FPrime, no bits set
null :: FP.FPrime
null :: FPrime
null = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
0
{-# INLINABLE null #-}

-- | special form of FPrime, lowest bit set
eins :: FP.FPrime
eins :: FPrime
eins = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
1
{-# INLINABLE eins #-}

-- | special form of FPrime, all bits set
alleeins:: FP.FPrime
-- alleeins = FP.fromInteger b (2^b-1)
alleeins :: FPrime
alleeins = Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
115792089237316195423570985008687907853269984665640564039457584007913129639935
{-# INLINABLE alleeins #-}

-- | recover the x coordinate from the y coordinate and a signum
xrecover :: FP.FPrime -> Integer -> FP.FPrime
xrecover :: FPrime -> FPrime -> FPrime
xrecover FPrime
y FPrime
sign' = let yy :: FPrime
yy = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
y FPrime
y
                       u :: FPrime
u = FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
yy FPrime
eins -- u = y^2-1
                       v :: FPrime
v = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
eins (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
d FPrime
yy -- v = dy^2+1
                       beta :: FPrime
beta = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
u (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
v (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime
FP.square FPrime
q FPrime
v) (FPrime -> FPrime -> FPrime -> FPrime
FP.pow FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
u (FPrime -> FPrime -> FPrime -> FPrime
FP.pow FPrime
q FPrime
v (FPrime
7::Integer))) (FPrime -> Int -> FPrime
FP.shift (FPrime -> FPrime -> FPrime
FP.sub FPrime
q (Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
5)) (-Int
3)))
                       -- v*beta^2 + u == 0? -> z [all-0 or some pattern]; foldr (.|.) 0 [bits from z] -> [0|1] -> [i|eins]
                       fixroot :: FPrime -> FPrime
fixroot FPrime
num = let c :: FPrime
c = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
v (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
num FPrime
num)) FPrime
u
                                         -- s = foldr (B..|.) 0 $ listofbits c
                                         s :: FPrime
s = -(FPrime -> Int -> FPrime
FP.shift (-(FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B.xor FPrime
c FPrime
null)) (-Int
255)) -- better than listbuilding, eccss-20130911b.pdf p.77/133 -- TODO: portable lowlevel!
                                         realpattern :: FPrime
realpattern = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins (FPrime -> FPrime -> FPrime
FP.sub FPrime
eins FPrime
s) -- pattern for == -u
                                         invpattern :: FPrime
invpattern = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins FPrime
s -- pattern for /= -u
                                     in FPrime -> FPrime -> FPrime
FP.add (FPrime
i FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
realpattern) (FPrime
eins FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
invpattern)
                       zwischen :: FPrime
zwischen = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
beta (FPrime -> FPrime
fixroot FPrime
beta)
                       signum :: FPrime -> FPrime -> FPrime
signum FPrime
num FPrime
sign'' = let signbit :: FPrime
signbit = FPrime -> FPrime
forall a. Num a => a -> a
abs (FPrime
sign'' FPrime -> FPrime -> FPrime
forall a. Num a => a -> a -> a
- (FPrime
num FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` FPrime
2)) -- y:(0 pos, 1 neg), beta`mod`2:(0 pos, 1 neg)
                                               pat :: FPrime
pat = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins (FPrime -> FPrime -> FPrime
FP.sub FPrime
eins FPrime
signbit) -- pattern for pos
                                               invpat :: FPrime
invpat = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins FPrime
signbit -- pattern for neg
                                           in FPrime -> FPrime -> FPrime
FP.add (FPrime
eins FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
pat) (FPrime -> FPrime -> FPrime
FP.neg FPrime
q FPrime
eins FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
invpat)
                   in FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime
signum FPrime
zwischen FPrime
sign') FPrime
zwischen -- multiply by masked one or zero


-- | base point on the curve
bPoint :: Point
bPoint :: Point
bPoint = (FPrime, FPrime, FPrime, FPrime) -> Point
Point (Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
15112221349535400772501151409588531511454012693041857206046113283949847762202,Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
46316835694926478169428394003475163141307993866256225615783033603165251855960, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
1, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
46827403850823179245072216630277197565144205554125654976674165829533817101731)
{-# INLINABLE bPoint #-}

-- | point negation
pneg :: Point -> Point
pneg :: Point -> Point
pneg (Point (FPrime
x,FPrime
y,FPrime
z,FPrime
t)) = (FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime -> FPrime -> FPrime
FP.neg FPrime
q FPrime
x, FPrime
y, FPrime
z, FPrime -> FPrime -> FPrime
FP.neg FPrime
q FPrime
t)
{-# INLINABLE pneg #-}

-- | k=2*d, constant used for point addition
k :: FP.FPrime
k :: FPrime
k = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
d FPrime
2
{-# INLINABLE k #-}

-- | point addition
-- add-2008-hwcd-3
padd :: Point -> Point -> Point
padd :: Point -> Point -> Point
padd (Point (FPrime
x1,FPrime
y1,FPrime
z1,FPrime
t1)) (Point (FPrime
x2,FPrime
y2,FPrime
z2,FPrime
t2)) =
  let a' :: FPrime
a' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
y1 FPrime
x1) (FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
y2 FPrime
x2)
      b' :: FPrime
b' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
y1 FPrime
x1) (FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
y2 FPrime
x2)
      c' :: FPrime
c' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
k (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
t1 FPrime
t2
      d' :: FPrime
d' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
2 (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
z1 FPrime
z2
      e' :: FPrime
e' = FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
b' FPrime
a'
      f' :: FPrime
f' = FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
d' FPrime
c'
      g' :: FPrime
g' = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
d' FPrime
c'
      h' :: FPrime
h' = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
b' FPrime
a'
      x3 :: FPrime
x3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
e' FPrime
f'
      y3 :: FPrime
y3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
g' FPrime
h'
      z3 :: FPrime
z3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
f' FPrime
g'
      t3 :: FPrime
t3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
e' FPrime
h'
  in (FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime
x3,FPrime
y3,FPrime
z3,FPrime
t3)

-- | point doubling
pdouble :: Point -> Point
-- {-
-- RFC 8032
pdouble :: Point -> Point
pdouble (Point (FPrime
x1,FPrime
y1,FPrime
z1,FPrime
_)) =
  let a' :: FPrime
a' = FPrime -> FPrime -> FPrime
FP.square FPrime
q FPrime
x1
      b' :: FPrime
b' = FPrime -> FPrime -> FPrime
FP.square FPrime
q FPrime
y1
      c' :: FPrime
c' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
2 (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime
FP.square FPrime
q FPrime
z1
      h' :: FPrime
h' = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
a' FPrime
b'
      e' :: FPrime
e' = FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
h' (FPrime -> FPrime -> FPrime
FP.square FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
x1 FPrime
y1))
      g' :: FPrime
g' = FPrime -> FPrime -> FPrime -> FPrime
FP.subr FPrime
q FPrime
a' FPrime
b'
      f' :: FPrime
f' = FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q FPrime
c' FPrime
g'
      x3 :: FPrime
x3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
e' FPrime
f'
      y3 :: FPrime
y3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
g' FPrime
h'
      z3 :: FPrime
z3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
f' FPrime
g'
      t3 :: FPrime
t3 = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
e' FPrime
h'
  in (FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime
x3,FPrime
y3,FPrime
z3,FPrime
t3)
-- -}
{-
-- dbl-2008-hwcd
pdouble (Point (x1,y1,z1,_)) =
  let a' = FP.square q x1
      b' = FP.square q y1
      c' = FP.mulr q 2 $ FP.square q z1
      d' = FP.neg q a'
      e' = FP.subr q (FP.subr q (FP.square q (FP.addr q x1 y1)) a') b'
      g' = FP.addr q d' b'
      f' = FP.subr q g' c'
      h' = FP.subr q d' b'
      x3 = FP.mulr q e' f'
      y3 = FP.mulr q g' h'
      z3 = FP.mulr q f' g'
      t3 = FP.mulr q e' h'
  in Point (x3,y3,z3,t3)
-- -}

-- | scalar multiplication, branchfree in k, pattern-matched branch on j (static known length of k)
pmul :: Point -> FP.FPrime -> Point
pmul :: Point -> FPrime -> Point
pmul (Point (FPrime
x,FPrime
y,FPrime
z,FPrime
_)) FPrime
k' =
  let ex :: Point -> Int -> Point
ex Point
erg Int
j
        | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Point
erg
        | Bool
otherwise = let s :: FPrime
s = FPrime -> Int -> FPrime
FP.condBit FPrime
k' Int
j
                          realpattern :: FPrime
realpattern = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins FPrime
s
                          invpattern :: FPrime
invpattern = FPrime -> FPrime -> FPrime
FP.mul FPrime
alleeins (FPrime -> FPrime -> FPrime
FP.sub FPrime
eins FPrime
s)
                          x' :: FPrime
x' = FPrime
x FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
realpattern
                          y' :: FPrime
y' = FPrime -> FPrime -> FPrime
FP.add (FPrime
y FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
realpattern) (FPrime
eins FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
invpattern)
                          z' :: FPrime
z' = FPrime -> FPrime -> FPrime
FP.add (FPrime
z FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
realpattern) (FPrime
eins FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
invpattern)
                          t' :: FPrime
t' = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
x' FPrime
y'
                      in Point -> Int -> Point
ex (Point -> Point -> Point
padd (Point -> Point
pdouble Point
erg) ((FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime
x', FPrime
y', FPrime
z',FPrime
t'))) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  -- length k should be at most 256 bits, since mod q we have 0xyz.. so at max 255 steps from 254 to 0 included
  in Point -> Int -> Point
ex Point
inf Int
254

-- | check if Point is on the curve, prevent some attacks
ison :: Point -> Bool
ison :: Point -> Bool
ison (Point (FPrime
x,FPrime
y,FPrime
z,FPrime
_)) = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
z FPrime
z) (FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q (FPrime -> FPrime -> FPrime
FP.neg FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
x FPrime
x)) (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
y FPrime
y)) FPrime -> FPrime -> Bool
forall a. Eq a => a -> a -> Bool
== FPrime -> FPrime -> FPrime -> FPrime
FP.addr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.pow FPrime
q FPrime
z FPrime
4) (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
d (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
x FPrime
x) (FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
y FPrime
y))

-- | make scalar format Point from projective coordinates
scale :: Point -> Point
scale :: Point -> Point
scale (Point (FPrime
xz,FPrime
yz,FPrime
z,FPrime
_)) = let zInv :: FPrime
zInv = FPrime -> FPrime -> FPrime
FP.inv FPrime
q FPrime
z
                                x :: FPrime
x = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
xz FPrime
zInv
                                y :: FPrime
y = FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
yz FPrime
zInv
                            in (FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime
x,FPrime
y,FPrime
1,FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
x FPrime
y)

-- | convert a point on the curve to a ByteString
pointtobs :: Point -> BS.ByteString
pointtobs :: Point -> ByteString
pointtobs Point
p = let Point (FPrime
x,FPrime
y,FPrime
_,FPrime
_) = Point -> Point
scale Point
p
                  -- LSB of x is sign bit, put to MSB of y (which was zero)
                  yf :: FPrime
yf = FPrime -> FPrime -> FPrime
FP.add FPrime
y (FPrime -> Int -> FPrime
FP.shift (FPrime
x FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
eins) (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
              in FPrime -> ByteString
putFPrime FPrime
yf

-- | convert a ByteString to a point on the curve
bstopoint :: BS.ByteString -> Either String Point
bstopoint :: ByteString -> Either String Point
bstopoint ByteString
bs = do
  let y :: Either String FPrime
y = ByteString -> Either String FPrime
getFPrime32 ByteString
bs
  case Either String FPrime
y of
    Left String
_ -> String -> Either String Point
forall a b. a -> Either a b
Left String
"Could not decode Point"
    Right (FPrime
y'::FP.FPrime) -> let yf :: FPrime
yf = FPrime
y' FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. (FPrime
alleeins FPrime -> FPrime -> FPrime
forall a. Num a => a -> a -> a
- (FPrime
2FPrime -> Int -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)))
                                 xf :: FPrime
xf = FPrime -> FPrime -> FPrime
xrecover FPrime
yf (FPrime -> Int -> FPrime
FP.condBit FPrime
y' (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                                 pt :: Point
pt = (FPrime, FPrime, FPrime, FPrime) -> Point
Point (FPrime
xf,FPrime
yf, Int -> FPrime -> FPrime
FP.fromInteger Int
b FPrime
1, FPrime -> FPrime -> FPrime -> FPrime
FP.mulr FPrime
q FPrime
xf FPrime
yf)
                             in if Point -> Bool
ison Point
pt then Point -> Either String Point
forall a b. b -> Either a b
Right Point
pt else String -> Either String Point
forall a b. a -> Either a b
Left String
"Point not on curve"

-- | clamping of a string of bytes to make it suitable for usage on the (clamped) Edwards curve in Ed25519, reduces cofactor
--          [  b Bits ]                           001..1000                   010..0
-- BigEndian 01x..x000 ==> ((getFPrime N) .&. (2^254-1-(2^0+2^1+2^2)) .|. (2^254))
-- .&. 28948022309329048855892746252171976963317496166410141009864396001978282409976 .|. 28948022309329048855892746252171976963317496166410141009864396001978282409984
clamp :: BS.ByteString -> Either String FP.FPrime
clamp :: ByteString -> Either String FPrime
clamp ByteString
bs = let num' :: Either String FPrime
num' = ByteString -> Either String FPrime
getFPrime32 ByteString
bs
           in case Either String FPrime
num' of
                Right FPrime
num -> FPrime -> Either String FPrime
forall a b. b -> Either a b
Right ((FPrime -> FPrime
FP.toInteger FPrime
num FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..&. FPrime
28948022309329048855892746252171976963317496166410141009864396001978282409976) FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime
28948022309329048855892746252171976963317496166410141009864396001978282409984)
                Left String
e -> String -> Either String FPrime
forall a b. a -> Either a b
Left String
e

-- | convert an 8 Byte little endian ByteString to either an error String (if too short) or a big endian FPrime
convertLE8ByteTo64BE :: BS.ByteString -> Either String FP.FPrime
convertLE8ByteTo64BE :: ByteString -> Either String FPrime
convertLE8ByteTo64BE ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 = String -> Either String FPrime
forall a b. a -> Either a b
Left String
"ByteString does not contain at least 32 Bytes"
                        | Bool
otherwise = 
                          let lowest :: Word8
lowest =  ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
0
                              lower :: Word8
lower =   ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
1
                              low :: Word8
low =     ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
2
                              midlow :: Word8
midlow =  ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
3
                              midhigh :: Word8
midhigh = ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
4
                              high :: Word8
high =    ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
5
                              higher :: Word8
higher =  ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
6
                              highest :: Word8
highest = ByteString
bs ByteString -> Int -> Word8
`BS.index` Int
7
                          in FPrime -> Either String FPrime
forall a b. b -> Either a b
Right (FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$  Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
lowest  
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
lower)   Int
8
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
low)     Int
16
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
midlow)  Int
24
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
midhigh) Int
32
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
high)    Int
40
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
higher)  Int
48
                                      FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (Word8 -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger Word8
highest) Int
56
                                   )

-- | convert a big endian FPrime to an 8 Byte little endian ByteString
convert64BEtoLE8Byte :: FP.FPrime -> BS.ByteString
convert64BEtoLE8Byte :: FPrime -> ByteString
convert64BEtoLE8Byte FPrime
z = let lowest :: Word8
lowest =  (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$          FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^( FPrime
8::Integer)))       ::W.Word8
                             lower :: Word8
lower =   (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
16::Integer))) ( -Int
8))::W.Word8
                             low :: Word8
low =     (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
24::Integer))) (-Int
16))::W.Word8
                             midlow :: Word8
midlow =  (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
32::Integer))) (-Int
24))::W.Word8
                             midhigh :: Word8
midhigh = (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
40::Integer))) (-Int
32))::W.Word8
                             high :: Word8
high =    (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
48::Integer))) (-Int
40))::W.Word8
                             higher :: Word8
higher =  (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
z FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
56::Integer))) (-Int
48))::W.Word8
                             highest :: Word8
highest = (FPrime -> Word8
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> Word8) -> FPrime -> Word8
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift  FPrime
z                          (-Int
56))::W.Word8
                         in [Word8] -> ByteString
BS.pack [Word8
lowest,Word8
lower,Word8
low,Word8
midlow,Word8
midhigh,Word8
high,Word8
higher,Word8
highest]

-- | converts 32 little endian bytes into one FPrime
getFPrime32 :: BS.ByteString -> Either String FP.FPrime
getFPrime32 :: ByteString -> Either String FPrime
getFPrime32 ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = String -> Either String FPrime
forall a b. a -> Either a b
Left String
"ByteString does not contain at least 32 Bytes"
               | Bool
otherwise = do
                   FPrime
lowest <- ByteString -> Either String FPrime
convertLE8ByteTo64BE ByteString
bs
                   FPrime
lower <- ByteString -> Either String FPrime
convertLE8ByteTo64BE (ByteString -> Either String FPrime)
-> ByteString -> Either String FPrime
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs
                   FPrime
higher <- ByteString -> Either String FPrime
convertLE8ByteTo64BE (ByteString -> Either String FPrime)
-> ByteString -> Either String FPrime
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
16 ByteString
bs
                   FPrime
highest <- ByteString -> Either String FPrime
convertLE8ByteTo64BE (ByteString -> Either String FPrime)
-> ByteString -> Either String FPrime
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
24 ByteString
bs
                   FPrime -> Either String FPrime
forall a b. b -> Either a b
Right (                FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
lowest
                           FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
lower)    Int
64
                           FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
higher)  Int
128
                           FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
highest) Int
192
                         )

-- | converts 64 little endian bytes into one FPrime
getFPrime64 :: BS.ByteString -> Either String FP.FPrime
getFPrime64 :: ByteString -> Either String FPrime
getFPrime64 ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
64 = String -> Either String FPrime
forall a b. a -> Either a b
Left String
"ByteString does not contain at least 64 Bytes"
               | Bool
otherwise = do
                   FPrime
low <- ByteString -> Either String FPrime
getFPrime32 ByteString
bs
                   FPrime
high <- ByteString -> Either String FPrime
getFPrime32 (ByteString -> Either String FPrime)
-> ByteString -> Either String FPrime
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
32 ByteString
bs
                   FPrime -> Either String FPrime
forall a b. b -> Either a b
Right (FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
low FPrime -> FPrime -> FPrime
forall a. Bits a => a -> a -> a
B..|. FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime -> FPrime
forall a. Integral a => a -> FPrime
P.toInteger FPrime
high) Int
256)

-- | converts one FPrime into exactly 32 little endian bytes
putFPrime :: FP.FPrime -> BS.ByteString
putFPrime :: FPrime -> ByteString
putFPrime FPrime
num = let arg :: FPrime
arg = FPrime -> FPrime
FP.toInteger FPrime
num
                    lowest :: FPrime
lowest =  FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime
arg FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
64::Integer))
                    lower :: FPrime
lower =   FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
arg FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
128::Integer))) (-Int
64)
                    higher :: FPrime
higher =  FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift (FPrime
arg FPrime -> FPrime -> FPrime
forall a. Integral a => a -> a -> a
`mod` (FPrime
2FPrime -> FPrime -> FPrime
forall a b. (Num a, Integral b) => a -> b -> a
^(FPrime
192::Integer))) (-Int
128)
                    highest :: FPrime
highest = FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger (FPrime -> FPrime) -> FPrime -> FPrime
forall a b. (a -> b) -> a -> b
$ FPrime -> Int -> FPrime
forall a. Bits a => a -> Int -> a
B.shift FPrime
arg (-Int
192)
                in             FPrime -> ByteString
convert64BEtoLE8Byte (FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger FPrime
lowest)
                   ByteString -> ByteString -> ByteString
`BS.append` FPrime -> ByteString
convert64BEtoLE8Byte (FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger FPrime
lower)
                   ByteString -> ByteString -> ByteString
`BS.append` FPrime -> ByteString
convert64BEtoLE8Byte (FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger FPrime
higher)
                   ByteString -> ByteString -> ByteString
`BS.append` FPrime -> ByteString
convert64BEtoLE8Byte (FPrime -> FPrime
forall a. Num a => FPrime -> a
P.fromInteger FPrime
highest)