mirror of
https://github.com/saymrwulf/betrusted-ed25519-verified.git
synced 2026-09-03 20:13:47 +00:00
mrwulf
a377ffc587
Canonicity pass (the layer is now closed under its own preconditions): - sub_val_spec post carries the exact value equation (exists beta <= 1, scVal r + scVal b = scVal a + ell*beta, with the underflow guard beta = 1 -> scVal a < scVal b) - add/montgomery_reduce/mul/aggregate posts all carry scVal r < ell: canonical inputs give canonical outputs everywhere. Needed because from_bytes_wide (hash-to-scalar) feeds Montgomery outputs into add. Hash-to-scalar foundation (toward Scalar::from_hash / EdDSA verify): - extraction scope + from_bytes_wide (brings constants::R); regenerated gen - source repos carry a documented Aeneas-compat patch: the bare `hi[4] = words[7] >> 20` extracts ill-typed at pin bf13c42e; masked (semantic no-op, words[7] >> 20 < 2^44) - Proofs/ScalarWideSpec.lean: R constant lemmas (R = 2^260 mod ell, witness 2^260 = R + 255*ell) and montgomery_mul_spec, the single Montgomery round: [r]*2^260 = [a]*[b], canonical bounded output check-scalar.sh: 10 proof files, 11 kernel audits, all exactly [propext, Classical.choice, Quot.sound]. Button pressed fresh: green.
295 lines
14 KiB
Text
295 lines
14 KiB
Text
/- ──────────────────────────────────────────────────────────────────────────────
|
||
Proofs/ScalarAddSpec.lean — Scalar52 addition mod ℓ (value + bounds)
|
||
|
||
WHAT THIS FILE CONTAINS
|
||
The value spec for the transpiled `Scalar52::add`: for limb-bounded,
|
||
canonical inputs (scVal < ℓ), `add a b` denotes ⟦a⟧ + ⟦b⟧ in ZMod ℓ.
|
||
|
||
RUST ANALOG (curve25519-dalek v5, scalar.rs:161-174)
|
||
let mut sum = Scalar52::ZERO; let mask = (1u64 << 52) - 1;
|
||
let mut carry: u64 = 0;
|
||
for i in 0..5 { carry = a[i] + b[i] + (carry >> 52); sum[i] = carry & mask; }
|
||
sum.sub(&constants::L) // conditional -ℓ canonicalization
|
||
Transpiled: `add` → `add_loop` (5 iterations) → `Scalar52.sub sum L`.
|
||
|
||
PROOF ARCHITECTURE
|
||
`add_loop_spec` mirrors ScalarSubSpec's cond_add_l unrolls (the carry
|
||
loop is the same shape with b's limbs in place of L's constants);
|
||
`add_telescope` (ScalarSubSpec) lifts the five carry equations to
|
||
scLimbs sum + 2^260·γ5 = scVal a + scVal b,
|
||
canonical inputs force γ5 = 0, and `sub_val_spec` with subtrahend L
|
||
(scVal L = ℓ ≤ ℓ — the ≤ hypothesis exists precisely for this call)
|
||
finishes: ⟦sub sum L⟧ = ⟦sum⟧ − ⟦L⟧ = ⟦a⟧ + ⟦b⟧ − 0.
|
||
|
||
ROLE IN THE PYRAMID
|
||
With sub (ScalarSubSpec), gives ℤ/ℓ its verified + and −.
|
||
────────────────────────────────────────────────────────────────────────────── -/
|
||
import Proofs.ScalarSubSpec
|
||
open Aeneas Aeneas.Std Result
|
||
open curve25519_dalek
|
||
|
||
set_option maxHeartbeats 4000000
|
||
set_option linter.unusedSimpArgs false
|
||
set_option exponentiation.threshold 300
|
||
|
||
namespace ScalarProofs
|
||
|
||
open Aeneas.Std.WP
|
||
|
||
/-- The addition carry loop, unrolled: five limbs of masked sums with the
|
||
carry chain, per-limb equations r_i + 2^52·γ_(i+1) = a_i + b_i + γ_i. -/
|
||
theorem add_loop_spec (a b : Sc) (mask : U64)
|
||
(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])
|
||
(hmask : mask.val = 2^52 - 1)
|
||
(hbnd : a0.val < 2^52 ∧ a1.val < 2^52 ∧ a2.val < 2^52 ∧ a3.val < 2^52 ∧ a4.val < 2^52 ∧
|
||
b0.val < 2^52 ∧ b1.val < 2^52 ∧ b2.val < 2^52 ∧ b3.val < 2^52 ∧ b4.val < 2^52) :
|
||
backend.serial.u64.scalar.Scalar52.add_loop
|
||
{ start := 0#usize, «end» := 5#usize } a b
|
||
backend.serial.u64.scalar.Scalar52.ZERO mask 0#u64
|
||
⦃ (s : Sc) => ∃ r0 r1 r2 r3 r4 : U64, ∃ γ1 γ2 γ3 γ4 γ5 : ℕ,
|
||
(↑s : List U64) = [r0, r1, r2, r3, r4] ∧
|
||
γ1 ≤ 1 ∧ γ2 ≤ 1 ∧ γ3 ≤ 1 ∧ γ4 ≤ 1 ∧ γ5 ≤ 1 ∧
|
||
r0.val < 2^52 ∧ r1.val < 2^52 ∧ r2.val < 2^52 ∧ r3.val < 2^52 ∧ r4.val < 2^52 ∧
|
||
r0.val + 2^52 * γ1 = a0.val + b0.val ∧
|
||
r1.val + 2^52 * γ2 = a1.val + b1.val + γ1 ∧
|
||
r2.val + 2^52 * γ3 = a2.val + b2.val + γ2 ∧
|
||
r3.val + 2^52 * γ4 = a3.val + b3.val + γ3 ∧
|
||
r4.val + 2^52 * γ5 = a4.val + b4.val + γ4 ⦄ := by
|
||
obtain ⟨hA0, hA1, hA2, hA3, hA4, hB0, hB1, hB2, hB3, hB4⟩ := hbnd
|
||
have hmaskv : mask.val = 2^52 - 1 := hmask
|
||
unfold backend.serial.u64.scalar.Scalar52.add_loop
|
||
-- Iteration 1 (i = 0)
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexUsizeU64.index,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexMutUsizeU64.index_mut,
|
||
bind_tc_ok]
|
||
step with range_next_lt_spec as ⟨o1, iter1, ho1, hs1, he1⟩
|
||
simp only [ho1]
|
||
step as ⟨x1, hx1⟩
|
||
step as ⟨y1, hy1⟩
|
||
simp [ha] at hx1
|
||
simp [hb] at hy1
|
||
have hxb1 : x1.val < 2^52 := by rw [hx1]; exact hA0
|
||
have hyb1 : y1.val < 2^52 := by rw [hy1]; exact hB0
|
||
step as ⟨v1, hv1⟩
|
||
step as ⟨g1, hg1⟩
|
||
have hgb1 : g1.val = 0 := by rw [hg1]; rfl
|
||
step as ⟨cy1, hcy1⟩
|
||
step as ⟨q1, bk1, hq1, hbk1⟩
|
||
step as ⟨r1, hr1⟩
|
||
try simp only [spec_ok]
|
||
have hcyv1 : cy1.val = a0.val + b0.val := by
|
||
rw [hcy1, hv1, hx1, hy1, hgb1]; omega
|
||
have hcyb1 : cy1.val < 2^53 := by rw [hcyv1]; omega
|
||
have hrv1 : r1.val = cy1.val % 2^52 := by
|
||
rw [hr1, UScalar.val_and, hmaskv, nat_and_mask52]
|
||
-- Iteration 2 (i = 1)
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexUsizeU64.index,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexMutUsizeU64.index_mut,
|
||
bind_tc_ok]
|
||
step with range_next_lt_spec as ⟨o2, iter2, ho2, hs2, he2⟩
|
||
simp only [ho2]
|
||
step as ⟨x2, hx2⟩
|
||
step as ⟨y2, hy2⟩
|
||
simp [ha, hs1, he1] at hx2
|
||
simp [hb, hs1, he1] at hy2
|
||
have hxb2 : x2.val < 2^52 := by rw [hx2]; exact hA1
|
||
have hyb2 : y2.val < 2^52 := by rw [hy2]; exact hB1
|
||
step as ⟨v2, hv2⟩
|
||
step as ⟨g2, hg2⟩
|
||
have hgeq2 : g2.val = cy1.val / 2^52 := by rw [hg2, nat_shift52]
|
||
have hgb2 : g2.val ≤ 1 := by rw [hgeq2]; omega
|
||
step as ⟨cy2, hcy2⟩
|
||
step as ⟨q2, bk2, hq2, hbk2⟩
|
||
step as ⟨r2, hr2⟩
|
||
try simp only [spec_ok]
|
||
have hcyv2 : cy2.val = a1.val + b1.val + g2.val := by
|
||
rw [hcy2, hv2, hx2, hy2]
|
||
have hcyb2 : cy2.val < 2^53 := by rw [hcyv2]; omega
|
||
have hrv2 : r2.val = cy2.val % 2^52 := by
|
||
rw [hr2, UScalar.val_and, hmaskv, nat_and_mask52]
|
||
-- Iteration 3 (i = 2)
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexUsizeU64.index,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexMutUsizeU64.index_mut,
|
||
bind_tc_ok]
|
||
step with range_next_lt_spec as ⟨o3, iter3, ho3, hs3, he3⟩
|
||
simp only [ho3]
|
||
step as ⟨x3, hx3⟩
|
||
step as ⟨y3, hy3⟩
|
||
simp [ha, hs1, he1, hs2, he2] at hx3
|
||
simp [hb, hs1, he1, hs2, he2] at hy3
|
||
have hxb3 : x3.val < 2^52 := by rw [hx3]; exact hA2
|
||
have hyb3 : y3.val < 2^52 := by rw [hy3]; exact hB2
|
||
step as ⟨v3, hv3⟩
|
||
step as ⟨g3, hg3⟩
|
||
have hgeq3 : g3.val = cy2.val / 2^52 := by rw [hg3, nat_shift52]
|
||
have hgb3 : g3.val ≤ 1 := by rw [hgeq3]; omega
|
||
step as ⟨cy3, hcy3⟩
|
||
step as ⟨q3, bk3, hq3, hbk3⟩
|
||
step as ⟨r3, hr3⟩
|
||
try simp only [spec_ok]
|
||
have hcyv3 : cy3.val = a2.val + b2.val + g3.val := by
|
||
rw [hcy3, hv3, hx3, hy3]
|
||
have hcyb3 : cy3.val < 2^53 := by rw [hcyv3]; omega
|
||
have hrv3 : r3.val = cy3.val % 2^52 := by
|
||
rw [hr3, UScalar.val_and, hmaskv, nat_and_mask52]
|
||
-- Iteration 4 (i = 3)
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexUsizeU64.index,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexMutUsizeU64.index_mut,
|
||
bind_tc_ok]
|
||
step with range_next_lt_spec as ⟨o4, iter4, ho4, hs4, he4⟩
|
||
simp only [ho4]
|
||
step as ⟨x4, hx4⟩
|
||
step as ⟨y4, hy4⟩
|
||
simp [ha, hs1, he1, hs2, he2, hs3, he3] at hx4
|
||
simp [hb, hs1, he1, hs2, he2, hs3, he3] at hy4
|
||
have hxb4 : x4.val < 2^52 := by rw [hx4]; exact hA3
|
||
have hyb4 : y4.val < 2^52 := by rw [hy4]; exact hB3
|
||
step as ⟨v4, hv4⟩
|
||
step as ⟨g4, hg4⟩
|
||
have hgeq4 : g4.val = cy3.val / 2^52 := by rw [hg4, nat_shift52]
|
||
have hgb4 : g4.val ≤ 1 := by rw [hgeq4]; omega
|
||
step as ⟨cy4, hcy4⟩
|
||
step as ⟨q4, bk4, hq4, hbk4⟩
|
||
step as ⟨r4, hr4⟩
|
||
try simp only [spec_ok]
|
||
have hcyv4 : cy4.val = a3.val + b3.val + g4.val := by
|
||
rw [hcy4, hv4, hx4, hy4]
|
||
have hcyb4 : cy4.val < 2^53 := by rw [hcyv4]; omega
|
||
have hrv4 : r4.val = cy4.val % 2^52 := by
|
||
rw [hr4, UScalar.val_and, hmaskv, nat_and_mask52]
|
||
-- Iteration 5 (i = 4)
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexUsizeU64.index,
|
||
backend.serial.u64.scalar.Scalar52.Insts.CoreOpsIndexIndexMutUsizeU64.index_mut,
|
||
bind_tc_ok]
|
||
step with range_next_lt_spec as ⟨o5, iter5, ho5, hs5, he5⟩
|
||
simp only [ho5]
|
||
step as ⟨x5, hx5⟩
|
||
step as ⟨y5, hy5⟩
|
||
simp [ha, hs1, he1, hs2, he2, hs3, he3, hs4, he4] at hx5
|
||
simp [hb, hs1, he1, hs2, he2, hs3, he3, hs4, he4] at hy5
|
||
have hxb5 : x5.val < 2^52 := by rw [hx5]; exact hA4
|
||
have hyb5 : y5.val < 2^52 := by rw [hy5]; exact hB4
|
||
step as ⟨v5, hv5⟩
|
||
step as ⟨g5, hg5⟩
|
||
have hgeq5 : g5.val = cy4.val / 2^52 := by rw [hg5, nat_shift52]
|
||
have hgb5 : g5.val ≤ 1 := by rw [hgeq5]; omega
|
||
step as ⟨cy5, hcy5⟩
|
||
step as ⟨q5, bk5, hq5, hbk5⟩
|
||
step as ⟨r5, hr5⟩
|
||
try simp only [spec_ok]
|
||
have hcyv5 : cy5.val = a4.val + b4.val + g5.val := by
|
||
rw [hcy5, hv5, hx5, hy5]
|
||
have hcyb5 : cy5.val < 2^53 := by rw [hcyv5]; omega
|
||
have hrv5 : r5.val = cy5.val % 2^52 := by
|
||
rw [hr5, UScalar.val_and, hmaskv, nat_and_mask52]
|
||
-- Iteration 6: exhausted
|
||
apply loop_step
|
||
simp only [backend.serial.u64.scalar.Scalar52.add_loop.body]
|
||
step with range_next_ge_spec as ⟨o6, iter6, ho6, hr6⟩
|
||
simp only [ho6]
|
||
try simp only [spec_ok]
|
||
refine ⟨r1, r2, r3, r4, r5,
|
||
cy1.val / 2^52, cy2.val / 2^52, cy3.val / 2^52, cy4.val / 2^52, cy5.val / 2^52,
|
||
?_, by omega, by omega, by omega, by omega, by omega,
|
||
by rw [hrv1]; omega, by rw [hrv2]; omega, by rw [hrv3]; omega,
|
||
by rw [hrv4]; omega, by rw [hrv5]; omega,
|
||
?_, ?_, ?_, ?_, ?_⟩
|
||
· simp [hbk1, hbk2, hbk3, hbk4, hbk5, Array.set_val_eq, ZERO_limbs, hs1, hs2, hs3, hs4]
|
||
· rw [hrv1, hcyv1]; omega
|
||
· rw [hrv2, hcyv2, hgeq2]; omega
|
||
· rw [hrv3, hcyv3, hgeq3]; omega
|
||
· rw [hrv4, hcyv4, hgeq4]; omega
|
||
· rw [hrv5, hcyv5, hgeq5]; omega
|
||
|
||
/-- **Scalar addition is correct mod ℓ.** For limb-bounded, canonical
|
||
inputs (scVal < ℓ), the transpiled `Scalar52::add` denotes ⟦a⟧ + ⟦b⟧
|
||
in `ZMod ℓ`: the carry loop computes the exact sum (canonical inputs
|
||
force the top carry to 0), and the trailing `sub sum L` subtracts
|
||
⟦L⟧ = 0 in ZMod ℓ while canonicalizing. -/
|
||
theorem add_val_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)
|
||
(hca : scVal a < Ell) (hcb : scVal b < Ell) :
|
||
backend.serial.u64.scalar.Scalar52.add 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.add
|
||
step as ⟨sh, hsh⟩
|
||
step as ⟨mask, hmask⟩
|
||
have hmaskv : mask.val = 2^52 - 1 := by
|
||
simp [hmask, hsh, U64.size_def, U64.numBits]
|
||
apply spec_bind (add_loop_spec a b mask a0 a1 a2 a3 a4 b0 b1 b2 b3 b4 ha hb hmaskv
|
||
⟨hA0, hA1, hA2, hA3, hA4, hB0, hB1, hB2, hB3, hB4⟩)
|
||
rintro sum ⟨r0, r1, r2, r3, r4, γ1, γ2, γ3, γ4, γ5, hrl,
|
||
hg1, hg2, hg3, hg4, hg5, hr0, hr1, hr2, hr3, hr4,
|
||
hf0, hf1, hf2, hf3, hf4⟩
|
||
try simp only at hrl
|
||
show backend.serial.u64.scalar.Scalar52.sub sum backend.serial.u64.constants.L
|
||
⦃ 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 ⦄
|
||
-- telescope: scLimbs sum + 2^260·γ5 = scVal a + scVal b; canonicity kills γ5
|
||
have hsva : scVal a = scLimbs a0 a1 a2 a3 a4 := scVal_eq a a0 a1 a2 a3 a4 ha
|
||
have hsvb : scVal b = scLimbs b0 b1 b2 b3 b4 := scVal_eq b b0 b1 b2 b3 b4 hb
|
||
have hT : scLimbs r0 r1 r2 r3 r4 + 2^260 * γ5
|
||
= scLimbs a0 a1 a2 a3 a4 + scLimbs b0 b1 b2 b3 b4 := by
|
||
unfold scLimbs
|
||
exact add_telescope _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ hf0 hf1 hf2 hf3 hf4
|
||
have hEllbig : Ell < 2^253 := by unfold Ell; norm_num
|
||
have hγ0 : γ5 = 0 := by
|
||
have hlt : scLimbs a0 a1 a2 a3 a4 + scLimbs b0 b1 b2 b3 b4 < 2^254 := by
|
||
rw [← hsva, ← hsvb]; omega
|
||
omega
|
||
have hsum : scVal sum = scVal a + scVal b := by
|
||
rw [scVal_eq sum r0 r1 r2 r3 r4 hrl, hsva, hsvb]
|
||
rw [hγ0] at hT; simpa using hT
|
||
-- L's limbs and their bounds (literals)
|
||
have hLb : (671914833335277:ℕ) < 2^52 ∧ (3916664325105025:ℕ) < 2^52 ∧
|
||
(1367801:ℕ) < 2^52 ∧ (0:ℕ) < 2^52 ∧ (17592186044416:ℕ) < 2^52 := by norm_num
|
||
have hLlist := L_limbs
|
||
have hLv0 : (671914833335277#u64).val = 671914833335277 := by rfl
|
||
-- apply the subtraction spec with subtrahend L (scVal L = ℓ ≤ ℓ)
|
||
apply spec_mono (sub_val_spec sum backend.serial.u64.constants.L
|
||
r0 r1 r2 r3 r4 _ _ _ _ _ hrl hLlist
|
||
⟨hr0, hr1, hr2, hr3, hr4⟩
|
||
(by refine ⟨?_, ?_, ?_, ?_, ?_⟩ <;> norm_num)
|
||
(by rw [L_val]))
|
||
intro r hr
|
||
obtain ⟨hbnds, ⟨β, hβle, heq, hguard⟩, hden⟩ := hr
|
||
rw [L_val] at heq
|
||
refine ⟨hbnds, ?_, ?_⟩
|
||
· -- canonicity: the trailing sub L leaves a value below ℓ
|
||
rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hβle with h0 | h1
|
||
· subst h0; omega
|
||
· subst h1
|
||
have hlt := hguard rfl
|
||
rw [L_val] at hlt
|
||
omega
|
||
· rw [hden]
|
||
have hL0 : scDenote backend.serial.u64.constants.L = 0 := by
|
||
simp only [scDenote, L_val]; exact ZMod.natCast_self Ell
|
||
have hsd : scDenote sum = scDenote a + scDenote b := by
|
||
simp only [scDenote, hsum]; push_cast; ring
|
||
rw [hL0, hsd]; ring
|
||
|
||
end ScalarProofs
|