{-# LANGUAGE BangPatterns #-}

-- | Elliptic Curve Arithmetic.
--
-- /WARNING:/ These functions are vulnerable to timing attacks, except on
-- P-256, whose multiplications go to the C implementation in
-- "Crypto.PubKey.ECC.P256".
module Crypto.PubKey.ECC.Prim (
    scalarGenerate,
    scalarInverse,
    scalarAdd,
    scalarMul,
    pointAdd,
    pointNegate,
    pointDouble,
    pointBaseMul,
    pointMul,
    pointAddTwoMuls,
    pointDecompose,
    pointCompose,
    isPointAtInfinity,
    isPointValid,
    isPointInSubgroup,
) where

import Crypto.Error (maybeCryptoError)
import Crypto.Internal.ECC (CurveField (..), MulResult (..), curveMul)
import Crypto.Number.Basic (numBits)
import Crypto.Number.F2m
import Crypto.Number.Generate (generateBetween)
import Crypto.Number.ModArithmetic
import qualified Crypto.PubKey.ECC.P256 as P256
import Crypto.PubKey.ECC.Types
import Crypto.Random
import Data.Bits (shiftL, shiftR, testBit, (.&.))
import Data.Maybe

-- | P-256, the one curve here that has a C implementation: 'SEC_p256r1', also
-- known as NIST P-256 and prime256v1.
--
-- A 'Curve' carries its parameters rather than a name, so this compares the
-- parameters.  They are public, so the comparison tells an attacker nothing.
p256Curve :: Curve
p256Curve :: Curve
p256Curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256r1
{-# NOINLINE p256Curve #-}

p256Order :: Integer
p256Order :: Integer
p256Order = CurveCommon -> Integer
ecc_n (Curve -> CurveCommon
common_curve Curve
p256Curve)

p256Base :: Point
p256Base :: Point
p256Base = CurveCommon -> Point
ecc_g (Curve -> CurveCommon
common_curve Curve
p256Curve)

-- | A point the C implementation will take: in range, on the curve, and not
-- the point at infinity, which it does not represent.  Anything else is left
-- to the generic code, which answers for points off the curve too.
toP256 :: Point -> Maybe P256.Point
toP256 :: Point -> Maybe Point
toP256 Point
PointO = Maybe Point
forall a. Maybe a
Nothing
toP256 (Point Integer
x Integer
y)
    | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
limit Bool -> Bool -> Bool
|| Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
limit = Maybe Point
forall a. Maybe a
Nothing
    | Point -> Bool
P256.pointIsValid Point
p = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
    | Bool
otherwise = Maybe Point
forall a. Maybe a
Nothing
  where
    limit :: Integer
limit = Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
256
    p :: Point
p = (Integer, Integer) -> Point
P256.pointFromIntegers (Integer
x, Integer
y)

fromP256 :: P256.Point -> Point
fromP256 :: Point -> Point
fromP256 Point
p
    | Point -> Bool
P256.pointIsAtInfinity Point
p = Point
PointO
    | Bool
otherwise = (Integer -> Integer -> Point) -> (Integer, Integer) -> Point
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Point
Point (Point -> (Integer, Integer)
P256.pointToIntegers Point
p)

-- | Any 256-bit number as a scalar.
--
-- The arithmetic below takes them as they come: a 256-bit value is barely
-- over the order, and both the multiplication and the addition bring their
-- answer back under it.  'Nothing' is for what does not fit in 256 bits,
-- which no scalar anybody signs with does.
p256Scalar :: Integer -> Maybe P256.Scalar
p256Scalar :: Integer -> Maybe Scalar
p256Scalar Integer
n
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
256 = Maybe Scalar
forall a. Maybe a
Nothing
    | Bool
otherwise = CryptoFailable Scalar -> Maybe Scalar
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (Integer -> CryptoFailable Scalar
P256.scalarFromInteger Integer
n)

-- | The scalar reduced into the range the C implementation takes.
--
-- Every point it accepts has the curve's order, so reducing changes no
-- answer; 'Nothing' means the multiple is the point at infinity, which is the
-- generic code's business.
-- The reduction is a single masked subtraction, so a secret scalar does not
-- steer it, which taking the remainder would: dividing takes a number of
-- steps that follows the number being divided.  Anything wider than 256 bits
-- has to go through a division first, but a scalar that wide is not one
-- anybody signs with.
toP256Scalar :: Integer -> Maybe P256.Scalar
toP256Scalar :: Integer -> Maybe Scalar
toP256Scalar Integer
n = case Scalar -> Scalar
P256.scalarReduce (Scalar -> Scalar) -> Maybe Scalar -> Maybe Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Scalar
p256Scalar Integer
n of
    Maybe Scalar
Nothing -> Integer -> Maybe Scalar
toP256Scalar (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p256Order) -- wider than 256 bits, or below zero
    Just Scalar
s
        | Scalar -> Bool
P256.scalarIsZero Scalar
s -> Maybe Scalar
forall a. Maybe a
Nothing
        | Bool
otherwise -> Scalar -> Maybe Scalar
forall a. a -> Maybe a
Just Scalar
s

-- | @n1 * p1 + n2 * p2@ through the C implementation, when one of the points
-- is the base point.  That is the shape signature verification uses.
p256AddTwoMuls :: Integer -> Point -> Integer -> Point -> Maybe Point
p256AddTwoMuls :: Integer -> Point -> Integer -> Point -> Maybe Point
p256AddTwoMuls Integer
n1 Point
p1 Integer
n2 Point
p2
    | Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p256Base = Integer -> Integer -> Point -> Maybe Point
withBase Integer
n1 Integer
n2 Point
p2
    | Point
p2 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p256Base = Integer -> Integer -> Point -> Maybe Point
withBase Integer
n2 Integer
n1 Point
p1
    | Bool
otherwise = Maybe Point
forall a. Maybe a
Nothing
  where
    withBase :: Integer -> Integer -> Point -> Maybe Point
withBase Integer
a Integer
b Point
q =
        Point -> Point
fromP256
            (Point -> Point) -> Maybe Point -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scalar -> Scalar -> Point -> Point
P256.pointsMulVarTime (Scalar -> Scalar -> Point -> Point)
-> Maybe Scalar -> Maybe (Scalar -> Point -> Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Scalar
toP256Scalar Integer
a Maybe (Scalar -> Point -> Point)
-> Maybe Scalar -> Maybe (Point -> Point)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Maybe Scalar
toP256Scalar Integer
b Maybe (Point -> Point) -> Maybe Point -> Maybe Point
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> Maybe Point
toP256 Point
q)

-- | Generate a valid scalar for a specific Curve
scalarGenerate :: MonadRandom randomly => Curve -> randomly PrivateNumber
scalarGenerate :: forall (randomly :: * -> *).
MonadRandom randomly =>
Curve -> randomly Integer
scalarGenerate Curve
curve = Integer -> Integer -> randomly Integer
forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
1 (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  where
    n :: Integer
n = CurveCommon -> Integer
ecc_n (CurveCommon -> Integer) -> CurveCommon -> Integer
forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
common_curve Curve
curve

-- | The inverse of a scalar modulo the order of the curve, without letting
-- the scalar steer how long the work takes.  This is what signing needs for
-- its nonce, which is as worth hiding as the private key itself: a handful of
-- signatures whose nonces are partly known give the key away.
--
-- On P-256 the C implementation does it; elsewhere it is 'inverseSafe'.
-- 'Nothing' means the scalar has no inverse, which for the curves in use here
-- means it was a multiple of the order.
scalarInverse :: Curve -> Integer -> Maybe Integer
scalarInverse :: Curve -> Integer -> Maybe Integer
scalarInverse Curve
c Integer
k
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve
    , Just Scalar
s <- Integer -> Maybe Scalar
toP256Scalar Integer
k =
        Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Scalar -> Integer
P256.scalarToInteger (Scalar -> Scalar
P256.scalarInvSafe Scalar
s))
    | Bool
otherwise = Integer -> Integer -> Maybe Integer
inverseSafe Integer
k (CurveCommon -> Integer
ecc_n (CurveCommon -> Integer) -> CurveCommon -> Integer
forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
common_curve Curve
c)

-- | Addition modulo the order of the curve.
--
-- On P-256 this is the C implementation's arithmetic, which works in a fixed
-- width and so does not let the values steer it; elsewhere it is 'Integer'
-- arithmetic, whose cost follows the values.
scalarAdd :: Curve -> Integer -> Integer -> Integer
scalarAdd :: Curve -> Integer -> Integer -> Integer
scalarAdd Curve
c Integer
a Integer
b
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve
    , Just Scalar
x <- Integer -> Maybe Scalar
p256Scalar Integer
a
    , Just Scalar
y <- Integer -> Maybe Scalar
p256Scalar Integer
b =
        Scalar -> Integer
P256.scalarToInteger (Scalar -> Scalar -> Scalar
P256.scalarAdd Scalar
x Scalar
y)
    | Bool
otherwise = (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` CurveCommon -> Integer
ecc_n (Curve -> CurveCommon
common_curve Curve
c)

-- | Multiplication modulo the order of the curve, as 'scalarAdd'.
scalarMul :: Curve -> Integer -> Integer -> Integer
scalarMul :: Curve -> Integer -> Integer -> Integer
scalarMul Curve
c Integer
a Integer
b
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve
    , Just Scalar
x <- Integer -> Maybe Scalar
p256Scalar Integer
a
    , Just Scalar
y <- Integer -> Maybe Scalar
p256Scalar Integer
b =
        Scalar -> Integer
P256.scalarToInteger (Scalar -> Scalar -> Scalar
P256.scalarMul Scalar
x Scalar
y)
    | Bool
otherwise = (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` CurveCommon -> Integer
ecc_n (Curve -> CurveCommon
common_curve Curve
c)

-- TODO: Extract helper function for `fromMaybe PointO...`

-- | Elliptic Curve point negation:
-- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@.
pointNegate :: Curve -> Point -> Point
pointNegate :: Curve -> Point -> Point
pointNegate Curve
_ Point
PointO = Point
PointO
pointNegate (CurveFP CurvePrime
c) (Point Integer
x Integer
y) = Integer -> Integer -> Point
Point Integer
x (CurvePrime -> Integer
ecc_p CurvePrime
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y)
pointNegate CurveF2m{} (Point Integer
x Integer
y) = Integer -> Integer -> Point
Point Integer
x (Integer
x Integer -> Integer -> Integer
`addF2m` Integer
y)

-- | Elliptic Curve point addition.
--
-- /WARNING:/ Vulnerable to timing attacks.
pointAdd :: Curve -> Point -> Point -> Point
pointAdd :: Curve -> Point -> Point -> Point
pointAdd Curve
_ Point
PointO Point
PointO = Point
PointO
pointAdd Curve
_ Point
PointO Point
q = Point
q
pointAdd Curve
_ Point
p Point
PointO = Point
p
pointAdd Curve
c Point
p Point
q
    | Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
q = Curve -> Point -> Point
pointDouble Curve
c Point
p
    | Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Curve -> Point -> Point
pointNegate Curve
c Point
q = Point
PointO
pointAdd (CurveFP (CurvePrime Integer
pr CurveCommon
_)) (Point Integer
xp Integer
yp) (Point Integer
xq Integer
yq) =
    Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
PointO (Maybe Point -> Point) -> Maybe Point -> Point
forall a b. (a -> b) -> a -> b
$ do
        Integer
s <- Integer -> Integer -> Integer -> Maybe Integer
divmod (Integer
yp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
yq) (Integer
xp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
xq) Integer
pr
        let xr :: Integer
xr = (Integer
s Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
xp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
xq) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
pr
            yr :: Integer
yr = (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
xp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
xr) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
yp) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
pr
        Point -> Maybe Point
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
pointAdd (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
xp Integer
yp) (Point Integer
xq Integer
yq) =
    Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
PointO (Maybe Point -> Point) -> Maybe Point -> Point
forall a b. (a -> b) -> a -> b
$ do
        Integer
s <- Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx (Integer
yp Integer -> Integer -> Integer
`addF2m` Integer
yq) (Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xq)
        let xr :: Integer
xr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s Integer
s Integer -> Integer -> Integer
`addF2m` Integer
s Integer -> Integer -> Integer
`addF2m` Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xq Integer -> Integer -> Integer
`addF2m` Integer
a
            yr :: Integer
yr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s (Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xr) Integer -> Integer -> Integer
`addF2m` Integer
xr Integer -> Integer -> Integer
`addF2m` Integer
yp
        Point -> Maybe Point
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
  where
    a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc

-- | Elliptic Curve point doubling.
--
-- /WARNING:/ Vulnerable to timing attacks.
--
-- This perform the following calculation:
-- > lambda = (3 * xp ^ 2 + a) / 2 yp
-- > xr = lambda ^ 2 - 2 xp
-- > yr = lambda (xp - xr) - yp
--
-- With binary curve:
-- > xp == 0   => P = O
-- > otherwise =>
-- >    s = xp + (yp / xp)
-- >    xr = s ^ 2 + s + a
-- >    yr = xp ^ 2 + (s+1) * xr
pointDouble :: Curve -> Point -> Point
pointDouble :: Curve -> Point -> Point
pointDouble Curve
_ Point
PointO = Point
PointO
pointDouble (CurveFP (CurvePrime Integer
pr CurveCommon
cc)) (Point Integer
xp Integer
yp) = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
PointO (Maybe Point -> Point) -> Maybe Point -> Point
forall a b. (a -> b) -> a -> b
$ do
    Integer
lambda <- Integer -> Integer -> Integer -> Maybe Integer
divmod (Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
xp Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a) (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
yp) Integer
pr
    let xr :: Integer
xr = (Integer
lambda Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
xp) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
pr
        yr :: Integer
yr = (Integer
lambda Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
xp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
xr) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
yp) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
pr
    Point -> Maybe Point
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
  where
    a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
pointDouble (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
xp Integer
yp)
    | Integer
xp Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Point
PointO
    | Bool
otherwise = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
PointO (Maybe Point -> Point) -> Maybe Point -> Point
forall a b. (a -> b) -> a -> b
$ do
        Integer
s <- Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
addF2m Integer
xp (Integer -> Maybe Integer) -> Maybe Integer -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx Integer
yp Integer
xp
        let xr :: Integer
xr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s Integer
s Integer -> Integer -> Integer
`addF2m` Integer
s Integer -> Integer -> Integer
`addF2m` Integer
a
            yr :: Integer
yr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
xp Integer
xp Integer -> Integer -> Integer
`addF2m` Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
xr (Integer
s Integer -> Integer -> Integer
`addF2m` Integer
1)
        Point -> Maybe Point
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
  where
    a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc

-- | Elliptic curve point multiplication using the base
--
-- On P-256 this reaches the C implementation, which multiplies the base point
-- through a table of its own.
--
-- /WARNING:/ On every other curve, vulnerable to timing attacks.
pointBaseMul :: Curve -> Integer -> Point
pointBaseMul :: Curve -> Integer -> Point
pointBaseMul Curve
c Integer
n = Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n (CurveCommon -> Point
ecc_g (CurveCommon -> Point) -> CurveCommon -> Point
forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
common_curve Curve
c)

-- | Elliptic curve point multiplication.
--
-- Over a prime field this goes to C, four bits of scalar at a time, with the
-- multiple to add taken from a table read by touching every entry of it.
-- Over a binary field it also goes to C, as Montgomery's ladder: it carries
-- the x coordinates of two consecutive multiples -- their difference being
-- the point is what lets it carry no more than that -- and spends one
-- addition and one doubling on every bit whichever way the bit goes, with the
-- two exchanged by a mask rather than chosen by a branch.  Either way the work
-- follows the width of the curve's order and not the scalar.
--
-- What falls back on the 'Integer' arithmetic below is a point that is not on
-- the curve, the one point of a binary curve that has no x, and a prime the C
-- will not take.
--
-- Multiplying the base point of a curve over a prime field -- which is what
-- signing and making a key do, and nothing else does -- goes through a table
-- of its multiples, built when that curve is first asked for one and kept
-- afterwards.  The build is a few milliseconds and the table a few hundred
-- kilobytes, and a multiplication that uses it takes about a third of what
-- one without it takes.
--
-- On P-256 the multiplication goes to the C implementation in
-- "Crypto.PubKey.ECC.P256", which has a table for the base point.
--
-- /WARNING:/ What is left of the 'Integer' arithmetic below -- a point off
-- the curve, the one point of a binary curve with no x, a prime or a
-- polynomial the C will not take -- has uniform operation counts at best, and
-- uniform operation counts are not constant time: those operations cost what
-- the values they are given cost.
pointMul :: Curve -> Integer -> Point -> Point
pointMul :: Curve -> Integer -> Point -> Point
pointMul Curve
_ Integer
_ Point
PointO = Point
PointO
pointMul Curve
c Integer
n Point
p
    -- the base point has a table of its own in the C, which is what makes key
    -- generation and signing quicker than multiplying any other point
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve
    , Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p256Base =
        Point -> (Scalar -> Point) -> Maybe Scalar -> Point
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Point
PointO (Point -> Point
fromP256 (Point -> Point) -> (Scalar -> Point) -> Scalar -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> Point
P256.toPoint) (Integer -> Maybe Scalar
toP256Scalar Integer
n)
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve
    , Just Point
q <- Point -> Maybe Point
toP256 Point
p =
        Point -> (Scalar -> Point) -> Maybe Scalar -> Point
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Point
PointO (\Scalar
s -> Point -> Point
fromP256 (Scalar -> Point -> Point
P256.pointMul Scalar
s Point
q)) (Integer -> Maybe Scalar
toP256Scalar Integer
n)
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Curve -> Integer -> Point -> Point
pointMul Curve
c (-Integer
n) (Curve -> Point -> Point
pointNegate Curve
c Point
p)
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Point
PointO
    | Bool
otherwise =
        case Curve
c of
            CurveFP (CurvePrime Integer
pr CurveCommon
cc) -> Integer -> CurveCommon -> Point
primeMul Integer
pr CurveCommon
cc
            CurveF2m (CurveBinary Integer
fx CurveCommon
cc) -> Integer -> CurveCommon -> Point
binaryMul Integer
fx CurveCommon
cc
  where
    -- The C answers for a point on the curve; anything else keeps the
    -- answers it has always had from the code below.  Multiplying the base
    -- point, which is what signing and making a key do, goes through the
    -- table kept for it.
    primeMul :: Integer -> CurveCommon -> Point
primeMul Integer
pr CurveCommon
cc = case Point
p of
        Point Integer
px Integer
py
            | Curve -> Point -> Bool
isPointValid Curve
c Point
p ->
                Point -> MulResult -> Point
answer Point
slow (MulResult -> Point) -> MulResult -> Point
forall a b. (a -> b) -> a -> b
$
                    CurveField
-> Integer -> Integer -> Integer -> Integer -> Bool -> MulResult
curveMul
                        (Integer -> Integer -> Integer -> CurveField
Prime Integer
pr (CurveCommon -> Integer
ecc_a CurveCommon
cc) (CurveCommon -> Integer
ecc_b CurveCommon
cc))
                        (CurveCommon -> Integer
ecc_n CurveCommon
cc)
                        Integer
n
                        Integer
px
                        Integer
py
                        (Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== CurveCommon -> Point
ecc_g CurveCommon
cc)
        Point
_ -> Point
slow
      where
        slow :: Point
slow =
            Integer -> Integer -> Int -> Integer -> Point -> Point
jacobianMul
                Integer
pr
                (CurveCommon -> Integer
ecc_a CurveCommon
cc)
                (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Integer -> Int
integerBits Integer
n) (Integer -> Int
integerBits (CurveCommon -> Integer
ecc_n CurveCommon
cc)))
                Integer
n
                Point
p

    -- The ladder answers for a point on the curve that has an x; the one
    -- point with no x, and anything off the curve, keep what they had.
    binaryMul :: Integer -> CurveCommon -> Point
binaryMul Integer
fx CurveCommon
cc = case Point
p of
        Point Integer
px Integer
py
            | Curve -> Point -> Bool
isPointValid Curve
c Point
p ->
                Point -> MulResult -> Point
answer (Integer -> Point -> Point
forall {t}. Integral t => t -> Point -> Point
affineMul Integer
n Point
p) (MulResult -> Point) -> MulResult -> Point
forall a b. (a -> b) -> a -> b
$
                    CurveField
-> Integer -> Integer -> Integer -> Integer -> Bool -> MulResult
curveMul (Integer -> Integer -> CurveField
Binary Integer
fx (CurveCommon -> Integer
ecc_b CurveCommon
cc)) (CurveCommon -> Integer
ecc_n CurveCommon
cc) Integer
n Integer
px Integer
py Bool
False
        Point
_ -> Integer -> Point -> Point
forall {t}. Integral t => t -> Point -> Point
affineMul Integer
n Point
p

    -- what the C could not take goes back to the code that was here before
    answer :: Point -> MulResult -> Point
answer Point
fallback MulResult
r = case MulResult
r of
        MulPoint Integer
x Integer
y -> Integer -> Integer -> Point
Point Integer
x Integer
y
        MulResult
MulInfinity -> Point
PointO
        MulResult
MulUnsupported -> Point
fallback

    affineMul :: t -> Point -> Point
affineMul t
k Point
q
        | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Point
PointO
        | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 = Point
q
        | t -> Bool
forall a. Integral a => a -> Bool
odd t
k = Curve -> Point -> Point -> Point
pointAdd Curve
c Point
q (t -> Point -> Point
affineMul (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Point
q)
        | Bool
otherwise = t -> Point -> Point
affineMul (t
k t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2) (Curve -> Point -> Point
pointDouble Curve
c Point
q)

-- | Number of bits needed to write n, for n > 0.
integerBits :: Integer -> Int
integerBits :: Integer -> Int
integerBits = Int -> Integer -> Int
forall {t} {t}. (Num t, Integral t) => t -> t -> t
go Int
0
  where
    go :: t -> t -> t
go t
acc t
0 = t
acc
    go t
acc t
k = t -> t -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
k t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2)

-- | A point in Jacobian coordinates: @(X, Y, Z)@ stands for the affine
-- @(X\/Z^2, Y\/Z^3)@, and @JPointO@ for the point at infinity.
data JPoint = JPointO | JPoint !Integer !Integer !Integer

-- | The field a prime curve works in, and how to reduce into it.
--
-- Most curve primes are @2^k - c@ with @c@ far smaller than the prime.
-- Reducing is then a shift, a multiplication by @c@ and an addition, where
-- dividing a number twice the width costs about four times as much: 227ns
-- against 183 for a P-384 multiplication, and 226 against 89 for P-521, whose
-- @c@ is one.
-- | The prime, the width to fold at, and what to fold back in.  A @c@ of zero
-- says to divide instead, either because the prime has no such shape or
-- because it is too small for folding to pay: @c@ has to be under half the
-- width, or folding would not shrink the number, and below 256 bits the
-- handful of 'Integer' operations folding takes costs more than the division
-- it saves -- measured on P-192, where folding is 14% slower.
data Field = Field !Integer !Int !Integer

mkField :: Integer -> Field
mkField :: Integer -> Field
mkField Integer
p
    | Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Integer -> Int
numBits Integer
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 = Integer -> Int -> Integer -> Field
Field Integer
p Int
k Integer
c
    | Bool
otherwise = Integer -> Int -> Integer -> Field
Field Integer
p Int
0 Integer
0
  where
    k :: Int
k = Integer -> Int
numBits Integer
p
    c :: Integer
c = (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
k) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
p

fieldPrime :: Field -> Integer
fieldPrime :: Field -> Integer
fieldPrime (Field Integer
p Int
_ Integer
_) = Integer
p

fieldReduce :: Field -> Integer -> Integer
fieldReduce :: Field -> Integer -> Integer
fieldReduce (Field Integer
p Int
k Integer
c) Integer
x
    | Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p
    | Bool
otherwise = Integer -> Integer
trim (Integer -> Integer
fold Integer
x)
  where
    mask :: Integer
mask = (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
k) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    fold :: Integer -> Integer
fold Integer
v
        | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
mask = Integer -> Integer
fold ((Integer
v Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
k) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
v Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask))
        | Bool
otherwise = Integer
v
    trim :: Integer -> Integer
trim Integer
v
        | Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p = Integer -> Integer
trim (Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
p)
        | Bool
otherwise = Integer
v
{-# INLINE fieldReduce #-}

-- | A point in affine coordinates: the second operand of every addition a
-- scalar multiplication makes, where knowing that z is one saves four
-- multiplications of the sixteen.
data Affine = AffineO | Affine !Integer !Integer

jacobianMul :: Integer -> Integer -> Int -> Integer -> Point -> Point
jacobianMul :: Integer -> Integer -> Int -> Integer -> Point -> Point
jacobianMul Integer
_ Integer
_ Int
_ Integer
_ Point
PointO = Point
PointO
jacobianMul Integer
pr Integer
a Int
bits Integer
n (Point Integer
px Integer
py) = Field -> JPoint -> Point
fromJacobian Field
f (Int -> JPoint -> JPoint
go (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) JPoint
JPointO)
  where
    f :: Field
f = Integer -> Field
mkField Integer
pr
    base :: Affine
base = Integer -> Integer -> Affine
Affine Integer
px Integer
py

    -- The bangs are what make the addition happen at every bit.  Without
    -- them the one that is not taken stays a thunk and is never worked out,
    -- so the multiplication costs a step for every bit that is set rather
    -- than for every bit there is, and a single measurement tells an attacker
    -- how many bits of the scalar are set.
    go :: Int -> JPoint -> JPoint
go Int
i JPoint
acc
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = JPoint
acc
        | Bool
otherwise =
            let !d :: JPoint
d = Field -> Integer -> JPoint -> JPoint
jDouble Field
f Integer
a JPoint
acc
                !s :: JPoint
s = Field -> Integer -> JPoint -> Affine -> JPoint
jAddAffine Field
f Integer
a JPoint
d Affine
base
             in Int -> JPoint -> JPoint
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
n Int
i then JPoint
s else JPoint
d)

jDouble :: Field -> Integer -> JPoint -> JPoint
jDouble :: Field -> Integer -> JPoint -> JPoint
jDouble Field
_ Integer
_ JPoint
JPointO = JPoint
JPointO
jDouble Field
f Integer
a (JPoint Integer
x Integer
y Integer
z)
    | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = JPoint
JPointO
    | Bool
otherwise = Integer -> Integer -> Integer -> JPoint
JPoint Integer
x3 Integer
y3 Integer
z3
  where
    red :: Integer -> Integer
red = Field -> Integer -> Integer
fieldReduce Field
f
    yy :: Integer
yy = Integer -> Integer
red (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)
    delta :: Integer
delta = Integer -> Integer
red (Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
yy)
    zz :: Integer
zz = Integer -> Integer
red (Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z)
    m :: Integer
m = Integer -> Integer
red (Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zz Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zz)
    x3 :: Integer
x3 = Integer -> Integer
red (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
delta)
    y3 :: Integer
y3 = Integer -> Integer
red (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
delta Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x3) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
yy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
yy)
    z3 :: Integer
z3 = Integer -> Integer
red (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z)

-- | Add a point whose z is one, which is what a scalar multiplication always
-- adds: u1 is x1, s1 is y1, and z3 is one multiplication rather than two.
jAddAffine :: Field -> Integer -> JPoint -> Affine -> JPoint
jAddAffine :: Field -> Integer -> JPoint -> Affine -> JPoint
jAddAffine Field
_ Integer
_ JPoint
p Affine
AffineO = JPoint
p
jAddAffine Field
_ Integer
_ JPoint
JPointO (Affine Integer
x2 Integer
y2) = Integer -> Integer -> Integer -> JPoint
JPoint Integer
x2 Integer
y2 Integer
1
jAddAffine Field
f Integer
a p :: JPoint
p@(JPoint Integer
x1 Integer
y1 Integer
z1) (Affine Integer
x2 Integer
y2)
    | Integer
h Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = Integer -> Integer -> Integer -> JPoint
JPoint Integer
x3 Integer
y3 Integer
z3
    | Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = JPoint
JPointO
    | Bool
otherwise = Field -> Integer -> JPoint -> JPoint
jDouble Field
f Integer
a JPoint
p
  where
    red :: Integer -> Integer
red = Field -> Integer -> Integer
fieldReduce Field
f
    z1s :: Integer
z1s = Integer -> Integer
red (Integer
z1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1)
    u2 :: Integer
u2 = Integer -> Integer
red (Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1s)
    s2 :: Integer
s2 = Integer -> Integer
red (Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1)
    h :: Integer
h = Integer -> Integer
red (Integer
u2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x1)
    r :: Integer
r = Integer -> Integer
red (Integer
s2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y1)
    h2 :: Integer
h2 = Integer -> Integer
red (Integer
h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
h)
    h3 :: Integer
h3 = Integer -> Integer
red (Integer
h2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
h)
    x3 :: Integer
x3 = Integer -> Integer
red (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
h3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
h2)
    y3 :: Integer
y3 = Integer -> Integer
red (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
h2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x3) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
h3)
    z3 :: Integer
z3 = Integer -> Integer
red (Integer
h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1)

fromJacobian :: Field -> JPoint -> Point
fromJacobian :: Field -> JPoint -> Point
fromJacobian Field
_ JPoint
JPointO = Point
PointO
fromJacobian Field
f (JPoint Integer
x Integer
y Integer
z) =
    case Integer -> Integer -> Maybe Integer
inverse Integer
z (Field -> Integer
fieldPrime Field
f) of
        Maybe Integer
Nothing -> Point
PointO
        Just Integer
zi ->
            let red :: Integer -> Integer
red = Field -> Integer -> Integer
fieldReduce Field
f
                zi2 :: Integer
zi2 = Integer -> Integer
red (Integer
zi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zi)
             in Integer -> Integer -> Point
Point (Integer -> Integer
red (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zi2)) (Integer -> Integer
red (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zi2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
zi))

-- | Elliptic curve double-scalar multiplication.
--
-- > pointAddTwoMuls c n1 p1 n2 p2 == pointAdd c (pointMul c n1 p1)
-- >                                             (pointMul c n2 p2)
--
-- which, apart from P-256, is how it is done: the two multiplications
-- separately, and then one addition.  P-256 has a double multiplication of
-- its own in C and takes it.
--
-- This used to be Shamir's trick, one pass over the bits of both scalars at
-- once, which shares the doublings between them and is the right thing to do
-- when the two multiplications would cost the same.  They no longer do.
-- 'pointMul' goes to C, and over a prime field it multiplies the base point
-- through a table of its multiples, which is a third of the price of an
-- ordinary multiplication -- and the base point is one of the two here, since
-- signature verification is what asks for this.  Sharing the doublings with a
-- pass in 'Integer' arithmetic gives that up and more: on P-384 it costs
-- twice what two multiplications in C cost, and on the curves over a binary
-- field, whose addition needs an inversion where the C has a ladder that
-- needs none, it costs two hundred times as much.
--
-- Both scalars are public wherever this is called from, so nothing here is
-- meant to hide them.
--
-- /WARNING:/ Vulnerable to timing attacks.
pointAddTwoMuls :: Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls :: Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls Curve
c Integer
n1 Point
p1 Integer
n2 Point
p2
    | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== Curve
p256Curve, Just Point
r <- Integer -> Point -> Integer -> Point -> Maybe Point
p256AddTwoMuls Integer
n1 Point
p1 Integer
n2 Point
p2 = Point
r
    | Bool
otherwise = Curve -> Point -> Point -> Point
pointAdd Curve
c (Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n1 Point
p1) (Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n2 Point
p2)

-- | Decompose a point into index, residue, and parity.
--
-- Adapted from SEC 1: Elliptic Curve Cryptography, Version 2.0, section 2.3.3.
pointDecompose :: Curve -> Point -> Maybe (Integer, Integer, Bool)
pointDecompose :: Curve -> Point -> Maybe (Integer, Integer, Bool)
pointDecompose Curve
_ Point
PointO = Maybe (Integer, Integer, Bool)
forall a. Maybe a
Nothing
pointDecompose Curve
curve (Point Integer
x Integer
y) = do
    let CurveCommon Integer
_ Integer
_ Point
_ Integer
n Integer
_ = Curve -> CurveCommon
common_curve Curve
curve
    let (Integer
index, Integer
residue) = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
n
    Bool
parity <- case Curve
curve of
        CurveFP CurvePrime
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
y
        CurveF2m CurveBinary
_ | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        CurveF2m (CurveBinary Integer
fx CurveCommon
_) -> Integer -> Bool
forall a. Integral a => a -> Bool
odd (Integer -> Bool) -> Maybe Integer -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx Integer
y Integer
x
    (Integer, Integer, Bool) -> Maybe (Integer, Integer, Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
index, Integer
residue, Bool
parity)

-- | Compose a point from index, residue, and parity.
--
-- Adapted from SEC 1: Elliptic Curve Cryptography, Version 2.0, section 2.3.4.
pointCompose :: Curve -> Integer -> Integer -> Bool -> Maybe Point
pointCompose :: Curve -> Integer -> Integer -> Bool -> Maybe Point
pointCompose Curve
curve Integer
index Integer
residue Bool
parity = do
    let CurveCommon Integer
a Integer
b Point
_ Integer
n Integer
_ = Curve -> CurveCommon
common_curve Curve
curve
    let x :: Integer
x = Integer
residue Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
index Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n
    Integer
y <- case Curve
curve of
        CurveFP (CurvePrime Integer
p CurveCommon
_) -> do
            Integer
z <- Integer -> Integer -> Maybe Integer
squareRoot Integer
p (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b
            Integer -> Maybe Integer
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
z Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
parity then Integer
z else Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
z
        CurveF2m (CurveBinary Integer
fx CurveCommon
_) | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Integer -> Maybe Integer
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
sqrtF2m Integer
fx Integer
b
        CurveF2m (CurveBinary Integer
fx CurveCommon
_) -> do
            Integer
c <- Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx Integer
b (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
squareF2m Integer
fx Integer
x
            Integer
z <- Integer -> Integer -> Maybe Integer
quadraticF2m Integer
fx (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
addF2m Integer
x (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
addF2m Integer
a Integer
c
            Integer -> Maybe Integer
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
x (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
z Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
parity then Integer
z else Integer -> Integer -> Integer
addF2m Integer
1 Integer
z
    Point -> Maybe Point
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
x Integer
y

-- | Check if a point is the point at infinity.
isPointAtInfinity :: Point -> Bool
isPointAtInfinity :: Point -> Bool
isPointAtInfinity Point
PointO = Bool
True
isPointAtInfinity Point
_ = Bool
False

-- | check if a point is on specific curve
--
-- This perform three checks:
--
-- * x is not out of range
-- * y is not out of range
-- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds
--
-- over a prime curve, and the corresponding checks over a binary curve: the
-- coordinates reduce to themselves in the field, and
-- @y^2 + x*y = x^3 + a*x^2 + b@ holds.
--
-- This is the check to make on a point that arrives from elsewhere, before
-- multiplying it by a private number.  Without it the multiplication is
-- carried out in whatever group the supplied point generates rather than the
-- curve group, and if that group is small the private number can be recovered
-- from the result.
--
-- Two things it does not establish:
--
-- * The point at infinity is reported as valid, since it is a member of the
--   curve group.  It is not a usable peer value: multiplying it by anything
--   yields the point at infinity again, which has no coordinates.  Reject it
--   separately where a peer is not allowed to send it.
--
-- * Being on the curve is not membership of the subgroup generated by the base
--   point.  The two coincide only when the cofactor is 1.  Of the curves in
--   'Crypto.PubKey.ECC.Types.CurveName' that holds for every prime curve
--   except @SEC_p112r2@ and @SEC_p128r2@, whose cofactor is 4, and for no
--   binary curve, whose cofactor is 2 or 4.  Where the cofactor is above 1 a
--   point on the curve may still generate a small subgroup, and ruling that
--   out needs a further check -- multiplying by the group order and requiring
--   the point at infinity, or clearing the cofactor -- that this function does
--   not make.
isPointValid :: Curve -> Point -> Bool
isPointValid :: Curve -> Point -> Bool
isPointValid Curve
_ Point
PointO = Bool
True
isPointValid (CurveFP (CurvePrime Integer
p CurveCommon
cc)) (Point Integer
x Integer
y) =
    Integer -> Bool
isValid Integer
x Bool -> Bool -> Bool
&& Integer -> Bool
isValid Integer
y Bool -> Bool -> Bool
&& (Integer
y Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) Integer -> Integer -> Bool
`eqModP` (Integer
x Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)
  where
    a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
    b :: Integer
b = CurveCommon -> Integer
ecc_b CurveCommon
cc
    eqModP :: Integer -> Integer -> Bool
eqModP Integer
z1 Integer
z2 = (Integer
z1 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
z2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p)
    isValid :: Integer -> Bool
isValid Integer
e = Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
p
isPointValid (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
x Integer
y) =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ Integer -> Bool
isValid Integer
x
        , Integer -> Bool
isValid Integer
y
        , ((((Integer
x Integer -> Integer -> Integer
`add` Integer
a) Integer -> Integer -> Integer
`mul` Integer
x Integer -> Integer -> Integer
`add` Integer
y) Integer -> Integer -> Integer
`mul` Integer
x) Integer -> Integer -> Integer
`add` Integer
b Integer -> Integer -> Integer
`add` (Integer -> Integer -> Integer
squareF2m Integer
fx Integer
y)) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        ]
  where
    a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
    b :: Integer
b = CurveCommon -> Integer
ecc_b CurveCommon
cc
    add :: Integer -> Integer -> Integer
add = Integer -> Integer -> Integer
addF2m
    mul :: Integer -> Integer -> Integer
mul = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx
    isValid :: Integer -> Bool
isValid Integer
e = Integer -> Integer -> Integer
modF2m Integer
fx Integer
e Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
e

-- | Check that a point is in the subgroup the base point generates, which is
-- the further check 'isPointValid' does not make.  A point that is on the
-- curve but outside that subgroup answers a multiplication modulo an order
-- smaller than the group's, so the multiplier -- a private number, where the
-- point came from a peer -- is revealed modulo that small order.
--
-- Where the cofactor is 1 the subgroup is the whole curve group and the
-- answer is 'True' for any point on the curve, at no cost.  Otherwise the
-- point is multiplied by the group order and the answer is whether that
-- reaches the point at infinity, which costs one scalar multiplication.  This
-- is the check OpenSSL's @EC_KEY_check_key@ makes.
--
-- The point at infinity is reported as in the subgroup, as 'isPointValid'
-- reports it valid; it is a member, and unusable for other reasons.
--
-- A point that is not on the curve at all has no meaningful answer here, so
-- check 'isPointValid' first.
isPointInSubgroup :: Curve -> Point -> Bool
isPointInSubgroup :: Curve -> Point -> Bool
isPointInSubgroup Curve
curve Point
p
    | CurveCommon -> Integer
ecc_h CurveCommon
cc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Bool
True
    | Bool
otherwise = Curve -> Integer -> Point -> Point
pointMul Curve
curve (CurveCommon -> Integer
ecc_n CurveCommon
cc) Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
PointO
  where
    cc :: CurveCommon
cc = Curve -> CurveCommon
common_curve Curve
curve

-- | div and mod
divmod :: Integer -> Integer -> Integer -> Maybe Integer
divmod :: Integer -> Integer -> Integer -> Maybe Integer
divmod Integer
y Integer
x Integer
m = do
    Integer
i <- Integer -> Integer -> Maybe Integer
inverse (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m) Integer
m
    Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m