Define the spec of Weierstrass curves (#6)

Define the spec of Weierstrass curves

This is the start of work on P256.

1 files changed, 84 insertions, 0 deletions

diff --git a/src/Spec/WeierstrassCurve.v b/src/Spec/WeierstrassCurve.v
new file mode 100644
index 000000000..7ec5d99ec
--- /dev/null
+++ b/src/Spec/WeierstrassCurve.v
@@ -0,0 +1,84 @@
+Require Crypto.WeierstrassCurve.Pre.
+
+Module E.
+  Section WeierstrassCurves.
+    (* Short Weierstrass curves with addition laws. References:
+     * <https://hyperelliptic.org/EFD/g1p/auto-shortw.html>
+     * <https://cr.yp.to/talks/2007.06.07/slides.pdf>
+     * See also:
+     * <http://cs.ucsb.edu/~koc/ccs130h/2013/EllipticHyperelliptic-CohenFrey.pdf> (page 79)
+     *)
+
+    Context {F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv} `{Algebra.field F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv}.
+    Local Infix "=" := Feq : type_scope. Local Notation "a <> b" := (not (a = b)) : type_scope.
+    Local Infix "=?" := Algebra.eq_dec (at level 70, no associativity) : type_scope.
+    Local Notation "x =? y" := (Sumbool.bool_of_sumbool (Algebra.eq_dec x y)) : bool_scope.
+    Local Infix "+" := Fadd. Local Infix "*" := Fmul.
+    Local Infix "-" := Fsub. Local Infix "/" := Fdiv.
+    Local Notation "- x" := (Fopp x).
+    Local Notation "x ^ 2" := (x*x) (at level 30). Local Notation "x ^ 3" := (x*x^2) (at level 30).
+    Local Notation "'∞'" := unit : type_scope.
+    Local Notation "'∞'" := (inr tt) : core_scope.
+    Local Notation "0" := Fzero.  Local Notation "1" := Fone.
+    Local Notation "2" := (1+1). Local Notation "3" := (1+2). Local Notation "4" := (1+3).
+    Local Notation "8" := (1+(1+(1+(1+4)))). Local Notation "12" := (1+(1+(1+(1+8)))).
+    Local Notation "16" := (1+(1+(1+(1+12)))). Local Notation "20" := (1+(1+(1+(1+16)))).
+    Local Notation "24" := (1+(1+(1+(1+20)))). Local Notation "27" := (1+(1+(1+24))).
+
+    Local Notation "( x , y )" := (inl (pair x y)).
+    Local Open Scope core_scope.
+
+    Context {a b: F}.
+
+    (** N.B. We may require more conditions to prove that points form
+        a group under addition (associativity, in particular.  If
+        that's the case, more fields will be added to this class. *)
+    Class weierstrass_params :=
+      {
+        char_gt_2 : 2 <> 0;
+        char_ne_3 : 3 <> 0;
+        nonzero_discriminant : -(16) * (4 * a^3 + 27 * b^2) <> 0
+      }.
+    Context `{weierstrass_params}.
+
+    Definition point := { P | match P with
+                              | (x, y) => y^2 = x^3 + a*x + b
+                              | ∞ => True
+                              end }.
+    Definition coordinates (P:point) : (F*F + ∞) := proj1_sig P.
+
+    (** The following points are indeed on the curve -- see [WeierstrassCurve.Pre] for proof *)
+    Local Obligation Tactic :=
+      try solve [ Program.Tactics.program_simpl
+                | intros; apply (Pre.unifiedAdd'_onCurve _ _ (proj2_sig _) (proj2_sig _)) ].
+
+    Program Definition zero : point := ∞.
+
+    Program Definition add (P1 P2:point) : point
+      := exist
+           _
+           (match coordinates P1, coordinates P2 return _ with
+            | (x1, y1), (x2, y2) =>
+              if x1 =? x2 then
+                if y2 =? -y1 then          ∞
+                else                       ((3*x1^2+a)^2 / (2*y1)^2 - x1 - x1,
+                                             (2*x1+x1)*(3*x1^2+a) / (2*y1) - (3*x1^2+a)^3/(2*y1)^3-y1)
+              else                         ((y2-y1)^2 / (x2-x1)^2 - x1 - x2,
+                                             (2*x1+x2)*(y2-y1) / (x2-x1) - (y2-y1)^3 / (x2-x1)^3 - y1)
+            | ∞, ∞ =>                      ∞
+            | ∞, _ =>                      coordinates P2
+            | _, ∞ =>                      coordinates P1
+            end)
+           _.
+
+    Fixpoint mul (n:nat) (P : point) : point :=
+      match n with
+      | O => zero
+      | S n' => add P (mul n' P)
+      end.
+  End WeierstrassCurves.
+End E.
+
+Delimit Scope E_scope with E.
+Infix "+" := E.add : E_scope.
+Infix "*" := E.mul : E_scope.