mirror of
https://github.com/saymrwulf/anza-ed25519-verified.git
synced 2026-09-03 20:13:46 +00:00
PHASE 2 COMPLETE ON ANZA: THE FULL POINT-LEVEL LIFT
(verify_accepts_iff_decompress, button-enforced)
Port of the dalek decompress chain (byte-identical gen: the anza
extraction of sqrt_ratio_i / from_bytes / decompress matches dalek's
exactly, so DecompressSpec + FromBytesSpec port verbatim modulo the
crate namespace):
- source patch 994c469 (solana-ed25519): decompress step_2
negate-then-conditional-assign (the documented sqrt_ratio_i rewrite);
extract.sh: decompress un-opaqued, re-extracted (the step_1/step_2
external axioms vanish from the template - decompress is transparent).
- Proofs/DecompressSpec.lean: pow_p58, ct_eq/cond-assign semantics,
sqrt_core, sqrt_ratio_i_sq_spec (even root, v*r^2 = u).
- Proofs/FromBytesSpec.lean: load8_at loader, 5-window LE parse,
from_bytes_spec (exact below bit 255).
- Proofs/DecompressMain.lean: edwards_d_denote, decompress_of_canonical
(standard three axioms), verify_accepts_iff_decompress against the
anza apex shape (rb/sb/s, minus_A):
accept <=> decompress(R) = [k]*minus_A + [s]*B (as points).
check.sh: 4-tier Phase 3b (byte apex, half-lift, point equation, full
lift), each cone exactly [3 standard + Signature + sha512_hash3 +
r_bytes + s_bytes]. Full button green fresh.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
parent
e429447764
commit
c2cf269656
9 changed files with 2074 additions and 760 deletions
File diff suppressed because one or more lines are too long
323
verification/Proofs/DecompressMain.lean
Normal file
323
verification/Proofs/DecompressMain.lean
Normal file
|
|
@ -0,0 +1,323 @@
|
|||
/- ──────────────────────────────────────────────────────────────────────────────
|
||||
Proofs/DecompressMain.lean — phase 2, decompress step 3: THE CONSTRUCTIVE
|
||||
DECOMPRESSION THEOREM.
|
||||
|
||||
`decompress_of_canonical`: for a valid on-curve point Q whose canonical
|
||||
encoding is the bytes rb, the extracted `CompressedEdwardsY::decompress`
|
||||
succeeds with `some P` — a valid on-curve point denoting exactly Q.
|
||||
|
||||
The chain: from_bytes recovers the y-residue (the sign bit at 2²⁵⁵ is
|
||||
discarded — from_bytes_spec is exact below it); u = y²−1 and
|
||||
v = d·y²+1 are built by certified ops with ⟪EDWARDS_D⟫ = d
|
||||
(edwards_d_spec + edD_char, cancelled by 121666 ≠ 0); Q's own
|
||||
x-coordinate witnesses that u/v is a square (x_sq_of_onCurve), so
|
||||
sqrt_ratio_i succeeds with the even-parity root; the sign bit — Q's
|
||||
x-parity, extracted from byte 31 — selects between ±root, and the
|
||||
parity-injectivity argument (enc_inj_coord, on-curve invariance of x²)
|
||||
pins the selected root to edX Q. The result point {X, Y, 1, X·Y} is
|
||||
ExtValid, on-curve, and denotes Q.
|
||||
────────────────────────────────────────────────────────────────────────────── -/
|
||||
import Proofs.FromBytesSpec
|
||||
open Aeneas Aeneas.Std Result
|
||||
open curve25519
|
||||
|
||||
set_option maxHeartbeats 8000000
|
||||
set_option linter.unusedSimpArgs false
|
||||
set_option maxRecDepth 8000
|
||||
|
||||
namespace CurveFieldProofs
|
||||
|
||||
open Aeneas.Std.WP
|
||||
|
||||
/-- ⟪EDWARDS_D⟫ is THE curve constant d. -/
|
||||
theorem edwards_d_denote :
|
||||
backend.serial.u64.constants.EDWARDS_D ⦃ D => Bnd D (2^52) ∧ ⟪D⟫ = edD ⦄ := by
|
||||
apply spec_mono edwards_d_spec
|
||||
intro D ⟨hb, hd⟩
|
||||
refine ⟨hb, ?_⟩
|
||||
have h121666 : (121666 : Fp) ≠ 0 := by
|
||||
have h : ((121666 : ℕ) : Fp) ≠ 0 := natCast_ne_zero_of_mod (by decide)
|
||||
exact_mod_cast h
|
||||
have hchar := edD_char
|
||||
have : (121666 : Fp) * (⟪D⟫ - edD) = 0 := by linear_combination hd - hchar
|
||||
rcases mul_eq_zero.mp this with h | h
|
||||
· exact absurd h h121666
|
||||
· linear_combination h
|
||||
|
||||
open ed_sigs ed_sigs.verification_key in
|
||||
/-- **THE CONSTRUCTIVE DECOMPRESSION THEOREM**: canonical encodings of
|
||||
valid on-curve points decompress to them. -/
|
||||
theorem decompress_of_canonical (Q : EdPoint) (hQv : ExtValid Q) (hQc : OnCurveExt Q)
|
||||
(rb : Std.Array Std.U8 32#usize)
|
||||
(b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 : Std.U8)
|
||||
(hbl : (↑rb : List Std.U8) = [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25, b26, b27, b28, b29, b30, b31])
|
||||
(henc : bytesVal rb = (edY Q).val + ((edX Q).val % 2) * 2^255) :
|
||||
edwards.CompressedEdwardsY.decompress rb ⦃ o =>
|
||||
∃ Pt : EdPoint, o = some Pt ∧ ExtValid Pt ∧ OnCurveExt Pt ∧ edPt Pt = edPt Q ⦄ := by
|
||||
haveI : NeZero P := ⟨by unfold P; norm_num⟩
|
||||
unfold edwards.CompressedEdwardsY.decompress curve25519.edwards.decompress.step_1
|
||||
-- as_bytes is the identity; parse y
|
||||
simp only [edwards.CompressedEdwardsY.as_bytes, bind_tc_ok]
|
||||
step with (from_bytes_spec rb b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13
|
||||
b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 hbl)
|
||||
as ⟨Y, hbY, hYv⟩
|
||||
-- the parsed field element denotes edY Q
|
||||
have hyresid : (edY Q).val < 2^255 :=
|
||||
lt_of_lt_of_le (ZMod.val_lt _) (by unfold P; norm_num)
|
||||
have hparle : (edX Q).val % 2 ≤ 1 := Nat.le_of_lt_succ (Nat.mod_lt _ (by norm_num))
|
||||
have hYval : feVal Y = (edY Q).val := by
|
||||
rw [hYv, henc]
|
||||
have : ((edY Q).val + (edX Q).val % 2 * 2^255) % 2^255 = (edY Q).val := by
|
||||
rcases Nat.mod_two_eq_zero_or_one (edX Q).val with h | h <;> rw [h] <;> omega
|
||||
exact this
|
||||
have hYden : ⟪Y⟫ = edY Q := by
|
||||
apply ZMod.val_injective
|
||||
show (⟪Y⟫).val = (edY Q).val
|
||||
unfold denote
|
||||
rw [ZMod.val_natCast, hYval, Nat.mod_eq_of_lt (ZMod.val_lt _)]
|
||||
-- Z = 1
|
||||
step with one_spec as ⟨Z, hbZ, hZv⟩
|
||||
-- YY = y², u = y² − 1
|
||||
step with (square_spec' Y (Bnd.mono hbY (by norm_num))) as ⟨YY, hbYY, hYY⟩
|
||||
obtain ⟨yy0, yy1, yy2, yy3, yy4, hyyl⟩ := Fe.exists_limbs YY
|
||||
obtain ⟨z0, z1, z2, z3, z4, hzl⟩ := Fe.exists_limbs Z
|
||||
step with (sub_spec YY Z yy0 yy1 yy2 yy3 yy4 z0 z1 z2 z3 z4 hyyl hzl
|
||||
(Bnd.mono hbYY (by norm_num)) (Bnd.mono hbZ (by norm_num))) as ⟨u, hbu, huv⟩
|
||||
-- D, then v = d·y² + 1
|
||||
step with edwards_d_denote as ⟨D, hbD, hDv⟩
|
||||
step with (mul_spec' YY D (Bnd.mono hbYY (by norm_num)) (Bnd.mono hbD (by norm_num)))
|
||||
as ⟨vd, hbvd, hvd⟩
|
||||
step with (add_spec'' vd Z (Bnd.mono hbvd (by norm_num)) (Bnd.mono hbZ (by norm_num)))
|
||||
as ⟨v, hbv, hvv⟩
|
||||
-- interpreted u, v
|
||||
have huval : ⟪u⟫ = (edY Q)^2 - 1 := by
|
||||
rw [huv, hYY, hYden, hZv]
|
||||
ring
|
||||
have hvval : ⟪v⟫ = 1 + edD * (edY Q)^2 := by
|
||||
rw [hvv, hvd, hYY, hYden, hDv, hZv]
|
||||
ring
|
||||
-- Q's x witnesses the square; v never vanishes
|
||||
have hvne : ⟪v⟫ ≠ 0 := by rw [hvval]; exact one_add_d_y_sq_ne_zero _
|
||||
have hwit : (edX Q) ^ 2 * ⟪v⟫ = ⟪u⟫ := by
|
||||
rw [hvval, huval]
|
||||
exact x_sq_of_onCurve hQc
|
||||
-- the square root succeeds with the even-parity root
|
||||
step with (sqrt_ratio_i_sq_spec u v (Bnd.mono hbu (by norm_num))
|
||||
(Bnd.mono hbv (by norm_num)) hvne (edX Q) hwit) as ⟨sc, sr, hc1, hbr, hrsq, hrpar⟩
|
||||
-- the validity Choice converts to true
|
||||
simp only [core.convert.IntoFrom.into, Bool.Insts.CoreConvertFromChoice.from,
|
||||
bind_tc_ok]
|
||||
rw [show (sc.val != 0) = true from by simp [hc1]]
|
||||
rw [if_pos rfl]
|
||||
-- ── step_2: the sign select ──────────────────────────────────────────────
|
||||
unfold curve25519.edwards.decompress.step_2
|
||||
simp only [edwards.CompressedEdwardsY.as_bytes, bind_tc_ok]
|
||||
step as ⟨t31, ht31⟩
|
||||
simp [hbl] at ht31
|
||||
step as ⟨sgn, hsgn⟩
|
||||
simp only [subtle.Choice.Insts.CoreConvertFromU8.from, bind_tc_ok]
|
||||
-- the sign bit is Q's x-parity
|
||||
have hb31v : b31.val = (edY Q).val / 2^248 + ((edX Q).val % 2) * 2^7 := by
|
||||
have hexp : bytesVal rb = b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248 := by
|
||||
simp only [bytesVal, hbl]
|
||||
rw [henc] at hexp
|
||||
have hB0 : b0.val < 256 := by scalar_tac
|
||||
have hB1 : b1.val < 256 := by scalar_tac
|
||||
have hB2 : b2.val < 256 := by scalar_tac
|
||||
have hB3 : b3.val < 256 := by scalar_tac
|
||||
have hB4 : b4.val < 256 := by scalar_tac
|
||||
have hB5 : b5.val < 256 := by scalar_tac
|
||||
have hB6 : b6.val < 256 := by scalar_tac
|
||||
have hB7 : b7.val < 256 := by scalar_tac
|
||||
have hB8 : b8.val < 256 := by scalar_tac
|
||||
have hB9 : b9.val < 256 := by scalar_tac
|
||||
have hB10 : b10.val < 256 := by scalar_tac
|
||||
have hB11 : b11.val < 256 := by scalar_tac
|
||||
have hB12 : b12.val < 256 := by scalar_tac
|
||||
have hB13 : b13.val < 256 := by scalar_tac
|
||||
have hB14 : b14.val < 256 := by scalar_tac
|
||||
have hB15 : b15.val < 256 := by scalar_tac
|
||||
have hB16 : b16.val < 256 := by scalar_tac
|
||||
have hB17 : b17.val < 256 := by scalar_tac
|
||||
have hB18 : b18.val < 256 := by scalar_tac
|
||||
have hB19 : b19.val < 256 := by scalar_tac
|
||||
have hB20 : b20.val < 256 := by scalar_tac
|
||||
have hB21 : b21.val < 256 := by scalar_tac
|
||||
have hB22 : b22.val < 256 := by scalar_tac
|
||||
have hB23 : b23.val < 256 := by scalar_tac
|
||||
have hB24 : b24.val < 256 := by scalar_tac
|
||||
have hB25 : b25.val < 256 := by scalar_tac
|
||||
have hB26 : b26.val < 256 := by scalar_tac
|
||||
have hB27 : b27.val < 256 := by scalar_tac
|
||||
have hB28 : b28.val < 256 := by scalar_tac
|
||||
have hB29 : b29.val < 256 := by scalar_tac
|
||||
have hB30 : b30.val < 256 := by scalar_tac
|
||||
have hB31 : b31.val < 256 := by scalar_tac
|
||||
omega
|
||||
have hsgnv : sgn.val = (edX Q).val % 2 := by
|
||||
rw [hsgn, ht31, nat_shr, hb31v]
|
||||
have : (edY Q).val / 2^248 < 2^7 := by
|
||||
have := hyresid
|
||||
omega
|
||||
omega
|
||||
-- −root, then select
|
||||
obtain ⟨r0, r1, r2, r3, r4, hrl⟩ := Fe.exists_limbs sr
|
||||
unfold Shared0FieldElement51.Insts.CoreOpsArithNegFieldElement51.neg
|
||||
step with (neg_spec sr r0 r1 r2 r3 r4 hrl (Bnd.mono hbr (by norm_num)))
|
||||
as ⟨Xn, hbXn, hXnv⟩
|
||||
obtain ⟨n0, n1, n2, n3, n4, hnl⟩ := Fe.exists_limbs Xn
|
||||
step with (fe_cond_assign_spec sr Xn sgn r0 r1 r2 r3 r4 n0 n1 n2 n3 n4 hrl hnl)
|
||||
as ⟨X1, hX1l⟩
|
||||
-- Bnd X1 first (needed by the T-multiply)
|
||||
have hbX1 : Bnd X1 (2^52) := by
|
||||
have hb1 : Bnd sr (2^52) := hbr
|
||||
have hb2 : Bnd Xn (2^52) := hbXn
|
||||
split at hX1l
|
||||
· rw [Bnd_eq X1 r0 r1 r2 r3 r4 _ (by rw [hX1l])]
|
||||
rw [Bnd_eq sr r0 r1 r2 r3 r4 _ hrl] at hb1
|
||||
exact hb1
|
||||
· rw [Bnd_eq X1 n0 n1 n2 n3 n4 _ (by rw [hX1l])]
|
||||
rw [Bnd_eq Xn n0 n1 n2 n3 n4 _ hnl] at hb2
|
||||
exact hb2
|
||||
-- T = X1·Y
|
||||
step with (mul_spec' X1 Y (Bnd.mono hbX1 (by norm_num)) (Bnd.mono hbY (by norm_num)))
|
||||
as ⟨T, hbT, hTv⟩
|
||||
try simp only [spec_ok]
|
||||
-- ── the selected root IS edX Q ───────────────────────────────────────────
|
||||
-- the root is on-curve (only x² appears in the equation)
|
||||
have hrsq' : ⟪sr⟫ ^ 2 = (edX Q) ^ 2 := by
|
||||
have h := hrsq
|
||||
rw [hwit.symm] at h
|
||||
have hcancel : (⟪sr⟫ ^ 2 - (edX Q) ^ 2) * ⟪v⟫ = 0 := by linear_combination h
|
||||
rcases mul_eq_zero.mp hcancel with h' | h'
|
||||
· linear_combination h'
|
||||
· exact absurd h' hvne
|
||||
have hronc : OnCurve ⟪sr⟫ (edY Q) := by
|
||||
show -(⟪sr⟫^2) + (edY Q)^2 = 1 + edD * ⟪sr⟫^2 * (edY Q)^2
|
||||
rw [hrsq']
|
||||
exact hQc
|
||||
have hX1den : ⟪X1⟫ = ⟪sr⟫ ∨ ⟪X1⟫ = -⟪sr⟫ := by
|
||||
split at hX1l
|
||||
· left
|
||||
unfold denote
|
||||
rw [feVal_eq X1 r0 r1 r2 r3 r4 (by rw [hX1l]),
|
||||
feVal_eq sr r0 r1 r2 r3 r4 hrl]
|
||||
· right
|
||||
have : ⟪X1⟫ = ⟪Xn⟫ := by
|
||||
unfold denote
|
||||
rw [feVal_eq X1 n0 n1 n2 n3 n4 (by rw [hX1l]),
|
||||
feVal_eq Xn n0 n1 n2 n3 n4 hnl]
|
||||
rw [this, hXnv]
|
||||
have hX1x : ⟪X1⟫ = edX Q := by
|
||||
rcases Nat.mod_two_eq_zero_or_one (edX Q).val with hx | hx
|
||||
· -- x has even parity: no flip (sgn = 0), root already matches by parity
|
||||
have hs0 : sgn.val = 0 := by rw [hsgnv, hx]
|
||||
have hkeep : ⟪X1⟫ = ⟪sr⟫ := by
|
||||
split at hX1l
|
||||
· unfold denote
|
||||
rw [feVal_eq X1 r0 r1 r2 r3 r4 (by rw [hX1l]),
|
||||
feVal_eq sr r0 r1 r2 r3 r4 hrl]
|
||||
· exact absurd hs0 (by assumption)
|
||||
rw [hkeep]
|
||||
exact enc_inj_coord hronc hQc (by rw [hrpar, hx])
|
||||
· -- x odd: the flip fires; −root has odd parity (root even, nonzero)
|
||||
have hs1 : sgn.val ≠ 0 := by rw [hsgnv, hx]; norm_num
|
||||
have hflip : ⟪X1⟫ = -⟪sr⟫ := by
|
||||
split at hX1l
|
||||
· exact absurd (by assumption) hs1
|
||||
· have : ⟪X1⟫ = ⟪Xn⟫ := by
|
||||
unfold denote
|
||||
rw [feVal_eq X1 n0 n1 n2 n3 n4 (by rw [hX1l]),
|
||||
feVal_eq Xn n0 n1 n2 n3 n4 hnl]
|
||||
rw [this, hXnv]
|
||||
have hrnz : ⟪sr⟫ ≠ 0 := by
|
||||
intro hz
|
||||
rw [hz] at hrsq'
|
||||
have hxz : edX Q = 0 := by
|
||||
have := hrsq'.symm
|
||||
have h2 : (edX Q)^2 = 0 := by linear_combination -hrsq'
|
||||
exact pow_eq_zero_iff (n := 2) (by norm_num) |>.mp h2
|
||||
rw [hxz] at hx
|
||||
simp at hx
|
||||
have hnegonc : OnCurve (-⟪sr⟫) (edY Q) := by
|
||||
show -((-⟪sr⟫)^2) + (edY Q)^2 = 1 + edD * (-⟪sr⟫)^2 * (edY Q)^2
|
||||
have : (-⟪sr⟫)^2 = ⟪sr⟫^2 := by ring
|
||||
rw [this, hrsq']
|
||||
exact hQc
|
||||
have hnegpar : (-⟪sr⟫).val % 2 = 1 := by
|
||||
rw [ZMod.neg_val, if_neg hrnz]
|
||||
have hlt := ZMod.val_lt ⟪sr⟫
|
||||
have hpodd : P % 2 = 1 := by unfold P; norm_num
|
||||
have hpos : 0 < (⟪sr⟫).val := by
|
||||
rcases Nat.eq_zero_or_pos (⟪sr⟫).val with h | h
|
||||
· exact absurd ((ZMod.val_eq_zero _).mp h) hrnz
|
||||
· exact h
|
||||
omega
|
||||
rw [hflip]
|
||||
exact enc_inj_coord hnegonc hQc (by rw [hnegpar, hx])
|
||||
-- ── assemble the point ───────────────────────────────────────────────────
|
||||
refine ⟨_, rfl, ?_, ?_, ?_⟩
|
||||
· -- ExtValid
|
||||
refine ⟨?_, Bnd.mono hbY (by norm_num), Bnd.mono hbZ (by norm_num), ?_, ?_, ?_⟩
|
||||
· exact hbX1
|
||||
· exact Bnd.mono hbT (by norm_num)
|
||||
· rw [hZv]; norm_num
|
||||
· -- coherence X·Y = Z·T
|
||||
show ⟪X1⟫ * ⟪Y⟫ = ⟪Z⟫ * ⟪T⟫
|
||||
rw [hTv, hZv]
|
||||
ring
|
||||
· -- on-curve
|
||||
show OnCurve (⟪X1⟫ / ⟪Z⟫) (⟪Y⟫ / ⟪Z⟫)
|
||||
rw [hZv, div_one, div_one, hX1x, hYden]
|
||||
exact hQc
|
||||
· -- denotes Q
|
||||
show (⟪X1⟫ / ⟪Z⟫, ⟪Y⟫ / ⟪Z⟫) = edPt Q
|
||||
rw [hZv, div_one, div_one, hX1x, hYden]
|
||||
rfl
|
||||
|
||||
open ed_sigs ed_sigs.verification_key in
|
||||
/-- **THE FULL POINT-LEVEL LIFT** (anza). Under the point-equation premises,
|
||||
the signature's R bytes DECOMPRESS to a valid on-curve point Pt, and the
|
||||
verifier accepts **iff** Pt equals the recomputed [k]·minus_A + [s]·B:
|
||||
|
||||
accept ⇔ decompress(R) = [k]·minus_A + [s]·B (as points).
|
||||
|
||||
This is the constructive capstone of phase 2: byte comparison ↔
|
||||
canonical-encoding equality ↔ point equality ↔ decompressed-point
|
||||
equality, every link machine-checked over the extracted code. -/
|
||||
theorem verify_accepts_iff_decompress
|
||||
(self : verification_key.VerificationKey)
|
||||
(sig : ed25519.Signature) (msg : Slice Std.U8)
|
||||
(rb sb : Std.Array Std.U8 32#usize) (s : scalar.Scalar)
|
||||
(er : edwards.CompressedEdwardsY) (e : Std.Array Std.U8 32#usize)
|
||||
(hrb : ed25519.Signature.r_bytes sig = ok rb)
|
||||
(hsb : ed25519.Signature.s_bytes sig = ok sb)
|
||||
(hA : VerificationKey.a_bytes_nonzero self = ok true)
|
||||
(hleg : is_legacy_excluded_r rb = ok false)
|
||||
(hs : check_scalar_canonical sb = ok (core.result.Result.Ok s))
|
||||
(hrec : VerificationKey.recompute_r_sha512 self rb s msg = ok er)
|
||||
(he : edwards.CompressedEdwardsY.as_bytes er = ok e)
|
||||
(hkv : ExtValid self.minus_A) (hkc : OnCurveExt self.minus_A)
|
||||
(t0 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 : Std.U8)
|
||||
(hsbytes : (↑s.bytes : List Std.U8) = [t0, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31])
|
||||
(Vs : ℕ) (hVs : Vs = t0.val + t1.val * 2^8 + t2.val * 2^16 + t3.val * 2^24 + t4.val * 2^32 + t5.val * 2^40 + t6.val * 2^48 + t7.val * 2^56 + t8.val * 2^64 + t9.val * 2^72 + t10.val * 2^80 + t11.val * 2^88 + t12.val * 2^96 + t13.val * 2^104 + t14.val * 2^112 + t15.val * 2^120 + t16.val * 2^128 + t17.val * 2^136 + t18.val * 2^144 + t19.val * 2^152 + t20.val * 2^160 + t21.val * 2^168 + t22.val * 2^176 + t23.val * 2^184 + t24.val * 2^192 + t25.val * 2^200 + t26.val * 2^208 + t27.val * 2^216 + t28.val * 2^224 + t29.val * 2^232 + t30.val * 2^240 + t31.val * 2^248)
|
||||
(hVslt : Vs < 2^253)
|
||||
(Q : EdPoint) (hQv : ExtValid Q) (hQc : OnCurveExt Q)
|
||||
(b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 : Std.U8)
|
||||
(hbl : (↑rb : List Std.U8) = [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25, b26, b27, b28, b29, b30, b31])
|
||||
(henc : bytesVal rb = (edY Q).val + ((edX Q).val % 2) * 2^255) :
|
||||
∃ (R' Pt : EdPoint), ExtValid R' ∧ OnCurveExt R' ∧
|
||||
curve25519.edwards.CompressedEdwardsY.decompress rb = ok (some Pt) ∧
|
||||
ExtValid Pt ∧ OnCurveExt Pt ∧
|
||||
(VerificationKey.verify_sha512 self sig msg = ok (core.result.Result.Ok ())
|
||||
↔ edPt Pt = edPt R') := by
|
||||
obtain ⟨R', hRv, hRc, hiff⟩ := verify_accepts_iff_point_eq self sig msg rb sb s er e
|
||||
hrb hsb hA hleg hs hrec he hkv hkc
|
||||
t0 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 hsbytes Vs hVs hVslt Q hQv hQc henc
|
||||
obtain ⟨o, ho, Pt, hosome, hPv, hPc, hPQ⟩ := spec_imp_exists
|
||||
(decompress_of_canonical Q hQv hQc rb b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 hbl henc)
|
||||
refine ⟨R', Pt, hRv, hRc, ?_, hPv, hPc, ?_⟩
|
||||
· rw [ho, hosome]
|
||||
· rw [hiff, hPQ]
|
||||
|
||||
end CurveFieldProofs
|
||||
509
verification/Proofs/DecompressSpec.lean
Normal file
509
verification/Proofs/DecompressSpec.lean
Normal file
|
|
@ -0,0 +1,509 @@
|
|||
/- ──────────────────────────────────────────────────────────────────────────────
|
||||
Proofs/DecompressSpec.lean — phase 2, the constructive decompress chain,
|
||||
part 1: the arithmetic ingredients of `sqrt_ratio_i`.
|
||||
|
||||
· `pow_p58_spec` — a^((p−5)/8) via the pow22501 chain (Fermat-style,
|
||||
the invert_spec pattern with exponent 2²⁵² − 3);
|
||||
· √−1 — already certified (ConstSpecs.sqrt_m1_spec);
|
||||
· `fe_ct_eq_spec` — the constant-time field comparison decides
|
||||
denotational equality: to_bytes is CANONICAL
|
||||
(to_bytes_spec), so byte equality is residue
|
||||
equality in both directions.
|
||||
|
||||
Part 2 (sequel): the sqrt_ratio_i success-case walk, from_bytes, and
|
||||
`decompress_of_canonical` — the constructive upgrade of the point-level
|
||||
verification equation.
|
||||
────────────────────────────────────────────────────────────────────────────── -/
|
||||
import Proofs.PointEqSpec
|
||||
import Proofs.InvertSpec
|
||||
open Aeneas Aeneas.Std Result
|
||||
open curve25519
|
||||
|
||||
set_option maxHeartbeats 4000000
|
||||
set_option linter.unusedSimpArgs false
|
||||
set_option exponentiation.threshold 600
|
||||
|
||||
namespace CurveFieldProofs
|
||||
|
||||
open Aeneas.Std.WP
|
||||
|
||||
/-- a^((p−5)/8) = a^(2²⁵² − 3): the pow22501 chain squared twice and folded
|
||||
once more with a — the invert_spec pattern. -/
|
||||
theorem pow_p58_spec (a : Fe) (hba : Bnd a (2^54)) :
|
||||
field.FieldElement51.pow_p58 a ⦃ r => Bnd r (2^52) ∧ ⟪r⟫ = ⟪a⟫ ^ (2^252 - 3) ⦄ := by
|
||||
unfold field.FieldElement51.pow_p58
|
||||
let* ⟨ t19, t3, h1, h2, h3, h4 ⟩ ← pow22501_spec by bnd
|
||||
let* ⟨ t20, t20_post1, t20_post2 ⟩ ← pow2k_spec' by bnd
|
||||
let* ⟨ r, r_post1, r_post2 ⟩ ← mul_spec' by bnd
|
||||
refine ⟨by bnd, ?_⟩
|
||||
rw [r_post2, t20_post2, h3]
|
||||
rw [← pow_mul, ← pow_succ']
|
||||
congr 1
|
||||
|
||||
/- √−1: `sqrt_m1_spec` (ConstSpecs.lean) already pins the SQRT_M1 constant:
|
||||
Bnd s (2⁵²) ∧ ⟪s⟫·⟪s⟫ = −1 — reused as-is by the sqrt walk below. -/
|
||||
|
||||
/-- Byte-array value equality forces list equality (the converse of congr):
|
||||
little-endian digits are unique. -/
|
||||
theorem bytesVal_inj (sa sb : Std.Array Std.U8 32#usize)
|
||||
(h : bytesVal sa = bytesVal sb) : (↑sa : List Std.U8) = (↑sb : List Std.U8) := by
|
||||
obtain ⟨e0, e1, e2, e3, e4, e5, e6, e7, e8, e9, e10, e11, e12, e13, e14, e15,
|
||||
e16, e17, e18, e19, e20, e21, e22, e23, e24, e25, e26, e27, e28, e29, e30, e31,
|
||||
hel⟩ := Bytes32.exists_bytes sa
|
||||
obtain ⟨r0, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15,
|
||||
r16, r17, r18, r19, r20, r21, r22, r23, r24, r25, r26, r27, r28, r29, r30, r31,
|
||||
hrl⟩ := Bytes32.exists_bytes sb
|
||||
have hrq := (rangeEq_iff_bytesVal sa sb).mpr h
|
||||
have hpt : ∀ j, j < 32 → sa.val[j]! = sb.val[j]! := fun j hj => hrq j (Nat.zero_le _) hj
|
||||
have h0 : e0 = r0 := by simpa [hel, hrl] using hpt 0 (by norm_num)
|
||||
have h1 : e1 = r1 := by simpa [hel, hrl] using hpt 1 (by norm_num)
|
||||
have h2 : e2 = r2 := by simpa [hel, hrl] using hpt 2 (by norm_num)
|
||||
have h3 : e3 = r3 := by simpa [hel, hrl] using hpt 3 (by norm_num)
|
||||
have h4 : e4 = r4 := by simpa [hel, hrl] using hpt 4 (by norm_num)
|
||||
have h5 : e5 = r5 := by simpa [hel, hrl] using hpt 5 (by norm_num)
|
||||
have h6 : e6 = r6 := by simpa [hel, hrl] using hpt 6 (by norm_num)
|
||||
have h7 : e7 = r7 := by simpa [hel, hrl] using hpt 7 (by norm_num)
|
||||
have h8 : e8 = r8 := by simpa [hel, hrl] using hpt 8 (by norm_num)
|
||||
have h9 : e9 = r9 := by simpa [hel, hrl] using hpt 9 (by norm_num)
|
||||
have h10 : e10 = r10 := by simpa [hel, hrl] using hpt 10 (by norm_num)
|
||||
have h11 : e11 = r11 := by simpa [hel, hrl] using hpt 11 (by norm_num)
|
||||
have h12 : e12 = r12 := by simpa [hel, hrl] using hpt 12 (by norm_num)
|
||||
have h13 : e13 = r13 := by simpa [hel, hrl] using hpt 13 (by norm_num)
|
||||
have h14 : e14 = r14 := by simpa [hel, hrl] using hpt 14 (by norm_num)
|
||||
have h15 : e15 = r15 := by simpa [hel, hrl] using hpt 15 (by norm_num)
|
||||
have h16 : e16 = r16 := by simpa [hel, hrl] using hpt 16 (by norm_num)
|
||||
have h17 : e17 = r17 := by simpa [hel, hrl] using hpt 17 (by norm_num)
|
||||
have h18 : e18 = r18 := by simpa [hel, hrl] using hpt 18 (by norm_num)
|
||||
have h19 : e19 = r19 := by simpa [hel, hrl] using hpt 19 (by norm_num)
|
||||
have h20 : e20 = r20 := by simpa [hel, hrl] using hpt 20 (by norm_num)
|
||||
have h21 : e21 = r21 := by simpa [hel, hrl] using hpt 21 (by norm_num)
|
||||
have h22 : e22 = r22 := by simpa [hel, hrl] using hpt 22 (by norm_num)
|
||||
have h23 : e23 = r23 := by simpa [hel, hrl] using hpt 23 (by norm_num)
|
||||
have h24 : e24 = r24 := by simpa [hel, hrl] using hpt 24 (by norm_num)
|
||||
have h25 : e25 = r25 := by simpa [hel, hrl] using hpt 25 (by norm_num)
|
||||
have h26 : e26 = r26 := by simpa [hel, hrl] using hpt 26 (by norm_num)
|
||||
have h27 : e27 = r27 := by simpa [hel, hrl] using hpt 27 (by norm_num)
|
||||
have h28 : e28 = r28 := by simpa [hel, hrl] using hpt 28 (by norm_num)
|
||||
have h29 : e29 = r29 := by simpa [hel, hrl] using hpt 29 (by norm_num)
|
||||
have h30 : e30 = r30 := by simpa [hel, hrl] using hpt 30 (by norm_num)
|
||||
have h31 : e31 = r31 := by simpa [hel, hrl] using hpt 31 (by norm_num)
|
||||
rw [hel, hrl, h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13,
|
||||
h14, h15, h16, h17, h18, h19, h20, h21, h22, h23, h24, h25, h26, h27,
|
||||
h28, h29, h30, h31]
|
||||
|
||||
/-- Lists determine `bytesVal`. -/
|
||||
theorem bytesVal_congr {sa sb : Std.Array Std.U8 32#usize}
|
||||
(h : (↑sa : List Std.U8) = ↑sb) : bytesVal sa = bytesVal sb := by
|
||||
unfold bytesVal
|
||||
rw [h]
|
||||
|
||||
/-- **The canonical-bytes bridge**: for canonical serializations, byte-list
|
||||
equality IS denotational equality. -/
|
||||
theorem bytes_eq_iff_denote {a b : Fe} {sa sb : Std.Array Std.U8 32#usize}
|
||||
(hsa : bytesVal sa = feVal a % P) (hsb : bytesVal sb = feVal b % P) :
|
||||
(↑sa : List Std.U8) = ↑sb ↔ ⟪a⟫ = ⟪b⟫ := by
|
||||
haveI : NeZero P := ⟨by unfold P; norm_num⟩
|
||||
have hmod : ⟪a⟫ = ⟪b⟫ ↔ feVal a % P = feVal b % P := by
|
||||
unfold denote
|
||||
rw [ZMod.natCast_eq_natCast_iff]
|
||||
exact ⟨fun h => h, fun h => h⟩
|
||||
constructor
|
||||
· intro h
|
||||
rw [hmod, ← hsa, ← hsb]
|
||||
exact bytesVal_congr h
|
||||
· intro h
|
||||
apply bytesVal_inj
|
||||
rw [hsa, hsb]
|
||||
exact hmod.mp h
|
||||
|
||||
/-- **The constant-time field comparison decides denotational equality**:
|
||||
to_bytes is canonical, so byte equality IS residue equality. -/
|
||||
theorem fe_ct_eq_spec (a b : Fe) :
|
||||
backend.serial.u64.field.FieldElement51.Insts.SubtleConstantTimeEq.ct_eq a b
|
||||
⦃ c => (c.val = 0 ∨ c.val = 1) ∧ (c.val = 1 ↔ ⟪a⟫ = ⟪b⟫) ⦄ := by
|
||||
unfold backend.serial.u64.field.FieldElement51.Insts.SubtleConstantTimeEq.ct_eq
|
||||
step with (to_bytes_spec' a) as ⟨sa, hsa⟩
|
||||
step as ⟨la, hla⟩
|
||||
step with (to_bytes_spec' b) as ⟨sb, hsb⟩
|
||||
step as ⟨lb, hlb⟩
|
||||
simp only [Slice.Insts.SubtleConstantTimeEq.ct_eq]
|
||||
try simp only [spec_ok]
|
||||
have hlav : la.val = sa.val := by rw [hla]; rfl
|
||||
have hlbv : lb.val = sb.val := by rw [hlb]; rfl
|
||||
rw [hlav, hlbv]
|
||||
have hbridge := bytes_eq_iff_denote hsa hsb
|
||||
by_cases heq : (↑sa : List Std.U8) = ↑sb
|
||||
· rw [if_pos heq]
|
||||
exact ⟨Or.inr rfl, fun _ => hbridge.mp heq, fun _ => rfl⟩
|
||||
· rw [if_neg heq]
|
||||
refine ⟨Or.inl rfl, fun h01 => absurd h01 (by norm_num), fun hab => ?_⟩
|
||||
exact absurd (hbridge.mpr hab) heq
|
||||
|
||||
/-- u64 constant-time assign keeps `self` iff the choice is 0 (rfl on the
|
||||
FunsExternal model; restated locally — Proofs.Basic is a parallel root
|
||||
that clashes with the ConstSpecs chain). -/
|
||||
theorem u64_cond_assign (a b : Std.U64) (c : subtle.Choice) :
|
||||
U64.Insts.SubtleConditionallySelectable.conditional_assign a b c
|
||||
= ok (if c.val = 0 then a else b) := rfl
|
||||
|
||||
/-- **Limb-wise constant-time selection on field elements**: keeps `self`
|
||||
iff the choice is 0 — the in-place flavor `sqrt_ratio_i` uses twice
|
||||
(root flip and sign normalization). -/
|
||||
theorem fe_cond_assign_spec (a b : Fe) (c : subtle.Choice)
|
||||
(x0 x1 x2 x3 x4 y0 y1 y2 y3 y4 : U64)
|
||||
(ha : (↑a : List U64) = [x0, x1, x2, x3, x4])
|
||||
(hb : (↑b : List U64) = [y0, y1, y2, y3, y4]) :
|
||||
backend.serial.u64.field.FieldElement51.Insts.SubtleConditionallySelectable.conditional_assign
|
||||
a b c
|
||||
⦃ r => (↑r : List U64)
|
||||
= if c.val = 0 then [x0, x1, x2, x3, x4] else [y0, y1, y2, y3, y4] ⦄ := by
|
||||
unfold backend.serial.u64.field.FieldElement51.Insts.SubtleConditionallySelectable.conditional_assign
|
||||
step as ⟨i0, back0, hi0, hback0⟩
|
||||
step as ⟨i1, hi1⟩
|
||||
try simp only [u64_cond_assign, bind_tc_ok]
|
||||
step as ⟨i3, back1, hi3, hback1⟩
|
||||
try simp only [hback0] at *
|
||||
step as ⟨i4, hi4⟩
|
||||
try simp only [u64_cond_assign, bind_tc_ok]
|
||||
step as ⟨i6, back2, hi6, hback2⟩
|
||||
try simp only [hback1] at *
|
||||
step as ⟨i7, hi7⟩
|
||||
try simp only [u64_cond_assign, bind_tc_ok]
|
||||
step as ⟨i9, back3, hi9, hback3⟩
|
||||
try simp only [hback2] at *
|
||||
step as ⟨i10, hi10⟩
|
||||
try simp only [u64_cond_assign, bind_tc_ok]
|
||||
step as ⟨i12, back4, hi12, hback4⟩
|
||||
try simp only [hback3] at *
|
||||
step as ⟨i13, hi13⟩
|
||||
try simp only [u64_cond_assign, bind_tc_ok]
|
||||
try simp only [spec_ok]
|
||||
by_cases hc : c.val = 0
|
||||
· simp only [hc, if_pos rfl] at *
|
||||
simp_all [Array.set_val_eq, ha, hb]
|
||||
· simp only [if_neg hc] at *
|
||||
simp_all [Array.set_val_eq, ha, hb]
|
||||
|
||||
/-- **THE SQUARE-ROOT CORE** (pure 𝔽_p): if u/v is a square (witness x)
|
||||
with v ≠ 0, the candidate r = (u·v³)·(u·v⁷)^((p−5)/8) satisfies
|
||||
v·r² = ±u — the algebraic heart of `sqrt_ratio_i`. The v-part of the
|
||||
exponent collapses by Fermat; the residual x^((p−1)/2) is ±1. -/
|
||||
theorem sqrt_core (u v x : Fp) (hv : v ≠ 0) (hx : x ^ 2 * v = u) :
|
||||
v * (u * v^3 * (u * v^7)^(2^252 - 3))^2 = u ∨
|
||||
v * (u * v^3 * (u * v^7)^(2^252 - 3))^2 = -u := by
|
||||
haveI : Fact (Nat.Prime P) := ⟨P_prime⟩
|
||||
by_cases hx0 : x = 0
|
||||
· -- x = 0 forces u = 0 and the candidate is 0 = u
|
||||
left
|
||||
have hu : u = 0 := by rw [← hx, hx0]; ring
|
||||
rw [hu]
|
||||
ring
|
||||
· set w : Fp := u * v^7 with hwdef
|
||||
have hw : w = x^2 * v^8 := by rw [hwdef, ← hx]; ring
|
||||
have hfer_v : v ^ (P - 1) = 1 := ZMod.pow_card_sub_one_eq_one hv
|
||||
have hfer_x2 : (x ^ ((P-1)/2))^2 = 1 := by
|
||||
rw [← pow_mul]
|
||||
have he : (P-1)/2 * 2 = P - 1 := by unfold P; norm_num
|
||||
rw [he]
|
||||
exact ZMod.pow_card_sub_one_eq_one hx0
|
||||
have hpm : x ^ ((P-1)/2) = 1 ∨ x ^ ((P-1)/2) = -1 := by
|
||||
have hfac : (x ^ ((P-1)/2) - 1) * (x ^ ((P-1)/2) + 1) = 0 := by
|
||||
linear_combination hfer_x2
|
||||
rcases mul_eq_zero.mp hfac with h' | h'
|
||||
· left; linear_combination h'
|
||||
· right; linear_combination h'
|
||||
have hkey : v * (u * v^3 * w^(2^252 - 3))^2 = u * x^((P-1)/2) := by
|
||||
have h1 : v * (u * v^3 * w^(2^252-3))^2 = u * w * (w^(2^252-3))^2 := by
|
||||
rw [hwdef]; ring
|
||||
have h2 : (w^(2^252-3) : Fp)^2 = w^(2^253-6) := by
|
||||
rw [← pow_mul]
|
||||
norm_num
|
||||
have h3 : (u * w * w^(2^253-6) : Fp) = u * w^(2^253-5) := by
|
||||
have : (w * w^(2^253-6) : Fp) = w^(2^253-5) := by
|
||||
rw [← pow_succ']
|
||||
norm_num
|
||||
rw [mul_assoc, this]
|
||||
rw [h1, h2, h3, hw]
|
||||
have h4 : ((x^2 * v^8 : Fp))^(2^253-5) = x^(2^254-10) * v^(2^256-40) := by
|
||||
rw [mul_pow, ← pow_mul, ← pow_mul]
|
||||
norm_num
|
||||
rw [h4]
|
||||
have h5 : (v : Fp)^(2^256-40) = 1 := by
|
||||
have he : (2^256 - 40 : ℕ) = (P - 1) * 2 := by unfold P; norm_num
|
||||
rw [he, pow_mul, hfer_v, one_pow]
|
||||
have h6 : (2^254 - 10 : ℕ) = (P-1)/2 := by unfold P; norm_num
|
||||
rw [h5, h6]
|
||||
ring
|
||||
rcases hpm with h | h
|
||||
· left; rw [hkey, h, mul_one]
|
||||
· right; rw [hkey, h]; ring
|
||||
|
||||
/-- In 𝔽_p (p odd), an element equal to its own negative is zero. -/
|
||||
theorem eq_neg_self_iff_zero (a : Fp) : a = -a ↔ a = 0 := by
|
||||
constructor
|
||||
· intro h
|
||||
have h2 : (2 : Fp) * a = 0 := by linear_combination h
|
||||
rcases mul_eq_zero.mp h2 with h' | h'
|
||||
· exact absurd h' two_ne_zero_Fp
|
||||
· exact h'
|
||||
· intro h; rw [h]; ring
|
||||
|
||||
/-- 1 + √−1 does not vanish (else −1 = 1, contradicting p odd). -/
|
||||
theorem one_add_i_ne_zero {i : Fp} (hi : i * i = -1) : (1 : Fp) + i ≠ 0 := by
|
||||
intro h
|
||||
have him : i = -1 := by linear_combination h
|
||||
rw [him] at hi
|
||||
have : (2 : Fp) = 0 := by linear_combination hi
|
||||
exact two_ne_zero_Fp this
|
||||
|
||||
/-- **THE SQUARE-ROOT WALK** (success case): if u/v is a square (witness x,
|
||||
v ≠ 0), `sqrt_ratio_i` returns choice 1 and the even-parity root:
|
||||
r² · v = u with r's canonical residue even. -/
|
||||
theorem sqrt_ratio_i_sq_spec (u v : Fe) (hbu : Bnd u (2^54)) (hbv : Bnd v (2^54))
|
||||
(hvne : ⟪v⟫ ≠ 0) (x : Fp) (hx : x ^ 2 * ⟪v⟫ = ⟪u⟫) :
|
||||
field.FieldElement51.sqrt_ratio_i u v ⦃ cr =>
|
||||
cr.1.val = 1 ∧ Bnd cr.2 (2^52) ∧
|
||||
⟪cr.2⟫ ^ 2 * ⟪v⟫ = ⟪u⟫ ∧ (⟪cr.2⟫).val % 2 = 0 ⦄ := by
|
||||
haveI : NeZero P := ⟨by unfold P; norm_num⟩
|
||||
unfold field.FieldElement51.sqrt_ratio_i
|
||||
-- the arithmetic chain: v³, v⁷, u·v³, u·v⁷, (u·v⁷)^((p−5)/8), r, r², check
|
||||
let* ⟨ fe, hbfe, hfe ⟩ ← square_spec' by bnd
|
||||
let* ⟨ v3, hbv3, hv3 ⟩ ← mul_spec' by bnd
|
||||
let* ⟨ fe1, hbfe1, hfe1 ⟩ ← square_spec' by bnd
|
||||
let* ⟨ v7, hbv7, hv7 ⟩ ← mul_spec' by bnd
|
||||
let* ⟨ fe2, hbfe2, hfe2 ⟩ ← mul_spec' by bnd
|
||||
let* ⟨ fe3, hbfe3, hfe3 ⟩ ← mul_spec' by bnd
|
||||
let* ⟨ fe4, hbfe4, hfe4 ⟩ ← pow_p58_spec by bnd
|
||||
let* ⟨ r, hbr, hr ⟩ ← mul_spec' by bnd
|
||||
let* ⟨ fe5, hbfe5, hfe5 ⟩ ← square_spec' by bnd
|
||||
let* ⟨ check, hbcheck, hcheck ⟩ ← mul_spec' by bnd
|
||||
-- √−1
|
||||
step with sqrt_m1_spec as ⟨im, hbim, him⟩
|
||||
-- the three constant-time checks
|
||||
step with (fe_ct_eq_spec check u) as ⟨correct, hc01, hciff⟩
|
||||
-- −u (needs u's limbs)
|
||||
obtain ⟨u0, u1, u2, u3, u4, hul⟩ := Fe.exists_limbs u
|
||||
unfold Shared0FieldElement51.Insts.CoreOpsArithNegFieldElement51.neg
|
||||
step with (neg_spec u u0 u1 u2 u3 u4 hul (by bnd)) as ⟨fe6, hbfe6, hfe6⟩
|
||||
step with (fe_ct_eq_spec check fe6) as ⟨flipped, hf01, hfiff⟩
|
||||
let* ⟨ fe7, hbfe7, hfe7 ⟩ ← mul_spec' by bnd
|
||||
step with (fe_ct_eq_spec check fe7) as ⟨flipped_i, hfi01, hfiiff⟩
|
||||
-- r′ = √−1 · r
|
||||
let* ⟨ r_prime, hbrp, hrp ⟩ ← mul_spec' by bnd
|
||||
-- the flip choice and the root flip
|
||||
simp only [subtle.Choice.Insts.CoreOpsBitBitOrChoiceChoice.bitor, bind_tc_ok]
|
||||
obtain ⟨rr0, rr1, rr2, rr3, rr4, hrl⟩ := Fe.exists_limbs r
|
||||
obtain ⟨rp0, rp1, rp2, rp3, rp4, hrpl⟩ := Fe.exists_limbs r_prime
|
||||
step with (fe_cond_assign_spec r r_prime _ rr0 rr1 rr2 rr3 rr4 rp0 rp1 rp2 rp3 rp4 hrl hrpl)
|
||||
as ⟨r1, hr1l⟩
|
||||
-- sign normalization
|
||||
step with (is_negative_spec r1) as ⟨rneg, hrneg⟩
|
||||
obtain ⟨q0, q1, q2, q3, q4, hq⟩ := Fe.exists_limbs r1
|
||||
-- Bnd r1 (2^52): its list is one of the two bounded lists
|
||||
have hbr1 : Bnd r1 (2^52) := by
|
||||
have hb1 : Bnd r (2^52) := Bnd.mono hbr (by norm_num)
|
||||
have hb2 : Bnd r_prime (2^52) := Bnd.mono hbrp (by norm_num)
|
||||
split at hr1l
|
||||
· rw [Bnd_eq r1 rr0 rr1 rr2 rr3 rr4 _ (by rw [hr1l])]
|
||||
rw [Bnd_eq r rr0 rr1 rr2 rr3 rr4 _ hrl] at hb1
|
||||
exact hb1
|
||||
· rw [Bnd_eq r1 rp0 rp1 rp2 rp3 rp4 _ (by rw [hr1l])]
|
||||
rw [Bnd_eq r_prime rp0 rp1 rp2 rp3 rp4 _ hrpl] at hb2
|
||||
exact hb2
|
||||
-- −r1 and the parity select
|
||||
step with (neg_spec r1 q0 q1 q2 q3 q4 hq (Bnd.mono hbr1 (by norm_num)))
|
||||
as ⟨r_neg, hbrn, hrn⟩
|
||||
obtain ⟨n0, n1, n2, n3, n4, hnl⟩ := Fe.exists_limbs r_neg
|
||||
step with (fe_cond_assign_spec r1 r_neg _ q0 q1 q2 q3 q4 n0 n1 n2 n3 n4 hq hnl)
|
||||
as ⟨r2, hr2l⟩
|
||||
try simp only [spec_ok]
|
||||
-- ── interpreted values ───────────────────────────────────────────────────
|
||||
have hfe2v : ⟪fe2⟫ = ⟪u⟫ * ⟪v⟫^3 := by rw [hfe2, hv3, hfe]; ring
|
||||
have hfe3v : ⟪fe3⟫ = ⟪u⟫ * ⟪v⟫^7 := by rw [hfe3, hv7, hfe1, hv3, hfe]; ring
|
||||
have hrval : ⟪r⟫ = ⟪u⟫ * ⟪v⟫^3 * (⟪u⟫ * ⟪v⟫^7)^(2^252-3) := by
|
||||
rw [hr, hfe2v, hfe4, hfe3v]
|
||||
have hcheckv : ⟪check⟫ = ⟪v⟫ * ⟪r⟫^2 := by rw [hcheck, hfe5]; ring
|
||||
have hcore := sqrt_core ⟪u⟫ ⟪v⟫ x hvne hx
|
||||
rw [← hrval] at hcore
|
||||
have hrpv : ⟪r_prime⟫ = ⟪im⟫ * ⟪r⟫ := hrp
|
||||
-- denote transfer along the two selects
|
||||
have hr1d : (flipped ||| flipped_i).val = 0 ∧ ⟪r1⟫ = ⟪r⟫ ∨
|
||||
(flipped ||| flipped_i).val ≠ 0 ∧ ⟪r1⟫ = ⟪r_prime⟫ := by
|
||||
split at hr1l
|
||||
· left
|
||||
refine ⟨by assumption, ?_⟩
|
||||
unfold denote
|
||||
rw [feVal_eq r1 rr0 rr1 rr2 rr3 rr4 (by rw [hr1l]),
|
||||
feVal_eq r rr0 rr1 rr2 rr3 rr4 hrl]
|
||||
· right
|
||||
refine ⟨by assumption, ?_⟩
|
||||
unfold denote
|
||||
rw [feVal_eq r1 rp0 rp1 rp2 rp3 rp4 (by rw [hr1l]),
|
||||
feVal_eq r_prime rp0 rp1 rp2 rp3 rp4 hrpl]
|
||||
have hr2d : rneg.val = 0 ∧ ⟪r2⟫ = ⟪r1⟫ ∨ rneg.val ≠ 0 ∧ ⟪r2⟫ = ⟪r_neg⟫ := by
|
||||
split at hr2l
|
||||
· left
|
||||
refine ⟨by assumption, ?_⟩
|
||||
unfold denote
|
||||
rw [feVal_eq r2 q0 q1 q2 q3 q4 (by rw [hr2l]),
|
||||
feVal_eq r1 q0 q1 q2 q3 q4 hq]
|
||||
· right
|
||||
refine ⟨by assumption, ?_⟩
|
||||
unfold denote
|
||||
rw [feVal_eq r2 n0 n1 n2 n3 n4 (by rw [hr2l]),
|
||||
feVal_eq r_neg n0 n1 n2 n3 n4 hnl]
|
||||
-- ── choice values from the three checks ──────────────────────────────────
|
||||
-- the value equation carried by r1 in every case: ⟪r1⟫²·⟪v⟫ = ⟪u⟫ and the
|
||||
-- flip choice consistent with the branch taken
|
||||
have hval1 : ⟪r1⟫ ^ 2 * ⟪v⟫ = ⟪u⟫ ∧ (correct ||| flipped).val = 1 := by
|
||||
haveI : Fact (Nat.Prime P) := ⟨P_prime⟩
|
||||
have hc01' := hc01
|
||||
have hf01' := hf01
|
||||
have hfi01' := hfi01
|
||||
by_cases hu0 : ⟪u⟫ = 0
|
||||
· -- u = 0: check = v·r² = ±0 = 0; every flag fires; r1 = im·r with r-part 0
|
||||
have hchk0 : ⟪check⟫ = 0 := by
|
||||
rcases hcore with h | h <;> rw [hcheckv]
|
||||
· rw [show ⟪v⟫ * ⟪r⟫^2 = ⟪v⟫ * (⟪u⟫ * ⟪v⟫^3 * (⟪u⟫*⟪v⟫^7)^(2^252-3))^2 from by rw [hrval]]
|
||||
rw [hrval] at h
|
||||
rw [h, hu0]
|
||||
· rw [hrval] at h ⊢
|
||||
rw [h, hu0]
|
||||
ring
|
||||
have hr0 : ⟪v⟫ * ⟪r⟫^2 = 0 := by rw [← hcheckv]; exact hchk0
|
||||
have hrz : ⟪r⟫ = 0 := by
|
||||
rcases mul_eq_zero.mp hr0 with h | h
|
||||
· exact absurd h hvne
|
||||
· exact pow_eq_zero_iff (n := 2) (by norm_num) |>.mp h
|
||||
have hcv : correct.val = 1 := hciff.mpr (by rw [hchk0, hu0])
|
||||
have hor1 : (correct ||| flipped).val = 1 := by
|
||||
rcases hf01 with h0 | h1
|
||||
· have : flipped = 0#u8 := UScalar.eq_of_val_eq (by simp [h0])
|
||||
rw [this]
|
||||
have : correct = 1#u8 := UScalar.eq_of_val_eq (by simp [hcv])
|
||||
rw [this]
|
||||
rfl
|
||||
· have : flipped = 1#u8 := UScalar.eq_of_val_eq (by simp [h1])
|
||||
rw [this]
|
||||
have : correct = 1#u8 := UScalar.eq_of_val_eq (by simp [hcv])
|
||||
rw [this]
|
||||
rfl
|
||||
refine ⟨?_, hor1⟩
|
||||
rcases hr1d with ⟨-, hd⟩ | ⟨-, hd⟩
|
||||
· rw [hd, hrz, hu0]; ring
|
||||
· rw [hd, hrpv, hrz, hu0]; ring
|
||||
· -- u ≠ 0: the disjunct decides everything
|
||||
rcases hcore with hA | hB
|
||||
· -- v·r² = u: no flip, correct = 1
|
||||
have hcv : correct.val = 1 := hciff.mpr (by rw [hcheckv]; exact hA)
|
||||
have hfv : flipped.val = 0 := by
|
||||
rcases hf01 with h | h
|
||||
· exact h
|
||||
· exfalso
|
||||
have := hfiff.mp h
|
||||
rw [hcheckv, hfe6] at this
|
||||
rw [hA] at this
|
||||
exact hu0 ((eq_neg_self_iff_zero ⟪u⟫).mp this)
|
||||
have hfiv : flipped_i.val = 0 := by
|
||||
rcases hfi01 with h | h
|
||||
· exact h
|
||||
· exfalso
|
||||
have := hfiiff.mp h
|
||||
rw [hcheckv, hfe7, hfe6] at this
|
||||
rw [hA] at this
|
||||
have hfac : ⟪u⟫ * (1 + ⟪im⟫) = 0 := by linear_combination this
|
||||
rcases mul_eq_zero.mp hfac with h' | h'
|
||||
· exact hu0 h'
|
||||
· exact one_add_i_ne_zero (by rw [← sq]; rw [sq]; exact him) h'
|
||||
have hflip0 : (flipped ||| flipped_i).val = 0 := by
|
||||
have h1 : flipped = 0#u8 := UScalar.eq_of_val_eq (by simp [hfv])
|
||||
have h2 : flipped_i = 0#u8 := UScalar.eq_of_val_eq (by simp [hfiv])
|
||||
rw [h1, h2]
|
||||
rfl
|
||||
refine ⟨?_, ?_⟩
|
||||
· rcases hr1d with ⟨-, hd⟩ | ⟨hne, -⟩
|
||||
· rw [hd]; linear_combination hA
|
||||
· exact absurd hflip0 hne
|
||||
· have h1 : correct = 1#u8 := UScalar.eq_of_val_eq (by simp [hcv])
|
||||
have h2 : flipped = 0#u8 := UScalar.eq_of_val_eq (by simp [hfv])
|
||||
rw [h1, h2]
|
||||
rfl
|
||||
· -- v·r² = −u: flip fires, r1 = im·r
|
||||
have hfv : flipped.val = 1 := hfiff.mpr (by rw [hcheckv, hfe6]; exact hB)
|
||||
have hflip1 : (flipped ||| flipped_i).val ≠ 0 := by
|
||||
have h1 : flipped = 1#u8 := UScalar.eq_of_val_eq (by simp [hfv])
|
||||
rw [h1]
|
||||
rcases hfi01 with h | h
|
||||
· have h2 : flipped_i = 0#u8 := UScalar.eq_of_val_eq (by simp [h])
|
||||
rw [h2]
|
||||
decide
|
||||
· have h2 : flipped_i = 1#u8 := UScalar.eq_of_val_eq (by simp [h])
|
||||
rw [h2]
|
||||
decide
|
||||
refine ⟨?_, ?_⟩
|
||||
· rcases hr1d with ⟨h0, -⟩ | ⟨-, hd⟩
|
||||
· exact absurd h0 hflip1
|
||||
· rw [hd, hrpv]
|
||||
have him2 : ⟪im⟫ ^ 2 = -1 := by rw [sq]; exact him
|
||||
have : (⟪im⟫ * ⟪r⟫) ^ 2 * ⟪v⟫ = ⟪im⟫^2 * (⟪v⟫ * ⟪r⟫^2) := by ring
|
||||
rw [this, him2, hB]
|
||||
ring
|
||||
· have h2 : flipped = 1#u8 := UScalar.eq_of_val_eq (by simp [hfv])
|
||||
rw [h2]
|
||||
rcases hc01 with h | h
|
||||
· have h1 : correct = 0#u8 := UScalar.eq_of_val_eq (by simp [h])
|
||||
rw [h1]
|
||||
rfl
|
||||
· have h1 : correct = 1#u8 := UScalar.eq_of_val_eq (by simp [h])
|
||||
rw [h1]
|
||||
rfl
|
||||
obtain ⟨hval1', hwas⟩ := hval1
|
||||
-- ── parity normalization and the final post ─────────────────────────────
|
||||
haveI : NeZero P := ⟨by unfold P; norm_num⟩
|
||||
have hrnegv : rneg.val = (⟪r1⟫).val % 2 := by
|
||||
rw [hrneg]
|
||||
unfold denote
|
||||
rw [ZMod.val_natCast]
|
||||
have hbr2 : Bnd r2 (2^52) := by
|
||||
split at hr2l
|
||||
· rw [Bnd_eq r2 q0 q1 q2 q3 q4 _ (by rw [hr2l])]
|
||||
rw [Bnd_eq r1 q0 q1 q2 q3 q4 _ hq] at hbr1
|
||||
exact hbr1
|
||||
· have hb3 : Bnd r_neg (2^52) := hbrn
|
||||
rw [Bnd_eq r2 n0 n1 n2 n3 n4 _ (by rw [hr2l])]
|
||||
rw [Bnd_eq r_neg n0 n1 n2 n3 n4 _ hnl] at hb3
|
||||
exact hb3
|
||||
refine ⟨hwas, hbr2, ?_, ?_⟩
|
||||
· -- the square equation survives the sign normalization
|
||||
rcases hr2d with ⟨-, hd⟩ | ⟨-, hd⟩
|
||||
· rw [hd]; exact hval1'
|
||||
· rw [hd, hrn]
|
||||
have : (-⟪r1⟫) ^ 2 * ⟪v⟫ = ⟪r1⟫ ^ 2 * ⟪v⟫ := by ring
|
||||
rw [this]
|
||||
exact hval1'
|
||||
· -- even parity
|
||||
rcases hr2d with ⟨h0, hd⟩ | ⟨hne, hd⟩
|
||||
· rw [hd]
|
||||
rw [hrnegv] at h0
|
||||
exact h0
|
||||
· rw [hd, hrn]
|
||||
have hodd : rneg.val = 1 := by
|
||||
have := hrnegv
|
||||
omega
|
||||
rw [hrnegv] at hodd
|
||||
have hr1nz : ⟪r1⟫ ≠ 0 := by
|
||||
intro hz
|
||||
rw [hz] at hodd
|
||||
simp at hodd
|
||||
have hnegval : (-⟪r1⟫).val = P - (⟪r1⟫).val := by
|
||||
rw [ZMod.neg_val, if_neg hr1nz]
|
||||
rw [hnegval]
|
||||
have hlt := ZMod.val_lt ⟪r1⟫
|
||||
have hpodd : P % 2 = 1 := by unfold P; norm_num
|
||||
have hpos : 0 < (⟪r1⟫).val := by
|
||||
rcases Nat.eq_zero_or_pos (⟪r1⟫).val with h | h
|
||||
· exact absurd ((ZMod.val_eq_zero _).mp h) hr1nz
|
||||
· exact h
|
||||
omega
|
||||
|
||||
end CurveFieldProofs
|
||||
438
verification/Proofs/FromBytesSpec.lean
Normal file
438
verification/Proofs/FromBytesSpec.lean
Normal file
|
|
@ -0,0 +1,438 @@
|
|||
/- ──────────────────────────────────────────────────────────────────────────────
|
||||
Proofs/FromBytesSpec.lean — phase 2, decompress step 2: the byte parser.
|
||||
|
||||
`FieldElement51::from_bytes` loads five 64-bit little-endian windows at
|
||||
byte offsets 0/6/12/19/24, shifts by 0/3/6/1/12, and masks to 51 bits —
|
||||
the windows tile bits 0..254 exactly, so
|
||||
|
||||
feVal (from_bytes b) = bytesVal b mod 2²⁵⁵ (from_bytes_spec)
|
||||
|
||||
— the top bit is discarded, everything else is exact. This is the y-parse
|
||||
of decompression: for a canonical encoding (y-residue + sign bit), the
|
||||
parsed field element denotes exactly the y-residue.
|
||||
|
||||
Structure: a generic 8-byte loader lemma (`load8_at_spec`, the disjoint-OR
|
||||
idiom), a pure window/digit identity (`limbs_of_bytes`), and the walk.
|
||||
────────────────────────────────────────────────────────────────────────────── -/
|
||||
import Proofs.DecompressSpec
|
||||
open Aeneas Aeneas.Std Result
|
||||
open curve25519
|
||||
|
||||
set_option maxHeartbeats 8000000
|
||||
set_option linter.unusedSimpArgs false
|
||||
set_option maxRecDepth 8000
|
||||
|
||||
namespace CurveFieldProofs
|
||||
|
||||
open Aeneas.Std.WP
|
||||
|
||||
/-- Disjoint low-bits OR is addition (product-order-robust form). -/
|
||||
theorem or_add_low {a b : ℕ} (k : ℕ) (ha : a < 2^k) :
|
||||
a ||| b * 2^k = a + b * 2^k := by
|
||||
have hor := Nat.two_pow_add_eq_or_of_lt (b := a) (i := k) ha b
|
||||
calc a ||| b * 2^k = a ||| 2^k * b := by rw [Nat.mul_comm b]
|
||||
_ = 2^k * b ||| a := Nat.lor_comm _ _
|
||||
_ = 2^k * b + a := hor.symm
|
||||
_ = a + b * 2^k := by ring
|
||||
|
||||
/-- Generic 8-byte little-endian loader: given the eight bytes at positions
|
||||
i..i+7, the loaded word is their LE value. -/
|
||||
theorem load8_at_spec (s : Slice Std.U8) (i : Std.Usize)
|
||||
(c0 c1 c2 c3 c4 c5 c6 c7 : Std.U8)
|
||||
(hlen : i.val + 7 < s.length)
|
||||
(h0 : s.val[i.val]! = c0) (h1 : s.val[i.val + 1]! = c1)
|
||||
(h2 : s.val[i.val + 2]! = c2) (h3 : s.val[i.val + 3]! = c3)
|
||||
(h4 : s.val[i.val + 4]! = c4) (h5 : s.val[i.val + 5]! = c5)
|
||||
(h6 : s.val[i.val + 6]! = c6) (h7 : s.val[i.val + 7]! = c7) :
|
||||
backend.serial.u64.field.FieldElement51.from_bytes.load8_at s i ⦃ w =>
|
||||
w.val = c0.val + c1.val * 2^8 + c2.val * 2^16 + c3.val * 2^24
|
||||
+ c4.val * 2^32 + c5.val * 2^40 + c6.val * 2^48 + c7.val * 2^56 ⦄ := by
|
||||
unfold backend.serial.u64.field.FieldElement51.from_bytes.load8_at
|
||||
step as ⟨x0, hx0⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) i.val (by scalar_tac)] at hx0
|
||||
rw [h0] at hx0
|
||||
step as ⟨w0, hw0⟩
|
||||
have hw0v : w0.val = c0.val := by
|
||||
rw [hw0, UScalar.cast_val_eq, hx0]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨p1, hp1⟩
|
||||
have hp1v : p1.val = i.val + 1 := by scalar_tac
|
||||
step as ⟨x1, hx1⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p1.val (by scalar_tac)] at hx1
|
||||
rw [hp1v, h1] at hx1
|
||||
step as ⟨y1, hy1⟩
|
||||
have hy1v : y1.val = c1.val := by
|
||||
rw [hy1, UScalar.cast_val_eq, hx1]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t1, ht1⟩
|
||||
have ht1v : t1.val = c1.val * 2^8 := by
|
||||
rw [ht1]
|
||||
simp only [Nat.shiftLeft_eq, hy1v]
|
||||
rw [Nat.mod_eq_of_lt (show c1.val * 2^8 < U64.size by scalar_tac)]
|
||||
step as ⟨w1, hw1⟩
|
||||
have hw1v : w1.val = c0.val + c1.val * 2^8 := by
|
||||
rw [hw1, UScalar.val_or, hw0v, ht1v]
|
||||
rw [or_add_low 8 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp1 hp1v hx1 hy1 hy1v ht1 ht1v hw0 hw0v
|
||||
step as ⟨p2, hp2⟩
|
||||
have hp2v : p2.val = i.val + 2 := by scalar_tac
|
||||
step as ⟨x2, hx2⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p2.val (by scalar_tac)] at hx2
|
||||
rw [hp2v, h2] at hx2
|
||||
step as ⟨y2, hy2⟩
|
||||
have hy2v : y2.val = c2.val := by
|
||||
rw [hy2, UScalar.cast_val_eq, hx2]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t2, ht2⟩
|
||||
have ht2v : t2.val = c2.val * 2^16 := by
|
||||
rw [ht2]
|
||||
simp only [Nat.shiftLeft_eq, hy2v]
|
||||
rw [Nat.mod_eq_of_lt (show c2.val * 2^16 < U64.size by scalar_tac)]
|
||||
step as ⟨w2, hw2⟩
|
||||
have hw2v : w2.val = c0.val + c1.val * 2^8 + c2.val * 2^16 := by
|
||||
rw [hw2, UScalar.val_or, hw1v, ht2v]
|
||||
rw [or_add_low 16 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp2 hp2v hx2 hy2 hy2v ht2 ht2v hw1 hw1v
|
||||
step as ⟨p3, hp3⟩
|
||||
have hp3v : p3.val = i.val + 3 := by scalar_tac
|
||||
step as ⟨x3, hx3⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p3.val (by scalar_tac)] at hx3
|
||||
rw [hp3v, h3] at hx3
|
||||
step as ⟨y3, hy3⟩
|
||||
have hy3v : y3.val = c3.val := by
|
||||
rw [hy3, UScalar.cast_val_eq, hx3]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t3, ht3⟩
|
||||
have ht3v : t3.val = c3.val * 2^24 := by
|
||||
rw [ht3]
|
||||
simp only [Nat.shiftLeft_eq, hy3v]
|
||||
rw [Nat.mod_eq_of_lt (show c3.val * 2^24 < U64.size by scalar_tac)]
|
||||
step as ⟨w3, hw3⟩
|
||||
have hw3v : w3.val = c0.val + c1.val * 2^8 + c2.val * 2^16 + c3.val * 2^24 := by
|
||||
rw [hw3, UScalar.val_or, hw2v, ht3v]
|
||||
rw [or_add_low 24 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp3 hp3v hx3 hy3 hy3v ht3 ht3v hw2 hw2v
|
||||
step as ⟨p4, hp4⟩
|
||||
have hp4v : p4.val = i.val + 4 := by scalar_tac
|
||||
step as ⟨x4, hx4⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p4.val (by scalar_tac)] at hx4
|
||||
rw [hp4v, h4] at hx4
|
||||
step as ⟨y4, hy4⟩
|
||||
have hy4v : y4.val = c4.val := by
|
||||
rw [hy4, UScalar.cast_val_eq, hx4]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t4, ht4⟩
|
||||
have ht4v : t4.val = c4.val * 2^32 := by
|
||||
rw [ht4]
|
||||
simp only [Nat.shiftLeft_eq, hy4v]
|
||||
rw [Nat.mod_eq_of_lt (show c4.val * 2^32 < U64.size by scalar_tac)]
|
||||
step as ⟨w4, hw4⟩
|
||||
have hw4v : w4.val = c0.val + c1.val * 2^8 + c2.val * 2^16 + c3.val * 2^24 + c4.val * 2^32 := by
|
||||
rw [hw4, UScalar.val_or, hw3v, ht4v]
|
||||
rw [or_add_low 32 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp4 hp4v hx4 hy4 hy4v ht4 ht4v hw3 hw3v
|
||||
step as ⟨p5, hp5⟩
|
||||
have hp5v : p5.val = i.val + 5 := by scalar_tac
|
||||
step as ⟨x5, hx5⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p5.val (by scalar_tac)] at hx5
|
||||
rw [hp5v, h5] at hx5
|
||||
step as ⟨y5, hy5⟩
|
||||
have hy5v : y5.val = c5.val := by
|
||||
rw [hy5, UScalar.cast_val_eq, hx5]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t5, ht5⟩
|
||||
have ht5v : t5.val = c5.val * 2^40 := by
|
||||
rw [ht5]
|
||||
simp only [Nat.shiftLeft_eq, hy5v]
|
||||
rw [Nat.mod_eq_of_lt (show c5.val * 2^40 < U64.size by scalar_tac)]
|
||||
step as ⟨w5, hw5⟩
|
||||
have hw5v : w5.val = c0.val + c1.val * 2^8 + c2.val * 2^16 + c3.val * 2^24 + c4.val * 2^32 + c5.val * 2^40 := by
|
||||
rw [hw5, UScalar.val_or, hw4v, ht5v]
|
||||
rw [or_add_low 40 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp5 hp5v hx5 hy5 hy5v ht5 ht5v hw4 hw4v
|
||||
step as ⟨p6, hp6⟩
|
||||
have hp6v : p6.val = i.val + 6 := by scalar_tac
|
||||
step as ⟨x6, hx6⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p6.val (by scalar_tac)] at hx6
|
||||
rw [hp6v, h6] at hx6
|
||||
step as ⟨y6, hy6⟩
|
||||
have hy6v : y6.val = c6.val := by
|
||||
rw [hy6, UScalar.cast_val_eq, hx6]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t6, ht6⟩
|
||||
have ht6v : t6.val = c6.val * 2^48 := by
|
||||
rw [ht6]
|
||||
simp only [Nat.shiftLeft_eq, hy6v]
|
||||
rw [Nat.mod_eq_of_lt (show c6.val * 2^48 < U64.size by scalar_tac)]
|
||||
step as ⟨w6, hw6⟩
|
||||
have hw6v : w6.val = c0.val + c1.val * 2^8 + c2.val * 2^16 + c3.val * 2^24 + c4.val * 2^32 + c5.val * 2^40 + c6.val * 2^48 := by
|
||||
rw [hw6, UScalar.val_or, hw5v, ht6v]
|
||||
rw [or_add_low 48 (by scalar_tac)]
|
||||
try ring
|
||||
clear hp6 hp6v hx6 hy6 hy6v ht6 ht6v hw5 hw5v
|
||||
step as ⟨p7, hp7⟩
|
||||
have hp7v : p7.val = i.val + 7 := by scalar_tac
|
||||
step as ⟨x7, hx7⟩
|
||||
rw [← getElem!_pos (↑s : List Std.U8) p7.val (by scalar_tac)] at hx7
|
||||
rw [hp7v, h7] at hx7
|
||||
step as ⟨y7, hy7⟩
|
||||
have hy7v : y7.val = c7.val := by
|
||||
rw [hy7, UScalar.cast_val_eq, hx7]
|
||||
norm_num [UScalarTy.numBits]
|
||||
scalar_tac
|
||||
step as ⟨t7, ht7⟩
|
||||
have ht7v : t7.val = c7.val * 2^56 := by
|
||||
rw [ht7]
|
||||
simp only [Nat.shiftLeft_eq, hy7v]
|
||||
rw [Nat.mod_eq_of_lt (show c7.val * 2^56 < U64.size by scalar_tac)]
|
||||
try simp only [spec_ok]
|
||||
rw [UScalar.val_or, hw6v, ht7v]
|
||||
rw [or_add_low 56 (by scalar_tac)]
|
||||
try ring
|
||||
|
||||
|
||||
/-- Extract a 64-bit window: with the value decomposed as low + 2^m·window
|
||||
+ 2^m·2^64·high (window < 2^64, low < 2^m), division and mod recover the
|
||||
window. -/
|
||||
theorem window_extract (Lo M H : ℕ) (m : ℕ) (hL : Lo < 2^m) (hM : M < 2^64) :
|
||||
(Lo + 2^m * M + 2^m * 2^64 * H) / 2^m % 2^64 = M := by
|
||||
have h1 : (Lo + 2^m * M + 2^m * 2^64 * H) / 2^m = M + 2^64 * H := by
|
||||
rw [show Lo + 2^m * M + 2^m * 2^64 * H = Lo + 2^m * (M + 2^64 * H) by ring]
|
||||
rw [Nat.add_mul_div_left _ _ (Nat.two_pow_pos m), Nat.div_eq_of_lt hL]
|
||||
omega
|
||||
rw [h1]
|
||||
omega
|
||||
|
||||
/-- Shift inside a 64-bit window: for sh + 51 ≤ 64,
|
||||
((B/2^(8o)) mod 2^64 / 2^sh) mod 2^51 = (B / 2^(8o+sh)) mod 2^51. -/
|
||||
theorem window_shift (B o sh : ℕ) (hsh : sh + 51 ≤ 64) :
|
||||
(B / 2^(8*o) % 2^64 / 2^sh) % 2^51 = B / 2^(8*o + sh) % 2^51 := by
|
||||
have h1 : B / 2^(8*o) % 2^64 / 2^sh = B / 2^(8*o) / 2^sh % 2^(64 - sh) := by
|
||||
have hsplit : (2:ℕ)^64 = 2^sh * 2^(64 - sh) := by
|
||||
rw [← pow_add]
|
||||
congr 1
|
||||
omega
|
||||
rw [hsplit, Nat.mod_mul_right_div_self]
|
||||
rw [h1, Nat.div_div_eq_div_mul, ← pow_add]
|
||||
have h2 : B / 2^(8*o + sh) % 2^(64 - sh) % 2^51 = B / 2^(8*o + sh) % 2^51 := by
|
||||
apply Nat.mod_mod_of_dvd
|
||||
exact pow_dvd_pow 2 (by omega)
|
||||
rw [h2]
|
||||
|
||||
/-- Base-2⁵¹ five-digit tiling: the masked digits reassemble the value
|
||||
mod 2²⁵⁵. -/
|
||||
theorem digits_tile (B : ℕ) :
|
||||
B % 2^51
|
||||
+ (B / 2^51 % 2^51) * 2^51
|
||||
+ (B / 2^102 % 2^51) * 2^102
|
||||
+ (B / 2^153 % 2^51) * 2^153
|
||||
+ (B / 2^204 % 2^51) * 2^204 = B % 2^255 := by
|
||||
have e1 : B / 2^51 / 2^51 = B / 2^102 := by rw [Nat.div_div_eq_div_mul]; norm_num
|
||||
have e2 : B / 2^102 / 2^51 = B / 2^153 := by rw [Nat.div_div_eq_div_mul]; norm_num
|
||||
have e3 : B / 2^153 / 2^51 = B / 2^204 := by rw [Nat.div_div_eq_div_mul]; norm_num
|
||||
have e4 : B / 2^204 / 2^51 = B / 2^255 := by rw [Nat.div_div_eq_div_mul]; norm_num
|
||||
have d0 := Nat.div_add_mod B (2^51)
|
||||
have d1 := Nat.div_add_mod (B / 2^51) (2^51)
|
||||
have d2 := Nat.div_add_mod (B / 2^102) (2^51)
|
||||
have d3 := Nat.div_add_mod (B / 2^153) (2^51)
|
||||
have d4 := Nat.div_add_mod (B / 2^204) (2^51)
|
||||
have dT := Nat.div_add_mod B (2^255)
|
||||
omega
|
||||
|
||||
/-- **The byte parser is exact below bit 255**: for any 32 input bytes,
|
||||
`from_bytes` succeeds with 51-bit limbs denoting `bytesVal b mod 2²⁵⁵`
|
||||
(the sign bit is discarded, the rest is the little-endian value). -/
|
||||
theorem from_bytes_spec (bytes : Std.Array Std.U8 32#usize)
|
||||
(b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 : Std.U8)
|
||||
(hbl : (↑bytes : List Std.U8) = [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24, b25, b26, b27, b28, b29, b30, b31]) :
|
||||
backend.serial.u64.field.FieldElement51.from_bytes bytes ⦃ r =>
|
||||
Bnd r (2^51) ∧ feVal r = bytesVal bytes % 2^255 ⦄ := by
|
||||
unfold backend.serial.u64.field.FieldElement51.from_bytes
|
||||
step as ⟨msk0, hmsk0⟩
|
||||
step as ⟨mask, hmask⟩
|
||||
have hmaskv : mask.val = 2251799813685247 := by
|
||||
rw [hmask, hmsk0]
|
||||
simp [Nat.shiftLeft_eq]
|
||||
scalar_tac
|
||||
-- window 0: bytes 0..7, shift 0
|
||||
step as ⟨s0, hs0⟩
|
||||
have hs0v : s0.val = (↑bytes : List Std.U8) := by rw [hs0]; rfl
|
||||
step with (load8_at_spec s0 0#usize b0 b1 b2 b3 b4 b5 b6 b7
|
||||
(by rw [Slice.length]; simp [hs0v, hbl])
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
(by simp only [hs0v, hbl]; rfl)
|
||||
) as ⟨w0, hw0⟩
|
||||
step as ⟨l0, hl0⟩
|
||||
have hl0v : l0.val = w0.val % 2^51 := by
|
||||
rw [hl0, UScalar.val_and, hmaskv, nat_and_mask]
|
||||
norm_num
|
||||
-- window 1: bytes 6..13, shift 3
|
||||
step as ⟨s1, hs1⟩
|
||||
have hs1v : s1.val = (↑bytes : List Std.U8) := by rw [hs1]; rfl
|
||||
step with (load8_at_spec s1 6#usize b6 b7 b8 b9 b10 b11 b12 b13
|
||||
(by rw [Slice.length]; simp [hs1v, hbl])
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
(by simp only [hs1v, hbl]; rfl)
|
||||
) as ⟨w1, hw1⟩
|
||||
step as ⟨sh1, hsh1⟩
|
||||
step as ⟨l1, hl1⟩
|
||||
have hl1v : l1.val = (w1.val / 2^3) % 2^51 := by
|
||||
rw [hl1, UScalar.val_and, hmaskv, nat_and_mask, hsh1, nat_shr]
|
||||
norm_num
|
||||
-- window 2: bytes 12..19, shift 6
|
||||
step as ⟨s2, hs2⟩
|
||||
have hs2v : s2.val = (↑bytes : List Std.U8) := by rw [hs2]; rfl
|
||||
step with (load8_at_spec s2 12#usize b12 b13 b14 b15 b16 b17 b18 b19
|
||||
(by rw [Slice.length]; simp [hs2v, hbl])
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
(by simp only [hs2v, hbl]; rfl)
|
||||
) as ⟨w2, hw2⟩
|
||||
step as ⟨sh2, hsh2⟩
|
||||
step as ⟨l2, hl2⟩
|
||||
have hl2v : l2.val = (w2.val / 2^6) % 2^51 := by
|
||||
rw [hl2, UScalar.val_and, hmaskv, nat_and_mask, hsh2, nat_shr]
|
||||
norm_num
|
||||
-- window 3: bytes 19..26, shift 1
|
||||
step as ⟨s3, hs3⟩
|
||||
have hs3v : s3.val = (↑bytes : List Std.U8) := by rw [hs3]; rfl
|
||||
step with (load8_at_spec s3 19#usize b19 b20 b21 b22 b23 b24 b25 b26
|
||||
(by rw [Slice.length]; simp [hs3v, hbl])
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
(by simp only [hs3v, hbl]; rfl)
|
||||
) as ⟨w3, hw3⟩
|
||||
step as ⟨sh3, hsh3⟩
|
||||
step as ⟨l3, hl3⟩
|
||||
have hl3v : l3.val = (w3.val / 2^1) % 2^51 := by
|
||||
rw [hl3, UScalar.val_and, hmaskv, nat_and_mask, hsh3, nat_shr]
|
||||
norm_num
|
||||
-- window 4: bytes 24..31, shift 12
|
||||
step as ⟨s4, hs4⟩
|
||||
have hs4v : s4.val = (↑bytes : List Std.U8) := by rw [hs4]; rfl
|
||||
step with (load8_at_spec s4 24#usize b24 b25 b26 b27 b28 b29 b30 b31
|
||||
(by rw [Slice.length]; simp [hs4v, hbl])
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
(by simp only [hs4v, hbl]; rfl)
|
||||
) as ⟨w4, hw4⟩
|
||||
step as ⟨sh4, hsh4⟩
|
||||
step as ⟨l4, hl4⟩
|
||||
have hl4v : l4.val = (w4.val / 2^12) % 2^51 := by
|
||||
rw [hl4, UScalar.val_and, hmaskv, nat_and_mask, hsh4, nat_shr]
|
||||
norm_num
|
||||
try simp only [spec_ok]
|
||||
constructor
|
||||
· rw [Bnd_eq _ l0 l1 l2 l3 l4 _ rfl]
|
||||
refine ⟨?_, ?_, ?_, ?_, ?_⟩ <;> · first
|
||||
| (rw [hl0v]; exact Nat.mod_lt _ (by norm_num))
|
||||
| (rw [hl1v]; exact Nat.mod_lt _ (by norm_num))
|
||||
| (rw [hl2v]; exact Nat.mod_lt _ (by norm_num))
|
||||
| (rw [hl3v]; exact Nat.mod_lt _ (by norm_num))
|
||||
| (rw [hl4v]; exact Nat.mod_lt _ (by norm_num))
|
||||
· rw [feVal_eq _ l0 l1 l2 l3 l4 rfl]
|
||||
unfold limbsVal
|
||||
have hB : bytesVal bytes = b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248 := by
|
||||
simp only [bytesVal, hbl]
|
||||
have hwin0 : w0.val = bytesVal bytes / 2^0 % 2^64 := by
|
||||
have hdecomp : (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248)
|
||||
= (0) + 2^0 * (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56) + 2^0 * 2^64 * (b8.val + b9.val * 2^8 + b10.val * 2^16 + b11.val * 2^24 + b12.val * 2^32 + b13.val * 2^40 + b14.val * 2^48 + b15.val * 2^56 + b16.val * 2^64 + b17.val * 2^72 + b18.val * 2^80 + b19.val * 2^88 + b20.val * 2^96 + b21.val * 2^104 + b22.val * 2^112 + b23.val * 2^120 + b24.val * 2^128 + b25.val * 2^136 + b26.val * 2^144 + b27.val * 2^152 + b28.val * 2^160 + b29.val * 2^168 + b30.val * 2^176 + b31.val * 2^184) := by
|
||||
ring
|
||||
rw [hw0, hB, hdecomp]
|
||||
exact (window_extract (0) (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56) (b8.val + b9.val * 2^8 + b10.val * 2^16 + b11.val * 2^24 + b12.val * 2^32 + b13.val * 2^40 + b14.val * 2^48 + b15.val * 2^56 + b16.val * 2^64 + b17.val * 2^72 + b18.val * 2^80 + b19.val * 2^88 + b20.val * 2^96 + b21.val * 2^104 + b22.val * 2^112 + b23.val * 2^120 + b24.val * 2^128 + b25.val * 2^136 + b26.val * 2^144 + b27.val * 2^152 + b28.val * 2^160 + b29.val * 2^168 + b30.val * 2^176 + b31.val * 2^184) 0
|
||||
(by scalar_tac) (by scalar_tac)).symm
|
||||
have hlimb0 : l0.val = bytesVal bytes / 2^0 % 2^51 := by
|
||||
rw [hl0v, hwin0]
|
||||
exact Nat.mod_mod_of_dvd _ (pow_dvd_pow 2 (by norm_num))
|
||||
have hwin1 : w1.val = bytesVal bytes / 2^48 % 2^64 := by
|
||||
have hdecomp : (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248)
|
||||
= (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40) + 2^48 * (b6.val + b7.val * 2^8 + b8.val * 2^16 + b9.val * 2^24 + b10.val * 2^32 + b11.val * 2^40 + b12.val * 2^48 + b13.val * 2^56) + 2^48 * 2^64 * (b14.val + b15.val * 2^8 + b16.val * 2^16 + b17.val * 2^24 + b18.val * 2^32 + b19.val * 2^40 + b20.val * 2^48 + b21.val * 2^56 + b22.val * 2^64 + b23.val * 2^72 + b24.val * 2^80 + b25.val * 2^88 + b26.val * 2^96 + b27.val * 2^104 + b28.val * 2^112 + b29.val * 2^120 + b30.val * 2^128 + b31.val * 2^136) := by
|
||||
ring
|
||||
rw [hw1, hB, hdecomp]
|
||||
exact (window_extract (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40) (b6.val + b7.val * 2^8 + b8.val * 2^16 + b9.val * 2^24 + b10.val * 2^32 + b11.val * 2^40 + b12.val * 2^48 + b13.val * 2^56) (b14.val + b15.val * 2^8 + b16.val * 2^16 + b17.val * 2^24 + b18.val * 2^32 + b19.val * 2^40 + b20.val * 2^48 + b21.val * 2^56 + b22.val * 2^64 + b23.val * 2^72 + b24.val * 2^80 + b25.val * 2^88 + b26.val * 2^96 + b27.val * 2^104 + b28.val * 2^112 + b29.val * 2^120 + b30.val * 2^128 + b31.val * 2^136) 48
|
||||
(by scalar_tac) (by scalar_tac)).symm
|
||||
have hlimb1 : l1.val = bytesVal bytes / 2^51 % 2^51 := by
|
||||
rw [hl1v, hwin1]
|
||||
have := window_shift (bytesVal bytes) 6 3 (by norm_num)
|
||||
norm_num at this ⊢
|
||||
rw [this]
|
||||
have hwin2 : w2.val = bytesVal bytes / 2^96 % 2^64 := by
|
||||
have hdecomp : (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248)
|
||||
= (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88) + 2^96 * (b12.val + b13.val * 2^8 + b14.val * 2^16 + b15.val * 2^24 + b16.val * 2^32 + b17.val * 2^40 + b18.val * 2^48 + b19.val * 2^56) + 2^96 * 2^64 * (b20.val + b21.val * 2^8 + b22.val * 2^16 + b23.val * 2^24 + b24.val * 2^32 + b25.val * 2^40 + b26.val * 2^48 + b27.val * 2^56 + b28.val * 2^64 + b29.val * 2^72 + b30.val * 2^80 + b31.val * 2^88) := by
|
||||
ring
|
||||
rw [hw2, hB, hdecomp]
|
||||
exact (window_extract (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88) (b12.val + b13.val * 2^8 + b14.val * 2^16 + b15.val * 2^24 + b16.val * 2^32 + b17.val * 2^40 + b18.val * 2^48 + b19.val * 2^56) (b20.val + b21.val * 2^8 + b22.val * 2^16 + b23.val * 2^24 + b24.val * 2^32 + b25.val * 2^40 + b26.val * 2^48 + b27.val * 2^56 + b28.val * 2^64 + b29.val * 2^72 + b30.val * 2^80 + b31.val * 2^88) 96
|
||||
(by scalar_tac) (by scalar_tac)).symm
|
||||
have hlimb2 : l2.val = bytesVal bytes / 2^102 % 2^51 := by
|
||||
rw [hl2v, hwin2]
|
||||
have := window_shift (bytesVal bytes) 12 6 (by norm_num)
|
||||
norm_num at this ⊢
|
||||
rw [this]
|
||||
have hwin3 : w3.val = bytesVal bytes / 2^152 % 2^64 := by
|
||||
have hdecomp : (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248)
|
||||
= (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144) + 2^152 * (b19.val + b20.val * 2^8 + b21.val * 2^16 + b22.val * 2^24 + b23.val * 2^32 + b24.val * 2^40 + b25.val * 2^48 + b26.val * 2^56) + 2^152 * 2^64 * (b27.val + b28.val * 2^8 + b29.val * 2^16 + b30.val * 2^24 + b31.val * 2^32) := by
|
||||
ring
|
||||
rw [hw3, hB, hdecomp]
|
||||
exact (window_extract (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144) (b19.val + b20.val * 2^8 + b21.val * 2^16 + b22.val * 2^24 + b23.val * 2^32 + b24.val * 2^40 + b25.val * 2^48 + b26.val * 2^56) (b27.val + b28.val * 2^8 + b29.val * 2^16 + b30.val * 2^24 + b31.val * 2^32) 152
|
||||
(by scalar_tac) (by scalar_tac)).symm
|
||||
have hlimb3 : l3.val = bytesVal bytes / 2^153 % 2^51 := by
|
||||
rw [hl3v, hwin3]
|
||||
have := window_shift (bytesVal bytes) 19 1 (by norm_num)
|
||||
norm_num at this ⊢
|
||||
rw [this]
|
||||
have hwin4 : w4.val = bytesVal bytes / 2^192 % 2^64 := by
|
||||
have hdecomp : (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184 + b24.val * 2^192 + b25.val * 2^200 + b26.val * 2^208 + b27.val * 2^216 + b28.val * 2^224 + b29.val * 2^232 + b30.val * 2^240 + b31.val * 2^248)
|
||||
= (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184) + 2^192 * (b24.val + b25.val * 2^8 + b26.val * 2^16 + b27.val * 2^24 + b28.val * 2^32 + b29.val * 2^40 + b30.val * 2^48 + b31.val * 2^56) + 2^192 * 2^64 * 0 := by
|
||||
ring
|
||||
rw [hw4, hB, hdecomp]
|
||||
exact (window_extract (b0.val + b1.val * 2^8 + b2.val * 2^16 + b3.val * 2^24 + b4.val * 2^32 + b5.val * 2^40 + b6.val * 2^48 + b7.val * 2^56 + b8.val * 2^64 + b9.val * 2^72 + b10.val * 2^80 + b11.val * 2^88 + b12.val * 2^96 + b13.val * 2^104 + b14.val * 2^112 + b15.val * 2^120 + b16.val * 2^128 + b17.val * 2^136 + b18.val * 2^144 + b19.val * 2^152 + b20.val * 2^160 + b21.val * 2^168 + b22.val * 2^176 + b23.val * 2^184) (b24.val + b25.val * 2^8 + b26.val * 2^16 + b27.val * 2^24 + b28.val * 2^32 + b29.val * 2^40 + b30.val * 2^48 + b31.val * 2^56) 0 192
|
||||
(by scalar_tac) (by scalar_tac)).symm
|
||||
have hlimb4 : l4.val = bytesVal bytes / 2^204 % 2^51 := by
|
||||
rw [hl4v, hwin4]
|
||||
have := window_shift (bytesVal bytes) 24 12 (by norm_num)
|
||||
norm_num at this ⊢
|
||||
rw [this]
|
||||
have ht := digits_tile (bytesVal bytes)
|
||||
norm_num at ht hlimb0 hlimb1 hlimb2 hlimb3 hlimb4 ⊢
|
||||
omega
|
||||
|
||||
end CurveFieldProofs
|
||||
|
|
@ -67,6 +67,9 @@ PROOFS=(
|
|||
SigApexSpec
|
||||
PointLiftSpec
|
||||
PointEqSpec
|
||||
DecompressSpec
|
||||
FromBytesSpec
|
||||
DecompressMain
|
||||
)
|
||||
# Fully-qualified certificate names; each must be axiom-clean.
|
||||
CERTS=(
|
||||
|
|
@ -91,6 +94,12 @@ CERTS=(
|
|||
ScalarProofs.from_bytes_mod_order_wide_spec
|
||||
CurveFieldProofs.vartime_dsm_basepoint_spec
|
||||
CurveFieldProofs.enc_point_inj
|
||||
CurveFieldProofs.pow_p58_spec
|
||||
CurveFieldProofs.fe_ct_eq_spec
|
||||
CurveFieldProofs.sqrt_core
|
||||
CurveFieldProofs.sqrt_ratio_i_sq_spec
|
||||
CurveFieldProofs.from_bytes_spec
|
||||
CurveFieldProofs.decompress_of_canonical
|
||||
)
|
||||
# Imports needed so every certificate in CERTS is in scope for the audit.
|
||||
AUDIT_IMPORTS=(
|
||||
|
|
@ -107,6 +116,9 @@ AUDIT_IMPORTS=(
|
|||
Proofs.ScalarPackSpec
|
||||
Proofs.PointLiftSpec
|
||||
Proofs.PointEqSpec
|
||||
Proofs.DecompressSpec
|
||||
Proofs.FromBytesSpec
|
||||
Proofs.DecompressMain
|
||||
)
|
||||
|
||||
# ── Phase 0: resource + integrity guards ────────────────────────────────────
|
||||
|
|
@ -198,17 +210,18 @@ lake env bash -c "
|
|||
cd '$HERE'
|
||||
ALLOWED='[propext, Classical.choice, Quot.sound, ed25519.Signature, ed_sigs.sha512_hash3, ed25519.Signature.r_bytes, ed25519.Signature.s_bytes]'
|
||||
AUD=\$(mktemp '$HERE/.apex-XXXX.lean')
|
||||
{ echo 'import Proofs.SigApexSpec'; echo 'import Proofs.PointLiftSpec'; echo 'import Proofs.PointEqSpec'; echo '#print axioms CurveFieldProofs.verify_accepts_iff'; echo '#print axioms CurveFieldProofs.verify_accepts_iff_point'; echo '#print axioms CurveFieldProofs.verify_accepts_iff_point_eq'; } > \"\$AUD\"
|
||||
{ echo 'import Proofs.SigApexSpec'; echo 'import Proofs.PointLiftSpec'; echo 'import Proofs.PointEqSpec'; echo 'import Proofs.DecompressMain'; echo '#print axioms CurveFieldProofs.verify_accepts_iff'; echo '#print axioms CurveFieldProofs.verify_accepts_iff_point'; echo '#print axioms CurveFieldProofs.verify_accepts_iff_point_eq'; echo '#print axioms CurveFieldProofs.verify_accepts_iff_decompress'; } > \"\$AUD\"
|
||||
OUT=\$(LEAN_TIMEOUT=$TIMEOUT LEAN_MEM_MB=4096 '$HERE/lean-guard' \"\$AUD\" 2>&1)
|
||||
echo \"\$OUT\"
|
||||
rm -f \"\$AUD\"
|
||||
FLAT=\$(echo \"\$OUT\" | tr '\\n' ' ' | tr -s ' ')
|
||||
if echo \"\$FLAT\" | grep -qF \"'CurveFieldProofs.verify_accepts_iff' depends on axioms: \$ALLOWED\" \
|
||||
&& echo \"\$FLAT\" | grep -qF \"'CurveFieldProofs.verify_accepts_iff_point' depends on axioms: \$ALLOWED\" \
|
||||
&& echo \"\$FLAT\" | grep -qF \"'CurveFieldProofs.verify_accepts_iff_point_eq' depends on axioms: \$ALLOWED\"; then
|
||||
echo ' apex axiom cone = exactly the SHA-512 + wire-format boundary (no curve/scalar/backend axioms)'
|
||||
&& echo \"\$FLAT\" | grep -qF \"'CurveFieldProofs.verify_accepts_iff_point_eq' depends on axioms: \$ALLOWED\" \
|
||||
&& echo \"\$FLAT\" | grep -qF \"'CurveFieldProofs.verify_accepts_iff_decompress' depends on axioms: \$ALLOWED\"; then
|
||||
echo ' apex + full-lift axiom cones = exactly the SHA-512 + wire-format boundary (no curve/scalar/backend axioms)'
|
||||
else
|
||||
echo 'APEX AUDIT FAILED: verify_accepts_iff cone is not the documented boundary'; exit 1
|
||||
echo 'APEX AUDIT FAILED: apex/full-lift cone is not the documented boundary'; exit 1
|
||||
fi
|
||||
"
|
||||
|
||||
|
|
|
|||
|
|
@ -5,9 +5,11 @@
|
|||
# roots: crate::field, crate::backend::serial::u64::field,
|
||||
# crate::backend::serial::curve_models, crate::edwards
|
||||
# (same widening the reference solution used for its Tier-1 addition-law
|
||||
# theorem; scalar-mul backends and decompress internals stay opaque —
|
||||
# upstream Aeneas cannot translate them; they are modeled/axiomatized in
|
||||
# gen/CurveField/FunsExternal.lean OUTSIDE every certificate's cone).
|
||||
# theorem; scalar-mul backends stay opaque — upstream Aeneas cannot
|
||||
# translate them; they are modeled/axiomatized in
|
||||
# gen/CurveField/FunsExternal.lean OUTSIDE every certificate's cone.
|
||||
# decompress IS extracted since the phase-2 full lift — the source's
|
||||
# step_2 uses the documented negate-then-conditional-assign rewrite).
|
||||
#
|
||||
# Rust --charon--> CurveField.llbc --aeneas--> gen/CurveField/*.lean
|
||||
#
|
||||
|
|
@ -59,7 +61,6 @@ charon cargo --preset=aeneas \
|
|||
--opaque 'crate::backend::serial::scalar_mul::pippenger' \
|
||||
--opaque 'crate::backend::vector' \
|
||||
--opaque 'crate::backend::scalar_fits_in_128_bits' \
|
||||
--opaque 'crate::edwards::decompress' \
|
||||
--opaque 'crate::edwards::_::sum' \
|
||||
--opaque 'crate::edwards::_::from_slice' \
|
||||
--dest-file "$HERE/CurveField.llbc" \
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -358,30 +358,13 @@ axiom edwards.affine.AffinePoint.Insts.CoreCmpEq.assert_fields_are_eq
|
|||
: edwards.affine.AffinePoint → Result Unit
|
||||
|
||||
/-- [curve25519::edwards::{impl core::cmp::Eq for curve25519::edwards::CompressedEdwardsY}::assert_fields_are_eq]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 183:0-183:33
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 182:0-182:33
|
||||
Visibility: public -/
|
||||
axiom edwards.CompressedEdwardsY.Insts.CoreCmpEq.assert_fields_are_eq
|
||||
: edwards.CompressedEdwardsY → Result Unit
|
||||
|
||||
/-- [curve25519::edwards::decompress::step_2]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 240:4-257:5 -/
|
||||
axiom edwards.decompress.step_2
|
||||
:
|
||||
edwards.CompressedEdwardsY → backend.serial.u64.field.FieldElement51 →
|
||||
backend.serial.u64.field.FieldElement51 →
|
||||
backend.serial.u64.field.FieldElement51 → Result edwards.EdwardsPoint
|
||||
|
||||
/-- [curve25519::edwards::decompress::step_1]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 226:4-237:5 -/
|
||||
axiom edwards.decompress.step_1
|
||||
:
|
||||
edwards.CompressedEdwardsY → Result (subtle.Choice ×
|
||||
backend.serial.u64.field.FieldElement51 ×
|
||||
backend.serial.u64.field.FieldElement51 ×
|
||||
backend.serial.u64.field.FieldElement51)
|
||||
|
||||
/-- [curve25519::edwards::{curve25519::edwards::CompressedEdwardsY}::from_slice]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 423:4-425:5
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 428:4-430:5
|
||||
Visibility: public -/
|
||||
axiom edwards.CompressedEdwardsY.from_slice
|
||||
:
|
||||
|
|
@ -389,7 +372,7 @@ axiom edwards.CompressedEdwardsY.from_slice
|
|||
core.array.TryFromSliceError)
|
||||
|
||||
/-- [curve25519::edwards::{impl subtle::ConditionallySelectable for curve25519::edwards::EdwardsPoint}::conditional_swap]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 486:0-495:1
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 491:0-500:1
|
||||
Visibility: public -/
|
||||
axiom edwards.EdwardsPoint.Insts.SubtleConditionallySelectable.conditional_swap
|
||||
:
|
||||
|
|
@ -397,7 +380,7 @@ axiom edwards.EdwardsPoint.Insts.SubtleConditionallySelectable.conditional_swap
|
|||
(edwards.EdwardsPoint × edwards.EdwardsPoint)
|
||||
|
||||
/-- [curve25519::edwards::{impl subtle::ConditionallySelectable for curve25519::edwards::EdwardsPoint}::conditional_assign]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 486:0-495:1
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 491:0-500:1
|
||||
Visibility: public -/
|
||||
axiom
|
||||
edwards.EdwardsPoint.Insts.SubtleConditionallySelectable.conditional_assign
|
||||
|
|
@ -406,13 +389,13 @@ axiom
|
|||
edwards.EdwardsPoint
|
||||
|
||||
/-- [curve25519::edwards::{impl core::cmp::Eq for curve25519::edwards::EdwardsPoint}::assert_fields_are_eq]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 520:0-520:27
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 525:0-525:27
|
||||
Visibility: public -/
|
||||
axiom edwards.EdwardsPoint.Insts.CoreCmpEq.assert_fields_are_eq
|
||||
: edwards.EdwardsPoint → Result Unit
|
||||
|
||||
/-- [curve25519::edwards::{impl core::iter::traits::accum::Sum<T> for curve25519::edwards::EdwardsPoint}::sum]:
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 829:4-834:5
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 834:4-839:5
|
||||
Visibility: public -/
|
||||
axiom edwards.EdwardsPoint.Insts.CoreIterTraitsAccumSum.sum
|
||||
{T : Type} {I : Type} (coreborrowBorrowTEdwardsPointInst : core.borrow.Borrow
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ structure traits.ValidityCheck (Self : Type) where
|
|||
is_valid : Self → Result Bool
|
||||
|
||||
/-- [curve25519::edwards::EdwardsPoint]
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 390:0-395:1
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 395:0-400:1
|
||||
Visibility: public -/
|
||||
structure edwards.EdwardsPoint where
|
||||
X : backend.serial.u64.field.FieldElement51
|
||||
|
|
@ -223,7 +223,7 @@ structure edwards.affine.AffinePoint where
|
|||
y : backend.serial.u64.field.FieldElement51
|
||||
|
||||
/-- [curve25519::edwards::CompressedEdwardsY]
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 175:0-175:44
|
||||
Source: 'curve25519/solana-ed25519/src/edwards.rs', lines 174:0-174:44
|
||||
Visibility: public -/
|
||||
@[reducible]
|
||||
def edwards.CompressedEdwardsY := Array Std.U8 32#usize
|
||||
|
|
|
|||
Loading…
Reference in a new issue