betrusted-ed25519-verified/verification/Proofs/ScalarFullMulSpec.lean

/- ──────────────────────────────────────────────────────────────────────────────
   Proofs/ScalarFullMulSpec.lean — Scalar52 multiplication, phase C: `mul`.

   `mul a b` composes the proven pieces (scalar.rs:302-305):
       mul_internal a b            — nine exact schoolbook columns (phase A)
       montgomery_reduce           — ⟦ab'⟧·R = a·b with R = 2^260 (phase B)
       mul_internal ab' RR         — columns against RR ≡ R² (mod ℓ)
       montgomery_reduce           — ⟦r⟧·R = ⟦ab'⟧·R²  ⟹  ⟦r⟧ = ⟦ab'⟧·R
   so ⟦r⟧·R = ⟦ab'⟧·R·R = (⟦a⟧·⟦b⟧)·R, and R = 2^260 is a unit in ZMod ℓ
   (ℓ is odd), giving  ⟦mul a b⟧ = ⟦a⟧ · ⟦b⟧.

   The first reduction carries the honest Montgomery hypothesis
   scVal a · scVal b < 2^260·ℓ (canonical inputs satisfy it: ℓ² < 2^260·ℓ);
   the second needs nothing extra because scVal RR < ℓ.
   ────────────────────────────────────────────────────────────────────────────── -/
import Proofs.ScalarReduceSpec
open Aeneas Aeneas.Std Result
open curve25519_dalek

set_option maxHeartbeats 8000000
set_option linter.unusedSimpArgs false
set_option exponentiation.threshold 600

namespace ScalarProofs

open Aeneas.Std.WP

/-! ### The RR constant: RR ≡ R² = 2^520 (mod ℓ) -/

/-- The transpiled `constants::RR` as a limb list. -/
theorem RR_limbs :
    (↑backend.serial.u64.constants.RR : List U64) =
      [2764609938444603#u64, 3768881411696287#u64, 1616719297148420#u64,
       1087343033131391#u64, 10175238647962#u64] := by
  unfold backend.serial.u64.constants.RR
  rfl

/-- The value of the transpiled RR constant. -/
theorem RR_scVal : scVal backend.serial.u64.constants.RR
    = 4185850391763183796333492317919282507600454137915443218209456916606550724923 := by
  rw [scVal_eq _ _ _ _ _ _ RR_limbs]
  unfold scLimbs
  norm_num

/-- RR is canonical (below ℓ). -/
theorem RR_lt : scVal backend.serial.u64.constants.RR < Ell := by
  rw [RR_scVal]; unfold Ell; norm_num

/-- **RR denotes R² = 2^520 in ZMod ℓ** — the exact division witness
    2^520 = RR + K·ℓ is kernel-checked literal arithmetic. -/
theorem RR_denote :
    ((4185850391763183796333492317919282507600454137915443218209456916606550724923 : ℕ)
      : ZMod Ell) = 2^520 := by
  have h : (2:ℕ)^520
      = 4185850391763183796333492317919282507600454137915443218209456916606550724923
        + 474284397516047136454946754595585670565175736652605875744292671501348828217547577
          * Ell := by
    unfold Ell; norm_num
  have hc := congrArg (Nat.cast (R := ZMod Ell)) h
  push_cast at hc
  -- push_cast evaluates 2^520 to its literal and kills the ↑Ell factor:
  -- hc : (2^520-literal : ZMod Ell) = RR + K·0
  have h2 : ((2:ZMod Ell))^520
      = (3432398830065304857490950399540696608634717650071652704697231729592771591698828026061279820330727277488648155695740429018560993999858321906287014145557528576 : ZMod Ell) := by norm_num
  rw [h2]
  push_cast
  rw [hc, ZMod.natCast_self Ell]
  ring

/-- 2^260 is a unit in ZMod ℓ (ℓ is odd). -/
theorem R_isUnit : IsUnit ((2 : ZMod Ell)^260) := by
  have hcop : Nat.Coprime 2 Ell := by
    unfold Ell
    norm_num
    exact ⟨3618502788666131106986593281521497120428558179689953803000975469142727125494,
           by norm_num⟩
  have h2 : IsUnit ((2 : ℕ) : ZMod Ell) := (ZMod.isUnit_iff_coprime 2 Ell).mpr hcop
  have h2' : IsUnit (2 : ZMod Ell) := by simpa using h2
  exact h2'.pow 260

/-- 52-bit product bound (both factors 52-bit). -/
theorem col_bound {x y : ℕ} (hx : x < 2^52) (hy : y < 2^52) : x * y < 2^104 := by
  have h := Nat.mul_lt_mul'' hx hy
  omega

/-! ### The full multiplication -/

/-- **Scalar multiplication is correct mod ℓ.** For limb-bounded inputs
    under the Montgomery hypothesis scVal a · scVal b < 2^260·ℓ (canonical
    inputs always satisfy it), the transpiled `Scalar52::mul` denotes
    ⟦a⟧·⟦b⟧ in ZMod ℓ, with a 52-bit-bounded limb representation. -/
theorem mul_spec (a b : Sc)
    (a0 a1 a2 a3 a4 b0 b1 b2 b3 b4 : U64)
    (ha : (↑a : List U64) = [a0, a1, a2, a3, a4])
    (hb : (↑b : List U64) = [b0, b1, b2, b3, b4])
    (hab : a0.val < 2^52 ∧ a1.val < 2^52 ∧ a2.val < 2^52 ∧ a3.val < 2^52 ∧ a4.val < 2^52)
    (hbb : b0.val < 2^52 ∧ b1.val < 2^52 ∧ b2.val < 2^52 ∧ b3.val < 2^52 ∧ b4.val < 2^52)
    (hcab : scVal a * scVal b < 2^260 * Ell) :
    backend.serial.u64.scalar.Scalar52.mul a b
      ⦃ r => (∃ s0 s1 s2 s3 s4 : U64, (↑r : List U64) = [s0, s1, s2, s3, s4] ∧
              s0.val < 2^52 ∧ s1.val < 2^52 ∧ s2.val < 2^52 ∧ s3.val < 2^52 ∧
              s4.val < 2^52) ∧
            scVal r < Ell ∧
            scDenote r = scDenote a * scDenote b ⦄ := by
  obtain ⟨hA0, hA1, hA2, hA3, hA4⟩ := hab
  obtain ⟨hB0, hB1, hB2, hB3, hB4⟩ := hbb
  unfold backend.serial.u64.scalar.Scalar52.mul
  -- ── columns of a·b ──
  apply spec_bind (mul_internal_spec a b a0 a1 a2 a3 a4 b0 b1 b2 b3 b4 ha hb
      ⟨hA0, hA1, hA2, hA3, hA4, hB0, hB1, hB2, hB3, hB4⟩)
  rintro zz ⟨z0, z1, z2, z3, z4, z5, z6, z7, z8, hzl,
    hz0e, hz1e, hz2e, hz3e, hz4e, hz5e, hz6e, hz7e, hz8e⟩
  show (do
    let ab ← backend.serial.u64.scalar.Scalar52.montgomery_reduce zz
    let a2 ← backend.serial.u64.scalar.Scalar52.mul_internal ab
      backend.serial.u64.constants.RR
    backend.serial.u64.scalar.Scalar52.montgomery_reduce a2)
    ⦃ r => (∃ s0 s1 s2 s3 s4 : U64, (↑r : List U64) = [s0, s1, s2, s3, s4] ∧
            s0.val < 2^52 ∧ s1.val < 2^52 ∧ s2.val < 2^52 ∧ s3.val < 2^52 ∧
            s4.val < 2^52) ∧
          scVal r < Ell ∧
          scDenote r = scDenote a * scDenote b ⦄
  -- column bounds and the column value identity
  have hzb0 : z0.val < 2^107 := by
    have := col_bound hA0 hB0; omega
  have hzb1 : z1.val < 2^107 := by
    have := col_bound hA0 hB1; have := col_bound hA1 hB0; omega
  have hzb2 : z2.val < 2^107 := by
    have := col_bound hA0 hB2; have := col_bound hA1 hB1
    have := col_bound hA2 hB0; omega
  have hzb3 : z3.val < 2^107 := by
    have := col_bound hA0 hB3; have := col_bound hA1 hB2
    have := col_bound hA2 hB1; have := col_bound hA3 hB0; omega
  have hzb4 : z4.val < 2^107 := by
    have := col_bound hA0 hB4; have := col_bound hA1 hB3
    have := col_bound hA2 hB2; have := col_bound hA3 hB1
    have := col_bound hA4 hB0; omega
  have hzb5 : z5.val < 2^107 := by
    have := col_bound hA1 hB4; have := col_bound hA2 hB3
    have := col_bound hA3 hB2; have := col_bound hA4 hB1; omega
  have hzb6 : z6.val < 2^107 := by
    have := col_bound hA2 hB4; have := col_bound hA3 hB3
    have := col_bound hA4 hB2; omega
  have hzb7 : z7.val < 2^107 := by
    have := col_bound hA3 hB4; have := col_bound hA4 hB3; omega
  have hzb8 : z8.val < 2^107 := by
    have := col_bound hA4 hB4; omega
  have hZval : z0.val + 2^52 * z1.val + 2^104 * z2.val + 2^156 * z3.val
      + 2^208 * z4.val + 2^260 * z5.val + 2^312 * z6.val + 2^364 * z7.val
      + 2^416 * z8.val = scVal a * scVal b := by
    rw [hz0e, hz1e, hz2e, hz3e, hz4e, hz5e, hz6e, hz7e, hz8e,
        scVal_eq a a0 a1 a2 a3 a4 ha, scVal_eq b b0 b1 b2 b3 b4 hb]
    unfold scLimbs
    ring
  have hZlt : z0.val + 2^52 * z1.val + 2^104 * z2.val + 2^156 * z3.val
      + 2^208 * z4.val + 2^260 * z5.val + 2^312 * z6.val + 2^364 * z7.val
      + 2^416 * z8.val < 2^260 * Ell := by rw [hZval]; exact hcab
  -- ── first reduction: ⟦ab'⟧·R = a·b ──
  apply spec_bind (montgomery_reduce_spec zz z0 z1 z2 z3 z4 z5 z6 z7 z8 hzl
      ⟨hzb0, hzb1, hzb2, hzb3, hzb4, hzb5, hzb6, hzb7, hzb8⟩ hZlt)
  rintro ab ⟨⟨ab0, ab1, ab2, ab3, ab4, habl, hab0, hab1, hab2, hab3, hab4⟩, habc, habd⟩
  show (do
    let a2 ← backend.serial.u64.scalar.Scalar52.mul_internal ab
      backend.serial.u64.constants.RR
    backend.serial.u64.scalar.Scalar52.montgomery_reduce a2)
    ⦃ r => (∃ s0 s1 s2 s3 s4 : U64, (↑r : List U64) = [s0, s1, s2, s3, s4] ∧
            s0.val < 2^52 ∧ s1.val < 2^52 ∧ s2.val < 2^52 ∧ s3.val < 2^52 ∧
            s4.val < 2^52) ∧
          scVal r < Ell ∧
          scDenote r = scDenote a * scDenote b ⦄
  -- RR limb values
  have hR0 : (2764609938444603#u64).val = 2764609938444603 := by rfl
  have hR1 : (3768881411696287#u64).val = 3768881411696287 := by rfl
  have hR2 : (1616719297148420#u64).val = 1616719297148420 := by rfl
  have hR3 : (1087343033131391#u64).val = 1087343033131391 := by rfl
  have hR4 : (10175238647962#u64).val = 10175238647962 := by rfl
  -- ── columns of ab'·RR ──
  apply spec_bind (mul_internal_spec ab backend.serial.u64.constants.RR
      ab0 ab1 ab2 ab3 ab4
      (2764609938444603#u64) (3768881411696287#u64) (1616719297148420#u64)
      (1087343033131391#u64) (10175238647962#u64)
      habl RR_limbs
      ⟨hab0, hab1, hab2, hab3, hab4,
       by rw [hR0]; norm_num, by rw [hR1]; norm_num, by rw [hR2]; norm_num,
       by rw [hR3]; norm_num, by rw [hR4]; norm_num⟩)
  rintro ww ⟨w0, w1, w2, w3, w4, w5, w6, w7, w8, hwl,
    hw0e, hw1e, hw2e, hw3e, hw4e, hw5e, hw6e, hw7e, hw8e⟩
  show backend.serial.u64.scalar.Scalar52.montgomery_reduce ww
    ⦃ r => (∃ s0 s1 s2 s3 s4 : U64, (↑r : List U64) = [s0, s1, s2, s3, s4] ∧
            s0.val < 2^52 ∧ s1.val < 2^52 ∧ s2.val < 2^52 ∧ s3.val < 2^52 ∧
            s4.val < 2^52) ∧
          scVal r < Ell ∧
          scDenote r = scDenote a * scDenote b ⦄
  simp only [hR0, hR1, hR2, hR3, hR4] at hw0e hw1e hw2e hw3e hw4e hw5e hw6e hw7e hw8e
  -- column bounds (RR limbs are literals below 2^52: linear, omega-cheap)
  have hwb0 : w0.val < 2^107 := by omega
  have hwb1 : w1.val < 2^107 := by omega
  have hwb2 : w2.val < 2^107 := by omega
  have hwb3 : w3.val < 2^107 := by omega
  have hwb4 : w4.val < 2^107 := by omega
  have hwb5 : w5.val < 2^107 := by omega
  have hwb6 : w6.val < 2^107 := by omega
  have hwb7 : w7.val < 2^107 := by omega
  have hwb8 : w8.val < 2^107 := by omega
  have hsvab : scVal ab = scLimbs ab0 ab1 ab2 ab3 ab4 :=
    scVal_eq ab ab0 ab1 ab2 ab3 ab4 habl
  have hWval : w0.val + 2^52 * w1.val + 2^104 * w2.val + 2^156 * w3.val
      + 2^208 * w4.val + 2^260 * w5.val + 2^312 * w6.val + 2^364 * w7.val
      + 2^416 * w8.val
      = scVal ab
        * 4185850391763183796333492317919282507600454137915443218209456916606550724923 := by
    rw [hw0e, hw1e, hw2e, hw3e, hw4e, hw5e, hw6e, hw7e, hw8e, hsvab]
    unfold scLimbs
    ring
  have hablt : scVal ab < 2^260 := by
    rw [hsvab]; unfold scLimbs; omega
  have hWlt : w0.val + 2^52 * w1.val + 2^104 * w2.val + 2^156 * w3.val
      + 2^208 * w4.val + 2^260 * w5.val + 2^312 * w6.val + 2^364 * w7.val
      + 2^416 * w8.val < 2^260 * Ell := by
    rw [hWval]
    have hRRE :
        (4185850391763183796333492317919282507600454137915443218209456916606550724923 : ℕ)
          < Ell := by unfold Ell; norm_num
    exact Nat.mul_lt_mul'' hablt hRRE
  -- ── second reduction and the R-cancellation ──
  apply spec_mono (montgomery_reduce_spec ww w0 w1 w2 w3 w4 w5 w6 w7 w8 hwl
      ⟨hwb0, hwb1, hwb2, hwb3, hwb4, hwb5, hwb6, hwb7, hwb8⟩ hWlt)
  intro r hr
  refine ⟨hr.1, hr.2.1, ?_⟩
  have hcW := congrArg (Nat.cast (R := ZMod Ell)) hWval
  push_cast at hcW
  have hcZ := congrArg (Nat.cast (R := ZMod Ell)) hZval
  push_cast at hcZ
  have hr2 := hr.2.2
  push_cast at hr2
  have habd2 := habd
  push_cast at habd2
  refine R_isUnit.mul_right_cancel ?_
  calc scDenote r * 2^260 = ((scVal ab : ℕ) : ZMod Ell)
          * ((4185850391763183796333492317919282507600454137915443218209456916606550724923 : ℕ)
              : ZMod Ell) := by
        rw [hr2]; push_cast; linear_combination hcW
    _ = ((scVal ab : ℕ) : ZMod Ell) * 2^520 := by rw [RR_denote]
    _ = (((scVal ab : ℕ) : ZMod Ell) * 2^260) * 2^260 := by ring
    _ = (((scVal a : ℕ) : ZMod Ell) * ((scVal b : ℕ) : ZMod Ell)) * 2^260 := by
        have hd : ((scVal ab : ℕ) : ZMod Ell) * 2^260
            = ((scVal a : ℕ) : ZMod Ell) * ((scVal b : ℕ) : ZMod Ell) := by
          simp only [scDenote] at habd2
          rw [habd2]; linear_combination hcZ
        rw [hd]
    _ = (scDenote a * scDenote b) * 2^260 := by simp only [scDenote]

end ScalarProofs