mirror of
https://github.com/saymrwulf/ltl-accumulator-verified.git
synced 2026-09-04 20:03:44 +00:00
Accumulator pyramid layers 1-2, mechanizing paper SS5.3/SS6 groundwork: - gen/LTLAcc/HashExternal.lean: the single sanctioned axiom, opaque sha256 (no properties assumed - the soundness theorems downstream are constructive collision extractors). - Proofs/Basic.lean: hleaf/hnode (0x00/0x01 domain stamps); Lemma 1 (domsep) proven AXIOM-FREE; kbelow (largest power of two below n) with pos/lt/le-two bound lemmas; MTH, Root (Option = rejection), ConsRec (four cases, b-flag, pinned anchor) - all with kernel-checked termination via the kbelow bounds. - check.sh: estate discipline (stub audit, axiom-smuggling gate, lean-guard compilation, boundary-exact per-certificate cone audit). All green; observed cones pinned exactly. Zero contact with the live LTL: no appends, no server, accumulator frozen at 12 leaves throughout this project. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
151 lines
5 KiB
Text
151 lines
5 KiB
Text
/- L1 + L2 of the accumulator pyramid: byte-level hashing shapes, domain
|
||
separation (paper Lemma 1), the split point, and the three §5.3
|
||
definitions (MTH, Path-dual Root, ConsRec) with their termination.
|
||
|
||
Everything here is stated over the opaque `sha256` of gen/ — no
|
||
property of the hash is used anywhere in this file. -/
|
||
import LTLAcc.HashExternal
|
||
|
||
namespace LTLAcc
|
||
|
||
abbrev Bytes := List UInt8
|
||
|
||
/-- Leaf hash: `H(0x00 ‖ d)` (paper §5.3). -/
|
||
noncomputable def hleaf (d : Bytes) : Bytes := sha256 (0x00 :: d)
|
||
|
||
/-- Node hash: `H(0x01 ‖ x ‖ y)` (paper §5.3). -/
|
||
noncomputable def hnode (x y : Bytes) : Bytes := sha256 (0x01 :: (x ++ y))
|
||
|
||
/-- **Lemma 1 (Domain separation), preimage form**: no leaf preimage
|
||
equals a node preimage as a byte string — the first byte differs. -/
|
||
theorem domsep (d x y : Bytes) :
|
||
(0x00 : UInt8) :: d ≠ (0x01 : UInt8) :: (x ++ y) := by
|
||
intro h
|
||
injection h with h0 _
|
||
exact absurd h0 (by decide)
|
||
|
||
/-- Largest power of two STRICTLY below `n`, for `n ≥ 2` (RFC 9162's
|
||
split point `k`; values at `n ≤ 1` are irrelevant and default to 1). -/
|
||
def kbelow (n : Nat) : Nat :=
|
||
if n ≤ 2 then 1
|
||
else 2 * kbelow ((n + 1) / 2)
|
||
termination_by n
|
||
decreasing_by omega
|
||
|
||
theorem kbelow_pos (n : Nat) : 0 < kbelow n := by
|
||
induction n using kbelow.induct with
|
||
| case1 n h => rw [kbelow]; simp [h]
|
||
| case2 n h ih => rw [kbelow]; simp [h]; omega
|
||
|
||
theorem kbelow_lt (n : Nat) (h : 2 ≤ n) : kbelow n < n := by
|
||
induction n using kbelow.induct with
|
||
| case1 n hle => rw [kbelow]; simp only [if_pos hle]; omega
|
||
| case2 n hgt ih =>
|
||
rw [kbelow]
|
||
simp only [if_neg hgt]
|
||
have h2 : 2 ≤ (n + 1) / 2 := by omega
|
||
have := ih h2
|
||
omega
|
||
|
||
theorem le_two_kbelow (n : Nat) (h : 2 ≤ n) : n ≤ 2 * kbelow n := by
|
||
induction n using kbelow.induct with
|
||
| case1 n hle => rw [kbelow]; simp only [if_pos hle]; omega
|
||
| case2 n hgt ih =>
|
||
rw [kbelow]
|
||
simp only [if_neg hgt]
|
||
have h2 : 2 ≤ (n + 1) / 2 := by omega
|
||
have := ih h2
|
||
omega
|
||
|
||
/-- `MTH` (paper §5.3): the RFC 9162 tree head over a leaf-data list.
|
||
`MTH [] = H(ε)`, `MTH [d] = hleaf d`, and for `n ≥ 2` the split at
|
||
`k = kbelow n`. -/
|
||
noncomputable def MTH (D : List Bytes) : Bytes :=
|
||
if _h0 : D.length = 0 then sha256 []
|
||
else if _h1 : D.length = 1 then hleaf (D.headD [])
|
||
else
|
||
hnode (MTH (D.take (kbelow D.length))) (MTH (D.drop (kbelow D.length)))
|
||
termination_by D.length
|
||
decreasing_by
|
||
· -- take-branch: k < n
|
||
simp only [List.length_take]
|
||
have h2 : 2 ≤ D.length := by omega
|
||
have hk := kbelow_lt D.length h2
|
||
omega
|
||
· -- drop-branch: n - k < n
|
||
simp only [List.length_drop]
|
||
have h2 : 2 ≤ D.length := by omega
|
||
have hk := kbelow_lt D.length h2
|
||
have hp := kbelow_pos D.length
|
||
omega
|
||
|
||
/-- `Root` (paper §5.3 / Appendix B): the consumer's root reconstruction.
|
||
`none` = rejection on any length mismatch, exactly as deployed. -/
|
||
noncomputable def Root (v : Bytes) (m n : Nat) (P : List Bytes) : Option Bytes :=
|
||
if n = 1 then
|
||
match P with
|
||
| [] => some v
|
||
| _ => none
|
||
else if n = 0 then none
|
||
else
|
||
match P.getLast? with
|
||
| none => none
|
||
| some s =>
|
||
let k := kbelow n
|
||
if m < k then
|
||
match Root v m k P.dropLast with
|
||
| none => none
|
||
| some x => some (hnode x s)
|
||
else
|
||
match Root v (m - k) (n - k) P.dropLast with
|
||
| none => none
|
||
| some x => some (hnode s x)
|
||
termination_by n
|
||
decreasing_by
|
||
· have h2 : 2 ≤ n := by omega
|
||
exact kbelow_lt n h2
|
||
· have := kbelow_pos n
|
||
omega
|
||
|
||
/-- `ConsRec` (paper §5.3): the recursive consistency verifier. Returns
|
||
the reconstructed pair (old root, new root); `none` = shape
|
||
mismatch. The flag `b` records whether the size-`n₀` subtree root is
|
||
carried implicitly (the pinned root `r`) or explicitly in `C`. -/
|
||
noncomputable def ConsRec (n₀ n : Nat) (C : List Bytes) (b : Bool) (r : Bytes) :
|
||
Option (Bytes × Bytes) :=
|
||
if n₀ = n then
|
||
if b then
|
||
match C with
|
||
| [] => some (r, r)
|
||
| _ => none
|
||
else
|
||
match C with
|
||
| [s] => some (s, s)
|
||
| _ => none
|
||
else if n₀ > n ∨ n₀ = 0 ∨ n ≤ 1 then none
|
||
else
|
||
match C.getLast? with
|
||
| none => none
|
||
| some s =>
|
||
let k := kbelow n
|
||
if n₀ ≤ k then
|
||
match ConsRec n₀ k C.dropLast b r with
|
||
| none => none
|
||
| some (x, y) => some (x, hnode y s)
|
||
else
|
||
match ConsRec (n₀ - k) (n - k) C.dropLast false r with
|
||
| none => none
|
||
| some (x, y) => some (hnode s x, hnode s y)
|
||
termination_by n
|
||
decreasing_by
|
||
· have h2 : 2 ≤ n := by omega
|
||
exact kbelow_lt n h2
|
||
· have := kbelow_pos n
|
||
omega
|
||
|
||
/-- The consumer's acceptance predicate for a consistency proof between
|
||
pinned head `(n₀, r₀)` and offered head `(n₁, r₁)` (paper §5.3). -/
|
||
def acceptCons (n₀ n₁ : Nat) (r₀ r₁ : Bytes) (C : List Bytes) : Prop :=
|
||
n₀ = 0 ∨ ConsRec n₀ n₁ C true r₀ = some (r₀, r₁)
|
||
|
||
end LTLAcc
|