diff --git a/.github/workflows/kani.yml b/.github/workflows/kani.yml new file mode 100644 index 00000000..7af32206 --- /dev/null +++ b/.github/workflows/kani.yml @@ -0,0 +1,28 @@ +name: Kani + +on: + pull_request: + paths: + - rust/** + - .github/workflows/kani.yml + push: + branches: + - master + +permissions: + contents: read + +concurrency: + group: kani-ci-${{ github.ref }} + cancel-in-progress: true + +jobs: + kani: + name: Model-check (panic/overflow safety) + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Run Kani harnesses + uses: model-checking/kani-github-action@v1 + with: + working-directory: rust diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml new file mode 100644 index 00000000..3fa58628 --- /dev/null +++ b/.github/workflows/lean.yml @@ -0,0 +1,67 @@ +name: Lean + +on: + pull_request: + paths: + - lean/** + - testdata/** + - rust/examples/lean_testdata.rs + - .github/workflows/lean.yml + push: + branches: + - master + +permissions: + contents: read + +concurrency: + group: lean-ci-${{ github.ref }} + cancel-in-progress: true + +jobs: + build: + name: Build proofs + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Install elan + run: | + curl --proto '=https' --tlsv1.2 -sSf https://elan.lean-lang.org/elan-init.sh \ + -o elan-init.sh + sh elan-init.sh -y --default-toolchain none + echo "$HOME/.elan/bin" >> "$GITHUB_PATH" + + - name: Regenerate differential test vectors + working-directory: ./rust + run: cargo run --example lean_testdata + + - name: Differential vectors in sync + run: | + # TestVectors.lean is generated from testdata/ by the Rust decoder; + # building it (below) re-verifies every shared vector against the + # Lean model with real SHA-256. Drift between the committed copy and + # a fresh regeneration means the vectors or the bridge changed. + git diff --exit-code lean/Ics23/TestVectors.lean + + - name: Build (checks all proofs) + working-directory: ./lean + run: lake build + + - name: Fail on unexpected sorry + working-directory: ./lean + run: | + # One sorry is expected: the abstract-root nonexistence_sound, left + # unproved by design (findings F3/F4 — an opaque root carries no tree + # structure). The genuine results are fully proved with no sorry: + # honest-root membership soundness (Theorem A, nonexistence_sound_tree's + # cousin membership_sound) AND honest-root non-existence soundness + # (Theorem B, nonexistence_sound_tree / _tendermint in TreeNonExist), + # plus byte-level existence binding. Fail if any others appear. + count=$(grep -rn --include='*.lean' '^\s*sorry\b\|:= sorry\| sorry$' Ics23 | wc -l | tr -d ' ') + echo "sorry count: $count" + if [ "$count" -ne 1 ]; then + echo "Unexpected number of sorry occurrences (expected 1)." + grep -rn --include='*.lean' '^\s*sorry\b\|:= sorry\| sorry$' Ics23 || true + exit 1 + fi diff --git a/docs/rfc/001-formal-verification.md b/docs/rfc/001-formal-verification.md new file mode 100644 index 00000000..1010b847 --- /dev/null +++ b/docs/rfc/001-formal-verification.md @@ -0,0 +1,291 @@ +# RFC 001: Formal Verification of ICS23 + +- Status: Draft +- Author: Zaki Manian +- Created: 2026-06-10 + +## Abstract + +This RFC proposes a program to formally verify the ICS23 proof verification +algorithm. The proposal centers on a mechanized model of the verifier with +machine-checked soundness proofs, connected to the shipped Go and Rust +implementations through differential testing, with optional code-level +refinement proofs as a stretch goal. The total scope is roughly 4-6 months +for one verification engineer plus a domain reviewer. + +## Motivation + +The ICS23 verifier is the security boundary of IBC state verification. It +runs inside light clients (ibc-go, ibc-rs, wasm light clients), and in that +setting the prover is the adversary: every byte of a `CommitmentProof` is +attacker-controlled. A soundness bug in the verifier allows an attacker to +convince a light client that an arbitrary key/value pair exists (or does not +exist) in a counterparty chain's state, which translates directly into theft +over IBC. The October 2022 "Dragonberry" advisory demonstrated that +proof-forgery bugs in the Cosmos proof verification stack are a realistic, +ecosystem-wide threat, not a theoretical one. + +The code has been audited (most recently by Zellic; see `docs/audits/`), and +both implementations carry fuzz tests. Audits and fuzzing find bugs but +cannot establish their absence. The verification surface is unusually well +suited to formal methods: + +- The hand-written core is small: about 1,100 lines of Rust + (`rust/src/verify.rs`, `rust/src/ops.rs`, `rust/src/compress.rs`) and + about 950 lines of Go (`go/proof.go`, `go/ops.go`, `go/ics23.go`). +- The logic is purely functional: no concurrency, no I/O, no system state. +- The intended security property has a crisp cryptographic statement + (commitment binding up to hash collisions). + +At the same time, the algorithm is genuinely subtle. Soundness depends on a +web of interacting side conditions: leaf/inner domain separation, prefix +length windows, child size constraints, lexicographic neighbor checks. The +non-existence logic in particular (`ensure_left_most`, `ensure_left_neighbor`, +`left_branches_are_empty`) is where historical bugs have concentrated. These +conditions are exactly the kind of thing a theorem prover is good at and a +human reviewer is bad at. + +## Scope + +### In scope + +- `verify_existence` / `ExistenceProof.Verify`: spec conformance checks and + root calculation. +- `verify_non_existence` / `NonExistenceProof.Verify`: neighbor ordering and + edge-of-tree logic. +- The `ProofSpec` well-formedness conditions under which the above are sound, + and concrete certification of the shipped `IavlSpec`, `TendermintSpec`, and + `SmtSpec`. +- Batch and compressed-batch verification (`rust/src/compress.rs`, + `go/proof.go` batch handling), treated as a second pass after the core, + since they are thin wrappers plus index handling. +- Implementation-level safety of the Rust crate: panic freedom, integer + cast/overflow safety, termination, allocation bounds on adversarial input. +- Go/Rust acceptance equivalence (consensus criticality: the two + implementations must accept exactly the same proofs). + +### Out of scope + +- Prover-side code (IAVL, CometBFT merkle, JMT). Completeness against real + provers is handled by differential testing, not proof, because the provers + live in other repositories. +- The cryptographic hash functions themselves. Hashes are modeled as + abstract functions; all soundness theorems are stated as constructive + reductions to collision finding (see below), so no axioms about SHA-256 + et al. are introduced. +- The legacy `calculate_existence_root` path that runs without a + `ProofSpec` (`rust/src/verify.rs`, `CalculateRoot` in Go). It skips the + spec-dependent child-size check and should be documented as carrying + weaker guarantees rather than verified. + +## Properties + +The properties below are stated informally; making them precise is Phase 0/1 +work. Throughout, "well-formed spec" refers to the decidable predicate of +Theorem C. + +**Theorem A (existence binding).** For a well-formed `ProofSpec` S and root +hash r: from any two accepted existence proofs under (S, r) that disagree on +their (key, value) pair, one can extract an explicit collision of the hash +function used by S. + +This is a constructive reduction: the proof term is an algorithm that +produces the two colliding preimages. The supporting lemmas mirror checks +the code performs operationally: + +1. *Leaf encoding injectivity.* The `LengthOp`-prefixed encoding of + (prehash(key), prehash(value)) is injective for the length ops permitted + by well-formed specs (notably `VAR_PROTO`), so distinct pairs produce + distinct leaf preimages. +2. *Leaf/inner domain separation.* No acceptable inner-node preimage shares + a prefix with the leaf prefix (enforced at `rust/src/verify.rs` + `ensure_inner`: `!has_prefix(leaf_spec.prefix, inner.prefix)`), so a leaf + hash cannot be reinterpreted as an inner hash or vice versa. +3. *Positional unambiguity.* The constraints relating `min_prefix_length`, + `max_prefix_length`, `child_size`, and suffix length (including + `max_prefix_length < min_prefix_length + child_size` and + `suffix.len() % child_size == 0`) guarantee that an accepted `InnerOp` + determines a unique child position, so two proofs cannot place the same + child hash at different positions in the same node without a collision. + +**Theorem B (non-existence soundness).** For a well-formed spec S and root +r: from an accepted non-existence proof for key k and an accepted existence +proof for k under (S, r), one can extract a hash collision. + +This requires formalizing the tree semantics that an `InnerSpec` describes: +which leaves a given root can commit to, what "left-most", "right-most", and +"adjacent" mean under arbitrary `child_order` permutations, and how +`empty_child` participates for sparse merkle trees. When +`prehash_key_before_comparison` is set (JMT), the ordering relation is over +hashed keys, and the theorem statement must reflect that the guarantee is +non-existence of the *hashed* key. + +**Theorem C (spec well-formedness certificate).** A decidable predicate +`WellFormed(spec)` capturing exactly the side conditions assumed by Theorems +A and B, together with computations certifying that `IavlSpec`, +`TendermintSpec`, and `SmtSpec` satisfy it. + +This artifact has standalone value beyond this repository: it gives chain +and bridge developers a machine-checkable answer to "is this custom +ProofSpec safe to accept?", which today is answered by folklore. + +**Property D (implementation safety).** The Rust crate, on arbitrary input: +never panics, performs no lossy or overflowing integer conversion (several +`i32`/`i64`/`usize` casts in `ensure_inner`, `ensure_inner_prefix`, and the +compressed-batch index lookups warrant machine checking), terminates, and +has allocation bounded by input size. + +**Property E (cross-implementation equivalence).** The Go and Rust +implementations accept exactly the same (proof, spec, root, key, value) +tuples. A divergence is itself a security incident even if both +implementations are individually sound, because IBC counterparties running +different implementations would disagree about state. + +## Approach + +The recommended architecture is model-first: prove the algorithm correct +once in a proof assistant, then connect the proven model to both shipped +implementations. This covers Go and Rust with one proof effort and keeps +the proof artifact maintainable independently of implementation churn. + +### Phase 0: Property mining (1-2 weeks) + +Extract every claimed invariant from the Zellic report, prior audits, and +the Dragonberry post-mortem. Reconstruct historical bugs as concrete +malicious proofs and add them to a regression corpus. The formal model is +required to reject every element of this corpus; this validates that the +model is modeling the right thing before any theorem is attempted. + +### Phase 1: Mechanized model and soundness proofs (6-10 weeks) + +Write the verifier as executable functions in Lean 4, mirroring +`rust/src/verify.rs` and `rust/src/ops.rs` as closely as practical, then +prove Theorems A, B, and C. Lean 4 is recommended over Rocq or F* for +ecosystem momentum and contributor availability; Rocq is the alternative if +alignment with `coq-of-rust` (Phase 2b) is prioritized. The expected +schedule risk concentrates in Theorem B's tree semantics; Theorem A should +land first and is independently publishable. + +### Phase 2: Connecting model to code (4-8 weeks) + +**2a (baseline): differential oracle.** Compile the Lean model to an +executable and differentially test it against both the Rust and Go +implementations: structure-aware generation of valid proofs from real IAVL, +CometBFT, and JMT trees, plus mutation-based adversarial inputs, run at +fuzzing scale in CI. This simultaneously discharges Property E by +transitivity and detects drift between the proven model and the shipped +code. It is cheap, immediate, and remains valuable forever. + +**2b (stretch): refinement proof.** Extract the actual Rust verification +core to a proof assistant using hax (Rust to F*/Coq, the methodology used +for libcrux) or `coq-of-rust`, and prove it refines the Phase 1 model. The +crate is `no_std`, small, and first-order, which makes it an unusually good +extraction candidate, but budget for friction around `prost`-generated +types and `anyhow` error plumbing (likely requiring a verification feature +gate or a thin shim around the core functions). This adds an estimated 2-3 +months and can be decided after Phase 1 results are in. + +### Phase 3: Code-level checks (2-4 weeks, parallel with Phase 1/2) + +- Kani harnesses on the Rust crate for Property D: panic freedom and cast + safety on `ensure_inner` / `ensure_inner_prefix` arithmetic and the + compressed-batch index handling, plus bounded-depth exhaustive checks of + small proofs. +- `cargo fuzz` targets mirroring `go/fuzz_test.go`, run continuously. +- No deductive verification of the Go implementation (Gobra is the only + candidate and the return on effort is poor); Go correctness is covered by + the Phase 2a oracle and native fuzzing. + +### Phase 4: CI integration and maintenance (1-2 weeks) + +- Lean proofs, Kani harnesses, and the differential fuzzer run in CI. +- A traceability document mapping each function in `verify.rs` / `proof.go` + to its model counterpart and the lemmas that depend on it. +- A contribution policy: changes touching the verification core require a + corresponding model update, enforced by CODEOWNERS on the relevant paths. + +## Alternatives considered + +**Direct deductive verification of the Rust crate (Verus or Creusot).** +Strongest possible code-level result, but Verus requires rewriting the crate +in its dialect (forking the artifact users actually depend on), Creusot +carries significant annotation and toolchain friction, and neither covers +the Go implementation, which remains the most widely deployed. Rejected as +the primary strategy; partially recovered via Phase 2b. + +**TLA+/Quint modeling.** Wrong tool: there is no concurrency or temporal +behavior here. The problem is data-structure and cryptographic soundness, +which model checkers over state machines do not address. + +**F* end-to-end from day one (libcrux-style).** Viable and proven for +cryptographic Rust, but F* expertise is scarce and long-term maintenance by +the Cosmos community is a real concern. Kept available through the hax +route in Phase 2b. + +**More auditing and fuzzing only.** Cheaper, but cannot establish absence +of soundness bugs, and provides no certificate for evaluating new +ProofSpecs (Theorem C), which is where much of the forward-looking risk +lives as new tree types are onboarded. + +## Risks + +- **Tree semantics formalization (Theorem B)** is the research-shaped + component: arbitrary `child_order` permutations and `empty_child` + handling for SMTs have no off-the-shelf formalization. Mitigation: + sequence Theorem A first; descope Theorem B to the three shipped specs' + parameter shapes if full generality stalls. +- **Model/code divergence** is the standing threat to any model-first + approach. Mitigation: the Phase 2a oracle runs continuously in CI, and + Phase 4 policy couples code changes to model changes. +- **Extraction friction in Phase 2b** around `prost` and `anyhow`. + Mitigation: treat 2b as optional; restructure the core behind a + dependency-free internal API only if 2b is funded. +- **Maintainer bandwidth**: a proof artifact nobody can maintain decays + into documentation. Mitigation: prefer Lean 4 for contributor pool; + require the traceability document; keep the model small by scoping it to + the verifier only. + +## Deliverables + +1. Property specification document with regression corpus (Phase 0). +2. Lean 4 model of the ICS23 verifier with machine-checked Theorems A, B, + and C, including well-formedness certificates for `IavlSpec`, + `TendermintSpec`, and `SmtSpec` (Phase 1). +3. Differential oracle harness (model vs. Rust vs. Go) integrated into CI + (Phase 2a). +4. Kani harnesses and `cargo fuzz` targets for the Rust crate (Phase 3). +5. Traceability document and contribution policy (Phase 4). +6. (Stretch) Refinement proof connecting `ics23-rs` to the model via hax or + `coq-of-rust` (Phase 2b). + +## Timeline and resourcing + +Phases 0 through 4 total roughly 4-6 months for one verification engineer +with proof-assistant experience, plus part-time review from an ICS23/IBC +domain expert. Phase 2b adds an estimated 2-3 months and a go/no-go +decision point after Phase 1. The work is well shaped for an external +engagement (candidate teams with relevant track records include Cryspen, +Formal Land, Informal Systems, and Galois) or an Interchain ecosystem grant. + +## Open questions + +1. Lean 4 vs. Rocq: primarily a question of who maintains the artifact and + whether Phase 2b via `coq-of-rust` is prioritized. +2. Is Phase 2b (refinement proof) in scope, or does the differential oracle + provide sufficient assurance for the cost? +3. Should batch/compressed proof verification be in the initial proof scope + or deferred until the core theorems land? +4. Where should the model live: this repository (keeps coupling tight) or a + sibling repository (keeps toolchains separate)? + +## References + +- ICS23 specification: https://github.com/cosmos/ibc/tree/main/spec/core/ics-023-vector-commitments +- Zellic audit report: `docs/audits/ICS-23 - Zellic Audit Report.pdf` +- Dragonberry advisory (Cosmos SDK, October 2022): + https://forum.cosmos.network/t/ibc-security-advisory-dragonberry/7702 +- hax (Rust extraction to F*/Coq): https://github.com/cryspen/hax +- coq-of-rust: https://github.com/formal-land/coq-of-rust +- Kani (Rust model checker): https://github.com/model-checking/kani +- libcrux, as precedent for verified Rust via extraction: + https://github.com/cryspen/libcrux diff --git a/docs/verification/properties.md b/docs/verification/properties.md new file mode 100644 index 00000000..f94eb0f8 --- /dev/null +++ b/docs/verification/properties.md @@ -0,0 +1,381 @@ +# ICS23 Verification — Property Catalogue (Phase 0) + +Status: living document. Companion to `docs/rfc/001-formal-verification.md` and +the Lean development under `lean/`. + +This catalogue enumerates the properties the formal model must establish and the +invariants the verifier relies on. Each property links to where it is enforced +in the code and where it lives in the Lean model. It also records the regression +corpus: concrete malicious inputs the model is required to reject. + +## Sources to mine + +- `docs/audits/ICS-23 - Zellic Audit Report.pdf` — **transcribed** into the + regression corpus (`lean/Ics23/Corpus.lean`, "Zellic audit findings" section): + all eight findings recorded, with machine-checked model witnesses for the ones + that have a decidable counterpart (3.1 sorted-keys → `SortedTree` hypothesis, + 3.2 `MaxPrefixLength` → `innerWFB`, 3.4 zero `child_size`, 3.5 proof-size depth + gate, 3.6 out-of-bounds `child_order` → total `getPadding`) and notes for the + implementation-only/out-of-scope ones (3.3 TS, 3.7 compressed batch, 3.8 + stricter checks). See "Zellic finding map" below. +- The 2020 Informal Systems audit of the original `confio/ics23`. +- The Cosmos "Dragonberry" advisory (Oct 2022) — proof-forgery class in the + Cosmos proof-verification stack; the canonical motivation. +- The ICS-023 specification (vector commitments). + +## Modeling assumptions (must stay honest) + +These are the places where the Lean model deliberately differs from the Rust. +Each is justified as *sound* (the model accepts at least every proof the code +accepts), so a soundness theorem about the model transfers to the code. + +1. **Optional fields collapsed.** `ProofSpec.{leaf,inner}_spec` and + `ExistenceProof.leaf` are `Option` in proto/Rust; a `None` triggers an + immediate reject. The model makes them non-optional, dropping inputs the + code rejects. Enlarges the accepted set ⇒ sound to omit. +2. **IAVL prefix checks omitted.** `ensure_leaf_prefix` / `ensure_inner_prefix` + (`rust/src/api.rs`) only fire when the spec equals the IAVL spec and can only + reject. Omitting them enlarges the accepted set ⇒ sound to omit. (A later + increment may add them to also reason about IAVL prefix structure.) +3. **Hash family abstract.** `do_hash` is modeled as an arbitrary + `HashFn : HashOp → Bytes → Bytes` with the single law `noHash = id`. No + collision-resistance assumption is made; soundness theorems *exhibit* a + collision instead. +4. **Spec integers are `Int`.** Faithful to the `i32` proto fields, so malformed + (e.g. negative) specs are representable and excluded by `WellFormed` rather + than by Lean typing. (Wrap/overflow of the `i32`/`usize` casts in the Rust is + a separate, code-level concern handled by Kani in Phase 3, not here.) + +## Properties + +### A. Existence binding (soundness) — headline + +A well-formed spec and a fixed root cannot bind one key to two different values +without a hash collision. + +- Enforced by: `verify_existence` + `check_existence_spec` + + `calculate_existence_root_for_spec` (`rust/src/verify.rs`). +- Model: proved — byte-level `Ics23.existence_binding` (Existence.lean) and + honest-root `membership_sound` / `membership_sound_tendermint` (Tree.lean) / + `membership_sound_smt` (SmtTree.lean). See "Remaining obligations" items 0–1. +- Rests on: + - **A1 Leaf-encoding injectivity.** `prefix ++ enc(prehash key) ++ enc(prehash value)` + parses uniquely into `(key, value)` — via a length-determining `LengthOp` + (VarProto/Fixed*/Require*) or fixed-length prehash images on both fields. + Captured by `leafDelimitingB`. Violated ⇒ a forger can re-split bytes into a + different `(key, value)`. + - **A2 Leaf/inner domain separation.** No accepted inner-op preimage carries + the leaf prefix (`ensure_inner`: `!has_prefix(leaf_spec.prefix, inner.prefix)`). + Requires a nonempty leaf prefix (`wellFormedB`). Violated ⇒ a leaf hash can + be reinterpreted as an inner hash (depth confusion). + - **A3 Positional unambiguity.** `min_prefix_length`, `max_prefix_length`, + `child_size`, suffix length, and `max < min + child_size` together fix a + child's position in its parent. Captured by `innerWFB` and `ensure_inner`. + - **A4 Inner preimage injectivity in the child.** Same op ⇒ equal images force + equal children. Proved: `Ics23.innerImage_inj`. + +### B. Non-existence soundness + +A well-formed spec and a fixed root cannot simultaneously admit a non-existence +proof for key `k` and an existence proof for `k`. + +- Enforced by: `verify_non_existence`, `ensure_left_most`, `ensure_right_most`, + `ensure_left_neighbor`, `left_branches_are_empty`, `right_branches_are_empty` + (`rust/src/verify.rs`). +- Model: proved in the honest-root tree models, total over verifier-accepted + shapes — `nonexistence_sound_tree_total` / `_tendermint_total` + (TreeNonExist.lean) and `nonexistence_sound_smt_total` (SmtNonExist.lean, + including `empty_child` placeholder handling and hashed-key order). See + "Remaining obligations" items 2–2a. Arbitrary `child_order` permutations + remain out of scope (all shipped specs are binary `[0, 1]`). +- Note: when `prehash_key_before_comparison` is set (SMT/JMT), the ordering is + over hashed keys, so the guarantee is non-existence of the *hashed* key. + +### C. Spec well-formedness certificate — proved + +A decidable `WellFormed` predicate capturing exactly A1–A3's side conditions, +plus machine-checked certificates that the shipped specs satisfy it. + +- Model: `wellFormedB` / `WellFormed`; certificates `iavl_wellFormed`, + `tendermint_wellFormed`, `smt_wellFormed` (proved by `decide`). +- Standalone value: a checkable answer to "is this custom `ProofSpec` safe?" + +### D. Implementation safety (Rust) — Phase 3 (Kani) + +Panic freedom, no lossy/overflowing integer casts (notably the `i32`/`i64`/`usize` +casts in `ensure_inner`, `ensure_inner_prefix`, and compressed-batch index +handling), termination, input-bounded allocation. Not in the Lean model. + +Landed (`rust/src/kani_proofs.rs`, `#[cfg(kani)]`, run by `cargo kani` / CI): +**five harnesses verified** by CBMC — the `ensure_inner` prefix-bound `i32` +arithmetic and the `get_padding` products are overflow-free under well-formed +bounds; the `left_branches_are_empty` / `right_branches_are_empty` (binary) slice +accesses are always in bounds (the Dragonberry-class out-of-range-slice surface); +and `decompress_exist`'s `lookup.get(x as usize)` compressed-batch index handling +is panic-free for any attacker-controlled `i32` index. Noted finding: an +adversarial spec with an enormous `child_size` could overflow the `i32` +prefix-bound product; the harnesses pin the safe precondition. Remaining: +panic-freedom of the `Result`-returning entry points (`do_length`, `proto_len`) +needs formatting stubs to keep CBMC tractable. + +### E. Go/Rust acceptance equivalence — Phase 2a (differential oracle) + +The two implementations accept exactly the same tuples. Covered by differential +testing of the executable model against both, not by proof. + +## Regression corpus (model must reject) + +Concrete malicious proofs, each targeting one invariant. To be encoded as Lean +`example … = false` and as fixtures for the Phase 2a oracle. + +- [ ] **A1-split:** NoPrefix length with variable-length prehash (e.g. NoHash on + both fields) — re-split `key ++ value` to forge a different pair under one + root. (A spec with this shape must be rejected by `WellFormed`.) +- [ ] **A2-depthconfusion:** an inner op whose prefix begins with the leaf + prefix; must fail `ensure_inner`. +- [ ] **A3-childsize:** inner suffix length not a multiple of `child_size`; must + fail `ensure_inner`. +- [ ] **A3-prefixwindow:** inner prefix length outside `[min, max + maxLeftChild]`. +- [ ] **C-negative:** spec with non-positive `child_size` or + `max_prefix_length ≥ min_prefix_length + child_size`; must fail `WellFormed`. +- [ ] **depth-bounds:** `min_depth ≠ 0` with path length outside `[min, max]`. +- [x] **Zellic findings** — transcribed; see the map below. + +### Zellic finding map (audit → model) + +The July 2024 Zellic assessment (`docs/audits/`) reported eight findings. Each is +recorded in `lean/Ics23/Corpus.lean` under "Zellic audit findings", with a +machine-checked witness where the model has a decidable counterpart: + +| # | Finding (severity) | Model treatment | +|---|---|---| +| 3.1 | Nonexistence soundness depends on sorted keys (Critical) | The `SortedTree`/`SortedTreeS` hypothesis of Theorem B (modeling note F4). Witness: the Zellic Fig. 3.1 tree is a member-bearing tree machine-checked **not** `SortedTree`. | +| 3.2 | Forging with `MaxPrefixLength ≥ MinPrefixLength + ChildSize` (Critical) | `innerWFB` requires `max < min + child_size`; the split-pinning lemmas rely on it. Witness: the boundary spec fails `wellFormedB` and the op fails `ensureInner`. | +| 3.3 | TypeScript skips IAVL prefix checks (Critical) | Implementation-specific (TS removed upstream). Model is the Rust/Go surface; omits IAVL prefix checks as a *sound over-approximation* (modeling assumption 2). Note only. | +| 3.4 | Zero division in `ensure_inner` (High) | `child_size = 0` fails `innerWFB`/`ensureInner` (model is `%`-total, no panic). Witness: `ensureInner … negChildSizeSpec = false`. Rust panic-freedom → Kani. | +| 3.5 | Unrestricted proof size (Medium) | Liveness/DoS, outside soundness. Model has the depth gate; shipped specs disable it (`min_depth = 0`), faithfully reflecting the finding. Witness: over-deep path fails `checkExistenceSpec` once armed. | +| 3.6 | Panic on out-of-bounds `ChildOrder` (Low) | Model's `getPadding` is total (returns `none`, never panics); theorems stated for binary `[0,1]`. Witness: `getPadding {childOrder := [0,2]} 1 = none`. | +| 3.7 | Panic in `decompressExist` (Low) | Compressed/batched proofs removed upstream; out of model scope. Note only. | +| 3.8 | IAVL/Tendermint checks could be stricter (Informational) | The honest-root tree models bake the stricter node shape into `WFTree`/`WFTreeI`/`WFTreeS`. Note only. | + +## Findings (surfaced by the verification work) + +- **F4 — non-existence soundness requires the store key-sortedness invariant + (it is a hypothesis, not enforced by the verifier).** `verify_non_existence` + checks `key_for_comparison(l.key) < key_for_comparison(key) < + key_for_comparison(r.key)` and that `l`, `r` are *position*-adjacent leaves + (`ensure_left_neighbor` etc.). But it never checks that leaf positions track + key order. So nothing in the verifier alone rules out an existence proof + placing `key`'s leaf at an unrelated position while its key value sits between + the neighbors — i.e. `nonexistence_sound` is **false without** assuming the + tree's leaves are sorted by key (left-to-right). ICS23 states this requirement + informally ("Supported merkle stores must be lexicographically ordered to + maintain soundness"); the formalization makes it precise: Theorem B must carry + a `KeySorted root` hypothesis (any two existence proofs to `root` have key + order iff position order). The `Order.lean` position lemmas are the start of + stating that invariant; with it, the proof is: `key` between `l`,`r` in key + order ⇒ (sortedness) between them in position order ⇒ contradicts adjacency. +- **F5 — the adjacency step is hash-structural, not pure lex (proof-obligation + refinement).** The adjacency lemma (`ensure_left_neighbor` ⇒ no leaf position + strictly between the neighbors) is *not* provable from the `lexLt` order alone: + a position `C ++ [0] ++ (k+1 ones)` is lex-greater than the left neighbor + `C ++ [0] ++ (k ones)` yet still less than the right neighbor `C ++ [1] ++ + (zeros)`. "No position between" holds only because the left neighbor's leaf is + **terminal** (no deeper-right leaf) — a fact about the tree's hash structure, + not the position order. A proof placing a leaf "past" the rightmost terminal + leaf forces an *inner* hash where the neighbor has a *leaf* hash, reducing to + `leaf_inner_domain_collision` (already proved). So Theorem B's remaining core is + the *integration* of the `Order.lean` position model with the hash-level + domain-separation machinery; the `lexLt` order theory is necessary scaffolding + but not sufficient alone. + + +- **F1 — i32 prefix-bound overflow (malformed spec).** `ensure_inner` computes + `max_prefix_length + (child_order.len()-1)*child_size` in `i32`; an adversarial + spec with an enormous `child_size` overflows it. Not reachable with the shipped + specs; the Kani harness pins the safe precondition. +- **F3 — positional ambiguity ⇒ general binding needs more than collision + resistance (analysis, not a live exploit).** Working the differing-path case of + Theorem A surfaced this. For a binary spec with `min_prefix_length = + max_prefix_length = p` (Tendermint, SMT), a node preimage + `P = prefix(p) ‖ child(cs) ‖ sibling(cs)` is accepted by `ensure_inner` under + *two* readings: as a **left**-child step (`|prefix| = p`, child `= P[p..p+cs]`, + suffix `= P[p+cs..]`) and as a **right**-child step (`|prefix| = p+cs`, child + `= P[p+cs..p+2cs]`, suffix empty) — both satisfy the prefix window + `[min, max + (n-1)·cs] = [p, p+cs]` and the `suffix % cs = 0` check. So the same + node hash does not, by the spec checks alone, determine which half is the + recursive child. + - Consequence: the clean "two accepted existence proofs that disagree ⇒ exhibit + a hash *collision*" reduction does **not** go through for differing tree + positions against an *arbitrary* hash `H`. An adversary exploiting the + ambiguity would need the sibling bytes to themselves be a valid + subtree/leaf hash of a different value — a **preimage** problem, not a + collision. Against an arbitrary `H` that is not ruled out; the honest model + must therefore either (a) treat hashes as injective/opaque tokens (a + structured/"free" hash model) or assume preimage resistance, or (b) re-include + the per-store prefix structure the model abstracts away — notably IAVL's + `ensure_inner_prefix`, which encodes `height/size/version` and pins the + position explicitly. The **same-shape** binding theorem (already proved) sits + below this obstacle because it fixes the path structure. + - **The IAVL prefix check does *not* fix it (machine-checked).** Re-including + `ensure_inner_prefix` (height/size/version + remaining-byte count) was the + natural candidate to pin position. It does not: for the IAVL preimage + `hsv ‖ 0x20 ‖ A ‖ 0x20 ‖ B`, the left reading leaves `remaining = 1` and the + right reading leaves `remaining = 34`, and the check explicitly admits *both* + (see `lean/Ics23/IavlPrefix.lean`, `native_decide` witnesses). So the + ambiguity is intrinsic to the prefix/suffix construction across all shipped + specs, IAVL included. Binding genuinely rests on **preimage resistance** (the + sibling bytes would have to be a valid subtree hash of a different value), + which the abstract-hash model does not capture. + - Action: this is why `existence_binding` (general) is still open. The correct + fix is a hash-model refinement — model node hashes as opaque/injective tokens + (a symbolic Merkle model) so sibling bytes cannot be re-read as a subtree + hash — or weaken the theorem's conclusion to "collision OR preimage". This is + a foundational reformulation, not a tactic tweak. No evidence of a live + exploit against the shipped stores; flagged for maintainer review. +- **F2 — left/right empty-branch asymmetry (ternary+ specs).** + `right_branches_are_empty` guards `suffix.len() == child_size` (one child) but + then reads `suffix[i*child_size..]` for `i in 0..right_branches`. For + `child_order.len() > 2`, `right_branches` can exceed 1, so the `i = 1` access is + out of bounds — a panic. The left side correctly sizes the prefix by + `left_branches*child_size`. No supported store is ternary (merk is unsupported), + so this is latent, not currently exploitable. Surfaced while writing the Kani + harnesses; the binary-case harness is verified. + +## Proof status (Lean) + +Model is complete (existence + non-existence). Proved with no `sorry`: +Theorem C (all three spec certificates); A1 leaf-encoding injectivity for both +`NoPrefix` (fixed-prehash) and `VarProto` (varint self-delimiting) shapes; +the path-fold backbone (`applyInner_inj`, `applyPath_sameops_inj`, +`applyPath_eqlen_merge`); **same-shape existence binding for all three shipped +specs** (`existence_binding_sameshape{,_noPrefix,_varProto}`); and +**equal-length existence binding** (`existence_binding_eqlen`) — same key, same +leaf op, equal path *depth* but arbitrary differing inner ops ⇒ `HashCollision ∨ +PositionalAmbiguity`. Non-existence padding / empty-branch logic is exercised by +the corpus. + +### Remaining obligations + +0. **Theorem A — honest-root form, DONE (`lean/Ics23/Tree.lean`).** The + *strongest* existence result: a Merkle tree model (`MTree`, `rootHash`, + `TreeMember`) and `membership_sound` — an existence proof verifying against + `root = rootHash t` for a real (Tendermint-shaped) tree implies *genuine + membership* in `t`, up to a hash collision, with **no ambiguity arm**. The F3 + positional ambiguity is fully resolved by `split_pins`: the verifier's + `suffix % child_size` check pins a node split to exactly the two genuine + children, so an accepted proof follows actual tree structure. Instantiated: + `membership_sound_tendermint` (structural side conditions by `decide`; joint + leaf injectivity now *proved* in `leafInj_tendermint`/`leafInj_varProto`, so + `FixedHash` is the only remaining clean crypto assumption). This is Option 1 + delivered for existence — it removes the byte-level disjunction's ambiguity + arms entirely. + +1. **Theorem A — DONE (existence binding, byte-level).** Fully proved, no `sorry`: + `existence_binding_shaped` (general, production-spec shape) concludes the + honest three-way disjunction `HashCollision ∨ PositionalAmbiguity ∨ + LeafAmbiguity`; `existence_binding_sameleaf` gives the stronger two-way + conclusion for the honest same-leaf case (a key's leaf op is determined in a + real tree). The two ambiguity arms are real machine-checkable obstructions + (F3 and its leaf-level analogue); collapsing them to a bare collision is what + the symbolic-Merkle model would add — not required for the honest theorem. +2. **Theorem B — honest-root form, DONE, total + (`lean/Ics23/TreeNonExist.lean`).** Non-existence soundness in the same + honest-root tree model as item 0, covering **every proof shape the verifier + accepts**: a verifying non-existence proof for `key` plus a verifying + existence proof for `key` against `root = rootHash t` of a key-sorted + (`SortedTree`) well-formed tree yields a `HashCollision`. + - *Two-sided* (`nonexistence_sound_tree`): `ensure_left_neighbor` + decomposes (`ensureLeftNeighbor_spec`) into a shared root path, a + left-step divergence, and right-most/left-most remainders; + `neighbor_divergence` (byte→tree navigation induction) pins both + bracketing proofs to a real divergence node `N`, so the absent key would + sit in the gap between `maxKey N.left` and `minKey N.right` — + `node_gap_no_member` rules that out in a sorted tree. The F4/F5 + padding-vs-placeholder subtlety is discharged by + `ensureRightMost_suffix_nil` / `ensureLeftMost_suffix_cs` (needs + `emptyChild.length ≠ childSize`, true for Tendermint's `[]`). + - *One-sided* (`nonexistence_sound_tree_leftOnly` / `_rightOnly`): a + left-only proof's `ensure_right_most` path makes its neighbor the + rightmost leaf (`reaches_max`), so `maxKey t < key` contradicts + `member_le_maxKey`; mirror with `reaches_min` / `minKey_le_member`. + - *Total* (`nonexistence_sound_tree_total`): case split over the four + neighbor shapes (no-neighbor proofs never verify, + `verifyNonExistence_none`). Instantiated: + `nonexistence_sound_tree_tendermint{,_total}` — side conditions by + `decide`, leaf injectivity proved, `FixedHash` the only assumption. + The *abstract-root* `nonexistence_sound` (NonExistSound.lean) remains the + one deliberate `sorry`: an opaque root carries no tree structure, so + nothing connects byte-order to tree position (exactly F3/F4) — adjacency is + inherently a statement about a real tree, making the honest-root model the + natural domain, not a shortcut. +2a. **Theorems A and B for the SMT/JMT spec — DONE + (`lean/Ics23/SmtTree.lean`, `lean/Ics23/SmtNonExist.lean`).** The `MTree` + model cannot represent sparse trees (empty subtrees hash to the constant + `empty_child` placeholder, not a hash image), and SMT's 32-byte + `emptyChild` *is* digest-sized, so the F4/F5 bridge above does not apply. + `SMTree` adds an `.empty` constructor with `rootHashS .empty = empty_child`, + and one new explicitly-stated assumption, `EmptyChildFree` (no exhibited + SHA-256 preimage of the all-zero placeholder — the standard sparse-merkle + assumption; without it a prover knowing `H(x) = 0^32` could graft a fake + empty subtree). + - *Theorem A* (`membership_sound_smt`): `reachesS` reuses `split_pins` + byte-level; a fold can never terminate inside an empty subtree because + fold values are hash images (`applyPath_ne_emptyChild`). + - *Theorem B* (`nonexistence_sound_smt_total`, with two-sided and + one-sided forms): the placeholder arm of `ensure_right_most` / + `ensure_left_most` is *embraced* instead of excluded — + `ensureRightMost_step_smt` shows each step's suffix is `[]` (genuine + right step) or exactly `emptyChild`, which pins the skipped sibling to a + genuinely empty subtree (`rootHashS_ec_empty`); mirrored on the prefix + side for left-most. `reaches_maxS`/`reaches_minS` land on the rightmost/ + leftmost *nonempty* leaf (Option-valued `maxKeyS`/`minKeyS`), and + `neighbor_divergence_smt` + `node_gap_no_memberS` close the gap argument. + Key order is on **comparison keys** (`keyForComparison` = SHA-256 of the + raw key for `smt_spec`, honoring `prehash_key_before_comparison`): + `SortedTreeS` is sortedness of the hashed key space, exactly how a real + SMT/JMT arranges its leaves. Side conditions by `decide`; remaining + hypotheses: `FixedHash`, `EmptyChildFree`, sortedness. +2b. **Theorems A and B for the IAVL spec — DONE + (`lean/Ics23/IavlTree.lean`, `lean/Ics23/IavlNonExist.lean`).** With this, + honest-root Theorems A and B hold for **all three shipped specs**. IAVL + breaks the Tendermint shape differently: variable 4–12 byte inner prefixes + (height/size/version varints) violate `min = max`, and the 33-byte amino + child slots (`0x20` length byte + 32-byte digest) make digest length ≠ + `child_size`. An IAVL node is the existing `MTree` shape with a 1-byte + `mid` (`WFTreeI`), and the pinning argument is replaced by + `split_pins_var`: the verifier's `suffix % child_size = 0` check together + with `max_prefix_length < child_size` (12 < 33 — the `max < min + + child_size` well-formedness family doing its job) pins the suffix length + to `0` or `child_size`, each resolving the whole split by plain append + injectivity, with *no* prefix-length pinning. The order machinery and + padding bridges reuse TreeNonExist.lean verbatim (IAVL's `emptyChild = []` + has length 0 ≠ 33, so the placeholder arm is unreachable as in + Tendermint). `membership_sound_iavl`, `nonexistence_sound_iavl_total`: + side conditions by `decide`, `FixedHash` the only remaining assumption. +3. **Transcribe Zellic findings** into Properties / corpus — **DONE.** All eight + recorded in `Corpus.lean` with machine-checked witnesses where decidable; see + the "Zellic finding map" above. +4. **Batch/compressed** verification — model + decide whether in proof scope + (RFC open question 3). (Zellic 3.7 concerns this; removed upstream.) + +## Open items (cross-phase) + +- Phase 2a differential oracle — **DONE for the shared vectors.** + `rust/examples/lean_testdata.rs` decodes every `testdata/{iavl,tendermint, + smt}/` vector's protobuf `CommitmentProof` and generates + `lean/Ics23/TestVectors.lean`: the decoded proofs as Lean literals plus a + `native_decide` acceptance check per vector mirroring the Rust call, so + `lake build` re-verifies all 18 shared vectors against the model with real + SHA-256. CI regenerates the file and fails on drift. + **First catch:** on its first run the oracle rejected all six IAVL vectors — + the model's `Sha256.pad` used truncating `Nat` subtraction and silently + dropped the spill-over padding block for message lengths `≡ 56..62 (mod + 64)`. The three embedded validation vectors and every Tendermint/SMT + preimage miss that window; IAVL's 57-byte leaf preimages land in it. Fixed + with boundary regressions in `Sha256.lean`. (Scope note: `Sha256.lean` is + the *executable* layer only — the soundness theorems are abstract over + `HashFn` and were never affected.) + Possible extension: also run the negative/malformed vectors + (`TestCheckAgainstSpecData.json` etc.) through the model. +- Phase 3 Kani harnesses for Rust panic/overflow safety. diff --git a/docs/verification/traceability.md b/docs/verification/traceability.md new file mode 100644 index 00000000..d979db68 --- /dev/null +++ b/docs/verification/traceability.md @@ -0,0 +1,78 @@ +# ICS23 Verification — Traceability + +Maps each function in the verifier to its Lean model counterpart and the +machine-checked results about it. Keep this current: a change to a left-column +function requires updating the corresponding model definition and re-checking +the right-column results (enforced socially via review; CI rebuilds the proofs). + +Legend: ✅ proved (no `sorry`) · 🟡 stated, proof in progress · 🔧 Kani-verified +(Rust) · 📋 exercised by the regression corpus. + +## Ops (`rust/src/ops.rs` ↔ `lean/Ics23/Ops.lean`, `Varint.lean`) + +| Rust | Lean | Results | +|------|------|---------| +| `apply_inner` | `applyInner` | ✅ `innerImage_inj`, `applyInner_inj` (Soundness.lean) | +| `apply_leaf` | `applyLeaf` | used by `existence_binding_sameshape` | +| `do_hash` | `HashFn` (abstract) | no hash assumption; collisions are exhibited | +| `do_length` | `doLength` | ✅ `doLength_noPrefix_inj`, `doLength_varProto_inj` | +| `prepare_leaf_data` | `prepareLeafData` | ✅ `prepareLeafData_inj` | +| `proto_len` | `varintEncode` | ✅ `varintEncode_append_inj` (self-delimiting); 🔧 `proto_len` overflow precondition | + +## Existence (`rust/src/verify.rs` ↔ `lean/Ics23/Verify.lean`, `Soundness.lean`, `Existence.lean`) + +| Rust | Lean | Results | +|------|------|---------| +| `verify_existence` | `verifyExistence` | ✅ `existence_binding_sameshape{,_noPrefix,_varProto}` (same-shape, all specs); 🟡 general `existence_binding` (differing-path) | +| `check_existence_spec` | `checkExistenceSpec` | 📋 depth-bound + leaf/inner checks | +| `calculate_existence_root_for_spec` | `calculateExistenceRoot` | ✅ `verifyExistence_root`, `calculateExistenceRoot_eq`; ✅ `applyPath_sameops_inj` | +| `ensure_leaf` | `ensureLeaf` | used by binding | +| `ensure_inner` | `ensureInner` | 📋 corpus (A2 domain sep, A3 child-size/prefix); 🔧 prefix-bound overflow (F1) | +| `has_prefix` | `hasPrefix` | ✅ `hasPrefix_refl` | + +## Non-existence (`rust/src/verify.rs` ↔ `lean/Ics23/NonExist.lean`, `NonExistSound.lean`) + +| Rust | Lean | Results | +|------|------|---------| +| `verify_non_existence` | `verifyNonExistence` | 🟡 `nonexistence_sound`; ✅ `verifyNonExistence_{left,right}`, `verifyNonExistence_neighbors_ordered` | +| `ensure_left_most` / `ensure_right_most` | `ensureLeftMost` / `ensureRightMost` | 📋 corpus (SMT padding) | +| `ensure_left_neighbor` | `ensureLeftNeighbor` | (modeled) | +| `is_left_step` | `isLeftStep` | 📋 corpus | +| `get_padding` / `has_padding` / `order_from_padding` | `getPadding` / `hasPadding` / `orderFromPadding` | 📋 corpus; 🔧 `get_padding` overflow | +| `left_branches_are_empty` | `leftBranchesAreEmpty` | 📋 corpus; 🔧 slice-in-bounds | +| `right_branches_are_empty` | `rightBranchesAreEmpty` | 📋 corpus; 🔧 slice-in-bounds (binary); finding F2 for ternary+ | +| lexicographic `Vec` ordering | `bytesLt` | ✅ `bytesLt_irrefl`, `bytesLt_ne`, `bytesLt_trans` | + +## Specs (`rust/src/api.rs` ↔ `lean/Ics23/Specs.lean`) + +| Rust | Lean | Results | +|------|------|---------| +| `iavl_spec` | `iavlSpec` | ✅ `iavl_wellFormed` (Theorem C) | +| `tendermint_spec` | `tendermintSpec` | ✅ `tendermint_wellFormed` | +| `smt_spec` | `smtSpec` | ✅ `smt_wellFormed` | +| `verify_membership` / `verify_non_membership` | (thin wrappers over the above) | not modeled separately | +| `ensure_leaf_prefix` / `ensure_inner_prefix` (IAVL) | abstracted away | sound abstraction (only restricts; see properties.md) | + +## Executable / oracle (`lean/Ics23/Sha256.lean`, `Executable.lean`) + +| Item | Lean | Results | +|------|------|---------| +| SHA-256 | `Sha256.hash` | ✅ validated against `rust/src/ops.rs` vectors | +| concrete verifier runs | `concreteHash` + demos | end-to-end verify + forgery rejection (existence and non-existence) by `native_decide` | + +## Implementation safety (`rust/src/kani_proofs.rs`) + +| Harness | Property | Status | +|---------|----------|--------| +| `ensure_inner_prefix_bound_no_overflow` | i32 prefix-bound overflow-free (well-formed) | 🔧 verified | +| `get_padding_no_overflow` | i32 padding products overflow-free | 🔧 verified | +| `left_branches_slice_in_bounds` | prefix slice in bounds | 🔧 verified | +| `right_branches_slice_in_bounds_binary` | suffix slice in bounds (binary) | 🔧 verified | + +## Not yet covered + +- General `existence_binding` (differing-path, A3) and `nonexistence_sound` + (tree semantics) — the two open `sorry`s. +- Batch / compressed proofs (`compress.rs`, batch handling). +- Go implementation: covered by acceptance equivalence via the planned Phase 2a + differential oracle, not by proof. diff --git a/lean/.gitignore b/lean/.gitignore new file mode 100644 index 00000000..4080d07d --- /dev/null +++ b/lean/.gitignore @@ -0,0 +1 @@ +/.lake/ diff --git a/lean/Ics23.lean b/lean/Ics23.lean new file mode 100644 index 00000000..a14a008d --- /dev/null +++ b/lean/Ics23.lean @@ -0,0 +1,24 @@ +-- ICS23 formal verification: root module. +-- See `docs/rfc/001-formal-verification.md` and `docs/verification/properties.md`. +import Ics23.Types +import Ics23.Ops +import Ics23.Verify +import Ics23.NonExist +import Ics23.Varint +import Ics23.IavlPrefix +import Ics23.Specs +import Ics23.Soundness +import Ics23.Existence +import Ics23.NonExistSound +import Ics23.Order +import Ics23.LeafInj +import Ics23.Tree +import Ics23.TreeNonExist +import Ics23.SmtTree +import Ics23.SmtNonExist +import Ics23.IavlTree +import Ics23.IavlNonExist +import Ics23.Sha256 +import Ics23.Executable +import Ics23.Corpus +import Ics23.TestVectors diff --git a/lean/Ics23/Corpus.lean b/lean/Ics23/Corpus.lean new file mode 100644 index 00000000..8950d9f9 --- /dev/null +++ b/lean/Ics23/Corpus.lean @@ -0,0 +1,284 @@ +/- +Regression corpus: concrete inputs encoded as machine-checked acceptance/ +rejection facts. These pin the spec-level invariants from +`docs/verification/properties.md` and double as the model's own test suite. + +Everything here is decided by computation (no hash function required), so each +`example` is a proof, not a test that might silently stop running. +-/ +import Ics23.Verify +import Ics23.NonExist +import Ics23.Specs +import Ics23.Soundness +import Ics23.Tree +import Ics23.TreeNonExist + +namespace Ics23 + +/-! ## Positive controls -/ + +/-- A leaf-only proof whose leaf matches the IAVL leaf spec passes spec checks. -/ +def iavlLeafProof : ExistenceProof := + { key := [1], value := [2], leaf := iavlSpec.leafSpec, path := [] } + +example : checkExistenceSpec iavlLeafProof iavlSpec = true := by decide + +/-- A well-formed Tendermint inner op is accepted by `ensureInner`. -/ +def tmValidInner : InnerOp := { hash := .sha256, prefixBytes := [1], suffix := [] } + +example : ensureInner tmValidInner tendermintSpec = true := by decide + +/-! ## A2 — leaf/inner domain separation + +An inner op whose prefix begins with the leaf prefix must be rejected, else a +leaf hash could be reinterpreted as an inner hash (depth confusion). -/ +def tmLeafPrefixInner : InnerOp := { hash := .sha256, prefixBytes := [0, 9], suffix := [] } + +example : ensureInner tmLeafPrefixInner tendermintSpec = false := by decide + +/-! ## A3 — positional unambiguity -/ + +/-- Suffix length not a multiple of `child_size` is rejected. -/ +def tmBadSuffixInner : InnerOp := { hash := .sha256, prefixBytes := [1], suffix := [0] } + +example : ensureInner tmBadSuffixInner tendermintSpec = false := by decide + +/-- Inner prefix shorter than `min_prefix_length` is rejected. -/ +def tmShortPrefixInner : InnerOp := { hash := .sha256, prefixBytes := [], suffix := [] } + +example : ensureInner tmShortPrefixInner tendermintSpec = false := by decide + +/-! ## C — malformed specs are not well-formed -/ + +/-- Non-positive `child_size`. -/ +def negChildSizeSpec : ProofSpec := + { tendermintSpec with + innerSpec := { tendermintSpec.innerSpec with childSize := 0 } } + +example : wellFormedB negChildSizeSpec = false := by decide + +/-- A1-split shape: `NoPrefix` length with variable-length prehash on both +fields — the `key ++ value` boundary is ambiguous, so the spec is unsafe. -/ +def splitSpec : ProofSpec := + { tendermintSpec with + leafSpec := { tendermintSpec.leafSpec with + length := .noPrefix, prehashValue := .noHash } } + +example : wellFormedB splitSpec = false := by decide + +/-! ## Depth bounds -/ + +/-- With `min_depth ≠ 0`, a path shorter than `min_depth` is rejected. -/ +def depthBoundedSpec : ProofSpec := { iavlSpec with minDepth := 2, maxDepth := 4 } + +def shallowProof : ExistenceProof := + { key := [1], value := [2], leaf := iavlSpec.leafSpec, path := [] } + +example : checkExistenceSpec shallowProof depthBoundedSpec = false := by decide + +/-! ## Non-existence: padding, ordering, and empty-branch placeholders + +These exercise the SMT inner spec (binary, `child_size = 32`, 32-byte zero +`empty_child`) — the logic where Dragonberry-class bugs live. Mirrors the Rust +`check_empty_branch` test. `native_decide` is used for the 32-byte cases. -/ + +/-- Left child position: prefix length 1, 32-byte right sibling in the suffix. -/ +def smtLeftStep : InnerOp := + { hash := .sha256, prefixBytes := [7], suffix := List.replicate 32 0 } + +/-- Right child position: 32-byte left sibling in the prefix, empty suffix. -/ +def smtRightStep : InnerOp := + { hash := .sha256, prefixBytes := List.replicate 32 0 ++ [7], suffix := [] } + +example : orderFromPadding smtSpec.innerSpec smtLeftStep = some 0 := by native_decide +example : orderFromPadding smtSpec.innerSpec smtRightStep = some 1 := by native_decide + +/-- The left child is immediately left of the right child. -/ +example : isLeftStep smtSpec.innerSpec smtLeftStep smtRightStep = true := by native_decide + +/-- A genuine left child is left-most. -/ +example : ensureLeftMost smtSpec.innerSpec [smtLeftStep] = true := by native_decide + +/-- A genuine right child is right-most. -/ +example : ensureRightMost smtSpec.innerSpec [smtRightStep] = true := by native_decide + +/-- A placeholder at branch 1 whose left sibling is the empty child is a valid +left-most step (the left subtree is empty). -/ +def smtLeftPlaceholder : InnerOp := + { hash := .sha256, prefixBytes := [9] ++ List.replicate 32 0, suffix := [] } + +example : leftBranchesAreEmpty smtSpec.innerSpec smtLeftPlaceholder = true := by native_decide +example : ensureLeftMost smtSpec.innerSpec [smtLeftPlaceholder] = true := by native_decide + +/-- A branch-1 step whose left sibling is *not* the empty child is not a valid +left-most placeholder. -/ +def smtNotLeftmost : InnerOp := + { hash := .sha256, prefixBytes := [9] ++ List.replicate 31 0 ++ [5], suffix := [] } + +example : leftBranchesAreEmpty smtSpec.innerSpec smtNotLeftmost = false := by native_decide +example : ensureLeftMost smtSpec.innerSpec [smtNotLeftmost] = false := by native_decide + +/-! ## Zellic audit findings (July 2024) + +`docs/audits/ICS-23 - Zellic Audit Report.pdf`. Each finding is recorded here as +either a machine-checked fact about the model (where the model has a decidable +witness) or, for the implementation- or liveness-only findings, a note pointing +to where the property lives. The two critical *soundness* findings (3.1, 3.2) map +directly onto hypotheses/checks the formal soundness theorems already rely on. -/ + +/-! ### 3.1 — Nonexistence soundness depends on sorted keys (Critical) + +The headline finding: a nonexistence proof for `b` and an existence proof for +`b` can both verify when the committed tree is *not* key-sorted. The PoC builds +this tree (Figure 3.1) — `b` sits left of `a` under `Y`, so the leaves are out +of order even though `a < b < c` lexicographically: + +``` + X + / \ + Y "c" + / \ + "b" "a" +``` + +In the formal model this is exactly the `SortedTree` hypothesis of +`nonexistence_sound_tree` (and `SortedTreeS` for SMT, `SortedTree` for IAVL): +non-existence soundness is *conditional* on a store invariant the verifier never +checks (modeling note F4). The witness below reconstructs the Zellic tree and +machine-checks that (a) `b` is a genuine member and (b) the tree is provably +**not** `SortedTree` — so the theorem's precondition is precisely what rules the +attack out. -/ + +/-- The Zellic Figure 3.1 tree as an `MTree` (hash/leaf ops are irrelevant to +ordering, so any concrete ops do). Keys: `a = 0x61`, `b = 0x62`, `c = 0x63`. -/ +def zellicUnsortedTree : MTree := + let lop := tendermintSpec.leafSpec + .node .sha256 [1] [] [] + (.node .sha256 [1] [] [] (.leaf lop [0x62] [0x62]) (.leaf lop [0x61] [0x61])) + (.leaf lop [0x63] [0x63]) + +/-- The absent-claimed key `b` is in fact a genuine member of the tree. -/ +example : TreeMember [0x62] [0x62] zellicUnsortedTree := Or.inl (Or.inl ⟨rfl, rfl⟩) + +/-- The bracketing keys order as `a < b < c`, so the forged nonexistence proof's +own ordering checks (`left.key < key < right.key`) pass — order alone does not +imply absence. -/ +example : bytesLt [0x61] [0x62] = true := by decide +example : bytesLt [0x62] [0x63] = true := by decide + +/-- …yet the tree is **not** `SortedTree`: under `Y`, `maxKey(left) = b` is not +`< minKey(right) = a`. This is the precondition `nonexistence_sound_tree` +requires; without it the gap argument (`node_gap_no_member`) does not hold. -/ +example : ¬ SortedTree zellicUnsortedTree := fun h => absurd h.1.2.2 (by decide) + +/-! ### 3.2 — Forging nonexistence proofs with incorrect `MaxPrefixLength` (Critical) + +If `max_prefix_length ≥ min_prefix_length + child_size`, the same bytes can be +read as both prefix and child in different parts of verification, breaking +nonexistence soundness and admitting nodes with more children than `child_order` +specifies. The PoC sets `MaxPrefixLength = 33` on `tendermint_spec` +(`min = 1`, `child_size = 32`, so `33 = min + child_size`). + +The model rules this out structurally: `innerWFB` requires +`max_prefix_length < min_prefix_length + child_size`, and the honest-root +soundness theorems pin a node split via exactly this bound (`split_pins` / +`split_pins_var` need `max_prefix_length < child_size + min`). -/ + +/-- The Zellic 3.2 malformed spec: `max = min + child_size` (the boundary). -/ +def zellicMaxPrefixSpec : ProofSpec := + { tendermintSpec with + innerSpec := { tendermintSpec.innerSpec with maxPrefixLength := 33 } } + +example : wellFormedB zellicMaxPrefixSpec = false := by decide + +/-- An inner op whose prefix lands in the now-overlapping window is still +rejected by `ensure_inner` against that spec — the `max < min + child_size` +check is duplicated at the op level. -/ +def zellicOverlapInner : InnerOp := + { hash := .sha256, prefixBytes := List.replicate 33 1, suffix := [] } + +example : ensureInner zellicOverlapInner zellicMaxPrefixSpec = false := by decide + +/-! ### 3.3 — TypeScript does not validate IAVL prefixes (Critical) + +TypeScript-implementation-specific (the Dragonberry class, where the attacker +needs only a single key's suffix, not control of tree shape). The TS library +was *removed* upstream rather than fixed, and the Lean model models the Rust/Go +verifier, so there is no model artifact. The model deliberately *omits* the IAVL +prefix checks (modeling assumption 2 in `properties.md`) as a sound +over-approximation — it accepts at least every proof the stricter code accepts — +so a soundness theorem here transfers to the implementations that *do* check. +Related: 3.8. -/ + +/-! ### 3.4 — Zero division in `ensure_inner` (High) + +`child_size = 0` triggers a divide-by-zero panic in the Rust `ensure_inner`. The +model is panic-free here (Lean `Int` `%` is total), and the soundness-relevant +gate is well-formedness: a zero (or negative) `child_size` spec is not +`WellFormed`. See the positive witness `negChildSizeSpec` above +(`wellFormedB … = false`); the op-level check is below. The Rust panic-freedom +itself is a liveness property covered by the Kani harnesses (Phase 3). -/ + +/-- `ensure_inner` rejects any op against a zero-`child_size` spec (the +`child_size > 0` conjunct), so the model never reaches the division. -/ +example : ensureInner tmValidInner negChildSizeSpec = false := by decide + +/-! ### 3.5 — Unrestricted proof size (Medium) + +No `MaxDepth` ⇒ arbitrarily large, expensive-to-verify proofs (a liveness/DoS +concern, outside soundness scope). The model *has* the depth gate +(`checkExistenceSpec`'s `min_depth`/`max_depth` bounds); the shipped specs set +`min_depth = max_depth = 0`, which disables it — faithfully reflecting the +finding (the fix is to set a bound). The `depthBoundedSpec` witnesses above show +the gate working; the over-deep rejection is below. -/ + +/-- A valid IAVL inner op (prefix length 4 ∈ [4, 45], empty suffix). -/ +def iavlDepthInner : InnerOp := + { hash := .sha256, prefixBytes := [1, 2, 3, 4], suffix := [] } + +/-- A path deeper than `max_depth = 4` is rejected once the depth gate is armed +(`min_depth ≠ 0`). -/ +def zellicDeepProof : ExistenceProof := + { key := [1], value := [2], leaf := iavlSpec.leafSpec, + path := List.replicate 5 iavlDepthInner } + +example : checkExistenceSpec zellicDeepProof depthBoundedSpec = false := by decide + +/-! ### 3.6 — Panic with out-of-bounds `InnerSpec.ChildOrder` (Low) + +`getPosition` panics for a branch absent from a non-contiguous `child_order` +(e.g. `[0, 2]`). The model's analog (`getPadding`) is *total* — it returns +`none` for an out-of-range branch instead of panicking (faithfulness note in +`NonExist.lean`: where the Rust would panic, the model returns `none`/`false`, +a sound divergence). So the 3.6 panic class cannot occur in the model. The +honest-root theorems are additionally stated only for the binary +`child_order = [0, 1]` shipped shape. -/ + +/-- The Zellic 3.6 non-contiguous child order. -/ +def zellicGapInnerSpec : InnerSpec := + { smtSpec.innerSpec with childOrder := [0, 2] } + +/-- Total, not panicking: branch `1` is absent from `[0, 2]` ⇒ `none`. -/ +example : getPadding zellicGapInnerSpec 1 = none := by decide + +/-- A present branch still resolves. -/ +example : (getPadding zellicGapInnerSpec 0).isSome = true := by decide + +/-! ### 3.7 — Panic in `decompressExist` (Low) + +Out-of-bounds index when decompressing a compressed batch proof. Compressed and +batched proofs were *removed* upstream (PRs 390/391/392) and are **out of scope** +for the model, which covers single existence/non-existence proofs only. No model +artifact. -/ + +/-! ### 3.8 — Checks for `IavlSpec`/`TendermintSpec` could be made stricter (Informational) + +Recommends tightening the verifier to reject more malformed-but-currently-accepted +IAVL/Tendermint proofs (IAVL leaf prefix's second varint `= 1`; Tendermint inner +prefix `= [1]`). The model's verifier (`ensureInner`/`ensureLeaf`) is the looser +upstream surface, but the honest-root *tree* models bake the stricter shape into +their well-formedness predicates: `WFTree tendermintSpec` requires each node +prefix to have length `= min_prefix_length = 1` and not begin with the leaf byte, +and `WFTreeI`/`WFTreeS` similarly constrain the IAVL/SMT node shape. Related: 3.3. -/ + +end Ics23 diff --git a/lean/Ics23/Executable.lean b/lean/Ics23/Executable.lean new file mode 100644 index 00000000..361ae1c4 --- /dev/null +++ b/lean/Ics23/Executable.lean @@ -0,0 +1,125 @@ +/- +The verifier model, run end to end with a concrete SHA-256. + +This grounds the abstract model: roots are computed with real hashing and +forgeries are rejected by computation (`native_decide`). It is the seed of the +Phase 2a differential oracle — the same `concreteHash` can drive the model +against the Rust/Go implementations over shared test vectors. +-/ +import Ics23.Verify +import Ics23.NonExist +import Ics23.Specs +import Ics23.Sha256 + +namespace Ics23 + +/-- A concrete `HashFn` covering the ops the shipped specs use (`noHash`, +`sha256`). Other ops are placeholders — not exercised by IAVL/Tendermint/SMT. -/ +def concreteHash : HashFn := fun op data => + match op with + | .sha256 => Sha256.hash data + | _ => data + +/-! ## End-to-end: a single-leaf IAVL proof -/ + +def demoLeafProof : ExistenceProof := + { key := [0x01], value := [0x02], leaf := iavlSpec.leafSpec, path := [] } + +/-- The root computed by the model with real SHA-256. -/ +def demoLeafRoot : Bytes := (calculateExistenceRoot concreteHash iavlSpec demoLeafProof).getD [] + +/-- The honest proof verifies. -/ +example : verifyExistence concreteHash demoLeafProof iavlSpec demoLeafRoot [0x01] [0x02] = true := by + native_decide + +/-- A different value under the same root is rejected (the hash chain no longer +matches) — a value-swap forgery, refuted by computation. -/ +def demoLeafForgery : ExistenceProof := { demoLeafProof with value := [0x03] } + +example : verifyExistence concreteHash demoLeafForgery iavlSpec demoLeafRoot [0x01] [0x03] = false := by + native_decide + +/-! ## End-to-end: an IAVL proof with one inner step -/ + +def demoInner : InnerOp := { hash := .sha256, prefixBytes := [0x01, 0x02, 0x03, 0x04], suffix := [] } + +def demoPathProof : ExistenceProof := { demoLeafProof with path := [demoInner] } + +def demoPathRoot : Bytes := (calculateExistenceRoot concreteHash iavlSpec demoPathProof).getD [] + +/-- The honest two-level proof verifies. -/ +example : verifyExistence concreteHash demoPathProof iavlSpec demoPathRoot [0x01] [0x02] = true := by + native_decide + +/-- The single-leaf root does not validate the two-level proof (and vice versa): +distinct tree shapes give distinct roots. -/ +example : verifyExistence concreteHash demoPathProof iavlSpec demoLeafRoot [0x01] [0x02] = false := by + native_decide + +/-! ## End-to-end: non-existence over a real 2-leaf Tendermint tree + +Leaves at keys `01` and `03`; the tree's inner node is `sha256(0x01 ‖ left ‖ right)`. +We prove non-membership of `02` (which sorts strictly between) and show the +verifier *refuses* to prove non-membership of `01` (which exists). -/ + +def tmLeaf : LeafOp := tendermintSpec.leafSpec +def lhA : Bytes := (applyLeaf concreteHash tmLeaf [0x01] [0x0a]).getD [] +def lhB : Bytes := (applyLeaf concreteHash tmLeaf [0x03] [0x0b]).getD [] + +/-- Left leaf's path: it is the left child, right sibling hash in the suffix. -/ +def exA : ExistenceProof := + { key := [0x01], value := [0x0a], leaf := tmLeaf, + path := [{ hash := .sha256, prefixBytes := [1], suffix := lhB }] } + +/-- Right leaf's path: it is the right child, left sibling hash in the prefix. -/ +def exB : ExistenceProof := + { key := [0x03], value := [0x0b], leaf := tmLeaf, + path := [{ hash := .sha256, prefixBytes := [1] ++ lhA, suffix := [] }] } + +def tmRoot : Bytes := (calculateExistenceRoot concreteHash tendermintSpec exA).getD [] + +/-- Both leaves hash up to the same root. -/ +example : calculateExistenceRoot concreteHash tendermintSpec exB = some tmRoot := by native_decide + +/-- Non-membership of `02` (strictly between the two leaves) verifies. -/ +def nexProof : NonExistenceProof := { key := [0x02], left := some exA, right := some exB } + +example : verifyNonExistence concreteHash nexProof tendermintSpec tmRoot [0x02] = true := by + native_decide + +/-- The verifier refuses to prove non-membership of `01`, which exists — the +Theorem B property, demonstrated computationally. -/ +def nexForgery : NonExistenceProof := { key := [0x01], left := some exA, right := some exB } + +example : verifyNonExistence concreteHash nexForgery tendermintSpec tmRoot [0x01] = false := by + native_decide + +/-! ## Finding F3, machine-checked: positional ambiguity of a node hash + +For the Tendermint spec the 65-byte preimage `[1] ‖ A ‖ B` is accepted by +`ensure_inner` both as a **left**-child step (child `A`, sibling `B` in the +suffix) and as a **right**-child step (child `B`, sibling `A` in the prefix). +Both readings produce the *same* node hash from *different* children — so the +spec checks alone do not pin a node's recursive child. See +`docs/verification/properties.md` (F3): this is why general `existence_binding` +needs more than collision resistance. -/ + +def ambA : Bytes := List.replicate 32 1 +def ambB : Bytes := List.replicate 32 2 + +/-- Left-child reading of the node. -/ +def opLeft : InnerOp := { hash := .sha256, prefixBytes := [1], suffix := ambB } + +/-- Right-child reading of the *same* node bytes. -/ +def opRight : InnerOp := { hash := .sha256, prefixBytes := [1] ++ ambA, suffix := [] } + +example : ensureInner opLeft tendermintSpec = true := by native_decide +example : ensureInner opRight tendermintSpec = true := by native_decide + +/-- The two accepted readings hash to the same node from different children. -/ +example : applyInner concreteHash opLeft ambA = applyInner concreteHash opRight ambB := by + native_decide + +example : ambA ≠ ambB := by native_decide + +end Ics23 diff --git a/lean/Ics23/Existence.lean b/lean/Ics23/Existence.lean new file mode 100644 index 00000000..e8489d75 --- /dev/null +++ b/lean/Ics23/Existence.lean @@ -0,0 +1,517 @@ +/- +Existence binding (Theorem A), developed incrementally. + +This file proves binding for the *same-shape* case: two existence proofs that +share the same leaf op and path ops, binding one key to two different values +under one root, yield a hash collision. It is parameterized by injectivity of +the leaf's length encoding (`hLeafInj`) and instantiated for both shipped leaf +shapes: + +* `existence_binding_sameshape_noPrefix` — SMT/JMT (`NoPrefix` length). +* `existence_binding_sameshape_varProto` — IAVL / Tendermint (`VarProto` length). + +The full chain is exercised: root extraction → path-fold injectivity +(`applyPath_sameops_inj`) → leaf-image cancellation → leaf-encoding injectivity +(`doLength_*_inj`). No `sorry` is used. The remaining gap to the *general* +`existence_binding` (in `Soundness.lean`) is the differing-path-structure case. +-/ +import Ics23.Soundness +import Ics23.Varint + +namespace Ics23 + +/-- A successful `verifyExistence` pins the computed root. -/ +theorem verifyExistence_root (H : HashFn) (p : ExistenceProof) (s : ProofSpec) + (root key value : Bytes) (h : verifyExistence H p s root key value = true) : + calculateExistenceRoot H s p = some root := by + unfold verifyExistence at h + simp only [Bool.and_eq_true] at h + obtain ⟨⟨⟨_, _⟩, _⟩, hr⟩ := h + cases hc : calculateExistenceRoot H s p with + | none => rw [hc] at hr; simp at hr + | some r => + rw [hc] at hr + simp only [Option.some.injEq] + exact (eq_of_beq hr) + +/-- `calculateExistenceRoot` factored into its leaf and path stages. -/ +theorem calculateExistenceRoot_eq (H : HashFn) (s : ProofSpec) (p : ExistenceProof) + (lh : Bytes) (hk : p.key.isEmpty = false) (hv : p.value.isEmpty = false) + (hl : applyLeaf H p.leaf p.key p.value = some lh) : + calculateExistenceRoot H s p = applyPath H s.innerSpec lh p.path := by + simp [calculateExistenceRoot, hk, hv, hl] + +/-- `doLength .noPrefix` is injective. -/ +theorem doLength_noPrefix_inj (a b : Bytes) + (h : doLength .noPrefix a = doLength .noPrefix b) : a = b := by + simp only [doLength, Option.some.injEq] at h; exact h + +/-- Leaf-value injectivity up to a collision: if two values encode to the same +leaf-value field under an injective length op, they are equal or their prehash +collides. -/ +theorem prepareLeafData_inj (H : HashFn) (pre : HashOp) (L : LengthOp) (v₁ v₂ : Bytes) + (hinj : ∀ a b, doLength L a = doLength L b → a = b) + (h : prepareLeafData H pre L v₁ = prepareLeafData H pre L v₂) + (hne1 : v₁.isEmpty = false) (hne2 : v₂.isEmpty = false) : + v₁ = v₂ ∨ HashCollision H := by + unfold prepareLeafData at h + rw [if_neg (by simp [hne1]), if_neg (by simp [hne2])] at h + have h' := hinj _ _ h + by_cases hv : v₁ = v₂ + · exact Or.inl hv + · exact Or.inr (hashCollision_of H pre v₁ v₂ hv h') + +/-- Two different values binding to the same leaf hash under one leaf op force a +collision (the base case of binding). -/ +theorem leaf_value_collision (H : HashFn) (leaf : LeafOp) (key v₁ v₂ L : Bytes) + (hLeafInj : ∀ a b, doLength leaf.length a = doLength leaf.length b → a = b) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) (hv : v₁ ≠ v₂) + (hl1 : applyLeaf H leaf key v₁ = some L) (hl2 : applyLeaf H leaf key v₂ = some L) : + HashCollision H := by + unfold applyLeaf at hl1 hl2 + cases hpk : prepareLeafData H leaf.prehashKey leaf.length key with + | none => simp [hpk] at hl1 + | some pk => + cases hpv1 : prepareLeafData H leaf.prehashValue leaf.length v₁ with + | none => simp [hpk, hpv1] at hl1 + | some pv1 => + cases hpv2 : prepareLeafData H leaf.prehashValue leaf.length v₂ with + | none => simp [hpk, hpv2] at hl2 + | some pv2 => + simp only [hpk, hpv1, Option.some.injEq] at hl1 + simp only [hpk, hpv2, Option.some.injEq] at hl2 + by_cases himg : leaf.prefixBytes ++ pk ++ pv1 = leaf.prefixBytes ++ pk ++ pv2 + · have hpveq : pv1 = pv2 := List.append_cancel_left himg + have hpv : prepareLeafData H leaf.prehashValue leaf.length v₁ + = prepareLeafData H leaf.prehashValue leaf.length v₂ := by rw [hpv1, hpv2, hpveq] + rcases prepareLeafData_inj H leaf.prehashValue leaf.length v₁ v₂ hLeafInj hpv hv1ne hv2ne + with hveq | hcol + · exact absurd hveq hv + · exact hcol + · exact hashCollision_of H leaf.hash _ _ himg (by rw [hl1, hl2]) + +/-- A leaf hash cannot also be an inner-node image: if it is, the leaf preimage +(starting with the leaf prefix byte) and the inner preimage (not) collide. The +length-mismatch case of binding. Requires the (shipped-spec) shape: a single-byte +leaf prefix, a shared hash op, and `min_prefix_length ≥ 1`. -/ +theorem leafHash_innerImage_collision (H : HashFn) (s : ProofSpec) + (leaf : LeafOp) (key val L : Bytes) (b : UInt8) + (hsh : s.leafSpec.hash = s.innerSpec.hash) + (hpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hleaf : ensureLeaf leaf s.leafSpec = true) + (hl : applyLeaf H leaf key val = some L) + (hii : IsInnerImage H s L) : HashCollision H := by + obtain ⟨op, c, hin, hic⟩ := hii + have hIimg := applyInner_image H op c L hic + unfold applyLeaf at hl + cases hpk : prepareLeafData H leaf.prehashKey leaf.length key with + | none => simp [hpk] at hl + | some pk => + cases hpv : prepareLeafData H leaf.prehashValue leaf.length val with + | none => simp [hpk, hpv] at hl + | some pv => + simp only [hpk, hpv, Option.some.injEq] at hl + unfold ensureLeaf at hleaf + simp only [Bool.and_eq_true] at hleaf + obtain ⟨⟨⟨⟨hLhash, _⟩, _⟩, _⟩, hLpre⟩ := hleaf + have hleafhash : leaf.hash = s.leafSpec.hash := (eq_of_beq hLhash).symm + have hophash : op.hash = s.innerSpec.hash := ensureInner_hash op s hin + have hLph : leaf.prefixBytes.head? = some b := by + apply hasPrefix_single_head; rw [← hpre]; exact hLpre + have hinx := hin + unfold ensureInner at hinx + simp only [Bool.and_eq_true] at hinx + obtain ⟨⟨⟨⟨⟨⟨_, hnp⟩, hmp⟩, _⟩, _⟩, _⟩, _⟩ := hinx + have hnp' : hasPrefix s.leafSpec.prefixBytes op.prefixBytes = false := by simpa using hnp + have hopne : op.prefixBytes ≠ [] := by + intro he + rw [he] at hmp + simp only [List.length_nil, decide_eq_true_eq] at hmp + omega + have hleafPre : (leaf.prefixBytes ++ pk ++ pv).head? = some b := by + cases hlp : leaf.prefixBytes with + | nil => rw [hlp] at hLph; simp at hLph + | cons y ys => + rw [hlp] at hLph; simp only [List.head?_cons, Option.some.injEq] at hLph + simp [hLph] + have hinnerPre : (op.prefixBytes ++ c ++ op.suffix).head? ≠ some b := by + cases hop : op.prefixBytes with + | nil => exact absurd hop hopne + | cons y ys => + have hh : hasPrefix [b] (y :: ys) = false := by rw [← hpre, ← hop]; exact hnp' + have hne := not_hasPrefix_single_head b y ys hh + simp only [List.cons_append, List.head?_cons] at hne ⊢ + exact hne + refine leaf_inner_domain_collision H leaf.hash _ _ b hleafPre hinnerPre ?_ + rw [hl, hleafhash, hsh, ← hophash, hIimg] + +/-- Every inner op of a verifying existence proof is spec-conformant. -/ +theorem verifyExistence_inners (H : HashFn) (p : ExistenceProof) (s : ProofSpec) + (root key value : Bytes) (h : verifyExistence H p s root key value = true) : + ∀ op ∈ p.path, ensureInner op s = true := by + unfold verifyExistence at h + simp only [Bool.and_eq_true] at h + obtain ⟨⟨⟨hces, _⟩, _⟩, _⟩ := h + unfold checkExistenceSpec at hces + simp only [Bool.and_eq_true] at hces + obtain ⟨⟨_, _⟩, hpath⟩ := hces + intro op hop + exact List.all_eq_true.mp hpath op hop + +/-- A verifying existence proof's leaf op is spec-conformant. -/ +theorem verifyExistence_leaf (H : HashFn) (p : ExistenceProof) (s : ProofSpec) + (root key value : Bytes) (h : verifyExistence H p s root key value = true) : + ensureLeaf p.leaf s.leafSpec = true := by + unfold verifyExistence at h + simp only [Bool.and_eq_true] at h + obtain ⟨⟨⟨hces, _⟩, _⟩, _⟩ := h + unfold checkExistenceSpec at hces + simp only [Bool.and_eq_true] at hces + exact hces.1.1 + +/-- Two leaf ops conforming to the same leaf spec with equal prefixes are equal +(the spec pins every other field). -/ +theorem ensureLeaf_eq (l1 l2 spec : LeafOp) + (h1 : ensureLeaf l1 spec = true) (h2 : ensureLeaf l2 spec = true) + (hp : l1.prefixBytes = l2.prefixBytes) : l1 = l2 := by + unfold ensureLeaf at h1 h2 + simp only [Bool.and_eq_true, beq_iff_eq] at h1 h2 + obtain ⟨⟨⟨⟨e1h, e1pk⟩, e1pv⟩, e1l⟩, _⟩ := h1 + obtain ⟨⟨⟨⟨e2h, e2pk⟩, e2pv⟩, e2l⟩, _⟩ := h2 + cases l1; cases l2; simp_all + +/-- **Theorem A, equal-length case.** Two existence proofs sharing the same leaf +op and the same path *length* (but possibly different inner ops), binding one key +to two different values under one root, yield a hash collision OR exhibit the F3 +positional ambiguity. Strengthens the same-shape theorem (identical ops) to equal +depth with arbitrary ops; closes the honest disjunction for equal-depth proofs. -/ +theorem existence_binding_eqlen + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) + (hlen : p₁.path.length = p₂.path.length) + (hLeafInj : ∀ a b, doLength p₁.leaf.length a = doLength p₁.leaf.length b → a = b) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) + (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity s := by + have r1 := verifyExistence_root H p₁ s root key v₁ h₁ + have r2 := verifyExistence_root H p₂ s root key v₂ h₂ + have hk1e : p₁.key.isEmpty = false := by rw [hk1]; exact hkne + have hk2e : p₂.key.isEmpty = false := by rw [hk2]; exact hkne + have hv1e : p₁.value.isEmpty = false := by rw [hvv1]; exact hv1ne + have hv2e : p₂.value.isEmpty = false := by rw [hvv2]; exact hv2ne + cases hl1 : applyLeaf H p₁.leaf p₁.key p₁.value with + | none => simp [calculateExistenceRoot, hk1e, hv1e, hl1] at r1 + | some lh₁ => + cases hl2 : applyLeaf H p₂.leaf p₂.key p₂.value with + | none => simp [calculateExistenceRoot, hk2e, hv2e, hl2] at r2 + | some lh₂ => + have e1 : applyPath H s.innerSpec lh₁ p₁.path = some root := by + rw [← calculateExistenceRoot_eq H s p₁ lh₁ hk1e hv1e hl1]; exact r1 + have e2 : applyPath H s.innerSpec lh₂ p₂.path = some root := by + rw [← calculateExistenceRoot_eq H s p₂ lh₂ hk2e hv2e hl2]; exact r2 + rcases applyPath_eqlen_merge H s p₁.path p₂.path hlen lh₁ lh₂ root + (verifyExistence_inners H p₁ s root key v₁ h₁) + (verifyExistence_inners H p₂ s root key v₂ h₂) e1 e2 with hc | ha | hlh + · exact Or.inl hc + · exact Or.inr ha + · -- lh₁ = lh₂: same leaf step as same-shape ⇒ collision or v₁ = v₂ (contra) + refine Or.inl ?_ + rw [hk1, hvv1] at hl1 + rw [hk2, hvv2, ← hleafEq] at hl2 + unfold applyLeaf at hl1 hl2 + cases hpk : prepareLeafData H p₁.leaf.prehashKey p₁.leaf.length key with + | none => simp [hpk] at hl1 + | some pk => + cases hpv1 : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₁ with + | none => simp [hpk, hpv1] at hl1 + | some pv1 => + cases hpv2 : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₂ with + | none => simp [hpk, hpv2] at hl2 + | some pv2 => + simp only [hpk, hpv1, Option.some.injEq] at hl1 + simp only [hpk, hpv2, Option.some.injEq] at hl2 + by_cases himg : + p₁.leaf.prefixBytes ++ pk ++ pv1 = p₁.leaf.prefixBytes ++ pk ++ pv2 + · have hpveq : pv1 = pv2 := List.append_cancel_left himg + have hpv : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₁ + = prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₂ := by + rw [hpv1, hpv2, hpveq] + rcases prepareLeafData_inj H p₁.leaf.prehashValue p₁.leaf.length v₁ v₂ + hLeafInj hpv hv1ne hv2ne with hveq | hcol + · exact absurd hveq hv + · exact hcol + · exact hashCollision_of H p₁.leaf.hash _ _ himg (by rw [hl1, hl2]; exact hlh) + +/-- **Theorem A, same-shape case (general length op).** Two existence proofs +sharing the same leaf op and path ops, binding the same (nonempty) key to two +different (nonempty) values under one root, yield a hash collision — provided the +leaf's length encoding is injective. -/ +theorem existence_binding_sameshape + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) + (hpathEq : p₁.path = p₂.path) + (hLeafInj : ∀ a b, doLength p₁.leaf.length a = doLength p₁.leaf.length b → a = b) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) + (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H := by + have r1 := verifyExistence_root H p₁ s root key v₁ h₁ + have r2 := verifyExistence_root H p₂ s root key v₂ h₂ + have hk1e : p₁.key.isEmpty = false := by rw [hk1]; exact hkne + have hk2e : p₂.key.isEmpty = false := by rw [hk2]; exact hkne + have hv1e : p₁.value.isEmpty = false := by rw [hvv1]; exact hv1ne + have hv2e : p₂.value.isEmpty = false := by rw [hvv2]; exact hv2ne + cases hl1 : applyLeaf H p₁.leaf p₁.key p₁.value with + | none => simp [calculateExistenceRoot, hk1e, hv1e, hl1] at r1 + | some lh₁ => + cases hl2 : applyLeaf H p₂.leaf p₂.key p₂.value with + | none => simp [calculateExistenceRoot, hk2e, hv2e, hl2] at r2 + | some lh₂ => + have e1 : applyPath H s.innerSpec lh₁ p₁.path = some root := by + rw [← calculateExistenceRoot_eq H s p₁ lh₁ hk1e hv1e hl1]; exact r1 + have e2 : applyPath H s.innerSpec lh₂ p₂.path = some root := by + rw [← calculateExistenceRoot_eq H s p₂ lh₂ hk2e hv2e hl2]; exact r2 + rw [hpathEq] at e1 + rcases applyPath_sameops_inj H s.innerSpec p₂.path lh₁ lh₂ root e1 e2 with hlh | hc + · rw [hk1, hvv1] at hl1 + rw [hk2, hvv2, ← hleafEq] at hl2 + unfold applyLeaf at hl1 hl2 + cases hpk : prepareLeafData H p₁.leaf.prehashKey p₁.leaf.length key with + | none => simp [hpk] at hl1 + | some pk => + cases hpv1 : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₁ with + | none => simp [hpk, hpv1] at hl1 + | some pv1 => + cases hpv2 : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₂ with + | none => simp [hpk, hpv2] at hl2 + | some pv2 => + simp only [hpk, hpv1, Option.some.injEq] at hl1 + simp only [hpk, hpv2, Option.some.injEq] at hl2 + by_cases himg : + p₁.leaf.prefixBytes ++ pk ++ pv1 = p₁.leaf.prefixBytes ++ pk ++ pv2 + · have hpveq : pv1 = pv2 := List.append_cancel_left himg + have hpv : prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₁ + = prepareLeafData H p₁.leaf.prehashValue p₁.leaf.length v₂ := by + rw [hpv1, hpv2, hpveq] + rcases prepareLeafData_inj H p₁.leaf.prehashValue p₁.leaf.length v₁ v₂ + hLeafInj hpv hv1ne hv2ne with hveq | hcol + · exact absurd hveq hv + · exact hcol + · exact hashCollision_of H p₁.leaf.hash _ _ himg (by rw [hl1, hl2]; exact hlh) + · exact hc + +/-- **Theorem A, SMT/JMT same-shape** (`NoPrefix` length). -/ +theorem existence_binding_sameshape_noPrefix + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) (hpathEq : p₁.path = p₂.path) + (hLen : p₁.leaf.length = .noPrefix) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H := + existence_binding_sameshape H s root key v₁ v₂ p₁ p₂ hleafEq hpathEq + (fun a b h => by rw [hLen] at h; exact doLength_noPrefix_inj a b h) + hk1 hk2 hkne hv1ne hv2ne hvv1 hvv2 hv h₁ h₂ + +/-- **Theorem A, IAVL / Tendermint same-shape** (`VarProto` length). -/ +theorem existence_binding_sameshape_varProto + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) (hpathEq : p₁.path = p₂.path) + (hLen : p₁.leaf.length = .varProto) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H := + existence_binding_sameshape H s root key v₁ v₂ p₁ p₂ hleafEq hpathEq + (fun a b h => by rw [hLen] at h; exact doLength_varProto_inj a b h) + hk1 hk2 hkne hv1ne hv2ne hvv1 hvv2 hv h₁ h₂ + +/-- **Theorem A, same-leaf case (arbitrary path length).** For a spec with a +single-byte leaf prefix, a shared leaf/inner hash op, and `min_prefix_length ≥ 1` +(all true for IAVL/Tendermint/SMT), two existence proofs sharing the same leaf op +— but with *arbitrary, differing-length* paths — that bind one key to two values +under one root yield a hash collision OR the F3 positional ambiguity. This is the +strongest binding result: it removes the equal-length restriction by handling the +length-mismatch via leaf/inner domain separation. -/ +theorem existence_binding_sameleaf + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) (b : UInt8) + (hsh : s.leafSpec.hash = s.innerSpec.hash) + (hpreShape : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hleafEq : p₁.leaf = p₂.leaf) + (hLeafInj : ∀ a b, doLength p₁.leaf.length a = doLength p₁.leaf.length b → a = b) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) + (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity s := by + have r1 := verifyExistence_root H p₁ s root key v₁ h₁ + have r2 := verifyExistence_root H p₂ s root key v₂ h₂ + have hk1e : p₁.key.isEmpty = false := by rw [hk1]; exact hkne + have hk2e : p₂.key.isEmpty = false := by rw [hk2]; exact hkne + have hv1e : p₁.value.isEmpty = false := by rw [hvv1]; exact hv1ne + have hv2e : p₂.value.isEmpty = false := by rw [hvv2]; exact hv2ne + cases hl1 : applyLeaf H p₁.leaf p₁.key p₁.value with + | none => simp [calculateExistenceRoot, hk1e, hv1e, hl1] at r1 + | some lh₁ => + cases hl2 : applyLeaf H p₂.leaf p₂.key p₂.value with + | none => simp [calculateExistenceRoot, hk2e, hv2e, hl2] at r2 + | some lh₂ => + have e1 : applyPath H s.innerSpec lh₁ p₁.path = some root := by + rw [← calculateExistenceRoot_eq H s p₁ lh₁ hk1e hv1e hl1]; exact r1 + have e2 : applyPath H s.innerSpec lh₂ p₂.path = some root := by + rw [← calculateExistenceRoot_eq H s p₂ lh₂ hk2e hv2e hl2]; exact r2 + -- normalize the leaf-hash facts to (key, vᵢ) + rw [hk1, hvv1] at hl1 + rw [hk2, hvv2] at hl2 + rcases applyPath_merge H s (p₁.path.length + p₂.path.length) p₁.path p₂.path lh₁ lh₂ root rfl + (verifyExistence_inners H p₁ s root key v₁ h₁) + (verifyExistence_inners H p₂ s root key v₂ h₂) e1 e2 with hc | ha | hlheq | hii1 | hii2 + · exact Or.inl hc + · exact Or.inr ha + · -- lh₁ = lh₂ : leaf injectivity + refine Or.inl ?_ + rw [hlheq] at hl1 + rw [← hleafEq] at hl2 + exact leaf_value_collision H p₁.leaf key v₁ v₂ lh₂ hLeafInj hv1ne hv2ne hv hl1 hl2 + · -- lh₁ is an inner image: leaf/inner domain separation + exact Or.inl (leafHash_innerImage_collision H s p₁.leaf key v₁ lh₁ b hsh hpreShape hmin + (verifyExistence_leaf H p₁ s root key v₁ h₁) hl1 hii1) + · -- lh₂ is an inner image + exact Or.inl (leafHash_innerImage_collision H s p₂.leaf key v₂ lh₂ b hsh hpreShape hmin + (verifyExistence_leaf H p₂ s root key v₂ h₂) hl2 hii2) + +/-- Same-leaf binding instantiated for the **IAVL** spec. -/ +theorem existence_binding_iavl + (H : HashFn) (root key v₁ v₂ : Bytes) (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) (hLen : p₁.leaf.length = .varProto) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ iavlSpec root key v₁ = true) + (h₂ : verifyExistence H p₂ iavlSpec root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity iavlSpec := + existence_binding_sameleaf H iavlSpec root key v₁ v₂ p₁ p₂ 0 + (by decide) (by decide) (by decide) hleafEq + (fun a b h => by rw [hLen] at h; exact doLength_varProto_inj a b h) + hk1 hk2 hkne hv1ne hv2ne hvv1 hvv2 hv h₁ h₂ + +/-- Same-leaf binding instantiated for the **Tendermint** spec. -/ +theorem existence_binding_tendermint + (H : HashFn) (root key v₁ v₂ : Bytes) (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) (hLen : p₁.leaf.length = .varProto) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ tendermintSpec root key v₁ = true) + (h₂ : verifyExistence H p₂ tendermintSpec root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity tendermintSpec := + existence_binding_sameleaf H tendermintSpec root key v₁ v₂ p₁ p₂ 0 + (by decide) (by decide) (by decide) hleafEq + (fun a b h => by rw [hLen] at h; exact doLength_varProto_inj a b h) + hk1 hk2 hkne hv1ne hv2ne hvv1 hvv2 hv h₁ h₂ + +/-- Same-leaf binding instantiated for the **SMT** spec (`NoPrefix` length). -/ +theorem existence_binding_smt + (H : HashFn) (root key v₁ v₂ : Bytes) (p₁ p₂ : ExistenceProof) + (hleafEq : p₁.leaf = p₂.leaf) (hLen : p₁.leaf.length = .noPrefix) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ smtSpec root key v₁ = true) + (h₂ : verifyExistence H p₂ smtSpec root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity smtSpec := + existence_binding_sameleaf H smtSpec root key v₁ v₂ p₁ p₂ 0 + (by decide) (by decide) (by decide) hleafEq + (fun a b h => by rw [hLen] at h; exact doLength_noPrefix_inj a b h) + hk1 hk2 hkne hv1ne hv2ne hvv1 hvv2 hv h₁ h₂ + +/-- **Theorem A, general (production-spec shape).** Two existence proofs binding +one key to two different values under one root — with NO assumption relating their +leaf ops or paths — yield the honest three-way disjunction: a hash collision, the +inner positional ambiguity (F3), or its leaf-level analogue. Proved with no +`sorry` for the shape shared by IAVL/Tendermint/SMT (single-byte leaf prefix, +shared leaf/inner hash op, `min_prefix_length ≥ 1`). The two ambiguity arms are +real, machine-checkable obstructions that the abstract-hash model cannot rule out; +collapsing them to a bare collision requires the symbolic-Merkle model. -/ +theorem existence_binding_shaped + (H : HashFn) (s : ProofSpec) (root key v₁ v₂ : Bytes) + (p₁ p₂ : ExistenceProof) (b : UInt8) + (hsh : s.leafSpec.hash = s.innerSpec.hash) + (hpreShape : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hLeafInj : ∀ a b, doLength p₁.leaf.length a = doLength p₁.leaf.length b → a = b) + (hk1 : p₁.key = key) (hk2 : p₂.key = key) + (hkne : key.isEmpty = false) + (hv1ne : v₁.isEmpty = false) (hv2ne : v₂.isEmpty = false) + (hvv1 : p₁.value = v₁) (hvv2 : p₂.value = v₂) + (hv : v₁ ≠ v₂) + (h₁ : verifyExistence H p₁ s root key v₁ = true) + (h₂ : verifyExistence H p₂ s root key v₂ = true) : + HashCollision H ∨ PositionalAmbiguity s ∨ LeafAmbiguity H s := by + have r1 := verifyExistence_root H p₁ s root key v₁ h₁ + have r2 := verifyExistence_root H p₂ s root key v₂ h₂ + have hk1e : p₁.key.isEmpty = false := by rw [hk1]; exact hkne + have hk2e : p₂.key.isEmpty = false := by rw [hk2]; exact hkne + have hv1e : p₁.value.isEmpty = false := by rw [hvv1]; exact hv1ne + have hv2e : p₂.value.isEmpty = false := by rw [hvv2]; exact hv2ne + cases hl1 : applyLeaf H p₁.leaf p₁.key p₁.value with + | none => simp [calculateExistenceRoot, hk1e, hv1e, hl1] at r1 + | some lh₁ => + cases hl2 : applyLeaf H p₂.leaf p₂.key p₂.value with + | none => simp [calculateExistenceRoot, hk2e, hv2e, hl2] at r2 + | some lh₂ => + have e1 : applyPath H s.innerSpec lh₁ p₁.path = some root := by + rw [← calculateExistenceRoot_eq H s p₁ lh₁ hk1e hv1e hl1]; exact r1 + have e2 : applyPath H s.innerSpec lh₂ p₂.path = some root := by + rw [← calculateExistenceRoot_eq H s p₂ lh₂ hk2e hv2e hl2]; exact r2 + rw [hk1, hvv1] at hl1 + rw [hk2, hvv2] at hl2 + rcases applyPath_merge H s (p₁.path.length + p₂.path.length) p₁.path p₂.path lh₁ lh₂ root rfl + (verifyExistence_inners H p₁ s root key v₁ h₁) + (verifyExistence_inners H p₂ s root key v₂ h₂) e1 e2 with hc | ha | hlheq | hii1 | hii2 + · exact Or.inl hc + · exact Or.inr (Or.inl ha) + · by_cases hpeq : p₁.leaf.prefixBytes = p₂.leaf.prefixBytes + · have hleq : p₁.leaf = p₂.leaf := + ensureLeaf_eq p₁.leaf p₂.leaf s.leafSpec + (verifyExistence_leaf H p₁ s root key v₁ h₁) + (verifyExistence_leaf H p₂ s root key v₂ h₂) hpeq + refine Or.inl ?_ + rw [hlheq] at hl1 + rw [← hleq] at hl2 + exact leaf_value_collision H p₁.leaf key v₁ v₂ lh₂ hLeafInj hv1ne hv2ne hv hl1 hl2 + · refine Or.inr (Or.inr ⟨p₁.leaf, p₂.leaf, key, v₁, key, v₂, lh₂, + verifyExistence_leaf H p₁ s root key v₁ h₁, + verifyExistence_leaf H p₂ s root key v₂ h₂, hpeq, ?_, hl2⟩) + rw [hlheq] at hl1; exact hl1 + · exact Or.inl (leafHash_innerImage_collision H s p₁.leaf key v₁ lh₁ b hsh hpreShape hmin + (verifyExistence_leaf H p₁ s root key v₁ h₁) hl1 hii1) + · exact Or.inl (leafHash_innerImage_collision H s p₂.leaf key v₂ lh₂ b hsh hpreShape hmin + (verifyExistence_leaf H p₂ s root key v₂ h₂) hl2 hii2) + +end Ics23 diff --git a/lean/Ics23/IavlNonExist.lean b/lean/Ics23/IavlNonExist.lean new file mode 100644 index 00000000..0525bcd5 --- /dev/null +++ b/lean/Ics23/IavlNonExist.lean @@ -0,0 +1,572 @@ +/- +Non-existence soundness (Theorem B) for the IAVL tree model. + +Everything order-theoretic reuses TreeNonExist.lean verbatim: `maxKey`, +`minKey`, `SortedTree`, `IsSubtree`, the BST gap (`node_gap_no_member`), the +neighbor-walk decomposition (`ensureLeftNeighbor_spec`), and — because IAVL's +`emptyChild` is `[]` (length 0 ≠ 33 = `childSize`) — the Tendermint-style +padding bridges `ensureRightMost_suffix_nil` / `ensureLeftMost_suffix_cs`, +instantiated at `cs = 33`. + +What changes is the navigation: with IAVL's variable 4–12 byte prefixes and +33-byte child slots (1-byte amino length prefix + 32-byte digest), the +`split_left` / `split_right` / `split_pins` family is replaced by +`split_var_left` / `split_var_right` / `split_pins_var` (IavlTree.lean), which +pin a node split from the suffix length alone. Key order is raw `bytesLt` +(`prehash_key_before_comparison = false` for IAVL). +-/ +import Ics23.IavlTree + +namespace Ics23 + +/-- An all-right path (`ensure_right_most`: each step has an empty suffix) +reaches the rightmost leaf of an IAVL-shaped tree — the proof's key is +`maxKey t`, up to a collision. -/ +theorem reaches_maxI (H : HashFn) (s : ProofSpec) (b : UInt8) (d : Nat) + (hH : FixedHash H d) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeI s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ op.suffix = []) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + (key = maxKey t ∧ TreeMember key value t) ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeI] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk, hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r _ ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, _, hsuf, _, _, hprene, hprehead, _, hwfr⟩ := hwf + subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ mid ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ mid ++ rhR + · have hmlen : m.length = d := + applyPath_len H s.innerSpec d hH q lh m + (applyLeaf_len H d hH s.leafSpec key value lh hlh) hpm + rw [(hpath topOp (by simp)).2] at hpe + obtain ⟨_, hmr⟩ := split_var_right pre lhL mid rhR topOp.prefixBytes m d + hpe (rootHash_len H d hH r rhR hr) hmlen + rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hr hpm with ⟨hk, hmem⟩ | hcol + · exact Or.inl ⟨by rw [hk]; rfl, Or.inr hmem⟩ + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- An all-left path (`ensure_left_most`: each step has a full `cs`-suffix) +reaches the leftmost leaf of an IAVL-shaped tree — the proof's key is +`minKey t`, up to a collision. -/ +theorem reaches_minI (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) + (hcsd : cs = d + 1) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeI s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ op.suffix.length = cs) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + (key = minKey t ∧ TreeMember key value t) ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeI] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk, hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl _ => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hmid1, hsuf, _, _, hprene, hprehead, hwfl, _⟩ := hwf + subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ mid ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ mid ++ rhR + · have hmlen : m.length = d := + applyPath_len H s.innerSpec d hH q lh m + (applyLeaf_len H d hH s.leafSpec key value lh hlh) hpm + obtain ⟨_, hml, _⟩ := split_var_left pre lhL mid rhR topOp.prefixBytes m topOp.suffix cs d + hpe (rootHash_len H d hH l lhL hl) (rootHash_len H d hH r rhR hr) hmlen + (by omega) (hpath topOp (by simp)).2 + rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hl hpm with ⟨hk, hmem⟩ | hcol + · exact Or.inl ⟨by rw [hk]; rfl, Or.inl hmem⟩ + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- **Neighbor walk → divergence node (IAVL).** Two verifying existence proofs +whose reversed paths share a root-side prefix and then diverge as a left-step +(with right-most / left-most remainders) navigate to a common node `N` of the +honest IAVL tree: the left proof reaches `maxKey N.left`, the right proof +`minKey N.right` — up to a hash collision. -/ +theorem neighbor_divergenceI (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (lhLeaf rhLeaf root : Bytes) + (leftKey leftVal rightKey rightVal : Bytes) + (pathL pathR : List InnerOp) + (topLeft topRight : InnerOp) (restL restR : List InnerOp), + WFTreeI s b t → + applyLeaf H s.leafSpec leftKey leftVal = some lhLeaf → + applyLeaf H s.leafSpec rightKey rightVal = some rhLeaf → + (∀ op ∈ pathL, ensureInner op s = true) → + (∀ op ∈ pathR, ensureInner op s = true) → + rootHash H t = some root → + applyPath H s.innerSpec lhLeaf pathL = some root → + applyPath H s.innerSpec rhLeaf pathR = some root → + dropCommonPrefix pathL.reverse pathR.reverse = (some topLeft, restL, some topRight, restR) → + isLeftStep s.innerSpec topLeft topRight = true → + ensureRightMost s.innerSpec restL.reverse = true → + ensureLeftMost s.innerSpec restR.reverse = true → + (∃ ihN preN midN lN rN, IsSubtree (.node ihN preN midN [] lN rN) t ∧ + (leftKey = maxKey lN ∨ HashCollision H) ∧ + (rightKey = minKey rN ∨ HashCollision H)) + ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR + topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + cases pathL with + | nil => + exfalso + rw [List.reverse_nil] at hdcp + rw [show dropCommonPrefix [] pathR.reverse + = ((none : Option InnerOp), ([] : List InnerOp), (none : Option InnerOp), + ([] : List InnerOp)) from rfl] at hdcp + exact absurd (congrArg Prod.fst hdcp) (by simp) + | cons op rest => + simp only [WFTreeI] at hwf; subst hwf + rw [rootHash] at hrh + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lhLeaf root (by simp) hpathL hapL + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl ihr => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR + topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + obtain ⟨hih, hmid1, hsuf, hpremin, hpremax, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + have hcsInt : s.innerSpec.childSize = (cs : Int) := by omega + have hprelt : pre.length < cs := by omega + -- both paths must be nonempty (else a leaf hash equals the node hash) + rcases List.eq_nil_or_concat pathL with hLnil | ⟨qL, topOpL, hLc⟩ + · subst hLnil + simp only [applyPath, Option.some.injEq] at hapL + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec leftKey leftVal lhLeaf b hlpre hlhL + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ mid ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapL]; exact hrh.symm + rcases List.eq_nil_or_concat pathR with hRnil | ⟨qR, topOpR, hRc⟩ + · subst hRnil + simp only [applyPath, Option.some.injEq] at hapR + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec rightKey rightVal rhLeaf b hlpre hlhR + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ mid ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapR]; exact hrh.symm + rw [List.concat_eq_append] at hLc hRc; subst hLc; subst hRc + simp only [List.reverse_append, List.reverse_singleton, List.singleton_append] at hdcp + obtain ⟨mL, hpmL, htopL, _⟩ := (applyPath_snoc H s.innerSpec qL topOpL lhLeaf root).mp hapL + obtain ⟨mR, hpmR, htopR, _⟩ := (applyPath_snoc H s.innerSpec qR topOpR rhLeaf root).mp hapR + have hmLlen : mL.length = d := applyPath_len H s.innerSpec d hH qL lhLeaf mL + (applyLeaf_len H d hH s.leafSpec leftKey leftVal lhLeaf hlhL) hpmL + have hmRlen : mR.length = d := applyPath_len H s.innerSpec d hH qR rhLeaf mR + (applyLeaf_len H d hH s.leafSpec rightKey rightVal rhLeaf hlhR) hpmR + have htopimgL := applyInner_image H topOpL mL root htopL + rw [ensureInner_hash topOpL s (hpathL topOpL (by simp))] at htopimgL + have htopimgR := applyInner_image H topOpR mR root htopR + rw [ensureInner_hash topOpR s (hpathR topOpR (by simp))] at htopimgR + have hlhLlen := rootHash_len H d hH l lhL hl + have hrhRlen := rootHash_len H d hH r rhR hr + unfold dropCommonPrefix at hdcp + by_cases heq : eqPS topOpL topOpR = true + · -- common root step: both proofs navigate into the SAME child; recurse + rw [if_pos heq] at hdcp + unfold eqPS at heq + simp only [Bool.and_eq_true, beq_iff_eq] at heq + obtain ⟨hpreEq, hsufEq⟩ := heq + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ mid ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ mid ++ rhR + · -- both top ops genuinely match the node split: mL = mR + have hcat : topOpL.prefixBytes ++ mL = topOpL.prefixBytes ++ mR := by + have hee : (topOpL.prefixBytes ++ mL) ++ topOpL.suffix + = (topOpL.prefixBytes ++ mR) ++ topOpL.suffix := by + rw [hpeL]; rw [hpreEq, hsufEq] at *; rw [hpeR] + exact (List.append_inj hee (by simp [hmLlen, hmRlen])).1 + have hmEq : mL = mR := List.append_cancel_left hcat + have hsufmod := ensureInner_suffix_mod topOpL s cs hcsspec + (hpathL topOpL (by simp)) + rcases split_pins_var pre lhL mid rhR topOpL.prefixBytes mL topOpL.suffix cs d + hpeL hlhLlen hrhRlen hmLlen (by omega) hprelt hsufmod with ⟨_, hmlL, _⟩ | ⟨_, hmrL, _⟩ + · rw [hmlL] at hpmL + rw [← hmEq, hmlL] at hpmR + rcases ihl lhLeaf rhLeaf lhL leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfl hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hl hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, midN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, midN, lN, rN, + by simp only [IsSubtree]; exact Or.inr (Or.inl hsub), h1, h2⟩ + · exact Or.inr hc + · rw [hmrL] at hpmL + rw [← hmEq, hmrL] at hpmR + rcases ihr lhLeaf rhLeaf rhR leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfr hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hr hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, midN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, midN, lN, rN, + by simp only [IsSubtree]; exact Or.inr (Or.inr hsub), h1, h2⟩ + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + · -- divergence here: this node IS the neighbor node N + rw [if_neg heq] at hdcp + simp only [Prod.mk.injEq, Option.some.injEq] at hdcp + obtain ⟨htL, hrestL, htR, hrestR⟩ := hdcp + subst htL; subst htR + rw [← hrestL, List.reverse_reverse] at hrm + rw [← hrestR, List.reverse_reverse] at hlm + obtain ⟨hsufL, hsufR⟩ := isLeftStep_binary s.innerSpec cs hco hcsspec topOpL topOpR hls + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ mid ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ mid ++ rhR + · obtain ⟨_, hmlL, _⟩ := split_var_left pre lhL mid rhR topOpL.prefixBytes mL + topOpL.suffix cs d hpeL hlhLlen hrhRlen hmLlen (by omega) hsufL + rw [List.length_eq_zero_iff.mp hsufR] at hpeR + obtain ⟨_, hmrR⟩ := split_var_right pre lhL mid rhR topOpR.prefixBytes mR d + hpeR hrhRlen hmRlen + rw [hmlL] at hpmL + rw [hmrR] at hpmR + have hqLspec : ∀ op ∈ qL, ensureInner op s = true ∧ op.suffix = [] := fun op hop => + ⟨hpathL op (List.mem_append.mpr (Or.inl hop)), + ensureRightMost_suffix_nil s.innerSpec cs hco hcsspec hec qL hrm op hop⟩ + have hqRspec : ∀ op ∈ qR, ensureInner op s = true ∧ op.suffix.length = cs := fun op hop => + ⟨hpathR op (List.mem_append.mpr (Or.inl hop)), + ensureLeftMost_suffix_cs s.innerSpec cs hco hcsspec hec qR hlm op hop⟩ + refine Or.inl ⟨s.innerSpec.hash, pre, mid, l, r, Or.inl rfl, ?_, ?_⟩ + · rcases reaches_maxI H s b d hH hihash hlpre hmin hLInj + l leftKey leftVal lhLeaf qL lhL hwfl hlhL hqLspec hl hpmL with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · rcases reaches_minI H s b cs d hH hcsd hihash hlpre hmin hLInj + r rightKey rightVal rhLeaf qR rhR hwfr hlhR hqRspec hr hpmR with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + +/-- **Theorem B (non-existence soundness), IAVL tree model — two-sided.** For a +key-sorted honest IAVL tree, a two-sided non-existence proof for `key` and an +existence proof for `key` cannot both verify without a hash collision. -/ +theorem nonexistence_soundI (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTreeI s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep lp rp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + -- the absent key is a genuine member of the honest tree (or a collision) + rcases membership_soundI H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin hmaxcs hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · -- bracketing proofs verify and bracket the key + obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hnb : ensureLeftNeighbor s.innerSpec lp.path rp.path = true := by + unfold verifyNonExistence at hne + simp only [hnl, hnr, Bool.and_eq_true] at hne + exact hne.2 + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + obtain ⟨topLeft, restL, topRight, restR, hdcp, hls, hrm, hlm⟩ := + ensureLeftNeighbor_spec s.innerSpec lp.path rp.path hnb + rcases neighbor_divergenceI H s b cs d hH hcsspec hcsd hlhash.symm hlpre hmin hmaxcs hco hec + hLInj t lhLeaf rhLeaf root lp.key lp.value rp.key rp.value lp.path rp.path + topLeft topRight restL restR + hwf hlapL hrapL hlinn hrinn hroot hlap hrap hdcp hls hrm hlm with hdiv | hc + · obtain ⟨ihN, preN, midN, lN, rN, hsub, hLeq, hReq⟩ := hdiv + rcases hLeq with hLeq | hc + · rcases hReq with hReq | hc + · -- maxKey N.left < key < minKey N.right, but key is a member: contradiction + rw [hkfc, hkfc] at hllt hrlt + exact (node_gap_no_member t hsort ihN preN midN [] lN rN hsub key value hmem + (by rw [← hLeq]; exact hllt) (by rw [← hReq]; exact hrlt)).elim + · exact hc + · exact hc + · exact hc + · exact hc + +/-- **Theorem B, IAVL tree model — left-only.** The lone left neighbor's +right-most path makes it the rightmost leaf (`reaches_maxI`), so +`maxKey t < key` contradicts `member_le_maxKey` for a verifying existence +proof. -/ +theorem nonexistence_soundI_leftOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTreeI s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep lp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = none) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + rcases membership_soundI H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin hmaxcs hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + have hrm := verifyNonExistence_leftOnly H s root key nep lp hnl hnr hne + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + rcases reaches_maxI H s b d hH hlhash.symm hlpre hmin hLInj + t lp.key lp.value lhLeaf lp.path root hwf hlapL + (fun op hop => ⟨hlinn op hop, + ensureRightMost_suffix_nil s.innerSpec cs hco hcsspec hec lp.path hrm op hop⟩) + hroot hlap with ⟨hk, _⟩ | hc + · rw [hkfc, hkfc] at hllt + exact (ble_not_gt key (maxKey t) + (member_le_maxKey t key value hsort hmem) (hk ▸ hllt)).elim + · exact hc + · exact hc + +/-- **Theorem B, IAVL tree model — right-only.** Mirror of +`nonexistence_soundI_leftOnly` via `reaches_minI` / `minKey_le_member`. -/ +theorem nonexistence_soundI_rightOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTreeI s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep rp : ExistenceProof) + (hnl : nep.left = none) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + rcases membership_soundI H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin hmaxcs hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hlm := verifyNonExistence_rightOnly H s root key nep rp hnl hnr hne + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + rcases reaches_minI H s b cs d hH hcsd hlhash.symm hlpre hmin hLInj + t rp.key rp.value rhLeaf rp.path root hwf hrapL + (fun op hop => ⟨hrinn op hop, + ensureLeftMost_suffix_cs s.innerSpec cs hco hcsspec hec rp.path hlm op hop⟩) + hroot hrap with ⟨hk, _⟩ | hc + · rw [hkfc, hkfc] at hrlt + exact (ble_not_gt (minKey t) key + (minKey_le_member t key value hsort hmem) (hk ▸ hrlt)).elim + · exact hc + · exact hc + +/-- **Theorem B, IAVL tree model — total.** Every verifier-accepted proof shape +is covered: two-sided, left-only, right-only (a no-neighbor proof never +verifies). -/ +theorem nonexistence_soundI_total (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTreeI s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = s.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = s.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + cases hnl : nep.left with + | none => + cases hnr : nep.right with + | none => + rw [verifyNonExistence_none H s root key nep hnl hnr] at hne + exact Bool.noConfusion hne + | some rp => + exact nonexistence_soundI_rightOnly H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin + hmaxcs hco hec hkfc hLInj t hwf hsort root key value hroot nep ep rp hnl hnr hepleaf + (hrleaf rp hnr) hne hex + | some lp => + cases hnr : nep.right with + | none => + exact nonexistence_soundI_leftOnly H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin + hmaxcs hco hec hkfc hLInj t hwf hsort root key value hroot nep ep lp hnl hnr hepleaf + (hlleaf lp hnl) hne hex + | some rp => + exact nonexistence_soundI H s b cs d hH hcs hcsspec hcsd hlhash hlpre hmin hmaxcs hco + hec hkfc hLInj t hwf hsort root key value hroot nep ep lp rp hnl hnr hepleaf + (hlleaf lp hnl) (hrleaf rp hnr) hne hex + +/-- **Theorem B for the IAVL spec — total.** All structural side conditions +discharged by computation; joint leaf injectivity proved (`leafInj_iavl`). The +only remaining hypothesis is collision resistance (`FixedHash`). With this, +honest-root Theorems A and B hold for **all three shipped specs**. -/ +theorem nonexistence_sound_iavl_total (H : HashFn) + (hH : FixedHash H 32) + (t : MTree) (hwf : WFTreeI iavlSpec 0 t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = iavlSpec.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = iavlSpec.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = iavlSpec.leafSpec) + (hne : verifyNonExistence H nep iavlSpec root key = true) + (hex : verifyExistence H ep iavlSpec root key value = true) : + HashCollision H := + nonexistence_soundI_total H iavlSpec 0 33 32 hH (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) + (fun k => by simp [keyForComparison, iavlSpec]) (leafInj_iavl H) + t hwf hsort root key value hroot nep ep hepleaf hlleaf hrleaf hne hex + +end Ics23 diff --git a/lean/Ics23/IavlPrefix.lean b/lean/Ics23/IavlPrefix.lean new file mode 100644 index 00000000..3a18f46f --- /dev/null +++ b/lean/Ics23/IavlPrefix.lean @@ -0,0 +1,87 @@ +/- +The IAVL-specific prefix checks, mirroring `ensure_iavl_prefix`, +`ensure_inner_prefix`, and `ensure_leaf_prefix` in `rust/src/api.rs`. These were +abstracted away in `Verify.lean` (a sound omission for soundness). Here we model +them faithfully to test whether re-including them resolves finding F3 +(positional ambiguity) for the IAVL spec. + +The IAVL prefix encodes three signed (zigzag) protobuf varints — height, size, +version — and `ensure_inner_prefix` then requires the *remaining* byte count to +be 1 (this node is the left child: just its length byte follows) or 34 (this +node is the right child: length byte + 32-byte left sibling + length byte). +-/ +import Ics23.Varint + +namespace Ics23 + +/-- Zigzag-decode an unsigned varint value to a signed integer (prost's +`read_varint`: `x = ux >> 1`, negated when the low bit is set). -/ +def zigzagDecode (u : Nat) : Int := + if u % 2 = 0 then (u / 2 : Int) else -((u / 2 : Int)) - 1 + +/-- Read one signed (zigzag) varint, returning the value and the rest. -/ +def readVarintSigned (data : Bytes) : Option (Int × Bytes) := + match varintDecode data with + | some (u, rest) => some (zigzagDecode u, rest) + | none => none + +/-- `ensure_iavl_prefix`: decode height/size/version with their bounds, returning +the number of bytes remaining after them (or `none` on a malformed prefix). -/ +def ensureIavlPrefix (data : Bytes) (minHeight : Int) : Option Nat := + match readVarintSigned data with + | none => none + | some (height, r1) => + if height < minHeight then none + else match readVarintSigned r1 with + | none => none + | some (size, r2) => + if size < 0 then none + else match readVarintSigned r2 with + | none => none + | some (version, r3) => if version < 0 then none else some r3.length + +/-- `ensure_inner_prefix` for the IAVL spec: the prefix decodes as height/size/ +version and the remaining bytes are 1 (left child) or 34 (right child), with a +SHA-256 hash op. -/ +def ensureInnerPrefixIavl (pre : Bytes) (minHeight : Int) (hashIsSha256 : Bool) : Bool := + match ensureIavlPrefix pre minHeight with + | none => false + | some remaining => (remaining = 1 || remaining = 34) && hashIsSha256 + +/-- `ensure_leaf_prefix` for the IAVL spec: prefix is exactly height/size/version +(no remaining bytes). -/ +def ensureLeafPrefixIavl (pre : Bytes) : Bool := + match ensureIavlPrefix pre 0 with + | none => false + | some remaining => remaining = 0 + +/-! ## Does the IAVL prefix check resolve F3? + +Take the IAVL node preimage `P = hsv ‖ 0x20 ‖ A ‖ 0x20 ‖ B`, where `hsv` is +height=1, size=2, version=3 (zigzag varints `[2,4,6]`) and `0x20 = 32` is the +child length byte. Read it two ways: + +* **left child**: prefix `= hsv ‖ 0x20` (`[2,4,6,32]`), child `= A`, suffix `= 0x20 ‖ B`. +* **right child**: prefix `= hsv ‖ 0x20 ‖ A ‖ 0x20`, child `= B`, suffix `= []`. + +If `ensure_inner_prefix` accepted only one, IAVL would pin the position. It does +not: the remaining-byte count is 1 for the left reading and 34 for the right +reading, and the check admits both. So F3 persists for IAVL. -/ + +def f3_hsv : Bytes := [2, 4, 6] +def f3_A : Bytes := List.replicate 32 0xAA +def f3_B : Bytes := List.replicate 32 0xBB + +/-- Left reading's prefix passes (`remaining = 1`). -/ +example : ensureInnerPrefixIavl (f3_hsv ++ [32]) 0 true = true := by native_decide + +/-- Right reading's prefix passes (`remaining = 34`) — same node bytes, other +position. So the IAVL prefix check does NOT disambiguate the child. -/ +example : ensureInnerPrefixIavl (f3_hsv ++ [32] ++ f3_A ++ [32]) 0 true = true := by native_decide + +/-- The two readings share the same node preimage but assign different children. -/ +example : + (f3_hsv ++ [32]) ++ f3_A ++ ([32] ++ f3_B) + = (f3_hsv ++ [32] ++ f3_A ++ [32]) ++ f3_B ++ ([] : Bytes) := by native_decide + +end Ics23 diff --git a/lean/Ics23/IavlTree.lean b/lean/Ics23/IavlTree.lean new file mode 100644 index 00000000..9c29f1df --- /dev/null +++ b/lean/Ics23/IavlTree.lean @@ -0,0 +1,271 @@ +/- +Honest-root IAVL tree model: Theorem A for the IAVL spec. + +The Tendermint-shape development (Tree.lean) assumes `min_prefix_length = +max_prefix_length`, which pins an accepted inner op's prefix to the node's +prefix length (`split_bounds` → `split_pins`). IAVL violates it: the inner +prefix is 4–12 bytes of height/size/version varints (followed by the `0x20` +amino length byte for the left child), and the 33-byte child slots are the +`0x20` length byte plus the 32-byte digest. So an IAVL node preimage is + + `pre ++ lh ++ mid ++ rh`, `|pre| ∈ [4,12]`, `|lh| = |rh| = 32`, `mid = [0x20]` + +— exactly the `MTree` node shape with a 1-byte `mid` and empty `suf`. + +The pinning argument changes: instead of prefix-length pinning, the verifier's +`suffix.length % child_size = 0` check together with the well-formedness fact +`max_prefix_length < child_size` (12 < 33) pins the suffix length to `0` or +`child_size`, and each choice resolves the whole split (`split_pins_var`). The +`max < min + child_size` family of checks is doing its job: no third, +straddling reading exists even with variable prefixes. +-/ +import Ics23.Tree +import Ics23.TreeNonExist + +namespace Ics23 + +/-- IAVL-shaped conformance of a tree to a spec: nodes use the inner-spec hash +with a 1-byte `mid` (the amino `0x20` length byte for the right child), empty +`suf`, a prefix whose length lies in the spec's `[min, max]` window (the +height/size/version varints plus the left child's length byte), nonempty and +not leaf-prefixed (domain separation); leaves carry exactly the spec leaf op. -/ +def WFTreeI (s : ProofSpec) (b : UInt8) : MTree → Prop + | .leaf op _ _ => op = s.leafSpec + | .node ih pre mid suf l r => + ih = s.innerSpec.hash ∧ mid.length = 1 ∧ suf = [] ∧ + s.innerSpec.minPrefixLength ≤ (pre.length : Int) ∧ + (pre.length : Int) ≤ s.innerSpec.maxPrefixLength ∧ + pre ≠ [] ∧ pre.head? ≠ some b ∧ + WFTreeI s b l ∧ WFTreeI s b r + +/-- `ensure_inner`'s suffix-multiple fact, extracted without the +`min = max` assumption `split_bounds` carries. -/ +theorem ensureInner_suffix_mod (op : InnerOp) (s : ProofSpec) (cs : Nat) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hen : ensureInner op s = true) : op.suffix.length % cs = 0 := by + unfold ensureInner at hen + simp only [Bool.and_eq_true, decide_eq_true_eq] at hen + have hc7 := hen.2 + have hcsInt : s.innerSpec.childSize = (cs : Int) := by omega + rw [hcsInt] at hc7 + have : ((op.suffix.length % cs : Nat) : Int) = 0 := by + rw [Int.natCast_emod]; exact hc7 + exact_mod_cast this + +/-- A four-part node split with a full `cs`-length suffix resolves completely: +prefix = node prefix, child = left digest, suffix = `mid ++ rh`. -/ +theorem split_var_left (pre lh mid rh topPre m topSuf : Bytes) (cs d : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ mid ++ rh) + (hlh : lh.length = d) (hrh : rh.length = d) (hm : m.length = d) + (hmid : mid.length + d = cs) + (hsufcs : topSuf.length = cs) : + topPre = pre ∧ m = lh ∧ topSuf = mid ++ rh := by + have hlen : topPre.length = pre.length := by + have h := congrArg List.length hN + simp only [List.length_append] at h; omega + simp only [List.append_assoc] at hN + have hA := List.append_inj hN hlen + have hB := List.append_inj hA.2 (by rw [hm, hlh]) + exact ⟨hA.1, hB.1, hB.2⟩ + +/-- A four-part node split with an empty suffix resolves completely: +prefix = node prefix ++ left digest ++ `mid`, child = right digest. -/ +theorem split_var_right (pre lh mid rh topPre m : Bytes) (d : Nat) + (hN : topPre ++ m ++ [] = pre ++ lh ++ mid ++ rh) + (hrh : rh.length = d) (hm : m.length = d) : + topPre = pre ++ lh ++ mid ∧ m = rh := by + rw [List.append_nil] at hN + have hlen : topPre.length = ((pre ++ lh) ++ mid).length := by + have h := congrArg List.length hN + simp only [List.length_append] at h ⊢; omega + exact List.append_inj hN hlen + +/-- **F3 resolution for variable prefixes (the IAVL crux).** For a node preimage +`pre ++ lh ++ mid ++ rh` with `d`-byte digests, `cs = |mid| + d` byte child +slots, and `|pre| < cs`, the verifier's `suffix % cs = 0` check alone pins any +accepted `d`-length-child split to exactly the two genuine children — no prefix +pinning needed, so `min ≠ max` prefix windows are fine. -/ +theorem split_pins_var (pre lh mid rh topPre m topSuf : Bytes) (cs d : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ mid ++ rh) + (hlh : lh.length = d) (hrh : rh.length = d) (hm : m.length = d) + (hmid : mid.length + d = cs) + (hprelt : pre.length < cs) + (hsuf : topSuf.length % cs = 0) : + (topPre = pre ∧ m = lh ∧ topSuf = mid ++ rh) + ∨ (topPre = pre ++ lh ++ mid ∧ m = rh ∧ topSuf = []) := by + have hlentot : topPre.length + m.length + topSuf.length + = pre.length + lh.length + mid.length + rh.length := by + have h := congrArg List.length hN + simp only [List.length_append] at h + omega + have hdvd : cs ∣ topSuf.length := Nat.dvd_of_mod_eq_zero hsuf + have hsuflen : topSuf.length = 0 ∨ topSuf.length = cs := by + rcases Nat.eq_zero_or_pos topSuf.length with h0 | hpos + · exact Or.inl h0 + · have hge : cs ≤ topSuf.length := Nat.le_of_dvd hpos hdvd + rcases Nat.eq_or_lt_of_le hge with heq | hlt + · exact Or.inr heq.symm + · -- a ≥ 2·cs suffix would force a negative prefix: |topPre| + |topSuf| + -- = |pre| + cs with |pre| < cs + exfalso + obtain ⟨k, hk⟩ := hdvd + have hk2 : 2 ≤ k := by + rcases Nat.lt_or_ge k 2 with hlt2 | hge2 + · exfalso + have hk01 : k = 0 ∨ k = 1 := by omega + rcases hk01 with rfl | rfl + · rw [Nat.mul_zero] at hk; omega + · rw [Nat.mul_one] at hk; omega + · exact hge2 + have h2cs : 2 * cs ≤ topSuf.length := by + rw [hk, Nat.mul_comm cs k] + exact Nat.mul_le_mul_right cs hk2 + omega + rcases hsuflen with hs0 | hscs + · exact Or.inr (by + have hsnil : topSuf = [] := List.length_eq_zero_iff.mp hs0 + rw [hsnil] at hN + obtain ⟨h1, h2⟩ := split_var_right pre lh mid rh topPre m d hN hrh hm + exact ⟨h1, h2, hsnil⟩) + · exact Or.inl (split_var_left pre lh mid rh topPre m topSuf cs d hN hlh hrh hm hmid hscs) + +/-- Core induction (IAVL analog of `reaches`): a proof whose leaf hash folds to +a real IAVL-shaped tree's root reaches a genuine leaf, with each step forced +into a real child by `split_pins_var`. -/ +theorem reachesI (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeI s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + TreeMember key value t ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeI] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap + subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) hpath hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hmid1, hsuf, hpremin, hpremax, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + have hcsInt : s.innerSpec.childSize = (cs : Int) := by omega + have hprelt : pre.length < cs := by omega + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · -- empty path: the proof's leaf hash equals the node hash ⇒ domain collision + subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ mid ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead + simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · -- nonempty path: peel the root op and force it into a genuine child + rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp))] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ mid ++ rhR + · have hmlen : m.length = d := + applyPath_len H s.innerSpec d hH q lh m + (applyLeaf_len H d hH s.leafSpec key value lh hlh) hpm + have hsufmod := ensureInner_suffix_mod topOp s cs hcsspec + (hpath topOp (by simp)) + rcases split_pins_var pre lhL mid rhR topOp.prefixBytes m topOp.suffix cs d + hpe (rootHash_len H d hH l lhL hl) (rootHash_len H d hH r rhR hr) + hmlen (by omega) hprelt hsufmod with ⟨_, hml, _⟩ | ⟨_, hmr, _⟩ + · rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hl hpm with hmem | hcol + · exact Or.inl (Or.inl hmem) + · exact Or.inr hcol + · rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hr hpm with hmem | hcol + · exact Or.inl (Or.inr hmem) + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- **Honest-root Theorem A, IAVL tree model.** An accepted existence proof +against an honest IAVL root names a genuine `(key, value)` leaf — up to a hash +collision. -/ +theorem membership_soundI (H : HashFn) (s : ProofSpec) (b : UInt8) (cs d : Nat) + (hH : FixedHash H d) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hcsd : cs = d + 1) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmaxcs : s.innerSpec.maxPrefixLength < s.innerSpec.childSize) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (ep : ExistenceProof) (root key value : Bytes), + WFTreeI s b t → + ep.leaf = s.leafSpec → + rootHash H t = some root → + verifyExistence H ep s root key value = true → + TreeMember key value t ∨ HashCollision H := by + intro t ep root key value hwf hep hrh hver + have hkey : ep.key = key ∧ ep.value = value := by + unfold verifyExistence at hver + simp only [Bool.and_eq_true] at hver + obtain ⟨⟨⟨_, hkk⟩, hvv⟩, _⟩ := hver + exact ⟨by simpa using hkk, by simpa using hvv⟩ + rw [← hkey.1, ← hkey.2] at hver + obtain ⟨lh, hlf, hap, hinn⟩ := verifyExistence_navigates H s ep root hep hver + rw [hkey.1, hkey.2] at hlf + exact reachesI H s b cs d hH hcs hcsspec hcsd hlhash.symm hlpre hmin hmaxcs hLInj + t key value lh ep.path root hwf hlf hinn hrh hap + +/-- **Theorem A for the IAVL spec.** Structural side conditions discharged by +computation; joint leaf injectivity proved (`leafInj_iavl`); the single +remaining hypothesis is the genuine cryptographic assumption (`FixedHash`). -/ +theorem membership_sound_iavl (H : HashFn) + (hH : FixedHash H 32) : + ∀ (t : MTree) (ep : ExistenceProof) (root key value : Bytes), + WFTreeI iavlSpec 0 t → + ep.leaf = iavlSpec.leafSpec → + rootHash H t = some root → + verifyExistence H ep iavlSpec root key value = true → + TreeMember key value t ∨ HashCollision H := + membership_soundI H iavlSpec 0 33 32 hH (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (leafInj_iavl H) + +end Ics23 diff --git a/lean/Ics23/LeafInj.lean b/lean/Ics23/LeafInj.lean new file mode 100644 index 00000000..11097245 --- /dev/null +++ b/lean/Ics23/LeafInj.lean @@ -0,0 +1,170 @@ +/- +Joint leaf injectivity (`hLInj`) discharged from the leaf encoding. + +Theorems A and B both take a hypothesis `hLInj`: two leaves hashing to the same +value share their `(key, value)` — unless a hash collision is exhibited. The +honest-root proofs assumed it; here we *prove* it for the length-prefixed +(`varProto`) leaf shape used by the IAVL and Tendermint specs, with no axioms. + +The reduction is exactly "varint self-delimiting + collision resistance": + apply_leaf k v = H_hash (prefix ++ frame(H_phk k) ++ frame(H_phv v)) +with `frame x = varintEncode |x| ++ x`. Equal images give either a collision on +the leaf `hash` op (differing preimages) or equal preimages; the latter cancels +the fixed `prefix`, then `varintEncode_append_inj` + `List.append_inj` peel the +two frames, leaving `H_phk k₁ = H_phk k₂` and `H_phv v₁ = H_phv v₂` — each of +which is either an equality of keys/values or a collision on the prehash op. +-/ +import Ics23.Ops +import Ics23.Varint +import Ics23.Specs +import Ics23.Soundness + +namespace Ics23 + +/-- The explicit preimage of a `varProto`-framed leaf hash. -/ +theorem applyLeaf_varProto_form (H : HashFn) (ls : LeafOp) (hlen : ls.length = .varProto) + (k v r : Bytes) (h : applyLeaf H ls k v = some r) : + r = H ls.hash (ls.prefixBytes + ++ (varintEncode (H ls.prehashKey k).length ++ H ls.prehashKey k) + ++ (varintEncode (H ls.prehashValue v).length ++ H ls.prehashValue v)) := by + unfold applyLeaf at h + rw [hlen] at h + cases hke : prepareLeafData H ls.prehashKey .varProto k with + | none => rw [hke] at h; simp at h + | some pk => + cases hve : prepareLeafData H ls.prehashValue .varProto v with + | none => rw [hke, hve] at h; simp at h + | some pv => + rw [hke, hve] at h + simp only [Option.some.injEq] at h + have hpk : pk = varintEncode (H ls.prehashKey k).length ++ H ls.prehashKey k := by + unfold prepareLeafData at hke + by_cases hkemp : k.isEmpty + · rw [if_pos hkemp] at hke; exact absurd hke (by simp) + · rw [if_neg hkemp] at hke; simp only [doLength, Option.some.injEq] at hke; exact hke.symm + have hpv : pv = varintEncode (H ls.prehashValue v).length ++ H ls.prehashValue v := by + unfold prepareLeafData at hve + by_cases hvemp : v.isEmpty + · rw [if_pos hvemp] at hve; exact absurd hve (by simp) + · rw [if_neg hvemp] at hve; simp only [doLength, Option.some.injEq] at hve; exact hve.symm + rw [← h, hpk, hpv] + +/-- **Joint leaf injectivity for any `varProto`-framed leaf op.** Two leaves +hashing to the same value share their key and value, or a hash collision is +exhibited. No assumption on `H` beyond what a collision witnesses. -/ +theorem leafInj_varProto (H : HashFn) (ls : LeafOp) (hlen : ls.length = .varProto) : + ∀ k₁ v₁ k₂ v₂ r, + applyLeaf H ls k₁ v₁ = some r → + applyLeaf H ls k₂ v₂ = some r → + (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H := by + intro k₁ v₁ k₂ v₂ r h1 h2 + have e1 := applyLeaf_varProto_form H ls hlen k₁ v₁ r h1 + have e2 := applyLeaf_varProto_form H ls hlen k₂ v₂ r h2 + by_cases hP : + (ls.prefixBytes ++ (varintEncode (H ls.prehashKey k₁).length ++ H ls.prehashKey k₁) + ++ (varintEncode (H ls.prehashValue v₁).length ++ H ls.prehashValue v₁)) + = (ls.prefixBytes ++ (varintEncode (H ls.prehashKey k₂).length ++ H ls.prehashKey k₂) + ++ (varintEncode (H ls.prehashValue v₂).length ++ H ls.prehashValue v₂)) + · -- equal preimages: cancel the prefix, then peel the two varint frames + simp only [List.append_assoc] at hP + have hP' := List.append_cancel_left hP + obtain ⟨hklen, hkrest⟩ := varintEncode_append_inj (H ls.prehashKey k₁).length + (H ls.prehashKey k₂).length _ _ hP' + obtain ⟨hkeq, hveqframe⟩ := List.append_inj hkrest hklen + obtain ⟨_, hveq⟩ := varintEncode_append_inj (H ls.prehashValue v₁).length + (H ls.prehashValue v₂).length _ _ hveqframe + by_cases hk : k₁ = k₂ + · by_cases hv : v₁ = v₂ + · exact Or.inl ⟨hk, hv⟩ + · exact Or.inr (hashCollision_of H ls.prehashValue v₁ v₂ hv hveq) + · exact Or.inr (hashCollision_of H ls.prehashKey k₁ k₂ hk hkeq) + · -- differing preimages with equal image: a collision on the leaf hash op + exact Or.inr (hashCollision_of H ls.hash _ _ hP (e1.symm.trans e2)) + +/-- Joint leaf injectivity for the Tendermint spec (its leaf op is `varProto`). -/ +theorem leafInj_tendermint (H : HashFn) : + ∀ k₁ v₁ k₂ v₂ r, + applyLeaf H tendermintSpec.leafSpec k₁ v₁ = some r → + applyLeaf H tendermintSpec.leafSpec k₂ v₂ = some r → + (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H := + leafInj_varProto H tendermintSpec.leafSpec (by rfl) + +/-- Joint leaf injectivity for the IAVL spec (identical `varProto` leaf op). -/ +theorem leafInj_iavl (H : HashFn) : + ∀ k₁ v₁ k₂ v₂ r, + applyLeaf H iavlSpec.leafSpec k₁ v₁ = some r → + applyLeaf H iavlSpec.leafSpec k₂ v₂ = some r → + (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H := + leafInj_varProto H iavlSpec.leafSpec (by rfl) + +/-! ## The SMT / `noPrefix` shape: fixed-length split + +The SMT spec uses `length := .noPrefix` (no varint frame) but prehashes both key +and value, so the leaf hash is `H_hash(prefix ++ H_phk k ++ H_phv v)` with the two +prehash digests each `cs` bytes wide (`FixedHash`). The fixed width is what makes +the concatenation uniquely splittable — the analogue of the varint frame above. -/ + +/-- The explicit preimage of a `noPrefix` leaf hash. -/ +theorem applyLeaf_noPrefix_form (H : HashFn) (ls : LeafOp) (hlen : ls.length = .noPrefix) + (k v r : Bytes) (h : applyLeaf H ls k v = some r) : + r = H ls.hash (ls.prefixBytes ++ H ls.prehashKey k ++ H ls.prehashValue v) := by + unfold applyLeaf at h + rw [hlen] at h + cases hke : prepareLeafData H ls.prehashKey .noPrefix k with + | none => rw [hke] at h; simp at h + | some pk => + cases hve : prepareLeafData H ls.prehashValue .noPrefix v with + | none => rw [hke, hve] at h; simp at h + | some pv => + rw [hke, hve] at h + simp only [Option.some.injEq] at h + have hpk : pk = H ls.prehashKey k := by + unfold prepareLeafData at hke + by_cases hkemp : k.isEmpty + · rw [if_pos hkemp] at hke; exact absurd hke (by simp) + · rw [if_neg hkemp] at hke; simp only [doLength, Option.some.injEq] at hke; exact hke.symm + have hpv : pv = H ls.prehashValue v := by + unfold prepareLeafData at hve + by_cases hvemp : v.isEmpty + · rw [if_pos hvemp] at hve; exact absurd hve (by simp) + · rw [if_neg hvemp] at hve; simp only [doLength, Option.some.injEq] at hve; exact hve.symm + rw [← h, hpk, hpv] + +/-- **Joint leaf injectivity for any `noPrefix` leaf op over a fixed-length hash.** +Both prehash digests are `cs` bytes wide, so the concatenation splits at the fixed +boundary; the rest mirrors `leafInj_varProto`. -/ +theorem leafInj_noPrefix (H : HashFn) (cs : Nat) (hH : FixedHash H cs) + (ls : LeafOp) (hlen : ls.length = .noPrefix) : + ∀ k₁ v₁ k₂ v₂ r, + applyLeaf H ls k₁ v₁ = some r → + applyLeaf H ls k₂ v₂ = some r → + (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H := by + intro k₁ v₁ k₂ v₂ r h1 h2 + have e1 := applyLeaf_noPrefix_form H ls hlen k₁ v₁ r h1 + have e2 := applyLeaf_noPrefix_form H ls hlen k₂ v₂ r h2 + by_cases hP : + (ls.prefixBytes ++ H ls.prehashKey k₁ ++ H ls.prehashValue v₁) + = (ls.prefixBytes ++ H ls.prehashKey k₂ ++ H ls.prehashValue v₂) + · -- equal preimages: cancel the prefix, then split at the fixed digest width + simp only [List.append_assoc] at hP + have hP' := List.append_cancel_left hP + have hlenK : (H ls.prehashKey k₁).length = (H ls.prehashKey k₂).length := + (hH ls.prehashKey k₁).trans (hH ls.prehashKey k₂).symm + obtain ⟨hkeq, hveq⟩ := List.append_inj hP' hlenK + by_cases hk : k₁ = k₂ + · by_cases hv : v₁ = v₂ + · exact Or.inl ⟨hk, hv⟩ + · exact Or.inr (hashCollision_of H ls.prehashValue v₁ v₂ hv hveq) + · exact Or.inr (hashCollision_of H ls.prehashKey k₁ k₂ hk hkeq) + · exact Or.inr (hashCollision_of H ls.hash _ _ hP (e1.symm.trans e2)) + +/-- Joint leaf injectivity for the SMT/JMT spec (`noPrefix`, prehashed key and +value), over a fixed 32-byte hash. -/ +theorem leafInj_smt (H : HashFn) (hH : FixedHash H 32) : + ∀ k₁ v₁ k₂ v₂ r, + applyLeaf H smtSpec.leafSpec k₁ v₁ = some r → + applyLeaf H smtSpec.leafSpec k₂ v₂ = some r → + (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H := + leafInj_noPrefix H 32 hH smtSpec.leafSpec (by rfl) + +end Ics23 diff --git a/lean/Ics23/NonExist.lean b/lean/Ics23/NonExist.lean new file mode 100644 index 00000000..92ac57d9 --- /dev/null +++ b/lean/Ics23/NonExist.lean @@ -0,0 +1,159 @@ +/- +The non-existence verifier, mirroring `verify_non_existence` and its helpers +(`ensure_left_most`, `ensure_right_most`, `ensure_left_neighbor`, `get_padding`, +`has_padding`, `order_from_padding`, `is_left_step`, `left_branches_are_empty`, +`right_branches_are_empty`) in `rust/src/verify.rs`. + +Faithfulness notes: +* Lexicographic `Vec` ordering is `bytesLt` (unsigned, shorter-is-less). +* Where the Rust would panic on an out-of-range slice or a `pop().unwrap()` of an + empty path, the model returns `false`. Panics are a liveness/DoS concern, not a + soundness one, and rejecting can only shrink the accepted set — a sound + divergence. Panic-freedom of the Rust is covered separately (Phase 3, Kani). +* `get_padding`'s `child_order.find(|x| x == branch)` binds `idx = branch`, so + `child_order` acts only as the index set `{0,…,n-1}` here; its permutation + content matters in the `*_branches_are_empty` checks. +-/ +import Ics23.Verify + +namespace Ics23 + +/-- Lexicographic unsigned byte-string `<`, matching `Vec` `Ord`. -/ +def bytesLt : Bytes → Bytes → Bool + | [], [] => false + | [], _ :: _ => true + | _ :: _, [] => false + | a :: as, b :: bs => + if a < b then true + else if a == b then bytesLt as bs + else false + +/-- The key used for ordering comparisons: hashed first iff the spec sets +`prehash_key_before_comparison` (SMT/JMT). -/ +def keyForComparison (H : HashFn) (s : ProofSpec) (key : Bytes) : Bytes := + if s.prehashKeyBeforeComparison then H s.leafSpec.prehashKey key else key + +/-- Expected prefix/suffix sizes for an inner op sitting at a given branch. -/ +structure Padding where + minPrefix : Int + maxPrefix : Int + suffix : Int + +/-- `get_padding`: with `idx = branch`, `branch * childSize` bytes of left +siblings in the prefix and `(n-1-branch) * childSize` bytes of right siblings in +the suffix. `none` if `branch` is out of range. -/ +def getPadding (isp : InnerSpec) (branch : Nat) : Option Padding := + if isp.childOrder.contains branch then + let cs := isp.childSize + some { minPrefix := (branch : Int) * cs + isp.minPrefixLength, + maxPrefix := (branch : Int) * cs + isp.maxPrefixLength, + suffix := cs * ((isp.childOrder.length : Int) - 1 - (branch : Int)) } + else none + +/-- `has_padding`: the op's prefix length is within `[min,max]` and its suffix +length is exactly the expected number of right-sibling bytes. -/ +def hasPadding (op : InnerOp) (pad : Padding) : Bool := + (pad.minPrefix ≤ (op.prefixBytes.length : Int)) + && ((op.prefixBytes.length : Int) ≤ pad.maxPrefix) + && ((op.suffix.length : Int) = pad.suffix) + +/-- `order_from_padding`: the unique branch whose padding the op matches. -/ +def orderFromPadding (isp : InnerSpec) (op : InnerOp) : Option Nat := + (List.range isp.childOrder.length).find? (fun branch => + match getPadding isp branch with + | some pad => hasPadding op pad + | none => false) + +/-- `data[from .. from+len]` if in range, else `none` (models the Rust slice +without panicking). -/ +def byteRange (data : Bytes) (start len : Nat) : Option Bytes := + if start + len ≤ data.length then some ((data.drop start).take len) else none + +/-- `left_branches_are_empty`: the prefix padding bytes are all `empty_child`, +i.e. this is a valid placeholder on a left-most path. -/ +def leftBranchesAreEmpty (isp : InnerSpec) (op : InnerOp) : Bool := + match orderFromPadding isp op with + | none => false + | some idx => + let leftBranches := idx + if leftBranches = 0 then false + else + let cs := isp.childSize.toNat + if op.prefixBytes.length < leftBranches * cs then false + else + let actualPrefix := op.prefixBytes.length - leftBranches * cs + (List.range leftBranches).all (fun i => + byteRange op.prefixBytes (actualPrefix + i * cs) cs == some isp.emptyChild) + +/-- `right_branches_are_empty`: the suffix padding bytes are all `empty_child`. -/ +def rightBranchesAreEmpty (isp : InnerSpec) (op : InnerOp) : Bool := + match orderFromPadding isp op with + | none => false + | some idx => + let rightBranches := isp.childOrder.length - 1 - idx + let cs := isp.childSize.toNat + if rightBranches = 0 then false + else if op.suffix.length ≠ cs then false + else + (List.range rightBranches).all (fun i => + byteRange op.suffix (i * cs) cs == some isp.emptyChild) + +/-- `ensure_left_most`: every step is the left padding or a valid left placeholder. -/ +def ensureLeftMost (isp : InnerSpec) (path : List InnerOp) : Bool := + match getPadding isp 0 with + | none => false + | some pad => path.all (fun step => hasPadding step pad || leftBranchesAreEmpty isp step) + +/-- `ensure_right_most`: every step is the right padding or a valid right placeholder. -/ +def ensureRightMost (isp : InnerSpec) (path : List InnerOp) : Bool := + match getPadding isp (isp.childOrder.length - 1) with + | none => false + | some pad => path.all (fun step => hasPadding step pad || rightBranchesAreEmpty isp step) + +/-- `is_left_step`: `left` sits immediately left of `right` among the branches. -/ +def isLeftStep (isp : InnerSpec) (l r : InnerOp) : Bool := + match orderFromPadding isp l, orderFromPadding isp r with + | some li, some ri => li + 1 = ri + | _, _ => false + +/-- Two inner ops match for the purposes of the neighbor walk (prefix & suffix). -/ +def eqPS (a b : InnerOp) : Bool := a.prefixBytes == b.prefixBytes && a.suffix == b.suffix + +/-- Drop the longest common (root-side) prefix of two reversed paths, returning +the first divergent op of each plus the remaining (still root→leaf) tails. +`none` if either runs out first (the Rust `pop().unwrap()` would panic). -/ +def dropCommonPrefix : List InnerOp → List InnerOp → + Option InnerOp × List InnerOp × Option InnerOp × List InnerOp + | a :: as, b :: bs => + if eqPS a b then dropCommonPrefix as bs else (some a, as, some b, bs) + | _, _ => (none, [], none, []) + +/-- `ensure_left_neighbor`: strip the shared root path, require the first +divergence to be a left-step, and the inner remainders to be right-most (left +proof) and left-most (right proof). -/ +def ensureLeftNeighbor (isp : InnerSpec) (left right : List InnerOp) : Bool := + match dropCommonPrefix left.reverse right.reverse with + | (some topLeft, restL, some topRight, restR) => + isLeftStep isp topLeft topRight + && ensureRightMost isp restL.reverse + && ensureLeftMost isp restR.reverse + | _ => false + +/-- `verify_non_existence`: the bracketing existence proofs verify, the key lies +strictly between them, and the paths are genuine tree neighbors. -/ +def verifyNonExistence (H : HashFn) (p : NonExistenceProof) (s : ProofSpec) + (root key : Bytes) : Bool := + let kfc := keyForComparison H s + (match p.left with + | some l => verifyExistence H l s root l.key l.value && bytesLt (kfc l.key) (kfc key) + | none => true) + && (match p.right with + | some r => verifyExistence H r s root r.key r.value && bytesLt (kfc key) (kfc r.key) + | none => true) + && (match p.left, p.right with + | some l, none => ensureRightMost s.innerSpec l.path + | none, some r => ensureLeftMost s.innerSpec r.path + | some l, some r => ensureLeftNeighbor s.innerSpec l.path r.path + | none, none => false) + +end Ics23 diff --git a/lean/Ics23/NonExistSound.lean b/lean/Ics23/NonExistSound.lean new file mode 100644 index 00000000..257f931d --- /dev/null +++ b/lean/Ics23/NonExistSound.lean @@ -0,0 +1,168 @@ +/- +Non-existence soundness (Theorem B), staged. + +States Theorem B precisely and proves supporting facts about the lexicographic +byte ordering `bytesLt` that the neighbor checks rely on. The main proof needs +the ordered-tree semantics an `InnerSpec` describes and is landed separately; +the statement is recorded here so the target is fixed (mirroring how Theorem A +was staged). Only `nonexistence_sound` uses `sorry`. +-/ +import Ics23.NonExist +import Ics23.Soundness +import Ics23.Order + +namespace Ics23 + +/-- `bytesLt` is irreflexive: no byte string is strictly less than itself. -/ +theorem bytesLt_irrefl (a : Bytes) : bytesLt a a = false := by + induction a with + | nil => rfl + | cons x xs ih => + show (if x < x then true else if x == x then bytesLt xs xs else false) = false + rw [if_neg (UInt8.lt_irrefl x), if_pos (by simp)] + exact ih + +/-- A strictly-ordered key cannot also be equal: `bytesLt` excludes equality. -/ +theorem bytesLt_ne (a b : Bytes) (h : bytesLt a b = true) : a ≠ b := by + intro hab + rw [hab, bytesLt_irrefl] at h + exact Bool.noConfusion h + +/-- `bytesLt` is transitive. -/ +theorem bytesLt_trans : ∀ (a b c : Bytes), + bytesLt a b = true → bytesLt b c = true → bytesLt a c = true + | [], [], _, h, _ => by simp [bytesLt] at h + | _ :: _, [], _, h, _ => by simp [bytesLt] at h + | [], _ :: _, [], _, h2 => by simp [bytesLt] at h2 + | [], _ :: _, _ :: _, _, _ => rfl + | x :: xs, y :: ys, [], _, h2 => by simp [bytesLt] at h2 + | x :: xs, y :: ys, z :: zs, h1, h2 => by + simp only [bytesLt] at h1 h2 ⊢ + by_cases hxy : x < y + · -- x < y + by_cases hyz : y < z + · simp [UInt8.lt_trans hxy hyz] + · simp only [hyz, if_false] at h2 + by_cases hyz' : (y == z) = true + · have hyzeq : y = z := eq_of_beq hyz' + subst hyzeq; simp [hxy] + · simp [hyz'] at h2 + · -- ¬ x < y + simp only [hxy, if_false] at h1 + by_cases hxy' : (x == y) = true + · have hxyeq : x = y := eq_of_beq hxy' + subst hxyeq + simp only [beq_self_eq_true, if_true] at h1 + by_cases hxz : x < z + · simp [hxz] + · simp only [hxz, if_false] at h2 ⊢ + by_cases hxz' : (x == z) = true + · have hxzeq : x = z := eq_of_beq hxz' + subst hxzeq + simp only [beq_self_eq_true, if_true] at h2 ⊢ + exact bytesLt_trans xs ys zs h1 h2 + · simp [hxz'] at h2 + · simp [hxy'] at h1 + +/-- Left-neighbor extraction: the left existence proof verifies and its key +sorts strictly before `key`. -/ +theorem verifyNonExistence_left (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (l : ExistenceProof) (hl : nep.left = some l) + (h : verifyNonExistence H nep s root key = true) : + verifyExistence H l s root l.key l.value = true ∧ + bytesLt (keyForComparison H s l.key) (keyForComparison H s key) = true := by + unfold verifyNonExistence at h + simp only [hl, Bool.and_eq_true] at h + exact h.1.1 + +/-- Right-neighbor extraction: the right existence proof verifies and its key +sorts strictly after `key`. -/ +theorem verifyNonExistence_right (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (r : ExistenceProof) (hr : nep.right = some r) + (h : verifyNonExistence H nep s root key = true) : + verifyExistence H r s root r.key r.value = true ∧ + bytesLt (keyForComparison H s key) (keyForComparison H s r.key) = true := by + unfold verifyNonExistence at h + simp only [hr, Bool.and_eq_true] at h + exact h.1.2 + +/-- One-sided extraction (left-only): with no right neighbor, the verifier +requires the left neighbor's path to be right-most — the claim is that `key` +lies beyond the last leaf of the tree. -/ +theorem verifyNonExistence_leftOnly (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (l : ExistenceProof) + (hl : nep.left = some l) (hr : nep.right = none) + (h : verifyNonExistence H nep s root key = true) : + ensureRightMost s.innerSpec l.path = true := by + unfold verifyNonExistence at h + simp only [hl, hr, Bool.and_eq_true] at h + exact h.2 + +/-- One-sided extraction (right-only): with no left neighbor, the verifier +requires the right neighbor's path to be left-most — the claim is that `key` +lies before the first leaf of the tree. -/ +theorem verifyNonExistence_rightOnly (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (r : ExistenceProof) + (hl : nep.left = none) (hr : nep.right = some r) + (h : verifyNonExistence H nep s root key = true) : + ensureLeftMost s.innerSpec r.path = true := by + unfold verifyNonExistence at h + simp only [hl, hr, Bool.and_eq_true] at h + exact h.2 + +/-- A no-neighbor non-existence proof never verifies. -/ +theorem verifyNonExistence_none (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (hl : nep.left = none) (hr : nep.right = none) : + verifyNonExistence H nep s root key = false := by + unfold verifyNonExistence + simp [hl, hr] + +/-- A two-sided non-existence proof brackets `key` strictly: its left neighbor +sorts before its right neighbor. Composes the extraction lemmas with +transitivity; a fully-proved consistency property of the verifier. -/ +theorem verifyNonExistence_neighbors_ordered + (H : HashFn) (s : ProofSpec) (root key : Bytes) + (nep : NonExistenceProof) (l r : ExistenceProof) + (hl : nep.left = some l) (hr : nep.right = some r) + (h : verifyNonExistence H nep s root key = true) : + bytesLt (keyForComparison H s l.key) (keyForComparison H s r.key) = true := + bytesLt_trans _ _ _ + (verifyNonExistence_left H s root key nep l hl h).2 + (verifyNonExistence_right H s root key nep r hr h).2 + +/-- **Theorem B (non-existence soundness), abstract-root statement.** A +non-existence proof for `key` and an existence proof for `key` cannot both verify +under the same spec and root without a hash collision. + +This abstract-root form is **deliberately left as the one `sorry`**: as written it +is not provable, for exactly the reasons findings F3/F4 record — an opaque `root` +carries no tree structure, so nothing connects byte-order (which the neighbor +checks constrain) to *position* in the tree, and nothing forbids `key`'s leaf +sitting at an unrelated position. This is the non-existence analog of why +Theorem A's real result is the honest-root `membership_sound` rather than an +abstract-root binding. + +The genuine result is proved in the honest-root tree model: +`Ics23.nonexistence_sound_tree` (and `nonexistence_sound_tree_tendermint`) in +`Tree`/`TreeNonExist`. There, `root = rootHash t` for a key-sorted honest tree +`t`, and the full chain is discharged with no axioms beyond `FixedHash` + joint +leaf injectivity: `membership_sound` makes the absent key a genuine member, +`ensureLeftNeighbor_spec` + `neighbor_divergence` pin the bracketing proofs to a +divergence node `N`, and `node_gap_no_member` shows no member can sit between +`maxKey N.left` and `minKey N.right`. The padding-vs-navigation subtlety (F4/F5) +is resolved by the `ensureRightMost_suffix_nil` / `ensureLeftMost_suffix_cs` +bridges. Respects `prehash_key_before_comparison` via the `keyForComparison` +hypothesis (identity for Tendermint; the SMT/JMT prehash composes analogously). -/ +theorem nonexistence_sound + (H : HashFn) (hNoHash : ∀ b, H .noHash b = b) + (s : ProofSpec) (hwf : WellFormed s) + (root key value : Bytes) + (hsorted : KeySorted H s root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hkey : ep.key = key) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + sorry + +end Ics23 diff --git a/lean/Ics23/Ops.lean b/lean/Ics23/Ops.lean new file mode 100644 index 00000000..5cd8aceb --- /dev/null +++ b/lean/Ics23/Ops.lean @@ -0,0 +1,68 @@ +/- +Leaf and inner operations: the hashing core, mirroring `rust/src/ops.rs`. + +The hash function is a parameter `HashFn`, never axiomatized. Soundness theorems +quantify over every `HashFn` and conclude by *exhibiting* a collision, so no +assumption about any concrete hash (SHA-256, etc.) is introduced. The only law +we ever require of a `HashFn` is that `noHash` is the identity, which is true of +the real `do_hash` and is passed explicitly where needed. +-/ +import Ics23.Types + +namespace Ics23 + +/-- An abstract hash family, keyed by `HashOp`. The real implementation is +`do_hash`; proofs treat it opaquely. -/ +abbrev HashFn := HashOp → Bytes → Bytes + +/-- Unsigned LEB128 varint encoding of a length, matching prost's +`encode_varint` as used by `LengthOp.varProto`. -/ +def varintEncode (n : Nat) : List UInt8 := + if n < 0x80 then + [UInt8.ofNat n] + else + UInt8.ofNat (n % 0x80 + 0x80) :: varintEncode (n / 0x80) +termination_by n +decreasing_by omega + +/-- Big-endian 4-byte length. -/ +def u32be (n : Nat) : List UInt8 := + [UInt8.ofNat (n >>> 24), UInt8.ofNat (n >>> 16), UInt8.ofNat (n >>> 8), UInt8.ofNat n] + +/-- Big-endian 8-byte length. -/ +def u64be (n : Nat) : List UInt8 := + [UInt8.ofNat (n >>> 56), UInt8.ofNat (n >>> 48), UInt8.ofNat (n >>> 40), UInt8.ofNat (n >>> 32), + UInt8.ofNat (n >>> 24), UInt8.ofNat (n >>> 16), UInt8.ofNat (n >>> 8), UInt8.ofNat n] + +/-- `do_length`: prepend (or require) a length encoding. Returns `none` for the +failing `Require*` cases, mirroring the Rust `ensure!`. -/ +def doLength : LengthOp → Bytes → Option Bytes + | .noPrefix, d => some d + | .require32Bytes, d => if d.length = 32 then some d else none + | .require64Bytes, d => if d.length = 64 then some d else none + | .varProto, d => some (varintEncode d.length ++ d) + | .fixed32Big, d => some (u32be d.length ++ d) + | .fixed32Little, d => some ((u32be d.length).reverse ++ d) + | .fixed64Big, d => some (u64be d.length ++ d) + | .fixed64Little, d => some ((u64be d.length).reverse ++ d) + +/-- `prepare_leaf_data`: prehash then length-encode. `none` on empty input, +matching the Rust `ensure!(!data.is_empty(), ...)`. -/ +def prepareLeafData (H : HashFn) (prehash : HashOp) (length : LengthOp) + (data : Bytes) : Option Bytes := + if data.isEmpty then none else doLength length (H prehash data) + +/-- `apply_leaf`: `hash(prefix ++ encode(prehashKey key) ++ encode(prehashValue value))`. -/ +def applyLeaf (H : HashFn) (leaf : LeafOp) (key value : Bytes) : Option Bytes := + match prepareLeafData H leaf.prehashKey leaf.length key, + prepareLeafData H leaf.prehashValue leaf.length value with + | some pk, some pv => some (H leaf.hash (leaf.prefixBytes ++ pk ++ pv)) + | _, _ => none + +/-- `apply_inner`: `hash(prefix ++ child ++ suffix)`. `none` on empty child, +matching `ensure!(!child.is_empty(), ...)`. -/ +def applyInner (H : HashFn) (inner : InnerOp) (child : Bytes) : Option Bytes := + if child.isEmpty then none + else some (H inner.hash (inner.prefixBytes ++ child ++ inner.suffix)) + +end Ics23 diff --git a/lean/Ics23/Order.lean b/lean/Ics23/Order.lean new file mode 100644 index 00000000..4e5b902f --- /dev/null +++ b/lean/Ics23/Order.lean @@ -0,0 +1,245 @@ +/- +Ordered-tree position semantics — the foundation for non-existence soundness +(Theorem B). A path determines a leaf's position via the branch each inner op +takes (`order_from_padding`). This file begins connecting the path-structure +checks (`ensure_left_most` / `ensure_right_most`) to those positions. + +Scoped first to specs with **no empty children** (`empty_child = []`), which +covers IAVL and Tendermint; there the placeholder logic never fires, so the +checks reduce cleanly to "every step is the leftmost / rightmost branch". +-/ +import Ics23.NonExist +import Ics23.Verify + +namespace Ics23 + +/-- Lexicographic order on leaf positions (root→leaf branch sequences), +shorter-is-less — the order in which leaves appear left-to-right. -/ +def lexLt : List Nat → List Nat → Bool + | [], [] => false + | [], _ :: _ => true + | _ :: _, [] => false + | a :: as, b :: bs => if a < b then true else if a == b then lexLt as bs else false + +/-- `lexLt` is irreflexive. -/ +theorem lexLt_irrefl (a : List Nat) : lexLt a a = false := by + induction a with + | nil => rfl + | cons x xs ih => + show (if x < x then true else if x == x then lexLt xs xs else false) = false + rw [if_neg (Nat.lt_irrefl x), if_pos (by simp)] + exact ih + +/-- `lexLt` cancels a common prefix — the shared path above the divergence node +in the neighbor argument. -/ +theorem lexLt_append (c a b : List Nat) : lexLt (c ++ a) (c ++ b) = lexLt a b := by + induction c with + | nil => rfl + | cons x xs ih => + show (if x < x then true else if x == x then lexLt (xs ++ a) (xs ++ b) else false) + = lexLt a b + rw [if_neg (Nat.lt_irrefl x), if_pos (by simp)] + exact ih + +/-- A position starting with a smaller branch is `lexLt`-below one starting with +a larger branch, regardless of tails. -/ +theorem lexLt_cons_lt (i j : Nat) (a b : List Nat) (h : i < j) : + lexLt (i :: a) (j :: b) = true := by + show (if i < j then true else if i == j then lexLt a b else false) = true + rw [if_pos h] + +/-- `lexLt` is transitive. -/ +theorem lexLt_trans : ∀ (a b c : List Nat), + lexLt a b = true → lexLt b c = true → lexLt a c = true + | [], [], _, h, _ => by simp [lexLt] at h + | _ :: _, [], _, h, _ => by simp [lexLt] at h + | [], _ :: _, [], _, h2 => by simp [lexLt] at h2 + | [], _ :: _, _ :: _, _, _ => rfl + | x :: xs, y :: ys, [], _, h2 => by simp [lexLt] at h2 + | x :: xs, y :: ys, z :: zs, h1, h2 => by + simp only [lexLt] at h1 h2 ⊢ + by_cases hxy : x < y + · by_cases hyz : y < z + · simp [Nat.lt_trans hxy hyz] + · simp only [hyz, if_false] at h2 + by_cases hyz' : (y == z) = true + · have hyzeq : y = z := by simpa using hyz' + subst hyzeq; simp [hxy] + · simp [hyz'] at h2 + · simp only [hxy, if_false] at h1 + by_cases hxy' : (x == y) = true + · have hxyeq : x = y := by simpa using hxy' + subst hxyeq + simp only [beq_self_eq_true, if_true] at h1 + by_cases hxz : x < z + · simp [hxz] + · simp only [hxz, if_false] at h2 ⊢ + by_cases hxz' : (x == z) = true + · have hxzeq : x = z := by simpa using hxz' + subst hxzeq + simp only [beq_self_eq_true, if_true] at h2 ⊢ + exact lexLt_trans xs ys zs h1 h2 + · simp [hxz'] at h2 + · simp [hxy'] at h1 + +/-- A successful `byteRange` returns a slice of exactly the requested length. -/ +theorem byteRange_length (data : Bytes) (start len : Nat) (s : Bytes) + (h : byteRange data start len = some s) : s.length = len := by + unfold byteRange at h + by_cases hb : start + len ≤ data.length + · rw [if_pos hb] at h + injection h with hs + rw [← hs, List.length_take, List.length_drop] + omega + · rw [if_neg hb] at h; exact absurd h (by simp) + +/-- With no empty children and positive child size, a step is never a (left) +empty placeholder. -/ +theorem leftBranchesAreEmpty_false_of_noEmpty (isp : InnerSpec) (op : InnerOp) + (hempty : isp.emptyChild = []) (hcs : isp.childSize > 0) : + leftBranchesAreEmpty isp op = false := by + unfold leftBranchesAreEmpty + cases h : orderFromPadding isp op with + | none => rfl + | some idx => + by_cases h0 : idx = 0 + · simp [h0] + · simp only [h0, if_false] + by_cases hlen : op.prefixBytes.length < idx * isp.childSize.toNat + · simp [hlen] + · simp only [hlen, if_false] + have hcsn : 0 < isp.childSize.toNat := by omega + rw [List.all_eq_false] + refine ⟨0, by simp only [List.mem_range]; omega, ?_⟩ + simp only [hempty] + cases hbr : byteRange op.prefixBytes + (op.prefixBytes.length - idx * isp.childSize.toNat + 0 * isp.childSize.toNat) + isp.childSize.toNat with + | none => decide + | some s => + have hsl := byteRange_length _ _ _ _ hbr + simp only [beq_iff_eq, Option.some.injEq] + intro hse + rw [hse, List.length_nil] at hsl + omega + +/-- The leaf position a path encodes: the branch each inner op takes, root→leaf. +`none` if any step's branch is undetermined. -/ +def pathPosition (isp : InnerSpec) (path : List InnerOp) : Option (List Nat) := + path.reverse.mapM (orderFromPadding isp) + +/-- The store key-sortedness invariant (finding F4): any two existence proofs to +`root` agree on order — left-to-right *position* order matches key order. This is +the hypothesis ICS23 requires ("stores must be lexicographically ordered") and +that `verify_non_existence` does **not** itself enforce. -/ +def KeySorted (H : HashFn) (s : ProofSpec) (root : Bytes) : Prop := + ∀ (ep₁ ep₂ : ExistenceProof) (pos₁ pos₂ : List Nat), + verifyExistence H ep₁ s root ep₁.key ep₁.value = true → + verifyExistence H ep₂ s root ep₂.key ep₂.value = true → + pathPosition s.innerSpec ep₁.path = some pos₁ → + pathPosition s.innerSpec ep₂.path = some pos₂ → + (lexLt pos₁ pos₂ = true ↔ + bytesLt (keyForComparison H s ep₁.key) (keyForComparison H s ep₂.key) = true) + +/-- If every element maps to `some 0`, `mapM` yields all zeros. -/ +theorem mapM_all_zero {α : Type} (l : List α) (f : α → Option Nat) + (h : ∀ a ∈ l, f a = some 0) : + l.mapM f = some (List.replicate l.length 0) := by + induction l with + | nil => rfl + | cons a t ih => + rw [List.mapM_cons, h a (List.mem_cons_self ..), + ih (fun x hx => h x (List.mem_cons_of_mem a hx))] + rfl + +/-- A step matching branch 0's padding sits at branch 0 (left child): branch 0 is +checked first by `order_from_padding`. -/ +theorem orderFromPadding_zero (isp : InnerSpec) (op : InnerOp) (pad0 : Padding) + (hn : 1 ≤ isp.childOrder.length) + (hpad : getPadding isp 0 = some pad0) (h : hasPadding op pad0 = true) : + orderFromPadding isp op = some 0 := by + unfold orderFromPadding + cases hlen : isp.childOrder.length with + | zero => rw [hlen] at hn; omega + | succ m => + rw [List.range_succ_eq_map, List.find?_cons] + simp only [hpad, h] + +/-- For a spec with no empty children, `ensure_left_most` forces every step to +match the left-branch (branch 0) padding — i.e. every step is a genuine left +child. The first ordered-tree-position fact. -/ +theorem ensureLeftMost_allLeftPadding (isp : InnerSpec) (path : List InnerOp) + (hempty : isp.emptyChild = []) (hcs : isp.childSize > 0) + (h : ensureLeftMost isp path = true) : + ∀ op ∈ path, ∃ pad, getPadding isp 0 = some pad ∧ hasPadding op pad = true := by + unfold ensureLeftMost at h + cases hpad : getPadding isp 0 with + | none => rw [hpad] at h; exact absurd h (by simp) + | some pad => + rw [hpad] at h + intro op hop + have hstep := (List.all_eq_true.mp h) op hop + rw [leftBranchesAreEmpty_false_of_noEmpty isp op hempty hcs, Bool.or_false] at hstep + exact ⟨pad, rfl, hstep⟩ + +/-- A left-most path's position is all-zeros (the leftmost leaf), for a spec with +no empty children. The first concrete position computed from a path check. -/ +theorem ensureLeftMost_position (isp : InnerSpec) (path : List InnerOp) + (hempty : isp.emptyChild = []) (hcs : isp.childSize > 0) + (hn : 1 ≤ isp.childOrder.length) + (h : ensureLeftMost isp path = true) : + pathPosition isp path = some (List.replicate path.length 0) := by + unfold pathPosition + have hall : ∀ op ∈ path.reverse, orderFromPadding isp op = some 0 := by + intro op hop + rw [List.mem_reverse] at hop + obtain ⟨pad, hpad, hhp⟩ := ensureLeftMost_allLeftPadding isp path hempty hcs h op hop + exact orderFromPadding_zero isp op pad hn hpad hhp + rw [mapM_all_zero path.reverse (orderFromPadding isp) hall, List.length_reverse] + +/-- Symmetric fact: with no empty children, a step is never a (right) empty +placeholder. -/ +theorem rightBranchesAreEmpty_false_of_noEmpty (isp : InnerSpec) (op : InnerOp) + (hempty : isp.emptyChild = []) (hcs : isp.childSize > 0) : + rightBranchesAreEmpty isp op = false := by + unfold rightBranchesAreEmpty + cases h : orderFromPadding isp op with + | none => rfl + | some idx => + by_cases h0 : isp.childOrder.length - 1 - idx = 0 + · simp [h0] + · simp only [h0, if_false] + by_cases hsuf : op.suffix.length ≠ isp.childSize.toNat + · simp [hsuf] + · simp only [hsuf, if_false] at * + have hcsn : 0 < isp.childSize.toNat := by omega + rw [List.all_eq_false] + refine ⟨0, by simp only [List.mem_range]; omega, ?_⟩ + simp only [hempty] + cases hbr : byteRange op.suffix (0 * isp.childSize.toNat) isp.childSize.toNat with + | none => decide + | some s => + have hsl := byteRange_length _ _ _ _ hbr + simp only [beq_iff_eq, Option.some.injEq] + intro hse + rw [hse, List.length_nil] at hsl + omega + +/-- `ensure_right_most` analogue: every step matches the right-branch padding. -/ +theorem ensureRightMost_allRightPadding (isp : InnerSpec) (path : List InnerOp) + (hempty : isp.emptyChild = []) (hcs : isp.childSize > 0) + (h : ensureRightMost isp path = true) : + ∀ op ∈ path, ∃ pad, getPadding isp (isp.childOrder.length - 1) = some pad ∧ + hasPadding op pad = true := by + unfold ensureRightMost at h + cases hpad : getPadding isp (isp.childOrder.length - 1) with + | none => rw [hpad] at h; exact absurd h (by simp) + | some pad => + rw [hpad] at h + intro op hop + have hstep := (List.all_eq_true.mp h) op hop + rw [rightBranchesAreEmpty_false_of_noEmpty isp op hempty hcs, Bool.or_false] at hstep + exact ⟨pad, rfl, hstep⟩ + +end Ics23 + diff --git a/lean/Ics23/Sha256.lean b/lean/Ics23/Sha256.lean new file mode 100644 index 00000000..714299ef --- /dev/null +++ b/lean/Ics23/Sha256.lean @@ -0,0 +1,135 @@ +/- +A concrete SHA-256 in Lean, so the verifier model becomes executable end to end +(Phase 2a groundwork: a concrete `HashFn` to run the model and, eventually, +differentially test it against the Rust/Go implementations). + +Validated below against the vectors embedded in `rust/src/ops.rs`. +-/ +import Ics23.Ops + +namespace Ics23.Sha256 + +/-- Right-rotate a 32-bit word. -/ +def rotr (x : UInt32) (n : UInt32) : UInt32 := (x >>> n) ||| (x <<< (32 - n)) + +def K : List UInt32 := + [0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, + 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, + 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, + 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, + 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, + 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, + 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, + 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2] + +def H0 : List UInt32 := + [0x6a09e667, 0xbb67ae85, 0x3c6ef372, 0xa54ff53a, 0x510e527f, 0x9b05688c, 0x1f83d9ab, 0x5be0cd19] + +/-- Pad a message to a multiple of 64 bytes per the SHA-256 spec. -/ +def pad (msg : List UInt8) : List UInt8 := + let len := msg.length + let bitLen : UInt64 := (UInt64.ofNat len) * 8 + -- 0x80, then k zero bytes so total ≡ 56 (mod 64), then 8-byte big-endian bit length. + -- `120 - r` keeps the subtraction non-truncating for r ∈ [0, 63]: Nat `56 - r` + -- clamps to 0 for r > 56, which dropped the spill-over padding block for + -- messages with `length % 64 ∈ [56, 62]` (caught by the IAVL test vectors — + -- their 57-byte leaf preimages land exactly in that window). + let withOne := msg ++ [0x80] + let zeros := (120 - (withOne.length % 64)) % 64 + let lenBytes : List UInt8 := + (List.range 8).map (fun i => UInt8.ofNat ((bitLen >>> (UInt64.ofNat (8 * (7 - i)))).toNat % 256)) + withOne ++ List.replicate zeros 0 ++ lenBytes + +/-- Pack 4 big-endian bytes into a word. -/ +def beWord (a b c d : UInt8) : UInt32 := + (a.toUInt32 <<< 24) ||| (b.toUInt32 <<< 16) ||| (c.toUInt32 <<< 8) ||| d.toUInt32 + +/-- Split a 64-byte block into its first 16 message-schedule words. -/ +def blockWords (block : List UInt8) : Array UInt32 := Id.run do + let arr := block.toArray + let mut ws : Array UInt32 := #[] + for i in [0:16] do + ws := ws.push (beWord arr[4*i]! arr[4*i+1]! arr[4*i+2]! arr[4*i+3]!) + return ws + +/-- Extend 16 schedule words to 64. -/ +def schedule (w0 : Array UInt32) : Array UInt32 := Id.run do + let mut w := w0 + for i in [16:64] do + let s0 := rotr w[i-15]! 7 ^^^ rotr w[i-15]! 18 ^^^ (w[i-15]! >>> 3) + let s1 := rotr w[i-2]! 17 ^^^ rotr w[i-2]! 19 ^^^ (w[i-2]! >>> 10) + w := w.push (w[i-16]! + s0 + w[i-7]! + s1) + return w + +/-- Compress one block into the running hash state. -/ +def compress (st : Array UInt32) (w : Array UInt32) : Array UInt32 := Id.run do + let mut a := st[0]!; let mut b := st[1]!; let mut c := st[2]!; let mut d := st[3]! + let mut e := st[4]!; let mut f := st[5]!; let mut g := st[6]!; let mut h := st[7]! + let karr := K.toArray + for i in [0:64] do + let s1 := rotr e 6 ^^^ rotr e 11 ^^^ rotr e 25 + let ch := (e &&& f) ^^^ ((~~~e) &&& g) + let t1 := h + s1 + ch + karr[i]! + w[i]! + let s0 := rotr a 2 ^^^ rotr a 13 ^^^ rotr a 22 + let maj := (a &&& b) ^^^ (a &&& c) ^^^ (b &&& c) + let t2 := s0 + maj + h := g; g := f; f := e; e := d + t1; d := c; c := b; b := a; a := t1 + t2 + return #[st[0]! + a, st[1]! + b, st[2]! + c, st[3]! + d, + st[4]! + e, st[5]! + f, st[6]! + g, st[7]! + h] + +/-- Hash a message, returning the 32-byte digest. -/ +def hash (msg : List UInt8) : List UInt8 := Id.run do + let padded := (pad msg).toArray + let mut st := H0.toArray + let nBlocks := padded.size / 64 + for blk in [0:nBlocks] do + let block := (padded.extract (blk*64) (blk*64+64)).toList + st := compress st (schedule (blockWords block)) + -- serialize state big-endian + let mut out : List UInt8 := [] + for word in st.toList do + out := out ++ [UInt8.ofNat ((word >>> 24).toNat % 256), UInt8.ofNat ((word >>> 16).toNat % 256), + UInt8.ofNat ((word >>> 8).toNat % 256), UInt8.ofNat (word.toNat % 256)] + return out + +/-- Hex string of a digest, for validation. -/ +def toHex (bs : List UInt8) : String := + let digit : Nat → Char := fun n => + if n < 10 then Char.ofNat (48 + n) else Char.ofNat (97 + n - 10) + String.ofList (bs.flatMap (fun b => [digit (b.toNat / 16), digit (b.toNat % 16)])) + +-- "food" → c1f026582fe6e8cb620d0c85a72fe421ddded756662a8ec00ed4c297ad10676b (rust/src/ops.rs) +example : toHex (hash [0x66, 0x6f, 0x6f, 0x64]) + = "c1f026582fe6e8cb620d0c85a72fe421ddded756662a8ec00ed4c297ad10676b" := by native_decide + +-- "foobar" (apply_leaf of foo/bar, no prehash/length) → +-- c3ab8ff13720e8ad9047dd39466b3c8974e592c2fa383d4a3960714caef0c4f2 +example : toHex (hash [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72]) + = "c3ab8ff13720e8ad9047dd39466b3c8974e592c2fa383d4a3960714caef0c4f2" := by native_decide + +-- empty string → e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 +example : toHex (hash []) + = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" := by native_decide + +/-! Padding-boundary regressions: lengths around `% 64 ∈ [55, 64]`, where the +8-byte length field no longer fits the final block and padding must spill into +an extra block. The original `pad` used truncating `Nat` subtraction and +silently dropped bytes exactly in the `[56, 62]` window — missed by the three +vectors above and by every Tendermint/SMT preimage, caught by the IAVL +differential vectors (TestVectors.lean). Digests cross-checked against +Python's `hashlib`. -/ + +example : toHex (hash (List.replicate 55 0x61)) + = "9f4390f8d30c2dd92ec9f095b65e2b9ae9b0a925a5258e241c9f1e910f734318" := by native_decide +example : toHex (hash (List.replicate 56 0x61)) + = "b35439a4ac6f0948b6d6f9e3c6af0f5f590ce20f1bde7090ef7970686ec6738a" := by native_decide +example : toHex (hash (List.replicate 57 0x61)) + = "f13b2d724659eb3bf47f2dd6af1accc87b81f09f59f2b75e5c0bed6589dfe8c6" := by native_decide +example : toHex (hash (List.replicate 62 0x61)) + = "f506898cc7c2e092f9eb9fadae7ba50383f5b46a2a4fe5597dbb553a78981268" := by native_decide +example : toHex (hash (List.replicate 63 0x61)) + = "7d3e74a05d7db15bce4ad9ec0658ea98e3f06eeecf16b4c6fff2da457ddc2f34" := by native_decide +example : toHex (hash (List.replicate 64 0x61)) + = "ffe054fe7ae0cb6dc65c3af9b61d5209f439851db43d0ba5997337df154668eb" := by native_decide + +end Ics23.Sha256 diff --git a/lean/Ics23/SmtNonExist.lean b/lean/Ics23/SmtNonExist.lean new file mode 100644 index 00000000..2c544307 --- /dev/null +++ b/lean/Ics23/SmtNonExist.lean @@ -0,0 +1,1115 @@ +/- +Non-existence soundness (Theorem B) for the SMT/JMT tree model. + +The Tendermint-shape development (TreeNonExist.lean) excludes the SMT spec at +two points, both rooted in `emptyChild`: + +* `ensureRightMost_suffix_nil` / `ensureLeftMost_suffix_cs` prove that the + verifier's `*_branches_are_empty` placeholder arm is *unreachable* when + `emptyChild.length ≠ childSize`. For `smt_spec` the placeholder is a full + 32-byte digest, so the arm is genuinely reachable: a right-most path may step + *left* under a node whose right subtree is empty, and symmetrically. +* `MTree` cannot represent those empty subtrees at all (fixed in SmtTree.lean). + +Here the placeholder arm is embraced instead of excluded: an `ensure_right_most` +step either has an empty suffix (a genuine right step) or a suffix equal to +`emptyChild` — which, under `EmptyChildFree`, pins the right sibling to a +genuinely *empty* subtree, so the path still reaches the rightmost (nonempty) +leaf. Key order throughout is on *comparison keys* `kf key` (for SMT, +`keyForComparison` prehashes with SHA-256), so sortedness is sortedness of the +hashed key space — exactly how a real SMT/JMT arranges its leaves. +-/ +import Ics23.SmtTree + +namespace Ics23 + +/-! ## Order infrastructure: Option-valued extreme keys, comparison-key sortedness -/ + +/-- The rightmost (nonempty) leaf's key, if the tree has any leaf. -/ +def maxKeyS : SMTree → Option Bytes + | .empty => none + | .leaf _ k _ => some k + | .node _ _ l r => + match maxKeyS r with + | some k => some k + | none => maxKeyS l + +/-- The leftmost (nonempty) leaf's key, if the tree has any leaf. -/ +def minKeyS : SMTree → Option Bytes + | .empty => none + | .leaf _ k _ => some k + | .node _ _ l r => + match minKeyS l with + | some k => some k + | none => minKeyS r + +/-- Sorted w.r.t. comparison keys `kf` (for SMT, the prehashed key — see +`keyForComparison`): every member of a left subtree is strictly below every +member of the sibling right subtree. -/ +def SortedTreeS (kf : Bytes → Bytes) : SMTree → Prop + | .empty => True + | .leaf _ _ _ => True + | .node _ _ l r => SortedTreeS kf l ∧ SortedTreeS kf r ∧ + ∀ k₁ v₁ k₂ v₂, TreeMemberS k₁ v₁ l → TreeMemberS k₂ v₂ r → + bytesLt (kf k₁) (kf k₂) = true + +/-- `N` is a subtree of `t`. -/ +def IsSubtreeS : SMTree → SMTree → Prop + | N, .empty => N = .empty + | N, .leaf op k v => N = .leaf op k v + | N, .node ih pre l r => N = .node ih pre l r ∨ IsSubtreeS N l ∨ IsSubtreeS N r + +/-- The max key, when present, is itself a member. -/ +theorem maxKeyS_mem : ∀ (t : SMTree) (mk : Bytes), maxKeyS t = some mk → + ∃ v, TreeMemberS mk v t := by + intro t + induction t with + | empty => intro mk h; simp [maxKeyS] at h + | leaf op k v => + intro mk h + simp only [maxKeyS, Option.some.injEq] at h + exact ⟨v, h, rfl⟩ + | node ih pre l r ihl ihr => + intro mk h + unfold maxKeyS at h + cases hr : maxKeyS r with + | some k => + rw [hr] at h; simp only [Option.some.injEq] at h; subst h + obtain ⟨v, hv⟩ := ihr k hr + exact ⟨v, Or.inr hv⟩ + | none => + rw [hr] at h + obtain ⟨v, hv⟩ := ihl mk h + exact ⟨v, Or.inl hv⟩ + +/-- The min key, when present, is itself a member. -/ +theorem minKeyS_mem : ∀ (t : SMTree) (mk : Bytes), minKeyS t = some mk → + ∃ v, TreeMemberS mk v t := by + intro t + induction t with + | empty => intro mk h; simp [minKeyS] at h + | leaf op k v => + intro mk h + simp only [minKeyS, Option.some.injEq] at h + exact ⟨v, h, rfl⟩ + | node ih pre l r ihl ihr => + intro mk h + unfold minKeyS at h + cases hl : minKeyS l with + | some k => + rw [hl] at h; simp only [Option.some.injEq] at h; subst h + obtain ⟨v, hv⟩ := ihl k hl + exact ⟨v, Or.inl hv⟩ + | none => + rw [hl] at h + obtain ⟨v, hv⟩ := ihr mk h + exact ⟨v, Or.inr hv⟩ + +/-- A tree with no max key has no members. -/ +theorem maxKeyS_none_no_member : ∀ (t : SMTree), maxKeyS t = none → + ∀ k v, ¬ TreeMemberS k v t := by + intro t + induction t with + | empty => intro _ k v hm; exact hm + | leaf op k' v' => intro h; simp [maxKeyS] at h + | node ih pre l r ihl ihr => + intro h k v hm + unfold maxKeyS at h + cases hr : maxKeyS r with + | some k' => rw [hr] at h; simp at h + | none => + rw [hr] at h + rcases hm with hml | hmr + · exact ihl h k v hml + · exact ihr hr k v hmr + +/-- A tree with no min key has no members. -/ +theorem minKeyS_none_no_member : ∀ (t : SMTree), minKeyS t = none → + ∀ k v, ¬ TreeMemberS k v t := by + intro t + induction t with + | empty => intro _ k v hm; exact hm + | leaf op k' v' => intro h; simp [minKeyS] at h + | node ih pre l r ihl ihr => + intro h k v hm + unfold minKeyS at h + cases hl : minKeyS l with + | some k' => rw [hl] at h; simp at h + | none => + rw [hl] at h + rcases hm with hml | hmr + · exact ihl hl k v hml + · exact ihr h k v hmr + +/-- A member's comparison key is `≤` the tree's max comparison key. -/ +theorem member_le_maxKeyS (kf : Bytes → Bytes) : ∀ (t : SMTree), + SortedTreeS kf t → ∀ key value, TreeMemberS key value t → + ∃ mk, maxKeyS t = some mk ∧ (kf key = kf mk ∨ bytesLt (kf key) (kf mk) = true) := by + intro t + induction t with + | empty => intro _ key value hm; exact absurd hm (by simp [TreeMemberS]) + | leaf op k v => + intro _ key value hm + obtain ⟨hk, _⟩ := hm + exact ⟨k, rfl, Or.inl (by rw [hk])⟩ + | node ih pre l r ihl ihr => + intro hs key value hm + obtain ⟨hsl, hsr, hlr⟩ := hs + rcases hm with hml | hmr + · obtain ⟨mkl, hmkl, hle⟩ := ihl hsl key value hml + cases hr : maxKeyS r with + | none => + refine ⟨mkl, ?_, hle⟩ + unfold maxKeyS; rw [hr]; exact hmkl + | some mkr => + refine ⟨mkr, by unfold maxKeyS; rw [hr], ?_⟩ + obtain ⟨vl, hvl⟩ := maxKeyS_mem l mkl hmkl + obtain ⟨vr, hvr⟩ := maxKeyS_mem r mkr hr + have hlt : bytesLt (kf mkl) (kf mkr) = true := hlr mkl vl mkr vr hvl hvr + rcases hle with h | h + · exact Or.inr (h ▸ hlt) + · exact Or.inr (bytesLt_trans _ _ _ h hlt) + · obtain ⟨mkr, hmkr, hle⟩ := ihr hsr key value hmr + exact ⟨mkr, by unfold maxKeyS; rw [hmkr], hle⟩ + +/-- The tree's min comparison key is `≤` a member's comparison key. -/ +theorem minKeyS_le_member (kf : Bytes → Bytes) : ∀ (t : SMTree), + SortedTreeS kf t → ∀ key value, TreeMemberS key value t → + ∃ mk, minKeyS t = some mk ∧ (kf mk = kf key ∨ bytesLt (kf mk) (kf key) = true) := by + intro t + induction t with + | empty => intro _ key value hm; exact absurd hm (by simp [TreeMemberS]) + | leaf op k v => + intro _ key value hm + obtain ⟨hk, _⟩ := hm + exact ⟨k, rfl, Or.inl (by rw [hk])⟩ + | node ih pre l r ihl ihr => + intro hs key value hm + obtain ⟨hsl, hsr, hlr⟩ := hs + rcases hm with hml | hmr + · obtain ⟨mkl, hmkl, hle⟩ := ihl hsl key value hml + exact ⟨mkl, by unfold minKeyS; rw [hmkl], hle⟩ + · obtain ⟨mkr, hmkr, hle⟩ := ihr hsr key value hmr + cases hl : minKeyS l with + | none => + refine ⟨mkr, ?_, hle⟩ + unfold minKeyS; rw [hl]; exact hmkr + | some mkl => + refine ⟨mkl, by unfold minKeyS; rw [hl], ?_⟩ + obtain ⟨vl, hvl⟩ := minKeyS_mem l mkl hl + obtain ⟨vr, hvr⟩ := minKeyS_mem r mkr hmkr + have hlt : bytesLt (kf mkl) (kf mkr) = true := hlr mkl vl mkr vr hvl hvr + rcases hle with h | h + · exact Or.inr (h ▸ hlt) + · exact Or.inr (bytesLt_trans _ _ _ hlt h) + +/-- A member of a subtree is a member of the whole tree. -/ +theorem subtree_memberS : ∀ (t N : SMTree), IsSubtreeS N t → + ∀ k v, TreeMemberS k v N → TreeMemberS k v t := by + intro t + induction t with + | empty => intro N hsub k v hm; simp only [IsSubtreeS] at hsub; subst hsub; exact hm + | leaf op k' v' => intro N hsub k v hm; simp only [IsSubtreeS] at hsub; subst hsub; exact hm + | node ih pre l r ihl ihr => + intro N hsub k v hm + simp only [IsSubtreeS] at hsub + rcases hsub with hN | hl | hr + · subst hN; exact hm + · exact Or.inl (ihl N hl k v hm) + · exact Or.inr (ihr N hr k v hm) + +/-- A subtree of a sorted tree is sorted. -/ +theorem subtree_sortedS (kf : Bytes → Bytes) : ∀ (t : SMTree), SortedTreeS kf t → + ∀ N, IsSubtreeS N t → SortedTreeS kf N := by + intro t + induction t with + | empty => intro hs N hsub; simp only [IsSubtreeS] at hsub; subst hsub; exact hs + | leaf op k v => intro hs N hsub; simp only [IsSubtreeS] at hsub; subst hsub; exact hs + | node ih pre l r ihl ihr => + intro hs N hsub + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtreeS] at hsub + rcases hsub with hN | hl | hr + · subst hN; exact ⟨hsl, hsr, hlr⟩ + · exact ihl hsl N hl + · exact ihr hsr N hr + +/-- **Subtree contiguity (members form).** A member of a sorted tree whose +comparison key is bracketed by two members of a subtree `N` is itself a member +of `N`. Sorted trees occupy contiguous comparison-key ranges. -/ +theorem member_bracketed_in_subtreeS (kf : Bytes → Bytes) : ∀ (t : SMTree), + SortedTreeS kf t → ∀ N, IsSubtreeS N t → + ∀ key value a va b vb, + TreeMemberS key value t → + TreeMemberS a va N → TreeMemberS b vb N → + (kf a = kf key ∨ bytesLt (kf a) (kf key) = true) → + (kf key = kf b ∨ bytesLt (kf key) (kf b) = true) → + TreeMemberS key value N := by + intro t + induction t with + | empty => intro _ N _ key value a va b vb hm; exact absurd hm (by simp [TreeMemberS]) + | leaf op k v => + intro _ N hsub key value a va b vb hm _ _ _ _ + simp only [IsSubtreeS] at hsub; subst hsub; exact hm + | node ih pre l r ihl ihr => + intro hs N hsub key value a va b vb hm ha hb hlo hhi + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtreeS] at hsub + rcases hsub with hN | hsubl | hsubr + · subst hN; exact hm + · -- N ⊆ l: a member of t in r would violate key ≤ kf b with b ∈ l + have hbl : TreeMemberS b vb l := subtree_memberS l N hsubl b vb hb + rcases hm with hml | hmr + · exact ihl hsl N hsubl key value a va b vb hml ha hb hlo hhi + · exact absurd (hlr b vb key value hbl hmr) (fun h => ble_not_gt _ _ hhi h) + · -- N ⊆ r: a member of t in l would violate kf a ≤ key with a ∈ r + have har : TreeMemberS a va r := subtree_memberS r N hsubr a va ha + rcases hm with hml | hmr + · exact absurd (hlr key value a va hml har) (fun h => ble_not_gt _ _ hlo h) + · exact ihr hsr N hsubr key value a va b vb hmr ha hb hlo hhi + +/-- **BST gap (SMT).** For a node-subtree `N` of a sorted tree, no member of the +tree has a comparison key strictly between `N`'s left-max and right-min. -/ +theorem node_gap_no_memberS (kf : Bytes → Bytes) (t : SMTree) (hs : SortedTreeS kf t) + (ih : HashOp) (pre : Bytes) (l r : SMTree) + (hsub : IsSubtreeS (.node ih pre l r) t) + (key value : Bytes) (hm : TreeMemberS key value t) + (kl kr : Bytes) (hkl : maxKeyS l = some kl) (hkr : minKeyS r = some kr) + (h1 : bytesLt (kf kl) (kf key) = true) (h2 : bytesLt (kf key) (kf kr) = true) : False := by + obtain ⟨vl, hvl⟩ := maxKeyS_mem l kl hkl + obtain ⟨vr, hvr⟩ := minKeyS_mem r kr hkr + have hmN : TreeMemberS key value (.node ih pre l r) := + member_bracketed_in_subtreeS kf t hs _ hsub key value kl vl kr vr hm + (Or.inl hvl) (Or.inr hvr) (Or.inr h1) (Or.inr h2) + have hsN := subtree_sortedS kf t hs _ hsub + obtain ⟨hsl, hsr, _⟩ := hsN + rcases hmN with hml | hmr + · -- key ∈ l: key ≤ maxKeyS l = kl, but kl < key + obtain ⟨mk, hmk, hle⟩ := member_le_maxKeyS kf l hsl key value hml + rw [hkl] at hmk + simp only [Option.some.injEq] at hmk; subst hmk + exact ble_not_gt _ _ hle h1 + · -- key ∈ r: kr = minKeyS r ≤ key, but key < kr + obtain ⟨mk, hmk, hle⟩ := minKeyS_le_member kf r hsr key value hmr + rw [hkr] at hmk + simp only [Option.some.injEq] at hmk; subst hmk + exact ble_not_gt _ _ hle h2 + +/-! ## SMT padding bridges + +The placeholder (`*_branches_are_empty`) arm is reachable for the SMT shape +(`emptyChild.length = childSize`), so instead of excluding it +(`ensureRightMost_suffix_nil`) we extract what it pins down: the sibling slot's +bytes are exactly `emptyChild`. -/ + +/-- An `ensure_right_most` step (binary spec) either has an empty suffix — a +genuine right step — or its suffix is exactly `emptyChild` (a left step whose +right sibling is the empty placeholder). -/ +theorem ensureRightMost_step_smt (isp : InnerSpec) (cs : Nat) + (hco : isp.childOrder = [0, 1]) + (hcsspec : isp.childSize.toNat = cs) + (path : List InnerOp) (h : ensureRightMost isp path = true) : + ∀ op, op ∈ path → op.suffix = [] ∨ op.suffix = isp.emptyChild := by + intro op hop + have hpadeq : getPadding isp (isp.childOrder.length - 1) + = some { minPrefix := (1 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (1 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 1) } := by + unfold getPadding; rw [hco]; rfl + unfold ensureRightMost at h + rw [hpadeq] at h + rw [List.all_eq_true] at h + have hstep := h op hop + rw [Bool.or_eq_true] at hstep + rcases hstep with hp | hr + · -- genuine right-pad: suffix length equals pad.suffix = childSize * 0 = 0 + refine Or.inl ?_ + unfold hasPadding at hp + simp only [Bool.and_eq_true, decide_eq_true_eq] at hp + have hz : (op.suffix.length : Int) = 0 := by have := hp.2; simpa using this + have : op.suffix.length = 0 := by exact_mod_cast hz + exact List.length_eq_zero_iff.mp this + · -- placeholder: the (single) right-sibling block is exactly emptyChild + refine Or.inr ?_ + unfold rightBranchesAreEmpty at hr + cases hofp : orderFromPadding isp op with + | none => rw [hofp] at hr; simp at hr + | some idx => + rw [hofp, hco] at hr + simp only [List.length_cons, List.length_nil] at hr + by_cases hrb : (2 - 1 - idx) = 0 + · rw [hrb] at hr; simp at hr + · rw [if_neg hrb] at hr + by_cases hsl : op.suffix.length = isp.childSize.toNat + · rw [if_neg (by omega)] at hr + have h0 : byteRange op.suffix (0 * isp.childSize.toNat) isp.childSize.toNat + == some isp.emptyChild := by + have := List.all_eq_true.mp hr 0 (by simp only [List.mem_range]; omega) + simpa using this + simp only [Nat.zero_mul, byteRange] at h0 + rw [if_pos (by omega)] at h0 + simp only [List.drop_zero, beq_iff_eq, Option.some.injEq] at h0 + rw [List.take_of_length_le (by omega)] at h0 + exact h0 + · rw [if_pos hsl] at hr; simp at hr + +/-- An `ensure_left_most` step (binary spec) either has a full-`cs` suffix — a +genuine left step — or it is a right step whose left sibling is the empty +placeholder: empty suffix, and the prefix's trailing `cs` bytes are exactly +`emptyChild`. -/ +theorem ensureLeftMost_step_smt (isp : InnerSpec) (cs : Nat) + (hco : isp.childOrder = [0, 1]) + (hcsspec : isp.childSize.toNat = cs) + (path : List InnerOp) (h : ensureLeftMost isp path = true) : + ∀ op, op ∈ path → op.suffix.length = cs ∨ + (op.suffix = [] ∧ cs ≤ op.prefixBytes.length ∧ + op.prefixBytes.drop (op.prefixBytes.length - cs) = isp.emptyChild) := by + intro op hop + have hpadeq : getPadding isp 0 + = some { minPrefix := (0 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (0 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 0) } := by + unfold getPadding; rw [hco]; rfl + unfold ensureLeftMost at h + rw [hpadeq] at h + rw [List.all_eq_true] at h + have hstep := h op hop + rw [Bool.or_eq_true] at hstep + rcases hstep with hp | hl + · -- genuine left-pad: suffix length equals pad.suffix = childSize + refine Or.inl ?_ + unfold hasPadding at hp + simp only [Bool.and_eq_true, decide_eq_true_eq] at hp + have hz : (op.suffix.length : Int) = isp.childSize * ((2 : Int) - 1 - 0) := hp.2 + have he1 : ((2 : Int) - 1 - 0) = 1 := by decide + rw [he1, Int.mul_one] at hz + have : op.suffix.length = isp.childSize.toNat := by omega + rw [this, hcsspec] + · -- placeholder: a right step over an empty left sibling + refine Or.inr ?_ + unfold leftBranchesAreEmpty at hl + cases hofp : orderFromPadding isp op with + | none => rw [hofp] at hl; simp at hl + | some idx => + simp only [hofp] at hl + by_cases hlb : idx = 0 + · rw [hlb] at hl; simp at hl + · rw [if_neg hlb] at hl + -- binary: idx = 1, and its padding forces an empty suffix + obtain ⟨hilt, pad, hpad, hhp⟩ := orderFromPadding_mem isp op idx hofp + rw [hco] at hilt + simp only [List.length_cons, List.length_nil] at hilt + have hi1 : idx = 1 := by omega + subst hi1 + have hpr1 : getPadding isp 1 + = some { minPrefix := (1 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (1 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 1) } := by + unfold getPadding; rw [hco]; rfl + rw [hpr1, Option.some.injEq] at hpad; subst hpad + unfold hasPadding at hhp + simp only [Bool.and_eq_true, decide_eq_true_eq] at hhp + have hsuf0 : op.suffix = [] := by + have hz : (op.suffix.length : Int) = isp.childSize * ((2 : Int) - 1 - 1) := hhp.2 + have he0 : ((2 : Int) - 1 - 1) = 0 := by decide + rw [he0, Int.mul_zero] at hz + exact List.length_eq_zero_iff.mp (by exact_mod_cast hz) + by_cases hpl : op.prefixBytes.length < 1 * isp.childSize.toNat + · rw [if_pos hpl] at hl; simp at hl + · rw [if_neg hpl] at hl + rw [Nat.one_mul] at hpl + have h0 : byteRange op.prefixBytes + ((op.prefixBytes.length - 1 * isp.childSize.toNat) + 0 * isp.childSize.toNat) + isp.childSize.toNat == some isp.emptyChild := by + have := List.all_eq_true.mp hl 0 (by simp only [List.mem_range]; omega) + simpa using this + simp only [Nat.zero_mul, Nat.one_mul, Nat.add_zero, byteRange] at h0 + rw [if_pos (by omega)] at h0 + simp only [beq_iff_eq, Option.some.injEq] at h0 + rw [List.take_of_length_le (by rw [List.length_drop]; omega)] at h0 + rw [← hcsspec] + exact ⟨hsuf0, by omega, h0⟩ + +/-! ## Navigation: extreme-key paths in the SMT model -/ + +/-- A node split with a full `cs`-length suffix resolves completely: the prefix +is the node prefix, the child is the left subtree hash, and the suffix is the +right subtree hash. (Strengthens `split_left` to also name the suffix, which for +SMT pins the right sibling.) -/ +theorem split_all (pre lh rh topPre m topSuf : Bytes) (cs : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ rh) + (hlh : lh.length = cs) (hrh : rh.length = cs) + (hm : m.length = cs) (hsuf : topSuf.length = cs) : + topPre = pre ∧ m = lh ∧ topSuf = rh := by + have hlen : topPre.length = pre.length := by + have h := congrArg List.length hN + simp only [List.length_append] at h; omega + simp only [List.append_assoc] at hN + have hA := List.append_inj hN hlen + have hB := List.append_inj hA.2 (by rw [hm, hlh]) + exact ⟨hA.1, hB.1, hB.2⟩ + +/-- A node split with an empty suffix resolves completely: the prefix is the +node prefix followed by the left subtree hash, and the child is the right +subtree hash. (Strengthens `split_right` to also name the prefix, which for SMT +pins the left sibling.) -/ +theorem split_all_right (pre lh rh topPre m : Bytes) (cs : Nat) + (hN : topPre ++ m ++ [] = pre ++ lh ++ rh) + (hlh : lh.length = cs) (hrh : rh.length = cs) (hm : m.length = cs) : + topPre = pre ++ lh ∧ m = rh := by + rw [List.append_nil] at hN + have hlen : topPre.length = (pre ++ lh).length := by + have h := congrArg List.length hN + simp only [List.length_append] at h ⊢; omega + exact List.append_inj hN hlen + +/-- An `ensure_right_most`-shaped path (each step: empty suffix, or suffix +`= emptyChild`) reaches the rightmost *nonempty* leaf: the proof's key is +`maxKeyS t`. A placeholder step pins the skipped right sibling to the empty +subtree (`rootHashS_ec_empty`), so the maximum is preserved. -/ +theorem reaches_maxS (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hecl : ec.length = cs) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : SMTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeS s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ (op.suffix = [] ∨ op.suffix = ec)) → + rootHashS H ec t = some root → + applyPath H s.innerSpec lh path = some root → + (maxKeyS t = some key ∧ TreeMemberS key value t) ∨ HashCollision H := by + intro t + induction t with + | empty => + intro key value lh path root _ hlh hpath hrh hap + exfalso + simp only [rootHashS, Option.some.injEq] at hrh + exact applyPath_ne_emptyChild H s ec hihash.symm hef key value lh root path + hlh (fun o ho => (hpath o ho).1) hap hrh.symm + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeS] at hwf; subst hwf + rw [rootHashS] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨by simp only [maxKeyS]; rw [hk], hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre l r ihl ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hih + rw [rootHashS] at hrh + cases hl : rootHashS H ec l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + have hlhLlen := rootHashS_len H ec cs hH hecl l lhL hl + have hrhRlen := rootHashS_len H ec cs hH hecl r rhR hr + have hq : ∀ op ∈ q, ensureInner op s = true ∧ (op.suffix = [] ∨ op.suffix = ec) := + fun o ho => hpath o (List.mem_append.mpr (Or.inl ho)) + rcases (hpath topOp (by simp)).2 with hsnil | hsec + · -- right step: recurse into the right subtree + rw [hsnil] at hpe + obtain ⟨_, hmr⟩ := split_all_right pre lhL rhR topOp.prefixBytes m cs + hpe hlhLlen hrhRlen hmlen + rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh hq hr hpm with ⟨hk, hmem⟩ | hcol + · refine Or.inl ⟨?_, Or.inr hmem⟩ + show (match maxKeyS r with | some k => some k | none => maxKeyS l) = some key + rw [hk] + · exact Or.inr hcol + · -- placeholder step: the right sibling is the empty subtree + obtain ⟨_, hml, hsr⟩ := split_all pre lhL rhR topOp.prefixBytes m topOp.suffix cs + hpe hlhLlen hrhRlen hmlen (by rw [hsec]; exact hecl) + have hrEC : rootHashS H ec r = some ec := by rw [hr, ← hsr, hsec] + have hrempty : r = .empty := + rootHashS_ec_empty H s b ec hihash.symm hef r hwfr hrEC + rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh hq hl hpm with ⟨hk, hmem⟩ | hcol + · refine Or.inl ⟨?_, Or.inl hmem⟩ + show (match maxKeyS r with | some k => some k | none => maxKeyS l) = some key + rw [hrempty] + show (match (none : Option Bytes) with + | some k => some k | none => maxKeyS l) = some key + exact hk + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- An `ensure_left_most`-shaped path (each step: full-`cs` suffix, or empty +suffix with trailing-`emptyChild` prefix) reaches the leftmost *nonempty* leaf: +the proof's key is `minKeyS t`. Mirror of `reaches_maxS`. -/ +theorem reaches_minS (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hecl : ec.length = cs) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : SMTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeS s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ + (op.suffix.length = cs ∨ + (op.suffix = [] ∧ cs ≤ op.prefixBytes.length ∧ + op.prefixBytes.drop (op.prefixBytes.length - cs) = ec))) → + rootHashS H ec t = some root → + applyPath H s.innerSpec lh path = some root → + (minKeyS t = some key ∧ TreeMemberS key value t) ∨ HashCollision H := by + intro t + induction t with + | empty => + intro key value lh path root _ hlh hpath hrh hap + exfalso + simp only [rootHashS, Option.some.injEq] at hrh + exact applyPath_ne_emptyChild H s ec hihash.symm hef key value lh root path + hlh (fun o ho => (hpath o ho).1) hap hrh.symm + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeS] at hwf; subst hwf + rw [rootHashS] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨by simp only [minKeyS]; rw [hk], hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre l r ihl ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hih + rw [rootHashS] at hrh + cases hl : rootHashS H ec l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + have hlhLlen := rootHashS_len H ec cs hH hecl l lhL hl + have hrhRlen := rootHashS_len H ec cs hH hecl r rhR hr + have hq : ∀ op ∈ q, ensureInner op s = true ∧ + (op.suffix.length = cs ∨ + (op.suffix = [] ∧ cs ≤ op.prefixBytes.length ∧ + op.prefixBytes.drop (op.prefixBytes.length - cs) = ec)) := + fun o ho => hpath o (List.mem_append.mpr (Or.inl ho)) + rcases (hpath topOp (by simp)).2 with hscs | ⟨hsnil, hple, hpec⟩ + · -- left step: recurse into the left subtree + obtain ⟨_, hml, _⟩ := split_all pre lhL rhR topOp.prefixBytes m topOp.suffix cs + hpe hlhLlen hrhRlen hmlen hscs + rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh hq hl hpm with ⟨hk, hmem⟩ | hcol + · refine Or.inl ⟨?_, Or.inl hmem⟩ + show (match minKeyS l with | some k => some k | none => minKeyS r) = some key + rw [hk] + · exact Or.inr hcol + · -- placeholder step: the left sibling is the empty subtree + rw [hsnil] at hpe + obtain ⟨hpfx, hmr⟩ := split_all_right pre lhL rhR topOp.prefixBytes m cs + hpe hlhLlen hrhRlen hmlen + have hlEC : lhL = ec := by + rw [hpfx] at hpec + have hplen : (pre ++ lhL).length - cs = pre.length := by + simp only [List.length_append]; omega + rw [hplen, List.drop_left] at hpec + exact hpec + have hrempty : l = .empty := + rootHashS_ec_empty H s b ec hihash.symm hef l hwfl (by rw [hl, hlEC]) + rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh hq hr hpm with ⟨hk, hmem⟩ | hcol + · refine Or.inl ⟨?_, Or.inr hmem⟩ + show (match minKeyS l with | some k => some k | none => minKeyS r) = some key + rw [hrempty] + show (match (none : Option Bytes) with + | some k => some k | none => minKeyS r) = some key + exact hk + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-! ## Neighbor divergence and Theorem B for the SMT model -/ + +/-- **Neighbor walk → divergence node (SMT).** Two verifying existence proofs +whose reversed paths share a root-side prefix and then diverge as a left-step +(with SMT right-most / left-most remainders) navigate to a common node `N` of +the honest SMT: the left proof reaches the max key of `N`'s left subtree, the +right proof the min key of `N`'s right subtree — up to a hash collision. -/ +theorem neighbor_divergence_smt (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hecl : ec.length = cs) + (hecspec : s.innerSpec.emptyChild = ec) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : SMTree) (lhLeaf rhLeaf root : Bytes) + (leftKey leftVal rightKey rightVal : Bytes) + (pathL pathR : List InnerOp) + (topLeft topRight : InnerOp) (restL restR : List InnerOp), + WFTreeS s b t → + applyLeaf H s.leafSpec leftKey leftVal = some lhLeaf → + applyLeaf H s.leafSpec rightKey rightVal = some rhLeaf → + (∀ op ∈ pathL, ensureInner op s = true) → + (∀ op ∈ pathR, ensureInner op s = true) → + rootHashS H ec t = some root → + applyPath H s.innerSpec lhLeaf pathL = some root → + applyPath H s.innerSpec rhLeaf pathR = some root → + dropCommonPrefix pathL.reverse pathR.reverse = (some topLeft, restL, some topRight, restR) → + isLeftStep s.innerSpec topLeft topRight = true → + ensureRightMost s.innerSpec restL.reverse = true → + ensureLeftMost s.innerSpec restR.reverse = true → + (∃ ihN preN lN rN, IsSubtreeS (.node ihN preN lN rN) t ∧ + (maxKeyS lN = some leftKey ∨ HashCollision H) ∧ + (minKeyS rN = some rightKey ∨ HashCollision H)) + ∨ HashCollision H := by + intro t + induction t with + | empty => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR + topLeft topRight restL restR + _ hlhL _ hpathL _ hrh hapL _ _ _ _ _ + exfalso + simp only [rootHashS, Option.some.injEq] at hrh + exact applyPath_ne_emptyChild H s ec hihash.symm hef leftKey leftVal lhLeaf root pathL + hlhL hpathL hapL hrh.symm + | leaf top tk tv => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR + topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + cases pathL with + | nil => + exfalso + rw [List.reverse_nil] at hdcp + rw [show dropCommonPrefix [] pathR.reverse + = ((none : Option InnerOp), ([] : List InnerOp), (none : Option InnerOp), + ([] : List InnerOp)) from rfl] at hdcp + exact absurd (congrArg Prod.fst hdcp) (by simp) + | cons op rest => + simp only [WFTreeS] at hwf; subst hwf + rw [rootHashS] at hrh + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lhLeaf root (by simp) hpathL hapL + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre l r ihl ihr => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR + topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + obtain ⟨hih, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hih + rw [rootHashS] at hrh + cases hl : rootHashS H ec l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [Option.some.injEq] at hrh + -- both paths must be nonempty (else a leaf hash equals the node hash) + rcases List.eq_nil_or_concat pathL with hLnil | ⟨qL, topOpL, hLc⟩ + · subst hLnil + simp only [applyPath, Option.some.injEq] at hapL + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec leftKey leftVal lhLeaf b hlpre hlhL + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapL]; exact hrh.symm + rcases List.eq_nil_or_concat pathR with hRnil | ⟨qR, topOpR, hRc⟩ + · subst hRnil + simp only [applyPath, Option.some.injEq] at hapR + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec rightKey rightVal rhLeaf b hlpre hlhR + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapR]; exact hrh.symm + rw [List.concat_eq_append] at hLc hRc; subst hLc; subst hRc + simp only [List.reverse_append, List.reverse_singleton, List.singleton_append] at hdcp + obtain ⟨mL, hpmL, htopL, _⟩ := (applyPath_snoc H s.innerSpec qL topOpL lhLeaf root).mp hapL + obtain ⟨mR, hpmR, htopR, _⟩ := (applyPath_snoc H s.innerSpec qR topOpR rhLeaf root).mp hapR + have hmLlen : mL.length = cs := applyPath_len H s.innerSpec cs hH qL lhLeaf mL + (applyLeaf_len H cs hH s.leafSpec leftKey leftVal lhLeaf hlhL) hpmL + have hmRlen : mR.length = cs := applyPath_len H s.innerSpec cs hH qR rhLeaf mR + (applyLeaf_len H cs hH s.leafSpec rightKey rightVal rhLeaf hlhR) hpmR + have htopimgL := applyInner_image H topOpL mL root htopL + rw [ensureInner_hash topOpL s (hpathL topOpL (by simp))] at htopimgL + have htopimgR := applyInner_image H topOpR mR root htopR + rw [ensureInner_hash topOpR s (hpathR topOpR (by simp))] at htopimgR + have hlhLlen := rootHashS_len H ec cs hH hecl l lhL hl + have hrhRlen := rootHashS_len H ec cs hH hecl r rhR hr + have hlowL : pre.length ≤ topOpL.prefixBytes.length := by + have := ensureInner_minle topOpL s (hpathL topOpL (by simp)); omega + have hlowR : pre.length ≤ topOpR.prefixBytes.length := by + have := ensureInner_minle topOpR s (hpathR topOpR (by simp)); omega + unfold dropCommonPrefix at hdcp + by_cases heq : eqPS topOpL topOpR = true + · -- common root step: both proofs navigate into the SAME child; recurse + rw [if_pos heq] at hdcp + unfold eqPS at heq + simp only [Bool.and_eq_true, beq_iff_eq] at heq + obtain ⟨hpreEq, hsufEq⟩ := heq + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ rhR + · -- both top ops genuinely match the node split: mL = mR + have hcat : topOpL.prefixBytes ++ mL = topOpL.prefixBytes ++ mR := by + have hee : (topOpL.prefixBytes ++ mL) ++ topOpL.suffix + = (topOpL.prefixBytes ++ mR) ++ topOpL.suffix := by + rw [hpeL]; rw [hpreEq, hsufEq] at *; rw [hpeR] + exact (List.append_inj hee (by simp [hmLlen, hmRlen])).1 + have hmEq : mL = mR := List.append_cancel_left hcat + obtain ⟨hb1, hb2, hb7⟩ := split_bounds topOpL s cs pre.length hcsspec hmm + (by rw [hco]; rfl) hppre (hpathL topOpL (by simp)) + rcases split_pins pre lhL rhR topOpL.prefixBytes mL topOpL.suffix cs pre.length + hpeL rfl hlhLlen hrhRlen hmLlen hcs hb1 hb2 hb7 with hmlL | hmrL + · rw [hmlL] at hpmL + rw [← hmEq, hmlL] at hpmR + rcases ihl lhLeaf rhLeaf lhL leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfl hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hl hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, lN, rN, + by simp only [IsSubtreeS]; exact Or.inr (Or.inl hsub), h1, h2⟩ + · exact Or.inr hc + · rw [hmrL] at hpmL + rw [← hmEq, hmrL] at hpmR + rcases ihr lhLeaf rhLeaf rhR leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfr hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hr hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, lN, rN, + by simp only [IsSubtreeS]; exact Or.inr (Or.inr hsub), h1, h2⟩ + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + · -- divergence here: this node IS the neighbor node N + rw [if_neg heq] at hdcp + simp only [Prod.mk.injEq, Option.some.injEq] at hdcp + obtain ⟨htL, hrestL, htR, hrestR⟩ := hdcp + subst htL; subst htR + rw [← hrestL, List.reverse_reverse] at hrm + rw [← hrestR, List.reverse_reverse] at hlm + obtain ⟨hsufL, hsufR⟩ := isLeftStep_binary s.innerSpec cs hco hcsspec topOpL topOpR hls + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ rhR + · have hmlL : mL = lhL := split_left pre lhL rhR topOpL.prefixBytes mL topOpL.suffix cs + hpeL hlowL hlhLlen hrhRlen hmLlen hsufL + have hmrR : mR = rhR := split_right pre lhL rhR topOpR.prefixBytes mR topOpR.suffix cs + hpeR hlhLlen hrhRlen hmRlen hsufR + rw [hmlL] at hpmL + rw [hmrR] at hpmR + have hqLspec : ∀ op ∈ qL, ensureInner op s = true ∧ + (op.suffix = [] ∨ op.suffix = ec) := fun op hop => + ⟨hpathL op (List.mem_append.mpr (Or.inl hop)), + hecspec ▸ ensureRightMost_step_smt s.innerSpec cs hco hcsspec qL hrm op hop⟩ + have hqRspec : ∀ op ∈ qR, ensureInner op s = true ∧ + (op.suffix.length = cs ∨ + (op.suffix = [] ∧ cs ≤ op.prefixBytes.length ∧ + op.prefixBytes.drop (op.prefixBytes.length - cs) = ec)) := fun op hop => + ⟨hpathR op (List.mem_append.mpr (Or.inl hop)), + hecspec ▸ ensureLeftMost_step_smt s.innerSpec cs hco hcsspec qR hlm op hop⟩ + refine Or.inl ⟨s.innerSpec.hash, pre, l, r, Or.inl rfl, ?_, ?_⟩ + · rcases reaches_maxS H s b cs ec hH hihash hlpre hmin hecl hef hLInj + l leftKey leftVal lhLeaf qL lhL hwfl hlhL hqLspec hl hpmL with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · rcases reaches_minS H s b cs ec hH hihash hlpre hmin hecl hef hLInj + r rightKey rightVal rhLeaf qR rhR hwfr hlhR hqRspec hr hpmR with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + +/-- **Theorem B (non-existence soundness), SMT tree model — two-sided.** For an +SMT sorted on comparison keys, a two-sided non-existence proof for `key` and an +existence proof for `key` cannot both verify without a hash collision. -/ +theorem nonexistence_soundS (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hecl : ec.length = cs) + (hecspec : s.innerSpec.emptyChild = ec) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : SMTree) (hwf : WFTreeS s b t) (hsort : SortedTreeS (keyForComparison H s) t) + (root key value : Bytes) (hroot : rootHashS H ec t = some root) + (nep : NonExistenceProof) (ep lp rp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + -- the absent key is a genuine member of the honest tree (or a collision) + rcases membership_soundS H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm hbin hecl hef hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · -- bracketing proofs verify and bracket the key + obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hnb : ensureLeftNeighbor s.innerSpec lp.path rp.path = true := by + unfold verifyNonExistence at hne + simp only [hnl, hnr, Bool.and_eq_true] at hne + exact hne.2 + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + obtain ⟨topLeft, restL, topRight, restR, hdcp, hls, hrm, hlm⟩ := + ensureLeftNeighbor_spec s.innerSpec lp.path rp.path hnb + rcases neighbor_divergence_smt H s b cs ec hH hcs hcsspec hlhash.symm hlpre hmin hmm hco + hecl hecspec hef hLInj + t lhLeaf rhLeaf root lp.key lp.value rp.key rp.value lp.path rp.path + topLeft topRight restL restR + hwf hlapL hrapL hlinn hrinn hroot hlap hrap hdcp hls hrm hlm with hdiv | hc + · obtain ⟨ihN, preN, lN, rN, hsub, hLeq, hReq⟩ := hdiv + rcases hLeq with hLeq | hc + · rcases hReq with hReq | hc + · -- the absent key sits in the forbidden gap of the divergence node + exact (node_gap_no_memberS (keyForComparison H s) t hsort ihN preN lN rN hsub + key value hmem lp.key rp.key hLeq hReq hllt hrlt).elim + · exact hc + · exact hc + · exact hc + · exact hc + +/-- **Theorem B, SMT tree model — left-only.** The lone left neighbor's +right-most path makes it the rightmost nonempty leaf (`reaches_maxS`), so +`key`'s comparison key exceeds the tree's maximum while a verifying existence +proof would bound it by that maximum. -/ +theorem nonexistence_soundS_leftOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hecl : ec.length = cs) + (hecspec : s.innerSpec.emptyChild = ec) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : SMTree) (hwf : WFTreeS s b t) (hsort : SortedTreeS (keyForComparison H s) t) + (root key value : Bytes) (hroot : rootHashS H ec t = some root) + (nep : NonExistenceProof) (ep lp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = none) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + rcases membership_soundS H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm hbin hecl hef hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + have hrm := verifyNonExistence_leftOnly H s root key nep lp hnl hnr hne + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + rcases reaches_maxS H s b cs ec hH hlhash.symm hlpre hmin hecl hef hLInj + t lp.key lp.value lhLeaf lp.path root hwf hlapL + (fun op hop => ⟨hlinn op hop, + hecspec ▸ ensureRightMost_step_smt s.innerSpec cs hco hcsspec lp.path hrm op hop⟩) + hroot hlap with ⟨hk, _⟩ | hc + · obtain ⟨mk, hmk, hle⟩ := member_le_maxKeyS (keyForComparison H s) t hsort key value hmem + rw [hk] at hmk + simp only [Option.some.injEq] at hmk + subst hmk + exact (ble_not_gt _ _ hle hllt).elim + · exact hc + · exact hc + +/-- **Theorem B, SMT tree model — right-only.** Mirror of +`nonexistence_soundS_leftOnly` via `reaches_minS` / `minKeyS_le_member`. -/ +theorem nonexistence_soundS_rightOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hecl : ec.length = cs) + (hecspec : s.innerSpec.emptyChild = ec) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : SMTree) (hwf : WFTreeS s b t) (hsort : SortedTreeS (keyForComparison H s) t) + (root key value : Bytes) (hroot : rootHashS H ec t = some root) + (nep : NonExistenceProof) (ep rp : ExistenceProof) + (hnl : nep.left = none) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + rcases membership_soundS H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm hbin hecl hef hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hlm := verifyNonExistence_rightOnly H s root key nep rp hnl hnr hne + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + rcases reaches_minS H s b cs ec hH hlhash.symm hlpre hmin hecl hef hLInj + t rp.key rp.value rhLeaf rp.path root hwf hrapL + (fun op hop => ⟨hrinn op hop, + hecspec ▸ ensureLeftMost_step_smt s.innerSpec cs hco hcsspec rp.path hlm op hop⟩) + hroot hrap with ⟨hk, _⟩ | hc + · obtain ⟨mk, hmk, hle⟩ := minKeyS_le_member (keyForComparison H s) t hsort key value hmem + rw [hk] at hmk + simp only [Option.some.injEq] at hmk + subst hmk + exact (ble_not_gt _ _ hle hrlt).elim + · exact hc + · exact hc + +/-- **Theorem B, SMT tree model — total.** Every verifier-accepted proof shape +is covered: two-sided, left-only, right-only (a no-neighbor proof never +verifies). -/ +theorem nonexistence_soundS_total (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hecl : ec.length = cs) + (hecspec : s.innerSpec.emptyChild = ec) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : SMTree) (hwf : WFTreeS s b t) (hsort : SortedTreeS (keyForComparison H s) t) + (root key value : Bytes) (hroot : rootHashS H ec t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = s.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = s.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + cases hnl : nep.left with + | none => + cases hnr : nep.right with + | none => + rw [verifyNonExistence_none H s root key nep hnl hnr] at hne + exact Bool.noConfusion hne + | some rp => + exact nonexistence_soundS_rightOnly H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm + hco hecl hecspec hef hLInj t hwf hsort root key value hroot nep ep rp hnl hnr hepleaf + (hrleaf rp hnr) hne hex + | some lp => + cases hnr : nep.right with + | none => + exact nonexistence_soundS_leftOnly H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm + hco hecl hecspec hef hLInj t hwf hsort root key value hroot nep ep lp hnl hnr hepleaf + (hlleaf lp hnl) hne hex + | some rp => + exact nonexistence_soundS H s b cs ec hH hcs hcsspec hlhash hlpre hmin hmm hco hecl + hecspec hef hLInj t hwf hsort root key value hroot nep ep lp rp hnl hnr hepleaf + (hlleaf lp hnl) (hrleaf rp hnr) hne hex + +/-- **Theorem B for the SMT/JMT spec — total.** All structural side conditions +discharged by computation; joint leaf injectivity proved (`leafInj_smt`). The +remaining hypotheses are the sparse-merkle construction's two cryptographic +assumptions — fixed 32-byte digests (`FixedHash`) and no exhibited preimage of +the all-zero placeholder (`EmptyChildFree`) — plus the store invariant that the +honest tree is sorted on *prehashed* keys (`keyForComparison`, which for +`smt_spec` is SHA-256 of the raw key), exactly how a real SMT/JMT arranges its +leaves. -/ +theorem nonexistence_sound_smt_total (H : HashFn) + (hH : FixedHash H 32) + (hef : EmptyChildFree H .sha256 (List.replicate 32 0)) + (t : SMTree) (hwf : WFTreeS smtSpec 0 t) + (hsort : SortedTreeS (keyForComparison H smtSpec) t) + (root key value : Bytes) (hroot : rootHashS H (List.replicate 32 0) t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = smtSpec.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = smtSpec.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = smtSpec.leafSpec) + (hne : verifyNonExistence H nep smtSpec root key = true) + (hex : verifyExistence H ep smtSpec root key value = true) : + HashCollision H := + nonexistence_soundS_total H smtSpec 0 32 (List.replicate 32 0) hH (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) + hef (leafInj_smt H hH) t hwf hsort root key value hroot nep ep hepleaf hlleaf hrleaf hne hex + +end Ics23 diff --git a/lean/Ics23/SmtTree.lean b/lean/Ics23/SmtTree.lean new file mode 100644 index 00000000..57d9092d --- /dev/null +++ b/lean/Ics23/SmtTree.lean @@ -0,0 +1,339 @@ +/- +Honest-root SMT/JMT tree model. + +The `MTree` model (Tree.lean) cannot represent sparse-merkle trees: an SMT node +may have an *empty* subtree whose digest is not a hash image but the constant +`empty_child` placeholder (for `smt_spec`, 32 zero bytes — the same length as a +real digest, which is exactly why the Tendermint-shape bridge lemmas +`ensureRightMost_suffix_nil` / `ensureLeftMost_suffix_cs` exclude it). This file +models that: `SMTree` adds an `.empty` constructor, and `rootHashS` maps it to +the placeholder constant `ec`. + +The price is one new, explicitly-stated assumption beyond collision resistance: +`EmptyChildFree` — the spec's hash op has no (exhibited) preimage of the +placeholder. For SHA-256 and the all-zero placeholder this is the standard +sparse-merkle-tree assumption; without it a prover who knows `x` with +`H(x) = 0^32` could graft a fake empty subtree over a real one. + +With it, Theorem A (`membership_soundS`) transfers: an accepted existence proof +against an honest SMT root reaches a genuine leaf, because the verifier's split +of each node is pinned to a real child (`split_pins`, reused byte-level), and a +path can never terminate inside an empty subtree (its digest would be a hash +image equal to the placeholder). +-/ +import Ics23.Tree +import Ics23.TreeNonExist + +namespace Ics23 + +/-- A binary sparse-merkle tree: like `MTree` but subtrees may be empty, and +node hashing has no mid/suffix bytes (`node = H ih (pre ++ lh ++ rh)`, the +SMT/JMT shape). -/ +inductive SMTree where + | empty : SMTree + | leaf : LeafOp → Bytes → Bytes → SMTree + | node : HashOp → Bytes → SMTree → SMTree → SMTree + deriving Inhabited + +/-- Root hash with placeholder `ec`: an empty subtree's digest is the constant +`ec` (`empty_child`), not a hash image. -/ +def rootHashS (H : HashFn) (ec : Bytes) : SMTree → Option Bytes + | .empty => some ec + | .leaf op k v => applyLeaf H op k v + | .node ih pre l r => + match rootHashS H ec l, rootHashS H ec r with + | some lh, some rh => some (H ih (pre ++ lh ++ rh)) + | _, _ => none + +/-- `(key, value)` is a leaf of the tree. -/ +def TreeMemberS (key val : Bytes) : SMTree → Prop + | .empty => False + | .leaf _ k v => k = key ∧ v = val + | .node _ _ l r => TreeMemberS key val l ∨ TreeMemberS key val r + +/-- SMT-shaped conformance to a spec: nodes use the inner-spec hash with a +fixed-length, non-leaf-prefixed prefix; leaves carry exactly the spec leaf op; +empty subtrees are unconstrained. -/ +def WFTreeS (s : ProofSpec) (b : UInt8) : SMTree → Prop + | .empty => True + | .leaf op _ _ => op = s.leafSpec + | .node ih pre l r => + ih = s.innerSpec.hash ∧ + (pre.length : Int) = s.innerSpec.minPrefixLength ∧ + pre ≠ [] ∧ pre.head? ≠ some b ∧ + WFTreeS s b l ∧ WFTreeS s b r + +/-- The SMT placeholder assumption: the hash op `op` has no exhibited preimage +of the placeholder `ec`. For SHA-256 and `ec = 0^32` this is the standard +sparse-merkle assumption (finding such a preimage is a break of preimage +resistance at a fixed target). -/ +def EmptyChildFree (H : HashFn) (op : HashOp) (ec : Bytes) : Prop := + ∀ x, H op x ≠ ec + +/-- A successful `applyLeaf` output is an image of the leaf's hash op. -/ +theorem applyLeaf_image (H : HashFn) (leaf : LeafOp) (k v lh : Bytes) + (h : applyLeaf H leaf k v = some lh) : ∃ x, H leaf.hash x = lh := by + unfold applyLeaf at h + cases hpk : prepareLeafData H leaf.prehashKey leaf.length k with + | none => simp [hpk] at h + | some pk => + cases hpv : prepareLeafData H leaf.prehashValue leaf.length v with + | none => simp [hpk, hpv] at h + | some pv => + rw [hpk, hpv] at h; simp only [Option.some.injEq] at h + exact ⟨_, h⟩ + +/-- Folding spec-conformant inner ops preserves being an image of the spec's +inner hash op. -/ +theorem applyPath_image (H : HashFn) (s : ProofSpec) : + ∀ (path : List InnerOp) (lh res : Bytes), + (∃ x, H s.innerSpec.hash x = lh) → + (∀ op ∈ path, ensureInner op s = true) → + applyPath H s.innerSpec lh path = some res → + ∃ x, H s.innerSpec.hash x = res := by + intro path + induction path with + | nil => + intro lh res him _ hap + simp only [applyPath, Option.some.injEq] at hap + exact hap ▸ him + | cons op rest ih => + intro lh res him hall hap + simp only [applyPath] at hap + cases hA : applyInner H op lh with + | none => simp [hA] at hap + | some h' => + simp only [hA] at hap + by_cases g : ((h'.length : Int) > s.innerSpec.childSize ∧ s.innerSpec.childSize ≥ 32) + · simp [g] at hap + · rw [if_neg g] at hap + refine ih h' res ?_ (fun o ho => hall o (List.mem_cons_of_mem op ho)) hap + have himg := applyInner_image H op lh h' hA + rw [ensureInner_hash op s (hall op (List.mem_cons_self ..))] at himg + exact ⟨_, himg⟩ + +/-- A leaf-rooted, spec-conformant fold never produces the placeholder. This is +the structural payoff of `EmptyChildFree`: a verifying proof cannot terminate +(or pass through) an empty subtree's digest. -/ +theorem applyPath_ne_emptyChild (H : HashFn) (s : ProofSpec) (ec : Bytes) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (key value lh res : Bytes) (path : List InnerOp) + (hlh : applyLeaf H s.leafSpec key value = some lh) + (hall : ∀ op ∈ path, ensureInner op s = true) + (hap : applyPath H s.innerSpec lh path = some res) : + res ≠ ec := by + obtain ⟨x, hx⟩ := applyLeaf_image H s.leafSpec key value lh hlh + rw [hlhash] at hx + obtain ⟨y, hy⟩ := applyPath_image H s path lh res ⟨x, hx⟩ hall hap + exact fun he => hef y (hy.trans he) + +/-- An SMT root hash is a `cs`-length digest (the placeholder included, since +`ec.length = cs` for the SMT shape). -/ +theorem rootHashS_len (H : HashFn) (ec : Bytes) (cs : Nat) (hH : FixedHash H cs) + (hecl : ec.length = cs) : + ∀ (t : SMTree) (r : Bytes), rootHashS H ec t = some r → r.length = cs := by + intro t + induction t with + | empty => + intro r h + simp only [rootHashS, Option.some.injEq] at h + rw [← h]; exact hecl + | leaf op k v => + intro r h; exact applyLeaf_len H cs hH op k v r h + | node ih pre l r _ _ => + intro root h + unfold rootHashS at h + cases hl : rootHashS H ec l with + | none => rw [hl] at h; simp at h + | some lh => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at h; simp at h + | some rh => + rw [hl, hr] at h; simp only [Option.some.injEq] at h + rw [← h]; exact hH _ _ + +/-- Under `EmptyChildFree`, only the empty tree hashes to the placeholder: a +well-formed leaf or node digest is a hash image. -/ +theorem rootHashS_ec_empty (H : HashFn) (s : ProofSpec) (b : UInt8) (ec : Bytes) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (t : SMTree) (hwf : WFTreeS s b t) (h : rootHashS H ec t = some ec) : + t = .empty := by + cases t with + | empty => rfl + | leaf op k v => + exfalso + simp only [WFTreeS] at hwf; subst hwf + obtain ⟨x, hx⟩ := applyLeaf_image H s.leafSpec k v ec h + rw [hlhash] at hx + exact hef x hx + | node ih pre l r => + exfalso + obtain ⟨hih, _, _, _, _, _⟩ := hwf + rw [rootHashS] at h + cases hl : rootHashS H ec l with + | none => rw [hl] at h; simp at h + | some lh => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at h; simp at h + | some rh => + rw [hl, hr] at h + simp only [Option.some.injEq] at h + rw [hih] at h + exact hef _ h + +/-- Core induction (SMT analog of `reaches`): a proof whose leaf hash folds to a +real SMT's root reaches a genuine leaf. The new case versus `MTree`: the fold +can never land in an empty subtree, because its digest is the placeholder and +the fold's value is always a hash image (`applyPath_ne_emptyChild`). -/ +theorem reachesS (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hbin : s.innerSpec.childOrder.length = 2) + (hecl : ec.length = cs) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : SMTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTreeS s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true) → + rootHashS H ec t = some root → + applyPath H s.innerSpec lh path = some root → + TreeMemberS key value t ∨ HashCollision H := by + intro t + induction t with + | empty => + intro key value lh path root _ hlh hpath hrh hap + exfalso + simp only [rootHashS, Option.some.injEq] at hrh + exact applyPath_ne_emptyChild H s ec hihash.symm hef key value lh root path + hlh hpath hap hrh.symm + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTreeS] at hwf; subst hwf + rw [rootHashS] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap + subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) hpath hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre l r ihl ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hih + rw [rootHashS] at hrh + cases hl : rootHashS H ec l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHashS H ec r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · -- empty path: the proof's leaf hash equals the node hash ⇒ domain collision + subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead + simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · -- nonempty path: peel the root op and force it into a genuine child + rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp))] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + obtain ⟨hb1, hb2, hb7⟩ := split_bounds topOp s cs pre.length hcsspec hmm hbin hppre + (hpath topOp (by simp)) + rcases split_pins pre lhL rhR topOp.prefixBytes m topOp.suffix cs pre.length + hpe rfl (rootHashS_len H ec cs hH hecl l lhL hl) + (rootHashS_len H ec cs hH hecl r rhR hr) + hmlen hcs hb1 hb2 hb7 with hml | hmr + · rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hl hpm with hmem | hcol + · exact Or.inl (Or.inl hmem) + · exact Or.inr hcol + · rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hr hpm with hmem | hcol + · exact Or.inl (Or.inr hmem) + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- **Honest-root Theorem A, SMT tree model.** An accepted existence proof +against an honest SMT root names a genuine `(key, value)` leaf — up to a hash +collision, given the placeholder assumption. -/ +theorem membership_soundS (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) (ec : Bytes) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hbin : s.innerSpec.childOrder.length = 2) + (hecl : ec.length = cs) + (hef : EmptyChildFree H s.innerSpec.hash ec) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : SMTree) (ep : ExistenceProof) (root key value : Bytes), + WFTreeS s b t → + ep.leaf = s.leafSpec → + rootHashS H ec t = some root → + verifyExistence H ep s root key value = true → + TreeMemberS key value t ∨ HashCollision H := by + intro t ep root key value hwf hep hrh hver + have hkey : ep.key = key ∧ ep.value = value := by + unfold verifyExistence at hver + simp only [Bool.and_eq_true] at hver + obtain ⟨⟨⟨_, hkk⟩, hvv⟩, _⟩ := hver + exact ⟨by simpa using hkk, by simpa using hvv⟩ + rw [← hkey.1, ← hkey.2] at hver + obtain ⟨lh, hlf, hap, hinn⟩ := verifyExistence_navigates H s ep root hep hver + rw [hkey.1, hkey.2] at hlf + exact reachesS H s b cs ec hH hcs hcsspec hlhash.symm hlpre hmin hmm hbin hecl hef hLInj + t key value lh ep.path root hwf hlf hinn hrh hap + +/-- **Theorem A for the SMT/JMT spec.** Structural side conditions discharged by +computation, joint leaf injectivity proved (`leafInj_smt`). The remaining +hypotheses are the two genuine cryptographic assumptions of the sparse-merkle +construction: fixed 32-byte digests (`FixedHash`) and no exhibited preimage of +the all-zero placeholder (`EmptyChildFree`). -/ +theorem membership_sound_smt (H : HashFn) + (hH : FixedHash H 32) + (hef : EmptyChildFree H .sha256 (List.replicate 32 0)) : + ∀ (t : SMTree) (ep : ExistenceProof) (root key value : Bytes), + WFTreeS smtSpec 0 t → + ep.leaf = smtSpec.leafSpec → + rootHashS H (List.replicate 32 0) t = some root → + verifyExistence H ep smtSpec root key value = true → + TreeMemberS key value t ∨ HashCollision H := + membership_soundS H smtSpec 0 32 (List.replicate 32 0) hH (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) + hef (leafInj_smt H hH) + +end Ics23 diff --git a/lean/Ics23/Soundness.lean b/lean/Ics23/Soundness.lean new file mode 100644 index 00000000..1ef5b038 --- /dev/null +++ b/lean/Ics23/Soundness.lean @@ -0,0 +1,498 @@ +/- +Soundness scaffolding for the existence verifier. + +This file contains: + * `HashCollision` — the constructive target of every soundness theorem. + * `WellFormed` — the decidable side condition on a `ProofSpec` under which + the verifier is sound (Theorem C certifies the shipped specs satisfy it). + * supporting lemmas that are fully proved. + * Theorem A (`existence_binding`) — stated precisely, proof in progress. + +Theorem A is the headline soundness property. Its proof is staged: the +structural lemmas it rests on are being landed first; the top-level statement is +recorded now (with `sorry`) so the target is fixed and reviewable. No `sorry` +is relied upon by `WellFormed`, the spec certificates, or the proved lemmas. +-/ +import Ics23.Verify +import Ics23.Specs + +namespace Ics23 + +/-! ## The collision target -/ + +/-- A concrete collision in the hash family `H`: two distinct preimages under +the same `HashOp` with the same image. Every soundness theorem concludes by +exhibiting one of these, so the results are unconditional (no hash assumptions). -/ +def HashCollision (H : HashFn) : Prop := + ∃ (op : HashOp) (a b : Bytes), a ≠ b ∧ H op a = H op b + +/-- A fixed-length hash family (`cs`-byte digests), with `cs = child_size`. The +honest setting: SHA-256 outputs 32 bytes and the binary specs set +`child_size = 32`. -/ +def FixedHash (H : HashFn) (cs : Nat) : Prop := ∀ (op : HashOp) (d : Bytes), (H op d).length = cs + +/-! ## Well-formedness of a `ProofSpec` + +These are the side conditions Theorems A and B assume. They are phrased as a +decidable `Bool` predicate so the shipped specs can be certified by computation. -/ + +/-- A length op whose output length is determined by the encoding itself +(length-prefixed) or fixed by construction (`Require*`). `noPrefix` is the only +non-determining op. -/ +def lengthDetermining : LengthOp → Bool + | .noPrefix => false + | _ => true + +/-- The fixed output length of a hash op, or `none` for `noHash` (identity, +hence variable length). -/ +def fixedOutputLen : HashOp → Option Nat + | .noHash => none + | .sha256 => some 32 + | .sha512 => some 64 + | .keccak256 => some 32 + | .ripemd160 => some 20 + | .bitcoin => some 20 + | .sha512256 => some 32 + | .blake2b512 => some 64 + | .blake2s256 => some 32 + | .blake3 => some 32 + +/-- The leaf encoding `prefix ++ enc(prehashKey key) ++ enc(prehashValue value)` +parses unambiguously into its two fields: either the `LengthOp` delimits them, or +both prehash images have fixed length. This is the heart of leaf injectivity. -/ +def leafDelimitingB (leaf : LeafOp) : Bool := + lengthDetermining leaf.length + || ((fixedOutputLen leaf.prehashKey).isSome && (fixedOutputLen leaf.prehashValue).isSome) + +/-- `l` is a permutation of `[0, …, l.length - 1]`. Decidable, and sufficient +because every index in range appearing in a list of that length forces a perm. -/ +def isPermRange (l : List Nat) : Bool := + (List.range l.length).all (fun i => l.contains i) + +/-- Inner-spec well-formedness: positive child size, sensible prefix window, +the `max < min + childSize` invariant (the same one `ensure_inner` enforces per +op), at least a binary node, a valid child ordering, and an `emptyChild` that is +either absent or exactly `childSize` bytes. -/ +def innerWFB (isp : InnerSpec) : Bool := + (isp.childSize > 0) + && (isp.minPrefixLength ≥ 0) + && (isp.maxPrefixLength ≥ isp.minPrefixLength) + && (isp.maxPrefixLength < isp.minPrefixLength + isp.childSize) + && (isp.childOrder.length ≥ 2) + && isPermRange isp.childOrder + && (isp.emptyChild.isEmpty || ((isp.emptyChild.length : Int) = isp.childSize)) + +/-- The full decidable well-formedness predicate. The nonempty leaf prefix is +what makes leaf/inner domain separation (the `!has_prefix(leafPrefix, ...)` +check in `ensure_inner`) meaningful. -/ +def wellFormedB (s : ProofSpec) : Bool := + leafDelimitingB s.leafSpec + && (s.leafSpec.prefixBytes.length > 0) + && innerWFB s.innerSpec + +/-- A spec is well-formed when it passes the decidable check. -/ +def WellFormed (s : ProofSpec) : Prop := wellFormedB s = true + +instance (s : ProofSpec) : Decidable (WellFormed s) := by + unfold WellFormed; infer_instance + +/-! ## Theorem C: the shipped specs are well-formed + +These hold by computation. They are the standalone, immediately-useful artifact: +a machine-checked answer to "is this `ProofSpec` safe to accept?". -/ + +theorem iavl_wellFormed : WellFormed iavlSpec := by decide + +theorem tendermint_wellFormed : WellFormed tendermintSpec := by decide + +theorem smt_wellFormed : WellFormed smtSpec := by decide + +/-! ## Supporting lemmas (fully proved) -/ + +/-- An inner op's preimage is injective in its child: same op, same surrounding +prefix/suffix, so equal images force equal children. This is the cancellation +step used when walking two proofs up to a shared node. -/ +theorem innerImage_inj (op : InnerOp) (c₁ c₂ : Bytes) : + op.prefixBytes ++ c₁ ++ op.suffix = op.prefixBytes ++ c₂ ++ op.suffix ↔ c₁ = c₂ := by + constructor + · intro h + have h2 : op.prefixBytes ++ c₁ = op.prefixBytes ++ c₂ := List.append_cancel_right h + exact List.append_cancel_left h2 + · intro h; rw [h] + +/-- `hasPrefix` is reflexive: every byte string is a prefix of itself. -/ +theorem hasPrefix_refl (b : Bytes) : hasPrefix b b = true := by + unfold hasPrefix + simp + +/-- If `[b]` is a prefix of `data`, then `data` starts with `b`. -/ +theorem hasPrefix_single_head (b : UInt8) (data : Bytes) + (h : hasPrefix [b] data = true) : data.head? = some b := by + cases data with + | nil => simp [hasPrefix] at h + | cons x xs => + unfold hasPrefix at h + simp only [List.length_cons, List.length_nil, List.take_succ_cons, List.take_zero, + Bool.and_eq_true] at h + have hx : b = x := by have := eq_of_beq h.2; simpa using this + simp [hx] + +/-- If `[b]` is *not* a prefix of a non-empty `data`, then `data` does not start +with `b`. -/ +theorem not_hasPrefix_single_head (b x : UInt8) (xs : Bytes) + (h : hasPrefix [b] (x :: xs) = false) : (x :: xs).head? ≠ some b := by + unfold hasPrefix at h + simp only [List.length_cons, List.length_nil, List.take_succ_cons, List.take_zero, + Bool.and_eq_false_iff, decide_eq_false_iff_not, Nat.not_le] at h + simp only [List.head?_cons, ne_eq, Option.some.injEq] + rcases h with hc | hbeq + · omega + · intro hxb; rw [hxb] at hbeq; simp at hbeq + +/-- Packaging a witnessed clash as a `HashCollision`. -/ +theorem hashCollision_of (H : HashFn) (op : HashOp) (a b : Bytes) + (hne : a ≠ b) (heq : H op a = H op b) : HashCollision H := + ⟨op, a, b, hne, heq⟩ + +/-- Leaf/inner domain separation as a collision: if a leaf preimage (starting +with the leaf prefix byte `b`) and an inner preimage (not starting with `b`) hash +to the same value under the same op, that is a collision. This discharges the +length-mismatch case of binding, where a short proof's leaf hash meets a long +proof's intermediate node hash. -/ +theorem leaf_inner_domain_collision (H : HashFn) (op : HashOp) + (lpre ipre : Bytes) (b : UInt8) + (hl0 : lpre.head? = some b) (hi0 : ipre.head? ≠ some b) + (heq : H op lpre = H op ipre) : HashCollision H := by + refine hashCollision_of H op lpre ipre ?_ heq + intro hpe; rw [hpe] at hl0; exact hi0 hl0 + +/-- The core inductive step of existence binding: one inner step is injective in +its child *up to a collision*. If two children hash to the same node under the +same inner op, then either the children are equal or the differing preimages +are an explicit collision. -/ +theorem applyInner_inj (H : HashFn) (op : InnerOp) (c₁ c₂ r : Bytes) + (h1 : applyInner H op c₁ = some r) (h2 : applyInner H op c₂ = some r) : + c₁ = c₂ ∨ HashCollision H := by + by_cases e1 : c₁.isEmpty = true + · rw [applyInner, if_pos e1] at h1; simp at h1 + · by_cases e2 : c₂.isEmpty = true + · rw [applyInner, if_pos e2] at h2; simp at h2 + · rw [applyInner, if_neg e1] at h1 + rw [applyInner, if_neg e2] at h2 + have hi1 := Option.some.inj h1 + have hi2 := Option.some.inj h2 + by_cases himg : + op.prefixBytes ++ c₁ ++ op.suffix = op.prefixBytes ++ c₂ ++ op.suffix + · exact Or.inl ((innerImage_inj op c₁ c₂).mp himg) + · exact Or.inr (hashCollision_of H op.hash _ _ himg (hi1.trans hi2.symm)) + +/-- Folding the *same* op-list over two starting hashes to the same root forces +the starting hashes equal, up to a collision. This is the inductive backbone of +existence binding for the shared portion of two proof paths. -/ +theorem applyPath_sameops_inj (H : HashFn) (isp : InnerSpec) : + ∀ (path : List InnerOp) (h₁ h₂ r : Bytes), + applyPath H isp h₁ path = some r → + applyPath H isp h₂ path = some r → + h₁ = h₂ ∨ HashCollision H := by + intro path + induction path with + | nil => + intro h₁ h₂ r e1 e2 + simp only [applyPath, Option.some.injEq] at e1 e2 + exact Or.inl (e1.trans e2.symm) + | cons step rest ih => + intro h₁ h₂ r e1 e2 + simp only [applyPath] at e1 e2 + cases hA1 : applyInner H step h₁ with + | none => simp [hA1] at e1 + | some h₁' => + cases hA2 : applyInner H step h₂ with + | none => simp [hA2] at e2 + | some h₂' => + simp only [hA1] at e1 + simp only [hA2] at e2 + by_cases g1 : (h₁'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · simp [g1] at e1 + · by_cases g2 : (h₂'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · simp [g2] at e2 + · rw [if_neg g1] at e1 + rw [if_neg g2] at e2 + rcases ih h₁' h₂' r e1 e2 with hh | hc + · subst hh + exact applyInner_inj H step h₁ h₂ h₁' hA1 hA2 + · exact Or.inr hc + +/-- The positional ambiguity of finding F3, formalized: two distinct inner ops +that both pass `ensureInner` for `s` and decompose the *same* node preimage with +*different* children. This is the obstacle to a pure collision reduction for +general binding (see `docs/verification/properties.md`, `IavlPrefix.lean`). -/ +def PositionalAmbiguity (s : ProofSpec) : Prop := + ∃ (op₁ op₂ : InnerOp) (c₁ c₂ : Bytes), + ensureInner op₁ s = true ∧ ensureInner op₂ s = true ∧ op₁ ≠ op₂ ∧ + op₁.prefixBytes ++ c₁ ++ op₁.suffix = op₂.prefixBytes ++ c₂ ++ op₂.suffix + +/-- The leaf-level analogue of `PositionalAmbiguity` (F3 at the leaf): two +spec-conformant leaf ops with *different* prefixes producing the same leaf hash. +Because `ensure_leaf` only requires the spec prefix to be *a* prefix (not exactly +equal), an adversary can pad the leaf prefix; resolving this needs the symbolic +hash model, exactly as for `PositionalAmbiguity`. -/ +def LeafAmbiguity (H : HashFn) (s : ProofSpec) : Prop := + ∃ (leaf₁ leaf₂ : LeafOp) (k₁ v₁ k₂ v₂ L : Bytes), + ensureLeaf leaf₁ s.leafSpec = true ∧ ensureLeaf leaf₂ s.leafSpec = true ∧ + leaf₁.prefixBytes ≠ leaf₂.prefixBytes ∧ + applyLeaf H leaf₁ k₁ v₁ = some L ∧ applyLeaf H leaf₂ k₂ v₂ = some L + +/-- `h` is the image of some spec-conformant inner op — i.e. a non-leaf node +hash. Used to discharge the length-mismatch case of binding via leaf/inner +domain separation. -/ +def IsInnerImage (H : HashFn) (s : ProofSpec) (h : Bytes) : Prop := + ∃ (op : InnerOp) (c : Bytes), ensureInner op s = true ∧ applyInner H op c = some h + +/-- The result of folding a non-empty, spec-conformant path is an inner-node +image. (Component of the differing-length case of binding.) -/ +theorem applyPath_result_isInnerImage (H : HashFn) (s : ProofSpec) : + ∀ (p : List InnerOp) (h r : Bytes), p ≠ [] → + (∀ op ∈ p, ensureInner op s = true) → + applyPath H s.innerSpec h p = some r → IsInnerImage H s r := by + intro p + induction p with + | nil => intro h r hne _ _; exact absurd rfl hne + | cons op rest ih => + intro h r _ hall happ + simp only [applyPath] at happ + cases hA : applyInner H op h with + | none => simp [hA] at happ + | some h' => + simp only [hA] at happ + by_cases g : (h'.length : Int) > s.innerSpec.childSize ∧ s.innerSpec.childSize ≥ 32 + · simp [g] at happ + · rw [if_neg g] at happ + cases rest with + | nil => + simp only [applyPath, Option.some.injEq] at happ + refine ⟨op, h, hall op (List.mem_cons_self ..), ?_⟩ + rw [hA]; exact congrArg some happ + | cons op2 rest2 => + exact ih h' r (by simp) (fun o ho => hall o (List.mem_cons_of_mem op ho)) happ + +/-- The image equation extracted from a successful `applyInner`. -/ +theorem applyInner_image (H : HashFn) (op : InnerOp) (c r : Bytes) + (happ : applyInner H op c = some r) : + H op.hash (op.prefixBytes ++ c ++ op.suffix) = r := by + unfold applyInner at happ + by_cases e : c.isEmpty = true + · rw [if_pos e] at happ; exact absurd happ (by simp) + · rw [if_neg e] at happ; exact Option.some.inj happ + +/-- A spec-conformant inner op uses the inner spec's hash. -/ +theorem ensureInner_hash (op : InnerOp) (s : ProofSpec) + (h : ensureInner op s = true) : op.hash = s.innerSpec.hash := by + unfold ensureInner at h + simp only [Bool.and_eq_true] at h + obtain ⟨⟨⟨⟨⟨⟨hh, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩ := h + exact eq_of_beq hh + +/-- **Binding for equal-length paths.** Two spec-conformant paths of the *same +length* folding two inputs to the same root force the inputs equal — or exhibit a +collision or the F3 positional ambiguity. This strengthens the same-shape result +(which required identical ops) to arbitrary differing ops at equal depth; the +equal length is what sidesteps the leaf/inner length-mismatch case. -/ +theorem applyPath_eqlen_merge (H : HashFn) (s : ProofSpec) : + ∀ (p₁ p₂ : List InnerOp), p₁.length = p₂.length → + ∀ (h₁ h₂ r : Bytes), + (∀ op ∈ p₁, ensureInner op s = true) → (∀ op ∈ p₂, ensureInner op s = true) → + applyPath H s.innerSpec h₁ p₁ = some r → applyPath H s.innerSpec h₂ p₂ = some r → + HashCollision H ∨ PositionalAmbiguity s ∨ h₁ = h₂ := by + intro p₁ + induction p₁ with + | nil => + intro p₂ hlen h₁ h₂ r _ _ e1 e2 + cases p₂ with + | nil => + simp only [applyPath, Option.some.injEq] at e1 e2 + exact Or.inr (Or.inr (e1.trans e2.symm)) + | cons => simp at hlen + | cons op1 rest1 ih => + intro p₂ hlen h₁ h₂ r hall1 hall2 e1 e2 + cases p₂ with + | nil => simp at hlen + | cons op2 rest2 => + have hlen' : rest1.length = rest2.length := by simpa using hlen + simp only [applyPath] at e1 e2 + cases hA1 : applyInner H op1 h₁ with + | none => simp [hA1] at e1 + | some h₁' => + cases hA2 : applyInner H op2 h₂ with + | none => simp [hA2] at e2 + | some h₂' => + simp only [hA1] at e1 + simp only [hA2] at e2 + by_cases g1 : (h₁'.length : Int) > s.innerSpec.childSize ∧ s.innerSpec.childSize ≥ 32 + · simp [g1] at e1 + · by_cases g2 : (h₂'.length : Int) > s.innerSpec.childSize ∧ s.innerSpec.childSize ≥ 32 + · simp [g2] at e2 + · rw [if_neg g1] at e1 + rw [if_neg g2] at e2 + have hin1 : ensureInner op1 s = true := hall1 op1 (List.mem_cons_self ..) + have hin2 : ensureInner op2 s = true := hall2 op2 (List.mem_cons_self ..) + rcases ih rest2 hlen' h₁' h₂' r + (fun o ho => hall1 o (List.mem_cons_of_mem op1 ho)) + (fun o ho => hall2 o (List.mem_cons_of_mem op2 ho)) e1 e2 with hc | ha | heq + · exact Or.inl hc + · exact Or.inr (Or.inl ha) + · subst heq + have hP1 := applyInner_image H op1 h₁ h₁' hA1 + have hP2 := applyInner_image H op2 h₂ h₁' hA2 + have hhash : op1.hash = op2.hash := + (ensureInner_hash op1 s hin1).trans (ensureInner_hash op2 s hin2).symm + rw [hhash] at hP1 + -- hP1 : H op2.hash P1 = h₁', hP2 : H op2.hash P2 = h₁' + by_cases hPeq : + op1.prefixBytes ++ h₁ ++ op1.suffix = op2.prefixBytes ++ h₂ ++ op2.suffix + · by_cases hop : op1 = op2 + · subst hop + exact Or.inr (Or.inr ((innerImage_inj op1 h₁ h₂).mp hPeq)) + · exact Or.inr (Or.inl ⟨op1, op2, h₁, h₂, hin1, hin2, hop, hPeq⟩) + · exact Or.inl (hashCollision_of H op2.hash _ _ hPeq (hP1.trans hP2.symm)) + +/-- Root-side characterization of a path fold: peeling the last (root-most) op. +Enables aligning two differing-length folds from the root. -/ +theorem applyPath_snoc (H : HashFn) (isp : InnerSpec) : + ∀ (p : List InnerOp) (op : InnerOp) (h r : Bytes), + applyPath H isp h (p ++ [op]) = some r ↔ + ∃ m, applyPath H isp h p = some m ∧ applyInner H op m = some r ∧ + ¬((r.length : Int) > isp.childSize ∧ isp.childSize ≥ 32) := by + intro p + induction p with + | nil => + intro op h r + simp only [List.nil_append] + constructor + · intro hh + simp only [applyPath] at hh + cases hA : applyInner H op h with + | none => simp only [hA] at hh; simp at hh + | some h' => + simp only [hA] at hh + by_cases g : (h'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · rw [if_pos g] at hh; simp at hh + · rw [if_neg g] at hh + simp only [Option.some.injEq] at hh + subst hh + exact ⟨h, rfl, hA, g⟩ + · rintro ⟨m, hm, hop, hg⟩ + simp only [applyPath, Option.some.injEq] at hm + subst hm + simp only [applyPath, hop] + rw [if_neg hg] + | cons a rest ih => + intro op h r + simp only [List.cons_append] + constructor + · intro hh + simp only [applyPath] at hh + cases hA : applyInner H a h with + | none => simp only [hA] at hh; simp at hh + | some h' => + simp only [hA] at hh + by_cases g : (h'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · rw [if_pos g] at hh; simp at hh + · rw [if_neg g] at hh + obtain ⟨m, hm, hop, hgr⟩ := (ih op h' r).mp hh + refine ⟨m, ?_, hop, hgr⟩ + simp only [applyPath, hA]; rw [if_neg g]; exact hm + · rintro ⟨m, hm, hop, hgr⟩ + simp only [applyPath] at hm + cases hA : applyInner H a h with + | none => simp only [hA] at hm; simp at hm + | some h' => + simp only [hA] at hm + by_cases g : (h'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · rw [if_pos g] at hm; simp at hm + · rw [if_neg g] at hm + simp only [applyPath, hA]; rw [if_neg g] + exact (ih op h' r).mpr ⟨m, hm, hop, hgr⟩ + +/-- **Root-side merge.** Two spec-conformant paths folding `h₁`, `h₂` to the same +root yield: a collision, the F3 ambiguity, equal inputs, or one input being an +inner-node image (the length-mismatch case, discharged at the leaf level by +domain separation). Root-side recursion keeps `h₁, h₂` fixed, so the conclusion is +about the original inputs. This is the structural core of general binding. -/ +theorem applyPath_merge (H : HashFn) (s : ProofSpec) : + ∀ (n : Nat) (p₁ p₂ : List InnerOp) (h₁ h₂ r : Bytes), + p₁.length + p₂.length = n → + (∀ op ∈ p₁, ensureInner op s = true) → (∀ op ∈ p₂, ensureInner op s = true) → + applyPath H s.innerSpec h₁ p₁ = some r → applyPath H s.innerSpec h₂ p₂ = some r → + HashCollision H ∨ PositionalAmbiguity s ∨ h₁ = h₂ + ∨ IsInnerImage H s h₁ ∨ IsInnerImage H s h₂ := by + intro n + induction n using Nat.strongRecOn with + | _ n ih => + intro p₁ p₂ h₁ h₂ r hn hin1 hin2 e1 e2 + rcases List.eq_nil_or_concat p₁ with hp1 | ⟨q₁, op1, hp1⟩ + · subst hp1 + simp only [applyPath, Option.some.injEq] at e1 + cases hp2c : p₂ with + | nil => + rw [hp2c] at e2 + simp only [applyPath, Option.some.injEq] at e2 + exact Or.inr (Or.inr (Or.inl (e1.trans e2.symm))) + | cons a2 rest2 => + have himg : IsInnerImage H s r := + applyPath_result_isInnerImage H s p₂ h₂ r (by rw [hp2c]; simp) + hin2 e2 + rw [← e1] at himg + exact Or.inr (Or.inr (Or.inr (Or.inl himg))) + · rw [List.concat_eq_append] at hp1 + subst hp1 + rcases List.eq_nil_or_concat p₂ with hp2 | ⟨q₂, op2, hp2⟩ + · subst hp2 + simp only [applyPath, Option.some.injEq] at e2 + have himg : IsInnerImage H s r := + applyPath_result_isInnerImage H s (q₁ ++ [op1]) h₁ r (by simp) hin1 e1 + rw [← e2] at himg + exact Or.inr (Or.inr (Or.inr (Or.inr himg))) + · rw [List.concat_eq_append] at hp2 + subst hp2 + obtain ⟨m₁, hm1, hop1, _⟩ := (applyPath_snoc H s.innerSpec q₁ op1 h₁ r).mp e1 + obtain ⟨m₂, hm2, hop2, _⟩ := (applyPath_snoc H s.innerSpec q₂ op2 h₂ r).mp e2 + have hP1 := applyInner_image H op1 m₁ r hop1 + have hP2 := applyInner_image H op2 m₂ r hop2 + have hin1' : ensureInner op1 s = true := hin1 op1 (by simp) + have hin2' : ensureInner op2 s = true := hin2 op2 (by simp) + have hhash : op1.hash = op2.hash := + (ensureInner_hash op1 s hin1').trans (ensureInner_hash op2 s hin2').symm + rw [hhash] at hP1 + by_cases hPeq : + op1.prefixBytes ++ m₁ ++ op1.suffix = op2.prefixBytes ++ m₂ ++ op2.suffix + · by_cases hop : op1 = op2 + · subst hop + have hmeq : m₁ = m₂ := (innerImage_inj op1 m₁ m₂).mp hPeq + subst hmeq + have hlt : q₁.length + q₂.length < n := by + simp only [List.length_append, List.length_cons, List.length_nil] at hn; omega + exact ih (q₁.length + q₂.length) hlt q₁ q₂ h₁ h₂ m₁ rfl + (fun o ho => hin1 o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hin2 o (List.mem_append.mpr (Or.inl ho))) hm1 hm2 + · exact Or.inr (Or.inl ⟨op1, op2, m₁, m₂, hin1', hin2', hop, hPeq⟩) + · exact Or.inl (hashCollision_of H op2.hash _ _ hPeq (hP1.trans hP2.symm)) + +/-! ## Theorem A: existence binding (soundness) + +The general existence-binding theorem is `Ics23.existence_binding_shaped` (in +`Existence.lean`), proved with **no `sorry`** for the production-spec shape +(single-byte leaf prefix, shared leaf/inner hash op, `min_prefix_length ≥ 1`), +with corollaries `existence_binding_{iavl,tendermint,smt}`. Its conclusion is the +honest three-way disjunction + + `HashCollision H ∨ PositionalAmbiguity s ∨ LeafAmbiguity H s`, + +which is exactly what the abstract-hash model can establish: a forger who binds a +key to two values either found a hash collision, or exploited the inner +positional ambiguity F3, or the leaf-level analogue. A collision-only conclusion +is provably too strong (machine-checked in `IavlPrefix.lean`); collapsing the two +ambiguity arms requires the symbolic "Merkle" hash model. The same-leaf case +(`existence_binding_sameleaf`) — the honest case, since a key's leaf op is +determined in a real tree — yields just `HashCollision ∨ PositionalAmbiguity`. -/ + +end Ics23 diff --git a/lean/Ics23/Specs.lean b/lean/Ics23/Specs.lean new file mode 100644 index 00000000..febfcfc8 --- /dev/null +++ b/lean/Ics23/Specs.lean @@ -0,0 +1,47 @@ +/- +The three shipped proof specs, mirroring `iavl_spec`, `tendermint_spec`, and +`smt_spec` in `rust/src/api.rs`. `Soundness.lean` certifies each is `WellFormed`. +-/ +import Ics23.Types + +namespace Ics23 + +/-- IAVL tree spec (`iavl_spec`). -/ +def iavlSpec : ProofSpec where + leafSpec := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0] } + innerSpec := + { childOrder := [0, 1], childSize := 33, minPrefixLength := 4, + maxPrefixLength := 12, emptyChild := [], hash := .sha256 } + minDepth := 0 + maxDepth := 0 + prehashKeyBeforeComparison := false + +/-- CometBFT/Tendermint simple-merkle spec (`tendermint_spec`). -/ +def tendermintSpec : ProofSpec where + leafSpec := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0] } + innerSpec := + { childOrder := [0, 1], childSize := 32, minPrefixLength := 1, + maxPrefixLength := 1, emptyChild := [], hash := .sha256 } + minDepth := 0 + maxDepth := 0 + prehashKeyBeforeComparison := false + +/-- Sparse-merkle-tree / JMT spec (`smt_spec`). Note `prehashKeyBeforeComparison` +and the 32-byte `emptyChild`. -/ +def smtSpec : ProofSpec where + leafSpec := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0] } + innerSpec := + { childOrder := [0, 1], childSize := 32, minPrefixLength := 1, + maxPrefixLength := 1, + emptyChild := List.replicate 32 0, hash := .sha256 } + minDepth := 0 + maxDepth := 0 + prehashKeyBeforeComparison := true + +end Ics23 diff --git a/lean/Ics23/TestVectors.lean b/lean/Ics23/TestVectors.lean new file mode 100644 index 00000000..863f8af1 --- /dev/null +++ b/lean/Ics23/TestVectors.lean @@ -0,0 +1,1559 @@ +/- +Shared test vectors (Phase 2a differential oracle). GENERATED FILE — do not +edit by hand; regenerate with `cargo run --example lean_testdata` in `rust/`. + +Each vector under `testdata/{iavl,tendermint,smt}/` is the decoded protobuf +`CommitmentProof` the Rust and Go suites verify, re-checked here against the +Lean model with real SHA-256 (`native_decide`). An accept/reject divergence +between the model and the implementations fails this build. +-/ +import Ics23.Executable + +namespace Ics23.TestVectors + +open Ics23 + +/-! ### `testdata/iavl/exist_left.json` -/ + +def iavlExistLeft : ExistenceProof where + key := [0x30, 0x33, 0x76, 0x34, 0x34, 0x45, 0x45, 0x74, 0x64, 0x72, 0x48, 0x42, 0x35, 0x56, 0x41, 0x75, + 0x79, 0x71, 0x59, 0x66] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x33, 0x76, 0x34, 0x34, 0x45, + 0x45, 0x74, 0x64, 0x72, 0x48, 0x42, 0x35, 0x56, 0x41, 0x75, 0x79, 0x71, 0x59, 0x66] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x04, 0x06, 0x02, 0x20], + suffix := [0x20, 0xaf, 0xca, 0x3d, 0xe8, 0xc7, 0xae, 0xfe, 0x10, 0x41, 0xf1, 0x85, 0xa3, 0x4e, 0x97, 0x7a, + 0x97, 0x6b, 0x37, 0xd6, 0xce, 0x4c, 0xce, 0x80, 0xe5, 0xe4, 0x54, 0x5b, 0x93, 0x41, 0x3e, 0xca, + 0x02] }, + { hash := .sha256, + prefixBytes := [0x06, 0x0c, 0x02, 0x20], + suffix := [0x20, 0x5e, 0x17, 0x12, 0x93, 0x8d, 0x9d, 0xce, 0xf3, 0x96, 0xa7, 0x6b, 0xbd, 0x7e, 0xa8, 0x44, + 0xbc, 0xc7, 0xe7, 0x2a, 0x64, 0xd4, 0x16, 0x48, 0x5b, 0xa1, 0x4e, 0x8c, 0x67, 0x94, 0x02, 0xdf, + 0xc3] }, + { hash := .sha256, + prefixBytes := [0x08, 0x18, 0x02, 0x20], + suffix := [0x20, 0xc6, 0xa6, 0x43, 0x04, 0x36, 0xf6, 0xe9, 0x5a, 0xb0, 0xc9, 0x0d, 0x7c, 0x3d, 0x32, 0xc7, + 0xe6, 0x28, 0x84, 0xa1, 0xe2, 0x8e, 0x22, 0xda, 0x87, 0xf9, 0xe8, 0xc8, 0x63, 0x78, 0x2b, 0x71, + 0x95] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x2c, 0x02, 0x20], + suffix := [0x20, 0x12, 0x04, 0xac, 0xd0, 0xc7, 0x29, 0x84, 0x4a, 0xa1, 0x9f, 0xfa, 0x80, 0xcf, 0xdf, 0xcb, + 0x93, 0x1f, 0x1e, 0xa5, 0x41, 0x67, 0xba, 0xbe, 0x18, 0x72, 0xa2, 0xfd, 0xcd, 0xf5, 0x20, 0x96, + 0x2a] }, + { hash := .sha256, + prefixBytes := [0x0c, 0x44, 0x02, 0x20], + suffix := [0x20, 0xc2, 0x19, 0x11, 0x26, 0x0b, 0x25, 0x3d, 0x74, 0xc8, 0x9d, 0x95, 0xec, 0x75, 0x34, 0xb7, + 0x49, 0x9b, 0x98, 0xa8, 0xb7, 0x52, 0x38, 0x57, 0xf7, 0xf3, 0x1e, 0x6a, 0xf7, 0x23, 0x24, 0x5b, + 0x89] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x6e, 0x02, 0x20], + suffix := [0x20, 0x45, 0xa0, 0x6e, 0x0b, 0x8f, 0x73, 0x91, 0xf6, 0x0a, 0x5f, 0x71, 0x6e, 0xee, 0xf9, 0xeb, + 0x01, 0xd8, 0xc5, 0x88, 0xbb, 0xdb, 0xfb, 0x4e, 0x6a, 0x67, 0x71, 0x8e, 0x92, 0xab, 0x3e, 0xd1, + 0x2d] }, + { hash := .sha256, + prefixBytes := [0x12, 0x96, 0x02, 0x02, 0x20], + suffix := [0x20, 0x9b, 0x77, 0xab, 0x64, 0xf5, 0xb7, 0xc2, 0x90, 0xb6, 0x08, 0x53, 0x3b, 0x70, 0x61, 0x2d, + 0x18, 0xa0, 0xd5, 0x5e, 0xde, 0x4c, 0xcb, 0x2f, 0x94, 0x18, 0xb5, 0x6a, 0xa1, 0x70, 0x69, 0xe9, + 0x66] }, + { hash := .sha256, + prefixBytes := [0x14, 0xe6, 0x03, 0x02, 0x20], + suffix := [0x20, 0x24, 0x6d, 0xce, 0x92, 0x8b, 0x80, 0x7f, 0x04, 0x02, 0x30, 0x21, 0x9a, 0x80, 0x8c, 0x04, + 0x9d, 0x7a, 0x17, 0x21, 0x08, 0xdb, 0x6b, 0x1c, 0x83, 0xc4, 0x45, 0xc6, 0x63, 0x73, 0xea, 0x4c, + 0xd9] }, + { hash := .sha256, + prefixBytes := [0x16, 0x80, 0x08, 0x02, 0x20], + suffix := [0x20, 0xec, 0x79, 0x4f, 0xb7, 0xe4, 0x9d, 0x3d, 0x35, 0x54, 0x68, 0x0a, 0xd0, 0xdf, 0x7d, 0x1c, + 0xc3, 0x79, 0x72, 0x01, 0xfe, 0x33, 0xfc, 0x82, 0x88, 0x58, 0x1f, 0x7a, 0xd3, 0x2b, 0xb9, 0x95, + 0xc0] }, + { hash := .sha256, + prefixBytes := [0x18, 0xb6, 0x0f, 0x02, 0x20], + suffix := [0x20, 0x3b, 0x05, 0x42, 0x86, 0x44, 0x52, 0x0c, 0x7b, 0xae, 0x4b, 0xe1, 0x97, 0xec, 0xb6, 0xde, + 0x54, 0xa0, 0x3a, 0x18, 0xa1, 0xeb, 0xd3, 0x48, 0x36, 0xee, 0xa3, 0x1f, 0xe5, 0x93, 0xa6, 0xb6, + 0xe0] } + ] + +def iavlExistLeftRoot : Bytes := + [0x77, 0xe4, 0x3e, 0xf9, 0x30, 0x47, 0xa9, 0x1f, 0xe4, 0x57, 0xf5, 0x49, 0x8b, 0xd7, 0xaf, 0xc6, + 0x0b, 0x9d, 0xdd, 0xd6, 0x61, 0xd8, 0xf1, 0x22, 0x5e, 0x5f, 0x40, 0xa9, 0x1b, 0xda, 0x46, 0x23] + +def iavlExistLeftKey : Bytes := + [0x30, 0x33, 0x76, 0x34, 0x34, 0x45, 0x45, 0x74, 0x64, 0x72, 0x48, 0x42, 0x35, 0x56, 0x41, 0x75, + 0x79, 0x71, 0x59, 0x66] + +def iavlExistLeftValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x33, 0x76, 0x34, 0x34, 0x45, + 0x45, 0x74, 0x64, 0x72, 0x48, 0x42, 0x35, 0x56, 0x41, 0x75, 0x79, 0x71, 0x59, 0x66] + +example : verifyExistence concreteHash iavlExistLeft iavlSpec iavlExistLeftRoot + iavlExistLeftKey iavlExistLeftValue = true := by native_decide + +/-! ### `testdata/iavl/exist_right.json` -/ + +def iavlExistRight : ExistenceProof where + key := [0x7a, 0x77, 0x73, 0x4b, 0x56, 0x61, 0x4b, 0x6b, 0x48, 0x58, 0x47, 0x43, 0x6c, 0x79, 0x50, 0x73, + 0x68, 0x6b, 0x39, 0x69] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x77, 0x73, 0x4b, 0x56, 0x61, + 0x4b, 0x6b, 0x48, 0x58, 0x47, 0x43, 0x6c, 0x79, 0x50, 0x73, 0x68, 0x6b, 0x39, 0x69] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x02, 0x04, 0x02, 0x20, 0xa8, 0x09, 0x64, 0x83, 0x9e, 0x7d, 0x4f, 0x4e, 0xa9, 0x55, 0x24, 0x91, + 0x09, 0xf9, 0x6d, 0x6b, 0x18, 0x90, 0x9a, 0x48, 0x4d, 0x59, 0x08, 0xef, 0x17, 0x95, 0xd5, 0x2f, + 0x1a, 0x71, 0xb9, 0xf9, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x04, 0x08, 0x02, 0x20, 0xf3, 0x16, 0xe6, 0x6f, 0x51, 0xc9, 0x41, 0xed, 0x0d, 0x6e, 0xc7, 0xef, + 0x9f, 0x3f, 0x23, 0x03, 0x53, 0xae, 0xac, 0x15, 0x02, 0xe8, 0x33, 0xee, 0x49, 0x64, 0x4a, 0x37, + 0x66, 0x06, 0x2a, 0x85, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x06, 0x10, 0x02, 0x20, 0xb9, 0x65, 0x7b, 0x80, 0xff, 0x14, 0x1a, 0x29, 0x84, 0x0b, 0x6d, 0x66, + 0x72, 0x6b, 0x81, 0x16, 0x84, 0x01, 0xca, 0x5c, 0x5e, 0x47, 0xf5, 0x50, 0x6a, 0xad, 0xd3, 0xba, + 0x23, 0x9d, 0x97, 0xa2, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x08, 0x1a, 0x02, 0x20, 0x10, 0x2c, 0x2c, 0x76, 0x7a, 0x05, 0xdb, 0xb2, 0x1f, 0xe6, 0x7a, 0x52, + 0x91, 0x75, 0x93, 0x4f, 0x95, 0x1f, 0x0a, 0x84, 0x46, 0xe7, 0x2b, 0xff, 0x5b, 0xc8, 0xb0, 0x0d, + 0x19, 0x5c, 0x6a, 0x43, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x30, 0x02, 0x20, 0x73, 0x68, 0xa0, 0xf8, 0x4b, 0x7d, 0x52, 0x72, 0x52, 0x96, 0x27, 0x7d, + 0x1e, 0x37, 0x25, 0x57, 0x88, 0x4d, 0xcf, 0x9c, 0x47, 0x98, 0x94, 0xda, 0xd9, 0x1e, 0x79, 0x66, + 0x8a, 0xcf, 0xc6, 0x5d, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0c, 0x52, 0x02, 0x20, 0x8e, 0x82, 0x3d, 0x59, 0x49, 0xda, 0x2f, 0x70, 0xd6, 0x95, 0xf1, 0x15, + 0xd4, 0x4a, 0x26, 0xb0, 0xa5, 0xf4, 0xfe, 0x9b, 0x15, 0x26, 0x12, 0x16, 0x02, 0x64, 0x42, 0xb2, + 0xdd, 0x68, 0x94, 0x3f, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x9e, 0x01, 0x02, 0x20, 0x3e, 0xb0, 0x3a, 0x9d, 0xcd, 0x75, 0x4a, 0x78, 0xeb, 0xd2, 0x3f, + 0x23, 0x96, 0x99, 0xc3, 0xd7, 0xaf, 0xef, 0x6e, 0xcd, 0x8a, 0xe7, 0x3a, 0xe1, 0x59, 0x67, 0xfd, + 0xbb, 0x72, 0x42, 0xb4, 0x83, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x10, 0xf2, 0x01, 0x02, 0x20, 0xd6, 0x46, 0x02, 0x75, 0x93, 0x51, 0x77, 0x4d, 0xab, 0x36, 0x24, + 0xc4, 0x7b, 0x58, 0x33, 0xdd, 0x85, 0xcc, 0x5b, 0x59, 0xa9, 0x2c, 0x19, 0x9f, 0xfd, 0x99, 0xe0, + 0xd6, 0x38, 0xcc, 0xb2, 0x15, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x12, 0xd6, 0x03, 0x02, 0x20, 0x54, 0x29, 0x9e, 0xe0, 0x36, 0x8a, 0x22, 0xe4, 0xf6, 0xcb, 0x10, + 0x05, 0xb1, 0x88, 0xf8, 0x59, 0x5e, 0x4c, 0xde, 0xc5, 0x38, 0x2f, 0x34, 0xe3, 0x16, 0x51, 0x0d, + 0x68, 0x5d, 0xf9, 0xfc, 0x7b, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x14, 0xda, 0x05, 0x02, 0x20, 0x9b, 0x54, 0xb6, 0xb1, 0x9b, 0x67, 0x56, 0xa8, 0x81, 0x40, 0x29, + 0x8a, 0x7b, 0x60, 0xc0, 0x44, 0x9e, 0x01, 0x3c, 0x77, 0x62, 0xca, 0x26, 0xc6, 0xc7, 0xfc, 0xda, + 0x1c, 0x7a, 0xcf, 0x8e, 0x3b, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x16, 0xc2, 0x0a, 0x02, 0x20, 0xaf, 0xfb, 0x77, 0x24, 0x16, 0x2f, 0x85, 0xbe, 0x6e, 0x87, 0x35, + 0xe8, 0x49, 0x8d, 0x84, 0x67, 0xde, 0x4b, 0xea, 0xf0, 0x97, 0x21, 0x62, 0xb4, 0xdc, 0x1c, 0xa1, + 0xec, 0xc8, 0x9e, 0x0c, 0xc0, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x18, 0xda, 0x13, 0x02, 0x20, 0xd1, 0xdc, 0xc3, 0xed, 0x25, 0x04, 0x6b, 0x94, 0xc1, 0x28, 0xff, + 0x3c, 0x7d, 0x31, 0xf9, 0xc1, 0x12, 0xb6, 0x79, 0x41, 0x1d, 0xbb, 0x8c, 0xc4, 0xac, 0xbf, 0xc8, + 0x72, 0xf8, 0x73, 0xd0, 0x06, 0x20], + suffix := [] } + ] + +def iavlExistRightRoot : Bytes := + [0x3c, 0x58, 0xf3, 0xce, 0x24, 0x88, 0x59, 0xb0, 0x7e, 0x29, 0x84, 0xa4, 0xfc, 0x95, 0xf2, 0x8e, + 0xe9, 0xca, 0x31, 0x72, 0x9f, 0x36, 0xd5, 0xd2, 0x48, 0xce, 0x80, 0x6b, 0xab, 0xd2, 0x7c, 0x39] + +def iavlExistRightKey : Bytes := + [0x7a, 0x77, 0x73, 0x4b, 0x56, 0x61, 0x4b, 0x6b, 0x48, 0x58, 0x47, 0x43, 0x6c, 0x79, 0x50, 0x73, + 0x68, 0x6b, 0x39, 0x69] + +def iavlExistRightValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x77, 0x73, 0x4b, 0x56, 0x61, + 0x4b, 0x6b, 0x48, 0x58, 0x47, 0x43, 0x6c, 0x79, 0x50, 0x73, 0x68, 0x6b, 0x39, 0x69] + +example : verifyExistence concreteHash iavlExistRight iavlSpec iavlExistRightRoot + iavlExistRightKey iavlExistRightValue = true := by native_decide + +/-! ### `testdata/iavl/exist_middle.json` -/ + +def iavlExistMiddle : ExistenceProof where + key := [0x36, 0x7a, 0x75, 0x7a, 0x4f, 0x78, 0x45, 0x41, 0x65, 0x30, 0x35, 0x79, 0x67, 0x61, 0x7a, 0x57, + 0x63, 0x4b, 0x6b, 0x70] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x36, 0x7a, 0x75, 0x7a, 0x4f, 0x78, + 0x45, 0x41, 0x65, 0x30, 0x35, 0x79, 0x67, 0x61, 0x7a, 0x57, 0x63, 0x4b, 0x6b, 0x70] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x04, 0x06, 0x02, 0x20], + suffix := [0x20, 0xe5, 0x73, 0xba, 0x32, 0xe4, 0xd4, 0x87, 0x52, 0xf7, 0x50, 0x14, 0x5e, 0x8f, 0x49, 0x27, + 0x2d, 0x81, 0xe5, 0xf4, 0xd8, 0x1f, 0x41, 0x8c, 0x6c, 0x8e, 0x01, 0xe2, 0xbd, 0x2b, 0xb0, 0x3e, + 0x92] }, + { hash := .sha256, + prefixBytes := [0x06, 0x0e, 0x02, 0x20], + suffix := [0x20, 0x2f, 0x74, 0x53, 0xb9, 0xdf, 0x6a, 0xfe, 0xce, 0xfc, 0xec, 0xd4, 0x64, 0xd5, 0x57, 0x70, + 0x16, 0x85, 0xce, 0xed, 0xdc, 0xf8, 0x2e, 0x20, 0x64, 0xf5, 0xd6, 0xa7, 0x51, 0xfe, 0x6f, 0x44, + 0x8c] }, + { hash := .sha256, + prefixBytes := [0x08, 0x1a, 0x02, 0x20], + suffix := [0x20, 0x0a, 0x60, 0x25, 0xa4, 0x9f, 0x3a, 0xff, 0x53, 0xa9, 0xfd, 0x7b, 0xd6, 0x0e, 0x0f, 0x24, + 0x18, 0x97, 0xbd, 0xff, 0x7f, 0xf5, 0xb0, 0x38, 0x6d, 0xe6, 0xe5, 0x82, 0xfa, 0x60, 0xa2, 0xff, + 0x64] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x34, 0x02, 0x20, 0x9b, 0xae, 0x06, 0x13, 0xf7, 0xec, 0xad, 0x99, 0xb5, 0xb4, 0x48, 0x71, + 0x4f, 0x1b, 0x66, 0x92, 0x9f, 0x06, 0xca, 0x05, 0xe9, 0x2d, 0xad, 0x7a, 0x7f, 0xc9, 0xc6, 0x24, + 0x34, 0x75, 0x13, 0x50, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x80, 0x01, 0x02, 0x20, 0xe5, 0x08, 0xb7, 0xf9, 0x79, 0xad, 0x0f, 0x16, 0x01, 0xb3, 0x44, + 0x26, 0x03, 0xf9, 0x28, 0xb3, 0xab, 0xa9, 0x12, 0x87, 0xa4, 0xc9, 0x88, 0x04, 0x5a, 0x88, 0xfa, + 0x1b, 0xf2, 0x6d, 0xf1, 0x71, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x10, 0xcc, 0x01, 0x02, 0x20, 0x1a, 0xbe, 0xb4, 0x1c, 0x3a, 0x4e, 0xc8, 0x5c, 0x07, 0xa7, 0x7a, + 0xf6, 0x01, 0x7d, 0xcb, 0x21, 0x71, 0xa1, 0xd5, 0xc2, 0x78, 0xb3, 0x00, 0xcc, 0x36, 0x1d, 0x7b, + 0x51, 0xc5, 0x93, 0xb7, 0xcf, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x12, 0xfa, 0x02, 0x02, 0x20], + suffix := [0x20, 0x55, 0x33, 0x7b, 0x41, 0x92, 0xed, 0xc0, 0x5b, 0xa1, 0xca, 0x4c, 0x51, 0xb1, 0x10, 0xaa, + 0x56, 0xfe, 0xb4, 0x6b, 0x58, 0x30, 0xba, 0x19, 0xee, 0x68, 0x2c, 0x9c, 0x88, 0xa4, 0x8c, 0xdf, + 0xee] }, + { hash := .sha256, + prefixBytes := [0x14, 0x9c, 0x06, 0x02, 0x20], + suffix := [0x20, 0x92, 0xfd, 0xf4, 0x83, 0x6b, 0x25, 0x61, 0xfb, 0x01, 0x8c, 0x29, 0x66, 0x02, 0x62, 0xb1, + 0x02, 0x76, 0x1f, 0x25, 0x92, 0x0e, 0xd4, 0x3a, 0xe4, 0x6b, 0xc4, 0x15, 0x3a, 0x55, 0xfd, 0x16, + 0x1b] }, + { hash := .sha256, + prefixBytes := [0x16, 0xd8, 0x0c, 0x02, 0x20], + suffix := [0x20, 0x04, 0xdd, 0xd2, 0x0b, 0x8b, 0xd3, 0xc1, 0x46, 0x12, 0x93, 0x92, 0x2b, 0xb3, 0xf9, 0x40, + 0x4e, 0xec, 0xaa, 0x2d, 0x18, 0x69, 0xd6, 0x51, 0xf1, 0xa3, 0x04, 0xa4, 0x75, 0x7b, 0xd5, 0xf6, + 0x46] } + ] + +def iavlExistMiddleRoot : Bytes := + [0xce, 0x93, 0xfb, 0x31, 0x42, 0x0c, 0xca, 0x24, 0x94, 0x0f, 0xd7, 0xe8, 0x74, 0x2c, 0xa1, 0x06, + 0x1b, 0x51, 0xc5, 0xd3, 0xc5, 0x43, 0x8b, 0x68, 0xbf, 0x05, 0x26, 0xbc, 0x93, 0xe4, 0x52, 0x74] + +def iavlExistMiddleKey : Bytes := + [0x36, 0x7a, 0x75, 0x7a, 0x4f, 0x78, 0x45, 0x41, 0x65, 0x30, 0x35, 0x79, 0x67, 0x61, 0x7a, 0x57, + 0x63, 0x4b, 0x6b, 0x70] + +def iavlExistMiddleValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x36, 0x7a, 0x75, 0x7a, 0x4f, 0x78, + 0x45, 0x41, 0x65, 0x30, 0x35, 0x79, 0x67, 0x61, 0x7a, 0x57, 0x63, 0x4b, 0x6b, 0x70] + +example : verifyExistence concreteHash iavlExistMiddle iavlSpec iavlExistMiddleRoot + iavlExistMiddleKey iavlExistMiddleValue = true := by native_decide + +/-! ### `testdata/iavl/nonexist_left.json` -/ + +def iavlNonexistLeftR : ExistenceProof where + key := [0x30, 0x37, 0x71, 0x6d, 0x49, 0x53, 0x76, 0x54, 0x47, 0x68, 0x78, 0x55, 0x65, 0x6b, 0x62, 0x4d, + 0x69, 0x76, 0x4e, 0x76] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x37, 0x71, 0x6d, 0x49, 0x53, + 0x76, 0x54, 0x47, 0x68, 0x78, 0x55, 0x65, 0x6b, 0x62, 0x4d, 0x69, 0x76, 0x4e, 0x76] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x02, 0x04, 0x02, 0x20], + suffix := [0x20, 0x70, 0x81, 0x6e, 0x5f, 0x4a, 0x9a, 0xdf, 0xba, 0x29, 0xe8, 0xb9, 0x97, 0x56, 0x2f, 0xc5, + 0x58, 0x23, 0x4e, 0xec, 0x33, 0x24, 0x73, 0x83, 0x3f, 0xfb, 0x79, 0x33, 0x4d, 0x8a, 0xea, 0x18, + 0xd9] }, + { hash := .sha256, + prefixBytes := [0x04, 0x08, 0x02, 0x20], + suffix := [0x20, 0x1e, 0x2c, 0xc6, 0x22, 0x7a, 0x41, 0xe0, 0xec, 0xee, 0x80, 0x26, 0x02, 0xfb, 0xcc, 0x52, + 0xaf, 0xfb, 0x1e, 0x43, 0xaa, 0xfd, 0xeb, 0xed, 0x7f, 0xb3, 0xe7, 0xa7, 0xd1, 0x55, 0x50, 0xa6, + 0x00] }, + { hash := .sha256, + prefixBytes := [0x06, 0x0c, 0x02, 0x20], + suffix := [0x20, 0xdc, 0xc5, 0xeb, 0x2e, 0x6d, 0x82, 0x1b, 0x74, 0xb6, 0x13, 0x52, 0xdd, 0xa6, 0x35, 0xef, + 0xb2, 0x61, 0xad, 0x71, 0x4a, 0x85, 0x06, 0x5f, 0xff, 0x80, 0xdf, 0x23, 0x06, 0xc8, 0xd7, 0x1f, + 0x7d] }, + { hash := .sha256, + prefixBytes := [0x08, 0x12, 0x02, 0x20], + suffix := [0x20, 0x13, 0x3c, 0x87, 0x66, 0xe7, 0x4d, 0x14, 0xfb, 0x33, 0x5b, 0x50, 0x12, 0x04, 0x1d, 0x86, + 0x15, 0x86, 0x90, 0x5e, 0x0b, 0x2b, 0xd7, 0x95, 0x13, 0x13, 0xd3, 0x4d, 0xc0, 0x90, 0x7f, 0xd6, + 0x5e] }, + { hash := .sha256, + prefixBytes := [0x0c, 0x38, 0x02, 0x20], + suffix := [0x20, 0x9f, 0x1c, 0xa3, 0x3c, 0x91, 0xf5, 0xd5, 0xc6, 0xb9, 0x9d, 0xbf, 0xd7, 0x42, 0x57, 0x6f, + 0x5f, 0x1b, 0x83, 0xfb, 0x01, 0xd2, 0x99, 0x76, 0xb0, 0x31, 0x26, 0xc0, 0xa8, 0x95, 0xca, 0xc2, + 0x45] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x72, 0x02, 0x20], + suffix := [0x20, 0x9c, 0x70, 0x77, 0x5d, 0x39, 0x25, 0x3c, 0x1a, 0xcf, 0xb2, 0x6a, 0x85, 0x0e, 0xf7, 0x13, + 0x30, 0x67, 0x57, 0x73, 0xa2, 0x99, 0x5c, 0xb5, 0xc6, 0x57, 0x7e, 0xcb, 0x5f, 0xa1, 0x27, 0xfe, + 0xdb] }, + { hash := .sha256, + prefixBytes := [0x12, 0x8e, 0x02, 0x02, 0x20], + suffix := [0x20, 0x46, 0x83, 0xca, 0xa5, 0x82, 0x26, 0xda, 0xe3, 0xcd, 0x26, 0x45, 0xa0, 0x27, 0xea, 0x77, + 0x64, 0x37, 0xec, 0x68, 0x4a, 0x25, 0xdc, 0xcc, 0xe0, 0x64, 0x58, 0xb5, 0x2f, 0x93, 0x20, 0x6a, + 0xb4] }, + { hash := .sha256, + prefixBytes := [0x14, 0xe8, 0x04, 0x02, 0x20], + suffix := [0x20, 0x65, 0x85, 0x8d, 0x65, 0xc8, 0xd6, 0xbc, 0xb6, 0x71, 0x96, 0x33, 0x3f, 0x91, 0x86, 0x3e, + 0x93, 0xf4, 0x36, 0x3f, 0xe2, 0x14, 0x63, 0x8c, 0x57, 0x6a, 0xfa, 0x89, 0x95, 0xa2, 0x88, 0xb5, + 0xc7] }, + { hash := .sha256, + prefixBytes := [0x16, 0x80, 0x09, 0x02, 0x20], + suffix := [0x20, 0xee, 0x7c, 0x45, 0x02, 0xea, 0x7f, 0x28, 0x35, 0x83, 0xe3, 0xe9, 0xc4, 0xca, 0xe4, 0xee, + 0x75, 0xc3, 0x5e, 0x30, 0xb5, 0x6f, 0x10, 0xaa, 0x23, 0x5c, 0xec, 0x94, 0x0c, 0x90, 0xb6, 0xa5, + 0x45] }, + { hash := .sha256, + prefixBytes := [0x18, 0xda, 0x0c, 0x02, 0x20], + suffix := [0x20, 0x45, 0x2e, 0xb3, 0x00, 0xe7, 0xca, 0x64, 0x58, 0x7b, 0xe0, 0x2b, 0xa9, 0x82, 0xb9, 0xb1, + 0xd9, 0xe9, 0x36, 0x80, 0x4e, 0x80, 0x5b, 0x1c, 0x1b, 0x61, 0xf9, 0x7b, 0x34, 0x9e, 0x79, 0xd4, + 0x78] } + ] + +def iavlNonexistLeft : NonExistenceProof where + key := [0x00, 0x00, 0x00, 0x01] + left := none + right := some iavlNonexistLeftR + +def iavlNonexistLeftRoot : Bytes := + [0x45, 0x51, 0x53, 0xed, 0x2b, 0xcd, 0xd9, 0x6d, 0xe8, 0x7a, 0x71, 0x05, 0x11, 0x9f, 0x40, 0x25, + 0xca, 0x72, 0x05, 0x55, 0xf3, 0x64, 0xaf, 0x7d, 0x5e, 0x48, 0xaa, 0xe0, 0x48, 0xcf, 0x05, 0x4e] + +def iavlNonexistLeftKey : Bytes := + [0x00, 0x00, 0x00, 0x01] + +example : verifyNonExistence concreteHash iavlNonexistLeft iavlSpec iavlNonexistLeftRoot + iavlNonexistLeftKey = true := by native_decide + +/-! ### `testdata/iavl/nonexist_right.json` -/ + +def iavlNonexistRightL : ExistenceProof where + key := [0x7a, 0x7a, 0x71, 0x49, 0x63, 0x72, 0x59, 0x44, 0x6f, 0x70, 0x76, 0x6e, 0x7a, 0x71, 0x50, 0x4a, + 0x79, 0x75, 0x5a, 0x6f] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x7a, 0x71, 0x49, 0x63, 0x72, + 0x59, 0x44, 0x6f, 0x70, 0x76, 0x6e, 0x7a, 0x71, 0x50, 0x4a, 0x79, 0x75, 0x5a, 0x6f] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x02, 0x04, 0x02, 0x20, 0x81, 0x43, 0x5c, 0x94, 0xd2, 0x34, 0xd2, 0x23, 0x41, 0xc3, 0xd1, 0xe9, + 0xda, 0x37, 0x1b, 0xcc, 0xe7, 0xaf, 0xf2, 0xee, 0x1a, 0xa9, 0x20, 0x23, 0xfe, 0x14, 0xf0, 0x82, + 0x20, 0x51, 0xb8, 0x95, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x04, 0x06, 0x02, 0x20, 0x12, 0x87, 0x2b, 0xc0, 0x98, 0xa6, 0xab, 0x45, 0x54, 0x57, 0x9c, 0xab, + 0x54, 0x70, 0x31, 0x37, 0xb9, 0xbb, 0xb9, 0x64, 0xcc, 0x83, 0xb0, 0x59, 0xf3, 0xfb, 0xca, 0x6d, + 0xc8, 0xde, 0xba, 0xb8, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x06, 0x0c, 0x02, 0x20, 0x9c, 0xea, 0x7e, 0x3e, 0xb0, 0x6f, 0x35, 0xa6, 0x59, 0x5d, 0x4f, 0x61, + 0xe8, 0xca, 0x23, 0x5e, 0xd0, 0xc5, 0x14, 0xc4, 0x7c, 0x8a, 0x4d, 0xd0, 0xb3, 0xa4, 0x24, 0x6f, + 0x8b, 0xb6, 0xb3, 0x53, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x08, 0x16, 0x02, 0x20, 0x03, 0x0a, 0x63, 0x04, 0x85, 0x0f, 0x9a, 0x70, 0xd9, 0x6f, 0x7f, 0x72, + 0x1f, 0xfc, 0x35, 0xf7, 0x73, 0xa7, 0x7b, 0x2a, 0x5a, 0x02, 0x23, 0x66, 0xb4, 0xa0, 0xaa, 0x16, + 0xb5, 0x77, 0x72, 0xc0, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x30, 0x02, 0x20, 0x8d, 0xbd, 0xcf, 0x15, 0x58, 0xab, 0x10, 0xc2, 0xa9, 0x4c, 0x97, 0x6c, + 0xd3, 0xcf, 0x11, 0x46, 0xb4, 0x11, 0x8b, 0x8d, 0xff, 0x3e, 0xa5, 0xa3, 0x69, 0xd5, 0x9b, 0x48, + 0x45, 0x04, 0x31, 0x5b, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0c, 0x54, 0x02, 0x20, 0x1d, 0xd8, 0xbf, 0xf9, 0xba, 0xb4, 0xfc, 0x6e, 0x7b, 0xfc, 0xa6, 0xd6, + 0x09, 0x14, 0x8d, 0x17, 0xbe, 0x74, 0x41, 0x54, 0x9e, 0xf8, 0xea, 0x03, 0x93, 0xb4, 0xea, 0x03, + 0xb9, 0x87, 0xa4, 0x64, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0e, 0xa6, 0x01, 0x02, 0x20, 0xbe, 0xe2, 0x09, 0xc6, 0x0e, 0x2c, 0x62, 0x85, 0x98, 0x37, 0x2f, + 0xd2, 0x28, 0xcf, 0x94, 0x0c, 0xa6, 0x40, 0xd7, 0x4e, 0x34, 0x5f, 0x36, 0xab, 0x46, 0x83, 0x9b, + 0x7b, 0x46, 0xb6, 0x66, 0x84, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x10, 0x86, 0x02, 0x02, 0x20, 0xe4, 0x01, 0xa0, 0x19, 0x69, 0x34, 0xb3, 0xbe, 0xe3, 0xcd, 0x7b, + 0x63, 0xd1, 0x5e, 0x1b, 0x52, 0xa5, 0x1e, 0xfd, 0xc4, 0x25, 0x5c, 0xfb, 0x4f, 0xc8, 0x2c, 0xb8, + 0x19, 0x18, 0x0c, 0x3c, 0x95, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x12, 0xde, 0x03, 0x02, 0x20, 0x64, 0xf4, 0x39, 0x52, 0xd0, 0xd4, 0xb6, 0xb6, 0xb0, 0xd4, 0x1c, + 0xf4, 0x4a, 0xfa, 0x12, 0xe5, 0x21, 0xdc, 0xfb, 0xb5, 0xbe, 0xb3, 0xa2, 0x28, 0xf8, 0x03, 0x76, + 0x27, 0x79, 0xc5, 0xe7, 0x15, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x14, 0x96, 0x07, 0x02, 0x20, 0x40, 0x0e, 0xa7, 0x94, 0x0c, 0x9c, 0x63, 0x9f, 0x83, 0x47, 0x8c, + 0xdb, 0x68, 0xc8, 0xa0, 0x17, 0x43, 0xa3, 0x44, 0x47, 0xc3, 0xdc, 0xca, 0xf8, 0xee, 0x02, 0xcf, + 0xc5, 0xa3, 0x70, 0x25, 0xc0, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x18, 0x90, 0x0f, 0x02, 0x20, 0xb7, 0x86, 0x78, 0xd9, 0x23, 0x54, 0x0c, 0x0b, 0xe0, 0xd2, 0x60, + 0x34, 0x50, 0xd7, 0x19, 0xf5, 0x9f, 0x5e, 0x40, 0x04, 0x64, 0xdd, 0x4b, 0x14, 0x0e, 0x55, 0x7e, + 0xb7, 0x55, 0xd8, 0x55, 0x72, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x1a, 0xfe, 0x17, 0x02, 0x20, 0x33, 0x47, 0x49, 0x24, 0x5d, 0xda, 0x33, 0x85, 0xa8, 0x36, 0x8b, + 0x09, 0xdb, 0x0c, 0xb8, 0x78, 0xcb, 0x07, 0x7a, 0x97, 0x51, 0x99, 0x83, 0xa9, 0x83, 0x42, 0xea, + 0x30, 0xe8, 0x93, 0x85, 0x01, 0x20], + suffix := [] } + ] + +def iavlNonexistRight : NonExistenceProof where + key := [0xff, 0xff, 0xff, 0xff] + left := some iavlNonexistRightL + right := none + +def iavlNonexistRightRoot : Bytes := + [0x18, 0xc8, 0x72, 0x2c, 0xe7, 0xe9, 0xf7, 0xa4, 0x87, 0x11, 0x0f, 0xf5, 0x01, 0xff, 0xcb, 0x74, + 0x5b, 0xe5, 0xec, 0xb3, 0xc9, 0x61, 0x5f, 0xe5, 0x3c, 0xfc, 0xa8, 0xb2, 0x9b, 0xdb, 0xe5, 0x49] + +def iavlNonexistRightKey : Bytes := + [0xff, 0xff, 0xff, 0xff] + +example : verifyNonExistence concreteHash iavlNonexistRight iavlSpec iavlNonexistRightRoot + iavlNonexistRightKey = true := by native_decide + +/-! ### `testdata/iavl/nonexist_middle.json` -/ + +def iavlNonexistMiddleL : ExistenceProof where + key := [0x6a, 0x47, 0x41, 0x64, 0x5a, 0x75, 0x70, 0x77, 0x49, 0x4e, 0x71, 0x4a, 0x35, 0x34, 0x50, 0x7a, + 0x47, 0x64, 0x48, 0x72] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x6a, 0x47, 0x41, 0x64, 0x5a, 0x75, + 0x70, 0x77, 0x49, 0x4e, 0x71, 0x4a, 0x35, 0x34, 0x50, 0x7a, 0x47, 0x64, 0x48, 0x72] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x04, 0x06, 0x02, 0x20, 0x91, 0x21, 0x5e, 0xd6, 0x2d, 0x84, 0x07, 0x85, 0x3f, 0x47, 0x6e, 0x12, + 0x25, 0x69, 0xbb, 0xf9, 0x6a, 0xe3, 0xab, 0x0f, 0x06, 0xb4, 0x46, 0xd7, 0x19, 0x82, 0x77, 0xd2, + 0xa8, 0x32, 0xcb, 0xb7, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x06, 0x0a, 0x02, 0x20, 0x2a, 0xad, 0xdc, 0x8b, 0x32, 0xce, 0x91, 0xd3, 0x82, 0xc3, 0x32, 0xb5, + 0x00, 0x71, 0xbe, 0x9c, 0xc7, 0xf9, 0x1d, 0x07, 0x28, 0xd5, 0xe9, 0xcd, 0x57, 0x3c, 0xe9, 0x74, + 0xca, 0xca, 0x7d, 0x3a, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x08, 0x1a, 0x02, 0x20], + suffix := [0x20, 0x50, 0x0d, 0xad, 0x43, 0x5a, 0xa1, 0xa3, 0xd3, 0x63, 0x6b, 0x5d, 0xdd, 0xbe, 0x4f, 0x3a, + 0x22, 0x11, 0x6d, 0x9c, 0xe3, 0x3f, 0x3b, 0x32, 0x82, 0xd0, 0xb7, 0xd2, 0x1a, 0x00, 0x3d, 0x42, + 0x3c] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x2c, 0x02, 0x20, 0xfe, 0xf9, 0x02, 0x50, 0xd2, 0x9f, 0x80, 0xa9, 0xa9, 0x5a, 0xf8, 0xaf, + 0x3c, 0x1f, 0x46, 0x58, 0xf3, 0xde, 0x65, 0x18, 0x8b, 0x87, 0x04, 0x7c, 0x32, 0xd4, 0x97, 0x95, + 0x00, 0x62, 0x1b, 0x19, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x72, 0x02, 0x20], + suffix := [0x20, 0x6b, 0x58, 0x9b, 0x1f, 0x35, 0x00, 0x37, 0x0e, 0xd4, 0x50, 0xb1, 0x3f, 0x6d, 0xb7, 0x1d, + 0x32, 0x73, 0xf5, 0x10, 0xa4, 0x65, 0x11, 0x91, 0xe2, 0xbb, 0x98, 0x12, 0x4e, 0xbe, 0xc8, 0x5e, + 0x24] }, + { hash := .sha256, + prefixBytes := [0x10, 0xc4, 0x01, 0x02, 0x20, 0x04, 0xba, 0x84, 0x13, 0x10, 0x4c, 0xc5, 0xa4, 0x82, 0x01, 0xfb, + 0x14, 0xf4, 0x00, 0xc2, 0xd9, 0xe6, 0x89, 0x9a, 0xbd, 0x27, 0x02, 0x01, 0x83, 0x35, 0xf4, 0xd9, + 0xf4, 0x54, 0x72, 0x4e, 0x02, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x12, 0xda, 0x02, 0x02, 0x20, 0x03, 0xf3, 0x51, 0x02, 0x45, 0xd8, 0x8d, 0xd8, 0x6e, 0x29, 0x57, + 0xaa, 0x3f, 0xc9, 0x6f, 0xe6, 0x1f, 0xf1, 0x71, 0x9b, 0x80, 0x2f, 0xac, 0xf5, 0xed, 0x34, 0x09, + 0x66, 0xbe, 0x42, 0xf3, 0x39, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x14, 0xca, 0x04, 0x02, 0x20], + suffix := [0x20, 0xc4, 0x4e, 0x20, 0x43, 0x3b, 0x25, 0xfd, 0x83, 0xec, 0x67, 0x57, 0x08, 0x3e, 0xcf, 0x6e, + 0xbd, 0x47, 0x96, 0x26, 0x8e, 0xd0, 0x73, 0x20, 0x56, 0xab, 0x6a, 0x3d, 0x16, 0x0e, 0x97, 0x48, + 0x3f] }, + { hash := .sha256, + prefixBytes := [0x16, 0xe6, 0x0a, 0x02, 0x20, 0x5e, 0x14, 0xfc, 0x09, 0x62, 0x4f, 0x31, 0xaa, 0xec, 0xe0, 0xf0, + 0x62, 0xb5, 0xe1, 0x6f, 0xeb, 0x32, 0xcb, 0x4b, 0xf9, 0x13, 0xae, 0x60, 0x62, 0x85, 0x2f, 0x27, + 0x90, 0x57, 0x09, 0x08, 0x96, 0x20], + suffix := [] } + ] + +def iavlNonexistMiddleR : ExistenceProof where + key := [0x6a, 0x4f, 0x35, 0x59, 0x35, 0x6a, 0x32, 0x45, 0x44, 0x35, 0x4d, 0x6e, 0x44, 0x6c, 0x48, 0x71, + 0x44, 0x6b, 0x77, 0x75] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x6a, 0x4f, 0x35, 0x59, 0x35, 0x6a, + 0x32, 0x45, 0x44, 0x35, 0x4d, 0x6e, 0x44, 0x6c, 0x48, 0x71, 0x44, 0x6b, 0x77, 0x75] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00, 0x02, 0x02] } + path := [ + { hash := .sha256, + prefixBytes := [0x02, 0x04, 0x02, 0x20], + suffix := [0x20, 0x9c, 0x89, 0xf4, 0x23, 0x97, 0xba, 0x12, 0xd9, 0xa9, 0x70, 0x26, 0x54, 0x7d, 0xbf, 0x68, + 0x66, 0x96, 0xfc, 0xd9, 0x0c, 0xca, 0x38, 0x43, 0x83, 0x5d, 0xe6, 0xea, 0x7a, 0xb3, 0x8e, 0xf2, + 0xc1] }, + { hash := .sha256, + prefixBytes := [0x04, 0x08, 0x02, 0x20], + suffix := [0x20, 0xd5, 0xf0, 0xef, 0x78, 0xaf, 0x12, 0xda, 0x2b, 0xe8, 0x7f, 0x35, 0x90, 0xc9, 0x42, 0x5e, + 0x81, 0x0e, 0x3f, 0x23, 0xd0, 0x45, 0x1e, 0xf9, 0x1b, 0x31, 0x14, 0x02, 0x8f, 0x9c, 0x25, 0xe0, + 0x7e] }, + { hash := .sha256, + prefixBytes := [0x06, 0x10, 0x02, 0x20], + suffix := [0x20, 0xab, 0xb1, 0xef, 0x0a, 0xb1, 0x02, 0xe0, 0x7a, 0xa9, 0x6a, 0xa8, 0xf8, 0xa4, 0x05, 0x06, + 0x36, 0xcf, 0xe5, 0xe2, 0x53, 0xe0, 0xe0, 0xe7, 0x7d, 0xfe, 0x9c, 0x06, 0x75, 0xd6, 0xb5, 0x5c, + 0xe5] }, + { hash := .sha256, + prefixBytes := [0x08, 0x1a, 0x02, 0x20, 0x22, 0x51, 0x1d, 0x95, 0x2d, 0x96, 0x5f, 0x27, 0x39, 0xb5, 0xb9, 0xdc, + 0xfa, 0x6d, 0x96, 0x4d, 0x0b, 0x77, 0xe1, 0x3b, 0x8a, 0xc4, 0x89, 0xd1, 0x33, 0x72, 0xb7, 0x3f, + 0x87, 0xef, 0x8c, 0xe7, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0a, 0x2c, 0x02, 0x20, 0xfe, 0xf9, 0x02, 0x50, 0xd2, 0x9f, 0x80, 0xa9, 0xa9, 0x5a, 0xf8, 0xaf, + 0x3c, 0x1f, 0x46, 0x58, 0xf3, 0xde, 0x65, 0x18, 0x8b, 0x87, 0x04, 0x7c, 0x32, 0xd4, 0x97, 0x95, + 0x00, 0x62, 0x1b, 0x19, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x0e, 0x72, 0x02, 0x20], + suffix := [0x20, 0x6b, 0x58, 0x9b, 0x1f, 0x35, 0x00, 0x37, 0x0e, 0xd4, 0x50, 0xb1, 0x3f, 0x6d, 0xb7, 0x1d, + 0x32, 0x73, 0xf5, 0x10, 0xa4, 0x65, 0x11, 0x91, 0xe2, 0xbb, 0x98, 0x12, 0x4e, 0xbe, 0xc8, 0x5e, + 0x24] }, + { hash := .sha256, + prefixBytes := [0x10, 0xc4, 0x01, 0x02, 0x20, 0x04, 0xba, 0x84, 0x13, 0x10, 0x4c, 0xc5, 0xa4, 0x82, 0x01, 0xfb, + 0x14, 0xf4, 0x00, 0xc2, 0xd9, 0xe6, 0x89, 0x9a, 0xbd, 0x27, 0x02, 0x01, 0x83, 0x35, 0xf4, 0xd9, + 0xf4, 0x54, 0x72, 0x4e, 0x02, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x12, 0xda, 0x02, 0x02, 0x20, 0x03, 0xf3, 0x51, 0x02, 0x45, 0xd8, 0x8d, 0xd8, 0x6e, 0x29, 0x57, + 0xaa, 0x3f, 0xc9, 0x6f, 0xe6, 0x1f, 0xf1, 0x71, 0x9b, 0x80, 0x2f, 0xac, 0xf5, 0xed, 0x34, 0x09, + 0x66, 0xbe, 0x42, 0xf3, 0x39, 0x20], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x14, 0xca, 0x04, 0x02, 0x20], + suffix := [0x20, 0xc4, 0x4e, 0x20, 0x43, 0x3b, 0x25, 0xfd, 0x83, 0xec, 0x67, 0x57, 0x08, 0x3e, 0xcf, 0x6e, + 0xbd, 0x47, 0x96, 0x26, 0x8e, 0xd0, 0x73, 0x20, 0x56, 0xab, 0x6a, 0x3d, 0x16, 0x0e, 0x97, 0x48, + 0x3f] }, + { hash := .sha256, + prefixBytes := [0x16, 0xe6, 0x0a, 0x02, 0x20, 0x5e, 0x14, 0xfc, 0x09, 0x62, 0x4f, 0x31, 0xaa, 0xec, 0xe0, 0xf0, + 0x62, 0xb5, 0xe1, 0x6f, 0xeb, 0x32, 0xcb, 0x4b, 0xf9, 0x13, 0xae, 0x60, 0x62, 0x85, 0x2f, 0x27, + 0x90, 0x57, 0x09, 0x08, 0x96, 0x20], + suffix := [] } + ] + +def iavlNonexistMiddle : NonExistenceProof where + key := [0x6a, 0x47, 0x41, 0x64, 0x5a, 0x75, 0x70, 0x77, 0x49, 0x4e, 0x71, 0x4a, 0x35, 0x34, 0x50, 0x7a, + 0x47, 0x64, 0xff, 0xff] + left := some iavlNonexistMiddleL + right := some iavlNonexistMiddleR + +def iavlNonexistMiddleRoot : Bytes := + [0xb7, 0x07, 0x74, 0x0d, 0xc2, 0xf7, 0x53, 0x81, 0xc4, 0xc8, 0xe9, 0x7a, 0x74, 0x3f, 0x5a, 0x98, + 0x48, 0xff, 0x38, 0xa4, 0x71, 0x01, 0x8f, 0xef, 0x28, 0x51, 0xd5, 0x9a, 0xae, 0x05, 0x9d, 0xfa] + +def iavlNonexistMiddleKey : Bytes := + [0x6a, 0x47, 0x41, 0x64, 0x5a, 0x75, 0x70, 0x77, 0x49, 0x4e, 0x71, 0x4a, 0x35, 0x34, 0x50, 0x7a, + 0x47, 0x64, 0xff, 0xff] + +example : verifyNonExistence concreteHash iavlNonexistMiddle iavlSpec iavlNonexistMiddleRoot + iavlNonexistMiddleKey = true := by native_decide + +/-! ### `testdata/tendermint/exist_left.json` -/ + +def tendermintExistLeft : ExistenceProof where + key := [0x30, 0x31, 0x42, 0x42, 0x43, 0x73, 0x61, 0x5a, 0x55, 0x71, 0x51, 0x46, 0x73, 0x52, 0x59, 0x43, + 0x6c, 0x6a, 0x57, 0x67] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x31, 0x42, 0x42, 0x43, 0x73, + 0x61, 0x5a, 0x55, 0x71, 0x51, 0x46, 0x73, 0x52, 0x59, 0x43, 0x6c, 0x6a, 0x57, 0x67] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xcb, 0x31, 0x31, 0xcd, 0x98, 0xb0, 0x69, 0xef, 0xcc, 0x0e, 0x8c, 0x7e, 0x68, 0xda, 0x47, 0x37, + 0x0a, 0xdb, 0xff, 0x32, 0x26, 0x6d, 0x7f, 0xcd, 0x1b, 0x05, 0x80, 0xfd, 0xf3, 0x96, 0x12, 0x66] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x21, 0xd1, 0x20, 0x5c, 0x1f, 0x85, 0x37, 0x20, 0x5e, 0x8f, 0xb4, 0xb1, 0x76, 0xf9, 0x60, 0xb4, + 0x59, 0xd9, 0x13, 0x16, 0x69, 0x96, 0x8d, 0x59, 0xc4, 0x56, 0x44, 0x2f, 0x76, 0x73, 0xb6, 0x8b] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xb8, 0x2a, 0x0e, 0x7f, 0x44, 0x34, 0xb3, 0xce, 0xdb, 0x87, 0xea, 0x83, 0xeb, 0x5a, 0x70, 0xc7, + 0xdc, 0x66, 0x4c, 0x77, 0xb2, 0xfe, 0x21, 0xc6, 0x24, 0x5f, 0x31, 0x5e, 0x58, 0xfd, 0xf7, 0x45] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xbf, 0x06, 0x57, 0xa0, 0xe6, 0xfb, 0xd8, 0xf2, 0x04, 0x3e, 0xb2, 0xcf, 0x75, 0x15, 0x61, 0xad, + 0xcf, 0x50, 0x54, 0x7d, 0x16, 0x20, 0x12, 0x24, 0x13, 0x3e, 0xeb, 0x8d, 0x38, 0x14, 0x52, 0x29] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x6d, 0x47, 0xc0, 0x3d, 0xf9, 0x1a, 0x4a, 0x02, 0x52, 0x05, 0x5d, 0x11, 0x64, 0x39, 0xd3, 0x4b, + 0x5b, 0x73, 0xf3, 0xa2, 0x4d, 0x5c, 0xb3, 0xcf, 0x0d, 0x4b, 0x08, 0xca, 0xa5, 0x40, 0xca, 0xc4] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xd5, 0xd2, 0x92, 0x69, 0x93, 0xfa, 0x15, 0xc7, 0x41, 0x0a, 0xc4, 0xee, 0x1f, 0x1d, 0x81, 0xaf, + 0xdd, 0xfb, 0x0a, 0xb5, 0xf6, 0xf4, 0x70, 0x6b, 0x05, 0xf4, 0x07, 0xbc, 0x01, 0x63, 0x81, 0x49] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x54, 0x07, 0x19, 0xb2, 0x6a, 0x73, 0x01, 0xad, 0x01, 0x2a, 0xc4, 0x5e, 0xbe, 0x71, 0x66, 0x79, + 0xe5, 0x59, 0x5e, 0x55, 0x70, 0xd7, 0x8b, 0xe9, 0xb6, 0xda, 0x8d, 0x85, 0x91, 0xaf, 0xb3, 0x74] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xfc, 0xca, 0xaa, 0x99, 0x50, 0x73, 0x0e, 0x80, 0xb9, 0xcc, 0xf7, 0x5a, 0xd2, 0xcf, 0xea, 0xb2, + 0x6a, 0xe7, 0x50, 0xb8, 0xbd, 0x6a, 0xc1, 0xff, 0x1c, 0x7a, 0x75, 0x02, 0xf3, 0xc6, 0x4b, 0xe2] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xec, 0xb6, 0x1a, 0x6d, 0x70, 0xac, 0xcb, 0x79, 0xc2, 0x32, 0x5f, 0xb0, 0xb5, 0x16, 0x77, 0xed, + 0x15, 0x61, 0xc9, 0x1a, 0xf5, 0xe1, 0x05, 0x78, 0xc8, 0x29, 0x40, 0x02, 0xfb, 0xb3, 0xc2, 0x1e] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x1b, 0x3b, 0xc1, 0xbd, 0x8d, 0x08, 0xaf, 0x9f, 0x61, 0x99, 0xde, 0x84, 0xe9, 0x5d, 0x64, 0x65, + 0x70, 0xcb, 0xd9, 0xb3, 0x06, 0xa6, 0x32, 0xa5, 0xac, 0xf6, 0x17, 0xcb, 0xd7, 0xd1, 0xab, 0x0a] } + ] + +def tendermintExistLeftRoot : Bytes := + [0xc5, 0x69, 0xa3, 0x8a, 0x57, 0x75, 0xbb, 0xda, 0x20, 0x51, 0xc3, 0x4a, 0xe0, 0x08, 0x94, 0x18, + 0x6f, 0x83, 0x7c, 0x39, 0xd1, 0x1d, 0xca, 0x55, 0x49, 0x5b, 0x9a, 0xed, 0x14, 0xf1, 0x7d, 0xdf] + +def tendermintExistLeftKey : Bytes := + [0x30, 0x31, 0x42, 0x42, 0x43, 0x73, 0x61, 0x5a, 0x55, 0x71, 0x51, 0x46, 0x73, 0x52, 0x59, 0x43, + 0x6c, 0x6a, 0x57, 0x67] + +def tendermintExistLeftValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x31, 0x42, 0x42, 0x43, 0x73, + 0x61, 0x5a, 0x55, 0x71, 0x51, 0x46, 0x73, 0x52, 0x59, 0x43, 0x6c, 0x6a, 0x57, 0x67] + +example : verifyExistence concreteHash tendermintExistLeft tendermintSpec tendermintExistLeftRoot + tendermintExistLeftKey tendermintExistLeftValue = true := by native_decide + +/-! ### `testdata/tendermint/exist_right.json` -/ + +def tendermintExistRight : ExistenceProof where + key := [0x7a, 0x78, 0x5a, 0x4e, 0x6b, 0x53, 0x4c, 0x64, 0x63, 0x4d, 0x65, 0x56, 0x57, 0x52, 0x6c, 0x76, + 0x58, 0x45, 0x66, 0x44] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x78, 0x5a, 0x4e, 0x6b, 0x53, + 0x4c, 0x64, 0x63, 0x4d, 0x65, 0x56, 0x57, 0x52, 0x6c, 0x76, 0x58, 0x45, 0x66, 0x44] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0x26, 0x34, 0xb8, 0x31, 0x46, 0x8d, 0xba, 0xfb, 0x1f, 0xc6, 0x1a, 0x97, 0x9c, 0x34, 0x8f, + 0xf8, 0x46, 0x2d, 0xa9, 0xa7, 0xd5, 0x50, 0x19, 0x1a, 0x6a, 0xfc, 0x91, 0x6a, 0xde, 0x16, 0xcc, + 0x99], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xab, 0x81, 0x4d, 0x41, 0x9b, 0xfc, 0x94, 0xee, 0x99, 0x20, 0xd0, 0xce, 0x99, 0x3c, 0xe5, + 0xda, 0x01, 0x1e, 0x43, 0x61, 0x3d, 0xaf, 0x4b, 0x6f, 0x30, 0x28, 0x55, 0x76, 0x00, 0x83, 0xd7, + 0xdd], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x5a, 0x15, 0x68, 0xc7, 0x3e, 0xae, 0xab, 0xa5, 0x67, 0xa6, 0xb2, 0xb2, 0x94, 0x4b, 0x0e, + 0x9a, 0x02, 0x28, 0xc9, 0x31, 0x88, 0x4c, 0xb5, 0x94, 0x2f, 0x58, 0xed, 0x83, 0x5b, 0x8a, 0x7a, + 0xc5], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xa1, 0x71, 0x41, 0x2d, 0xb5, 0xee, 0x84, 0x83, 0x5e, 0xf2, 0x47, 0x76, 0x89, 0x14, 0xe8, + 0x35, 0xff, 0x80, 0xb7, 0x71, 0x1e, 0x4a, 0xa8, 0x06, 0x08, 0x71, 0xc2, 0x66, 0x7e, 0xc3, 0xea, + 0x29], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xf9, 0xc2, 0x49, 0x18, 0x84, 0xde, 0x24, 0xfb, 0x61, 0xba, 0x8f, 0x35, 0x8a, 0x56, 0xb3, + 0x06, 0xa8, 0x98, 0x9b, 0xd3, 0x5f, 0x1f, 0x8a, 0x4c, 0x8d, 0xab, 0xce, 0x22, 0xf7, 0x03, 0xcc, + 0x14], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x2f, 0x12, 0xa6, 0xaa, 0x62, 0x70, 0xef, 0xf8, 0xa1, 0x62, 0x80, 0x52, 0x93, 0x8f, 0xf5, + 0xe3, 0x6c, 0xfc, 0xc5, 0xbf, 0x2e, 0xae, 0xdc, 0x09, 0x41, 0xee, 0x46, 0x39, 0x8e, 0xbc, 0x7c, + 0x38], + suffix := [] } + ] + +def tendermintExistRightRoot : Bytes := + [0xf5, 0x42, 0x27, 0xf1, 0xa7, 0xd9, 0x0a, 0xa2, 0xbf, 0x79, 0x31, 0x06, 0x61, 0x96, 0xfd, 0x30, + 0x72, 0xb7, 0xfe, 0x6b, 0x1f, 0xbd, 0x49, 0xd1, 0xe2, 0x6e, 0x85, 0xa9, 0x0d, 0x95, 0x41, 0xbb] + +def tendermintExistRightKey : Bytes := + [0x7a, 0x78, 0x5a, 0x4e, 0x6b, 0x53, 0x4c, 0x64, 0x63, 0x4d, 0x65, 0x56, 0x57, 0x52, 0x6c, 0x76, + 0x58, 0x45, 0x66, 0x44] + +def tendermintExistRightValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x78, 0x5a, 0x4e, 0x6b, 0x53, + 0x4c, 0x64, 0x63, 0x4d, 0x65, 0x56, 0x57, 0x52, 0x6c, 0x76, 0x58, 0x45, 0x66, 0x44] + +example : verifyExistence concreteHash tendermintExistRight tendermintSpec tendermintExistRightRoot + tendermintExistRightKey tendermintExistRightValue = true := by native_decide + +/-! ### `testdata/tendermint/exist_middle.json` -/ + +def tendermintExistMiddle : ExistenceProof where + key := [0x51, 0x33, 0x34, 0x65, 0x6d, 0x76, 0x6f, 0x39, 0x44, 0x71, 0x45, 0x58, 0x57, 0x35, 0x32, 0x52, + 0x57, 0x52, 0x38, 0x35] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x51, 0x33, 0x34, 0x65, 0x6d, 0x76, + 0x6f, 0x39, 0x44, 0x71, 0x45, 0x58, 0x57, 0x35, 0x32, 0x52, 0x57, 0x52, 0x38, 0x35] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0xe2, 0x31, 0xd7, 0x75, 0x38, 0x0f, 0x2d, 0x66, 0x36, 0x51, 0xe2, 0x13, 0xcc, 0x72, 0x66, + 0x60, 0xe2, 0xce, 0x0a, 0x2f, 0x2e, 0x9e, 0xe1, 0x2c, 0xbb, 0x7d, 0xf3, 0x22, 0x94, 0x10, 0x4a, + 0x8c], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x14, 0xaf, 0x19, 0x4c, 0x63, 0x50, 0x02, 0x36, 0xe5, 0x2c, 0xc2, 0x90, 0xab, 0x24, 0x24, 0x4f, + 0xab, 0x39, 0xa5, 0x20, 0xec, 0xe7, 0xe2, 0x0f, 0xa9, 0x3f, 0x4c, 0x9f, 0xf8, 0x0c, 0x66, 0x26] }, + { hash := .sha256, + prefixBytes := [0x01, 0x79, 0x66, 0xd2, 0xea, 0xd3, 0x44, 0x18, 0xdb, 0x2e, 0xaa, 0x04, 0xc0, 0xdf, 0xfb, 0x93, + 0x16, 0x80, 0x5e, 0x8a, 0x0d, 0x42, 0x1d, 0x12, 0x70, 0xc8, 0x95, 0x4c, 0x35, 0xee, 0x32, 0x21, + 0x38], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x72, 0x33, 0x9e, 0x20, 0xa4, 0x9b, 0xb1, 0x67, 0x95, 0xa9, 0x9b, 0xd9, 0x05, 0xb4, 0x7f, + 0x99, 0xc4, 0x5e, 0x5e, 0x5a, 0x9e, 0x6b, 0x7f, 0xb2, 0x23, 0xdc, 0x8f, 0xe6, 0x75, 0x1e, 0x1b, + 0xda], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x53, 0xdd, 0x1e, 0xcc, 0x25, 0xff, 0x90, 0x6a, 0x0e, 0xf4, 0xdb, 0x37, 0xee, 0x06, 0x8f, 0x3d, + 0x8a, 0xd6, 0xd1, 0xd4, 0x99, 0x13, 0xee, 0xfb, 0x84, 0x7a, 0x67, 0x5a, 0x68, 0x1c, 0x5f, 0xfa] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xde, 0x90, 0xf9, 0x95, 0x1a, 0x19, 0x49, 0x7b, 0xe7, 0xe3, 0x89, 0xe0, 0x2a, 0xa7, 0x9e, 0x26, + 0xfa, 0xf7, 0x70, 0x80, 0xe7, 0x40, 0xe8, 0x74, 0x32, 0x49, 0xa1, 0x7a, 0x53, 0x7f, 0x28, 0x7d] }, + { hash := .sha256, + prefixBytes := [0x01, 0xad, 0x4e, 0x53, 0xe9, 0x81, 0xaf, 0xc5, 0xa7, 0x1e, 0x34, 0xab, 0x0c, 0x4f, 0xfb, 0xcc, + 0xf1, 0xb4, 0x68, 0x41, 0x4d, 0x9d, 0x09, 0x39, 0xbd, 0x08, 0xed, 0xbd, 0x24, 0x61, 0xbc, 0x94, + 0x4a], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x9b, 0x4c, 0xf8, 0x9c, 0x39, 0x95, 0xb9, 0xdd, 0x66, 0xd5, 0x8a, 0xb0, 0x88, 0x84, 0x6b, 0x2c, + 0x6b, 0x59, 0xc5, 0x2c, 0x6d, 0x10, 0xec, 0x1d, 0x75, 0x9c, 0xa9, 0xe9, 0xaa, 0x5e, 0xef, 0x5c] }, + { hash := .sha256, + prefixBytes := [0x01, 0x39, 0x28, 0xa0, 0x78, 0xbd, 0x66, 0xab, 0x39, 0x49, 0xf5, 0xb1, 0x84, 0x6b, 0x6d, 0x35, + 0x4d, 0xbd, 0xc1, 0x96, 0x8a, 0x41, 0x66, 0x07, 0xc7, 0xd9, 0x15, 0x55, 0xca, 0x26, 0x71, 0x66, + 0x67], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xd2, 0xd8, 0x2c, 0xf8, 0x91, 0x5b, 0x9a, 0xe6, 0xf9, 0x2c, 0x7e, 0xae, 0x34, 0x3e, 0x37, 0xd3, + 0x12, 0xac, 0xe0, 0x5e, 0x65, 0x4c, 0xe4, 0x7a, 0xcd, 0xf5, 0x7d, 0x0a, 0x54, 0x90, 0xb8, 0x73] } + ] + +def tendermintExistMiddleRoot : Bytes := + [0x49, 0x4b, 0x16, 0xe3, 0xa6, 0x4a, 0x85, 0xdf, 0x14, 0x3b, 0x28, 0x81, 0xbd, 0xd3, 0xec, 0x94, + 0xc3, 0xf8, 0xe1, 0x8b, 0x34, 0x3e, 0x8f, 0xf9, 0xc2, 0xd6, 0x1a, 0xfd, 0x05, 0xd0, 0x40, 0xc8] + +def tendermintExistMiddleKey : Bytes := + [0x51, 0x33, 0x34, 0x65, 0x6d, 0x76, 0x6f, 0x39, 0x44, 0x71, 0x45, 0x58, 0x57, 0x35, 0x32, 0x52, + 0x57, 0x52, 0x38, 0x35] + +def tendermintExistMiddleValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x51, 0x33, 0x34, 0x65, 0x6d, 0x76, + 0x6f, 0x39, 0x44, 0x71, 0x45, 0x58, 0x57, 0x35, 0x32, 0x52, 0x57, 0x52, 0x38, 0x35] + +example : verifyExistence concreteHash tendermintExistMiddle tendermintSpec tendermintExistMiddleRoot + tendermintExistMiddleKey tendermintExistMiddleValue = true := by native_decide + +/-! ### `testdata/tendermint/nonexist_left.json` -/ + +def tendermintNonexistLeftR : ExistenceProof where + key := [0x30, 0x32, 0x61, 0x54, 0x65, 0x36, 0x64, 0x72, 0x48, 0x34, 0x56, 0x70, 0x6f, 0x4f, 0x58, 0x32, + 0x45, 0x50, 0x71, 0x37] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x30, 0x32, 0x61, 0x54, 0x65, 0x36, + 0x64, 0x72, 0x48, 0x34, 0x56, 0x70, 0x6f, 0x4f, 0x58, 0x32, 0x45, 0x50, 0x71, 0x37] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xb8, 0x43, 0x48, 0x14, 0x96, 0xdc, 0x10, 0x56, 0x10, 0x56, 0xb6, 0x3e, 0xc8, 0xf7, 0x26, 0xf3, + 0x35, 0x73, 0x95, 0xb6, 0x10, 0x35, 0x5b, 0x25, 0x08, 0x2f, 0x57, 0x68, 0xb2, 0x07, 0x3e, 0x91] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xd5, 0x28, 0x1f, 0xdd, 0x87, 0x20, 0x60, 0xe8, 0x91, 0x73, 0xd4, 0xde, 0x11, 0x00, 0xfa, 0x6c, + 0x96, 0xf7, 0x78, 0x46, 0x7d, 0xf6, 0x6a, 0xbb, 0x10, 0xcf, 0x3b, 0x1f, 0x58, 0x21, 0xf1, 0x82] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xeb, 0x98, 0x10, 0x20, 0x43, 0x3d, 0x92, 0x9c, 0x62, 0x75, 0xad, 0x77, 0x2a, 0xcc, 0xf2, 0xe6, + 0xaa, 0x91, 0x6d, 0xb9, 0x7e, 0x31, 0xd2, 0xf2, 0x6d, 0x0b, 0x6b, 0x07, 0xb4, 0x44, 0xbb, 0xef] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x4a, 0x40, 0xe8, 0x13, 0x13, 0x2a, 0xff, 0x60, 0xb6, 0x4b, 0xa9, 0xd1, 0x09, 0x54, 0x8a, 0xb3, + 0x94, 0x59, 0xad, 0x48, 0xa2, 0x03, 0xab, 0x8d, 0x34, 0x55, 0xdd, 0x84, 0x2a, 0x7a, 0xb1, 0xda] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x8f, 0x35, 0x4a, 0x84, 0xce, 0x14, 0x76, 0xe0, 0xb9, 0xcc, 0xa9, 0x2e, 0x65, 0x30, 0x1a, 0x64, + 0x35, 0xb1, 0xf2, 0x42, 0xc2, 0xf5, 0x3f, 0x94, 0x3b, 0x76, 0x4a, 0x4f, 0x32, 0x6a, 0x71, 0xc7] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xac, 0x64, 0x51, 0x61, 0x7a, 0x64, 0x06, 0x00, 0x50, 0x35, 0xdd, 0xda, 0xd3, 0x66, 0x57, 0xfd, + 0xe5, 0x31, 0x2c, 0xc4, 0xd6, 0x7d, 0x69, 0xca, 0x14, 0x64, 0x61, 0x18, 0x47, 0xc1, 0x0c, 0xfb] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x23, 0xc1, 0xd1, 0xdd, 0x62, 0x00, 0x2a, 0x0e, 0x2e, 0xfc, 0xc6, 0x79, 0x19, 0x65, 0x89, 0xa4, + 0x33, 0x72, 0x34, 0xdc, 0xd2, 0x09, 0xcb, 0x44, 0x9c, 0xc3, 0xac, 0x10, 0x77, 0x3b, 0x60, 0xe0] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x3b, 0x11, 0xc2, 0x67, 0x32, 0x8b, 0xa7, 0x61, 0xdd, 0xc6, 0x30, 0xdd, 0x5e, 0xf7, 0x64, 0x2a, + 0xed, 0xa0, 0x5f, 0x18, 0x05, 0x39, 0xfe, 0x93, 0xc0, 0xca, 0x57, 0x72, 0x97, 0x05, 0xbc, 0x46] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x5f, 0xf2, 0xe1, 0x93, 0x3b, 0xe7, 0x04, 0x53, 0x94, 0x63, 0xc2, 0x64, 0xb1, 0x57, 0xff, 0x2b, + 0x8d, 0x99, 0x60, 0x81, 0x3b, 0xd3, 0x6c, 0x69, 0xc5, 0x20, 0x8d, 0x57, 0xe3, 0xb1, 0xe0, 0x7e] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xc4, 0xa7, 0x9e, 0x6c, 0x0c, 0xbf, 0x60, 0xfb, 0x8e, 0x5b, 0xf9, 0x40, 0xdb, 0x4c, 0x44, 0x4b, + 0x7e, 0x44, 0x29, 0x51, 0xb6, 0x9c, 0x84, 0x0d, 0xb3, 0x8c, 0xf2, 0x8c, 0x8a, 0xa0, 0x08, 0xbe] } + ] + +def tendermintNonexistLeft : NonExistenceProof where + key := [0x01, 0x01, 0x01, 0x01] + left := none + right := some tendermintNonexistLeftR + +def tendermintNonexistLeftRoot : Bytes := + [0x4e, 0x2e, 0x78, 0xd2, 0xda, 0x50, 0x5b, 0x7d, 0x0b, 0x00, 0xfd, 0xa5, 0x5a, 0x4b, 0x04, 0x8e, + 0xed, 0x9a, 0x23, 0xa7, 0xf7, 0xfc, 0x3d, 0x80, 0x1f, 0x20, 0xce, 0x48, 0x51, 0xb4, 0x42, 0xaa] + +def tendermintNonexistLeftKey : Bytes := + [0x01, 0x01, 0x01, 0x01] + +example : verifyNonExistence concreteHash tendermintNonexistLeft tendermintSpec tendermintNonexistLeftRoot + tendermintNonexistLeftKey = true := by native_decide + +/-! ### `testdata/tendermint/nonexist_right.json` -/ + +def tendermintNonexistRightL : ExistenceProof where + key := [0x7a, 0x77, 0x4e, 0x4d, 0x4a, 0x45, 0x6f, 0x79, 0x32, 0x67, 0x42, 0x53, 0x58, 0x62, 0x77, 0x66, + 0x6e, 0x63, 0x50, 0x4a] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x7a, 0x77, 0x4e, 0x4d, 0x4a, 0x45, + 0x6f, 0x79, 0x32, 0x67, 0x42, 0x53, 0x58, 0x62, 0x77, 0x66, 0x6e, 0x63, 0x50, 0x4a] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0x78, 0xa2, 0x15, 0x35, 0x5c, 0x17, 0x37, 0x15, 0x83, 0x41, 0x8d, 0xf9, 0x57, 0x73, 0x47, + 0x6b, 0x34, 0x7a, 0x85, 0x3f, 0x6e, 0xae, 0x31, 0x76, 0x77, 0x72, 0x1e, 0x0c, 0x24, 0xe7, 0x8a, + 0xd2], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x5e, 0x2c, 0xf8, 0x93, 0xe7, 0xcd, 0x70, 0x25, 0x1e, 0xb4, 0xde, 0xbd, 0x85, 0x5c, 0x8c, + 0x9a, 0x92, 0xf6, 0xe0, 0xa1, 0xfd, 0x93, 0x1c, 0xf4, 0x1e, 0x05, 0x75, 0x84, 0x6a, 0xb1, 0x74, + 0xe8], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x41, 0x4b, 0xae, 0x88, 0x3f, 0x81, 0x33, 0xf0, 0x20, 0x1a, 0x27, 0x91, 0xda, 0xfe, 0xae, + 0xf3, 0xda, 0xa2, 0x4a, 0x66, 0x31, 0xb3, 0xf9, 0x40, 0x2d, 0xe3, 0xa4, 0xdc, 0x65, 0x8f, 0xd0, + 0x35], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x2e, 0x28, 0x29, 0xbe, 0xee, 0x26, 0x6a, 0x81, 0x4a, 0xf4, 0xdb, 0x08, 0x04, 0x6f, 0x45, + 0x75, 0xb0, 0x11, 0xe5, 0xec, 0x9d, 0x2d, 0x93, 0xc1, 0x51, 0x0c, 0x3c, 0xc7, 0xd8, 0x21, 0x9e, + 0xdc], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xf8, 0x28, 0x65, 0x97, 0x07, 0x84, 0x91, 0xae, 0x0e, 0xf6, 0x12, 0x64, 0xc2, 0x18, 0xc6, + 0xe1, 0x67, 0xe4, 0xe0, 0x3f, 0x1d, 0xe4, 0x79, 0x45, 0xd9, 0xba, 0x75, 0xbb, 0x41, 0xde, 0xb8, + 0x1a], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xde, 0xa6, 0xa5, 0x30, 0x98, 0xd1, 0x1c, 0xe2, 0x13, 0x8c, 0xbc, 0xae, 0x26, 0xb3, 0x92, + 0x95, 0x9f, 0x05, 0xd7, 0xe1, 0xe2, 0x4b, 0x95, 0x47, 0x58, 0x45, 0x71, 0x01, 0x22, 0x80, 0xf2, + 0x89], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x0a, 0x8e, 0x53, 0x50, 0x94, 0xd1, 0x8b, 0x21, 0x20, 0xc3, 0x84, 0x54, 0xb4, 0x45, 0xd9, + 0xac, 0xcf, 0x3f, 0x1b, 0x25, 0x56, 0x90, 0xe6, 0xf3, 0xd4, 0x81, 0x64, 0xae, 0x73, 0xb4, 0xc7, + 0x75], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x2c, 0xbb, 0x51, 0x8f, 0x52, 0xec, 0x1f, 0x8e, 0x26, 0xdd, 0x36, 0x58, 0x7f, 0x29, 0xa6, + 0x89, 0x0a, 0x11, 0xc0, 0xdd, 0x3f, 0x94, 0xe7, 0xa2, 0x85, 0x46, 0xe6, 0x95, 0xf2, 0x96, 0xd3, + 0xa7], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x83, 0x9d, 0x9d, 0xdd, 0x9d, 0xad, 0xf4, 0x1c, 0x0e, 0xcf, 0xc3, 0xf7, 0xe2, 0x0f, 0x57, + 0x83, 0x3b, 0x8f, 0xb5, 0xbc, 0xb7, 0x03, 0xbe, 0xf4, 0xf9, 0x79, 0x10, 0xbb, 0xe5, 0xb5, 0x79, + 0xb9], + suffix := [] } + ] + +def tendermintNonexistRight : NonExistenceProof where + key := [0xff, 0xff, 0xff, 0xff] + left := some tendermintNonexistRightL + right := none + +def tendermintNonexistRightRoot : Bytes := + [0x83, 0x95, 0x2b, 0x0b, 0x17, 0xe6, 0x4c, 0x86, 0x26, 0x28, 0xbc, 0xc1, 0x27, 0x7e, 0x7f, 0x88, + 0x47, 0x58, 0x9a, 0xf7, 0x94, 0xed, 0x5a, 0x85, 0x53, 0x39, 0x28, 0x1d, 0x39, 0x5e, 0xc0, 0x4f] + +def tendermintNonexistRightKey : Bytes := + [0xff, 0xff, 0xff, 0xff] + +example : verifyNonExistence concreteHash tendermintNonexistRight tendermintSpec tendermintNonexistRightRoot + tendermintNonexistRightKey = true := by native_decide + +/-! ### `testdata/tendermint/nonexist_middle.json` -/ + +def tendermintNonexistMiddleL : ExistenceProof where + key := [0x54, 0x4f, 0x31, 0x48, 0x36, 0x68, 0x78, 0x4a, 0x4b, 0x66, 0x71, 0x36, 0x54, 0x7a, 0x56, 0x76, + 0x76, 0x49, 0x77, 0x47] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x54, 0x4f, 0x31, 0x48, 0x36, 0x68, + 0x78, 0x4a, 0x4b, 0x66, 0x71, 0x36, 0x54, 0x7a, 0x56, 0x76, 0x76, 0x49, 0x77, 0x47] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0x43, 0xe1, 0x9c, 0xb5, 0xe5, 0xda, 0xb0, 0x17, 0x73, 0x4c, 0xaa, 0x78, 0xa2, 0xe2, 0xbc, + 0xcb, 0xb4, 0x79, 0x7b, 0x7d, 0xc5, 0xa9, 0x1a, 0xbe, 0xab, 0x63, 0x0c, 0x66, 0xfa, 0x6b, 0x16, + 0x25], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xb5, 0x75, 0x40, 0x4a, 0x1b, 0xb4, 0x2b, 0x0f, 0xef, 0x8a, 0xe7, 0xf2, 0x17, 0xaf, 0x88, + 0xae, 0xc7, 0x69, 0xf7, 0xd6, 0x6b, 0x5b, 0xc4, 0xb2, 0x91, 0x3e, 0x74, 0xd6, 0x51, 0x36, 0x54, + 0x73], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x7c, 0x22, 0xdc, 0x50, 0xe8, 0x66, 0xf9, 0xa1, 0xdc, 0xe5, 0x17, 0xea, 0x01, 0x62, 0x11, + 0x61, 0xce, 0xcd, 0x70, 0xf4, 0xbd, 0xcd, 0x02, 0x4b, 0x5a, 0x39, 0x27, 0x46, 0xa1, 0xc8, 0xdc, + 0x26], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x57, 0x81, 0x05, 0x34, 0x4f, 0x2c, 0x98, 0xc3, 0x23, 0xba, 0x0b, 0x8c, 0xa3, 0x1e, 0x75, + 0xaa, 0xa2, 0xb8, 0x65, 0xcc, 0x38, 0x96, 0x81, 0xe3, 0x00, 0xb1, 0x4d, 0x1c, 0x20, 0x71, 0x37, + 0x96], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x89, 0x5c, 0x07, 0x0c, 0x14, 0x54, 0x6e, 0xce, 0xf7, 0xf5, 0xcb, 0x3a, 0x4b, 0xda, 0x1f, 0xd4, + 0x36, 0xa0, 0xff, 0x99, 0x19, 0x0f, 0x90, 0xbd, 0x03, 0x7c, 0xbe, 0xaf, 0x52, 0xb2, 0xff, 0xc1] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xf7, 0x57, 0x1f, 0xca, 0x06, 0xac, 0x43, 0x87, 0xc3, 0xea, 0xe5, 0x46, 0x9c, 0x15, 0x24, 0x27, + 0xb7, 0x97, 0xab, 0xb5, 0x5f, 0xa9, 0x87, 0x27, 0xea, 0xcb, 0xd5, 0xc1, 0xc9, 0x1b, 0x5f, 0xb4] }, + { hash := .sha256, + prefixBytes := [0x01, 0x50, 0x56, 0xe6, 0x47, 0x2f, 0x8e, 0x5c, 0x5c, 0x9b, 0x88, 0x81, 0xc5, 0xf0, 0xe4, 0x96, + 0x01, 0xe9, 0xec, 0xa3, 0x1f, 0x3e, 0x17, 0x66, 0xaa, 0x69, 0xc2, 0xdc, 0x9c, 0x6d, 0x91, 0x12, + 0xbe], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x6c, 0x74, 0x43, 0x95, 0x56, 0xc5, 0xed, 0xb5, 0xaa, 0x69, 0x3a, 0xf4, 0x10, 0xd3, 0x71, 0x8d, + 0xbb, 0x61, 0x3d, 0x37, 0x79, 0x9f, 0x2f, 0x4e, 0x8f, 0xf3, 0x04, 0xa8, 0xbf, 0xe3, 0x35, 0x1b] }, + { hash := .sha256, + prefixBytes := [0x01, 0x25, 0x30, 0x14, 0x33, 0x4c, 0x7b, 0x8c, 0xd7, 0x84, 0x36, 0x97, 0x95, 0x54, 0xf7, 0x89, + 0x0f, 0x3d, 0xc1, 0xc9, 0x71, 0x92, 0x5e, 0xa3, 0x1b, 0x48, 0xfc, 0x72, 0x9c, 0xd1, 0x79, 0xc7, + 0x01], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xb8, 0x1c, 0x19, 0xad, 0x4b, 0x5d, 0x8d, 0x15, 0xf7, 0x16, 0xb9, 0x15, 0x19, 0xbf, 0x7a, 0xd3, + 0xd6, 0xe2, 0x28, 0x9f, 0x90, 0x61, 0xfd, 0x25, 0x92, 0xa8, 0x43, 0x1e, 0xa9, 0x78, 0x06, 0xfe] } + ] + +def tendermintNonexistMiddleR : ExistenceProof where + key := [0x54, 0x4f, 0x43, 0x33, 0x44, 0x68, 0x31, 0x50, 0x66, 0x4f, 0x76, 0x65, 0x75, 0x38, 0x58, 0x51, + 0x66, 0x63, 0x57, 0x78] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x54, 0x4f, 0x43, 0x33, 0x44, 0x68, + 0x31, 0x50, 0x66, 0x4f, 0x76, 0x65, 0x75, 0x38, 0x58, 0x51, 0x66, 0x63, 0x57, 0x78] + leaf := + { hash := .sha256, prehashKey := .noHash, prehashValue := .sha256, + length := .varProto, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x41, 0x5d, 0x4c, 0xfa, 0xed, 0x0b, 0xfc, 0x98, 0xac, 0x32, 0xac, 0xc2, 0x19, 0xa8, 0x51, 0x7b, + 0xfa, 0x19, 0x83, 0xa1, 0x5c, 0xc7, 0x42, 0xe8, 0xb2, 0xf8, 0x60, 0x16, 0x74, 0x84, 0xbd, 0x46] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x98, 0xd8, 0x53, 0xd9, 0xcc, 0x0e, 0xe1, 0xd2, 0x16, 0x25, 0x27, 0xf6, 0x60, 0xf2, 0xb9, 0x0a, + 0xb5, 0x5b, 0x13, 0xe5, 0x53, 0x4f, 0x1b, 0x77, 0x53, 0xec, 0x48, 0x1d, 0x79, 0x01, 0xd3, 0xec] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xb5, 0x11, 0x3e, 0x60, 0x00, 0xc5, 0x41, 0x1b, 0x7c, 0xfa, 0x6f, 0xd0, 0x9b, 0x67, 0x52, 0xa4, + 0x3d, 0xe0, 0xfc, 0xd3, 0x95, 0x1e, 0xd3, 0xb1, 0x54, 0xd1, 0x62, 0xde, 0xb5, 0x32, 0x24, 0xa2] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x8c, 0xe1, 0x8c, 0xd7, 0x2c, 0xc8, 0x35, 0x11, 0xcb, 0x8f, 0xf7, 0x06, 0x43, 0x3f, 0x2f, 0xa4, + 0x20, 0x8c, 0x85, 0xb9, 0xf4, 0xc8, 0xd0, 0xed, 0x71, 0xa6, 0x14, 0xf2, 0x4b, 0x89, 0xae, 0x6c] }, + { hash := .sha256, + prefixBytes := [0x01, 0xc6, 0x11, 0x24, 0x4f, 0xe6, 0xb5, 0xfd, 0xa4, 0x25, 0x76, 0x15, 0x90, 0x2e, 0xb2, 0x4c, + 0x14, 0xef, 0xcd, 0x97, 0x08, 0xc7, 0xc8, 0x75, 0xd1, 0xac, 0x5e, 0x86, 0x77, 0x67, 0xaa, 0x1e, + 0xab], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xf7, 0x57, 0x1f, 0xca, 0x06, 0xac, 0x43, 0x87, 0xc3, 0xea, 0xe5, 0x46, 0x9c, 0x15, 0x24, 0x27, + 0xb7, 0x97, 0xab, 0xb5, 0x5f, 0xa9, 0x87, 0x27, 0xea, 0xcb, 0xd5, 0xc1, 0xc9, 0x1b, 0x5f, 0xb4] }, + { hash := .sha256, + prefixBytes := [0x01, 0x50, 0x56, 0xe6, 0x47, 0x2f, 0x8e, 0x5c, 0x5c, 0x9b, 0x88, 0x81, 0xc5, 0xf0, 0xe4, 0x96, + 0x01, 0xe9, 0xec, 0xa3, 0x1f, 0x3e, 0x17, 0x66, 0xaa, 0x69, 0xc2, 0xdc, 0x9c, 0x6d, 0x91, 0x12, + 0xbe], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x6c, 0x74, 0x43, 0x95, 0x56, 0xc5, 0xed, 0xb5, 0xaa, 0x69, 0x3a, 0xf4, 0x10, 0xd3, 0x71, 0x8d, + 0xbb, 0x61, 0x3d, 0x37, 0x79, 0x9f, 0x2f, 0x4e, 0x8f, 0xf3, 0x04, 0xa8, 0xbf, 0xe3, 0x35, 0x1b] }, + { hash := .sha256, + prefixBytes := [0x01, 0x25, 0x30, 0x14, 0x33, 0x4c, 0x7b, 0x8c, 0xd7, 0x84, 0x36, 0x97, 0x95, 0x54, 0xf7, 0x89, + 0x0f, 0x3d, 0xc1, 0xc9, 0x71, 0x92, 0x5e, 0xa3, 0x1b, 0x48, 0xfc, 0x72, 0x9c, 0xd1, 0x79, 0xc7, + 0x01], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xb8, 0x1c, 0x19, 0xad, 0x4b, 0x5d, 0x8d, 0x15, 0xf7, 0x16, 0xb9, 0x15, 0x19, 0xbf, 0x7a, 0xd3, + 0xd6, 0xe2, 0x28, 0x9f, 0x90, 0x61, 0xfd, 0x25, 0x92, 0xa8, 0x43, 0x1e, 0xa9, 0x78, 0x06, 0xfe] } + ] + +def tendermintNonexistMiddle : NonExistenceProof where + key := [0x54, 0x4f, 0x31, 0x48, 0x36, 0x68, 0x78, 0x4a, 0x4b, 0x66, 0x71, 0x36, 0x54, 0x7a, 0x56, 0x76, + 0x76, 0x49, 0xff, 0xff] + left := some tendermintNonexistMiddleL + right := some tendermintNonexistMiddleR + +def tendermintNonexistMiddleRoot : Bytes := + [0x4b, 0xf2, 0x8d, 0x94, 0x85, 0x66, 0x07, 0x8c, 0x5e, 0xbf, 0xa8, 0x6d, 0xb7, 0x47, 0x1c, 0x15, + 0x41, 0xea, 0xb8, 0x34, 0xf5, 0x39, 0x03, 0x70, 0x75, 0xb9, 0xf9, 0xe3, 0xb1, 0xc7, 0x2c, 0xfc] + +def tendermintNonexistMiddleKey : Bytes := + [0x54, 0x4f, 0x31, 0x48, 0x36, 0x68, 0x78, 0x4a, 0x4b, 0x66, 0x71, 0x36, 0x54, 0x7a, 0x56, 0x76, + 0x76, 0x49, 0xff, 0xff] + +example : verifyNonExistence concreteHash tendermintNonexistMiddle tendermintSpec tendermintNonexistMiddleRoot + tendermintNonexistMiddleKey = true := by native_decide + +/-! ### `testdata/smt/exist_left.json` -/ + +def smtExistLeft : ExistenceProof where + key := [0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, + 0x37, 0x6d, 0x64, 0x45] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, + 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, 0x37, 0x6d, 0x64, 0x45] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xbc, 0x79, 0xee, 0x59, 0xa6, 0x0c, 0x4f, 0x08, 0xcc, 0x02, 0x16, 0xa5, 0xf6, 0x4d, 0x39, 0xf8, + 0x71, 0xcd, 0x73, 0x0b, 0x69, 0x83, 0x07, 0x94, 0x29, 0xe9, 0x1d, 0x9b, 0xcd, 0x57, 0xd4, 0x70] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x67, 0x32, 0xb1, 0xea, 0xa2, 0xcf, 0x07, 0xfb, 0xc9, 0x45, 0x99, 0xae, 0xcc, 0x2d, 0xf0, 0x57, + 0xd8, 0xef, 0xb0, 0xcc, 0xd7, 0x75, 0xd8, 0x6b, 0x6e, 0xa1, 0x76, 0xbf, 0xaa, 0xd3, 0x67, 0xad] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x31, 0x12, 0xff, 0xea, 0x61, 0x1a, 0x3e, 0xf0, 0x30, 0xf5, 0xed, 0x8d, 0xaf, 0xb8, 0xbc, 0xaf, + 0x8e, 0x33, 0xbe, 0xc1, 0x6f, 0xff, 0x90, 0x27, 0xb1, 0xa0, 0xc7, 0x18, 0x13, 0x6d, 0xe2, 0xd3] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x48, 0x09, 0x83, 0xa2, 0x54, 0x1b, 0x55, 0x27, 0xe1, 0xb5, 0x60, 0x7e, 0x32, 0xf0, 0x59, 0x7b, + 0x12, 0x20, 0x4d, 0x49, 0x73, 0xb5, 0xd9, 0xb4, 0x98, 0xd1, 0xff, 0x2a, 0x23, 0x50, 0x35, 0x2b] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x97, 0x05, 0x8f, 0x1b, 0xf5, 0x0e, 0x2b, 0x47, 0xad, 0x12, 0x9f, 0xda, 0xf2, 0xdf, 0xd5, 0x3f, + 0x88, 0xf8, 0x14, 0x67, 0xda, 0xd5, 0x4d, 0xab, 0xfc, 0xf0, 0xfb, 0xe8, 0x33, 0x0c, 0x4e, 0x4c] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x08, 0xf6, 0xf1, 0xe4, 0x59, 0x58, 0xb4, 0x78, 0x0e, 0x1e, 0x0f, 0x77, 0x91, 0x31, 0x5d, 0x44, + 0x35, 0x5e, 0xba, 0x4e, 0x51, 0x9e, 0x2f, 0xb2, 0x5c, 0x3d, 0xc4, 0x86, 0x27, 0xa5, 0x9a, 0x45] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xbb, 0x4f, 0x60, 0x7c, 0xb6, 0x2f, 0x20, 0xe6, 0x73, 0xfd, 0xfa, 0xd3, 0xe4, 0x0a, 0x8b, 0x59, + 0x6d, 0xb5, 0x0d, 0xc7, 0xc3, 0x4e, 0x65, 0xab, 0xa7, 0x4e, 0xec, 0x37, 0xf7, 0x91, 0xe8, 0x86] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xfe, 0x97, 0xc3, 0x21, 0x1b, 0x6a, 0x7e, 0xb3, 0xd8, 0x59, 0xe7, 0x54, 0xb3, 0x73, 0xe8, 0x98, + 0x97, 0xa5, 0x4f, 0x74, 0x24, 0x4f, 0x0a, 0x84, 0xde, 0xfc, 0x1d, 0xf2, 0xa2, 0x03, 0xdf, 0xd8] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x2c, 0xab, 0x93, 0xbf, 0x9b, 0x91, 0xd2, 0x50, 0x10, 0x97, 0x29, 0x68, 0xd6, 0x9b, 0x47, 0xca, + 0x9d, 0xfd, 0x5b, 0x4c, 0xea, 0x0c, 0x71, 0x31, 0x0e, 0x0a, 0xdc, 0xed, 0x33, 0xac, 0xb1, 0x9d] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x69, 0xca, 0x51, 0x9f, 0x1f, 0x25, 0x28, 0xc9, 0x71, 0xa9, 0x30, 0xcd, 0xd0, 0x0b, 0x65, 0xc4, + 0x17, 0x62, 0xe8, 0x51, 0x0c, 0xe3, 0xd4, 0xa9, 0x98, 0xd4, 0xad, 0x8c, 0xcf, 0x59, 0x89, 0x84] } + ] + +def smtExistLeftRoot : Bytes := + [0x43, 0x2d, 0x73, 0xb4, 0x90, 0x19, 0xd8, 0xdf, 0x5c, 0x7e, 0x38, 0xfd, 0x93, 0x28, 0x8d, 0x02, + 0x40, 0xa6, 0x2a, 0x3c, 0x01, 0x0e, 0x72, 0x17, 0xa4, 0xa7, 0x4f, 0x58, 0x85, 0xc3, 0x91, 0xd5] + +def smtExistLeftKey : Bytes := + [0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, + 0x37, 0x6d, 0x64, 0x45] + +def smtExistLeftValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, + 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, 0x37, 0x6d, 0x64, 0x45] + +example : verifyExistence concreteHash smtExistLeft smtSpec smtExistLeftRoot + smtExistLeftKey smtExistLeftValue = true := by native_decide + +/-! ### `testdata/smt/exist_right.json` -/ + +def smtExistRight : ExistenceProof where + key := [0x79, 0x6c, 0x52, 0x70, 0x43, 0x56, 0x71, 0x31, 0x62, 0x70, 0x6b, 0x45, 0x75, 0x78, 0x6b, 0x52, + 0x6b, 0x68, 0x64, 0x4f] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x79, 0x6c, 0x52, 0x70, 0x43, 0x56, + 0x71, 0x31, 0x62, 0x70, 0x6b, 0x45, 0x75, 0x78, 0x6b, 0x52, 0x6b, 0x68, 0x64, 0x4f] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0x3a, 0xe2, 0xd9, 0x0a, 0x11, 0x8d, 0xd6, 0xf8, 0xa4, 0x2f, 0x40, 0x06, 0x81, 0x7e, 0x77, + 0x7f, 0x22, 0x54, 0x0e, 0x92, 0x1d, 0xf1, 0xd9, 0x7e, 0xd3, 0x34, 0xa8, 0xb9, 0xde, 0x92, 0xc6, + 0xcd], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x56, 0xa6, 0x2a, 0x01, 0x5a, 0x84, 0xaf, 0x9a, 0x33, 0xca, 0x71, 0x6f, 0x52, 0xed, 0x41, + 0x43, 0x82, 0xbe, 0xd2, 0x7a, 0x70, 0xb0, 0x03, 0x91, 0xf1, 0x5a, 0x54, 0x71, 0xf9, 0x44, 0x43, + 0xd3], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x44, 0xc4, 0x8b, 0xf2, 0xa8, 0x02, 0x19, 0x5f, 0xba, 0x51, 0x64, 0xa7, 0xa6, 0xc1, 0x71, + 0xa9, 0xaf, 0x7a, 0x11, 0x4c, 0x78, 0x80, 0x13, 0x61, 0x08, 0xa5, 0x54, 0x4d, 0x82, 0xfb, 0xac, + 0xba], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xc0, 0xbd, 0xa8, 0x82, 0x2a, 0x88, 0x1b, 0x6a, 0x6a, 0x1d, 0xc5, 0x01, 0x6b, 0xb0, 0x62, + 0xa9, 0xdd, 0x43, 0x4e, 0xe3, 0xfe, 0x1c, 0x9b, 0xfb, 0x5b, 0xc0, 0x24, 0x7b, 0xd6, 0xae, 0xb5, + 0xb4], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x38, 0xcb, 0x0f, 0x6e, 0xf9, 0x07, 0xa1, 0x79, 0xa5, 0x30, 0xfb, 0xa8, 0x48, 0xba, 0xe9, + 0x54, 0x7b, 0xcc, 0x37, 0xb9, 0x20, 0x7a, 0xea, 0xd6, 0xf7, 0xef, 0x44, 0x06, 0x49, 0x00, 0x38, + 0x6c], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x08, 0xf1, 0x20, 0xd8, 0x4f, 0xa1, 0xd8, 0xb2, 0xe7, 0xcc, 0x08, 0x06, 0x73, 0xb3, 0x82, + 0xcb, 0x29, 0x16, 0x9d, 0xd6, 0xe9, 0x54, 0xb0, 0x90, 0xf9, 0xcb, 0x7a, 0x25, 0x19, 0x5d, 0x59, + 0xa4], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xad, 0x47, 0x6a, 0x12, 0x3e, 0x0e, 0x8f, 0xbb, 0xbd, 0x4a, 0x22, 0x5e, 0x29, 0xb1, 0x93, + 0xaf, 0x4a, 0xe6, 0x46, 0x00, 0xcc, 0xba, 0x4c, 0xc3, 0x79, 0x22, 0xfc, 0x5d, 0x09, 0x15, 0x99, + 0x63], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x3a, 0xd5, 0x2a, 0x70, 0x5d, 0x9b, 0x92, 0x3d, 0xd0, 0x70, 0x47, 0xae, 0xa6, 0xad, 0x1b, + 0xc1, 0x32, 0x7e, 0x75, 0x57, 0x21, 0x0c, 0x77, 0xcf, 0x06, 0xbc, 0xab, 0x78, 0x33, 0xae, 0x31, + 0x36], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xc3, 0xa4, 0x0a, 0xc7, 0xab, 0x7c, 0x6c, 0xd3, 0xf2, 0x67, 0x98, 0x1d, 0xcd, 0x75, 0x15, + 0x80, 0x53, 0xdc, 0xad, 0x70, 0x0a, 0xf4, 0x23, 0xac, 0x05, 0x41, 0xac, 0x0d, 0x31, 0x5b, 0x4e, + 0x7b], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x71, 0x76, 0xac, 0xbe, 0x69, 0x27, 0xc4, 0x79, 0x7f, 0x9e, 0x04, 0x56, 0xb7, 0x07, 0x38, + 0x02, 0xad, 0x01, 0x5f, 0xa8, 0xa9, 0x15, 0x71, 0x2e, 0x87, 0xb2, 0x28, 0x30, 0xb7, 0x2a, 0x1f, + 0x94], + suffix := [] } + ] + +def smtExistRightRoot : Bytes := + [0x61, 0x77, 0x83, 0x6a, 0xc5, 0x20, 0x80, 0x8d, 0xf6, 0x7b, 0xc4, 0x02, 0xae, 0x76, 0x38, 0x22, + 0x82, 0xf4, 0xf0, 0x7a, 0x52, 0x6a, 0x2a, 0xc2, 0x5c, 0x40, 0x9c, 0xf0, 0x38, 0x0c, 0xad, 0x97] + +def smtExistRightKey : Bytes := + [0x79, 0x6c, 0x52, 0x70, 0x43, 0x56, 0x71, 0x31, 0x62, 0x70, 0x6b, 0x45, 0x75, 0x78, 0x6b, 0x52, + 0x6b, 0x68, 0x64, 0x4f] + +def smtExistRightValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x79, 0x6c, 0x52, 0x70, 0x43, 0x56, + 0x71, 0x31, 0x62, 0x70, 0x6b, 0x45, 0x75, 0x78, 0x6b, 0x52, 0x6b, 0x68, 0x64, 0x4f] + +example : verifyExistence concreteHash smtExistRight smtSpec smtExistRightRoot + smtExistRightKey smtExistRightValue = true := by native_decide + +/-! ### `testdata/smt/exist_middle.json` -/ + +def smtExistMiddle : ExistenceProof where + key := [0x46, 0x4a, 0x54, 0x4d, 0x75, 0x78, 0x7a, 0x57, 0x58, 0x73, 0x71, 0x34, 0x70, 0x43, 0x6c, 0x46, + 0x50, 0x6e, 0x6b, 0x48] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x46, 0x4a, 0x54, 0x4d, 0x75, 0x78, + 0x7a, 0x57, 0x58, 0x73, 0x71, 0x34, 0x70, 0x43, 0x6c, 0x46, 0x50, 0x6e, 0x6b, 0x48] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0xc6, 0x07, 0xdf, 0xf7, 0x2d, 0x77, 0x49, 0x6a, 0x80, 0x88, 0xf5, 0x8c, 0x88, 0x6a, 0x59, + 0xe2, 0xc2, 0xe1, 0x15, 0xc1, 0x86, 0x88, 0xc1, 0xea, 0x21, 0x00, 0x7f, 0xa8, 0xa9, 0xc8, 0x84, + 0xda], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x52, 0x49, 0x1d, 0xba, 0x09, 0x42, 0x31, 0x18, 0x8b, 0x89, 0x3d, 0x16, 0xb0, 0xb0, 0x8a, + 0xd2, 0x52, 0x46, 0xd5, 0x14, 0x7a, 0x7a, 0x62, 0x14, 0x91, 0x86, 0x51, 0x87, 0x12, 0x61, 0x80, + 0x54], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00] }, + { hash := .sha256, + prefixBytes := [0x01, 0xe3, 0xa8, 0x5f, 0xeb, 0xd8, 0x96, 0xe1, 0x93, 0xb7, 0xba, 0x37, 0xbc, 0x63, 0x8c, 0x46, + 0xd6, 0x95, 0x30, 0xde, 0x82, 0x06, 0x47, 0xfc, 0xcb, 0x40, 0xda, 0x85, 0x83, 0x47, 0x3c, 0x8f, + 0xeb], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x4b, 0xaf, 0x41, 0xd8, 0x5d, 0xc3, 0x99, 0xf4, 0x06, 0xed, 0xbe, 0x43, 0x74, 0xe6, 0xb7, + 0x67, 0x66, 0x3e, 0x46, 0x80, 0xfe, 0xe2, 0x17, 0xbf, 0xbc, 0xa8, 0x89, 0x61, 0x8b, 0x7a, 0x83, + 0xdc], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x4e, 0xd1, 0x21, 0xef, 0x20, 0xf0, 0xe1, 0xd6, 0x5a, 0x8a, 0x5e, 0x7d, 0x9e, 0xd8, 0x68, 0x44, + 0xde, 0x0b, 0xfd, 0x82, 0x62, 0x1f, 0x33, 0x25, 0xf6, 0x0e, 0xb8, 0x72, 0xe9, 0xe7, 0x38, 0xea] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xa7, 0xcd, 0x5e, 0x87, 0xf5, 0x43, 0x53, 0xe0, 0xb8, 0xd3, 0x69, 0x01, 0xba, 0x17, 0x5d, 0xaf, + 0x7c, 0x00, 0xff, 0x05, 0xc0, 0x01, 0x83, 0xf5, 0x22, 0xe9, 0x48, 0x50, 0xa3, 0x9a, 0xc4, 0xce] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x5a, 0x92, 0x7f, 0xe7, 0x00, 0xb5, 0xfe, 0xac, 0xbf, 0x30, 0xa7, 0xcd, 0x16, 0x05, 0x33, 0xe3, + 0x26, 0xc5, 0x13, 0xee, 0xdc, 0x8e, 0x1d, 0x00, 0x0c, 0xd8, 0xa7, 0x1a, 0xbd, 0x84, 0x80, 0xf5] }, + { hash := .sha256, + prefixBytes := [0x01, 0xd9, 0x42, 0x3c, 0x60, 0x94, 0x19, 0x97, 0xd2, 0x07, 0x8a, 0xbd, 0x89, 0x7d, 0x53, 0xf0, + 0x9c, 0xb4, 0xa8, 0x44, 0xc6, 0x84, 0xbc, 0x6a, 0x38, 0x14, 0x0c, 0x04, 0xd6, 0x86, 0x98, 0x09, + 0xde], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xb1, 0xde, 0x51, 0xac, 0x7a, 0xbc, 0x0e, 0x0e, 0x5b, 0xc6, 0x95, 0x5c, 0x42, 0x23, 0x22, + 0x8d, 0x16, 0xab, 0xa8, 0xcd, 0xb6, 0xe5, 0x9b, 0xfd, 0x11, 0x1d, 0x09, 0x01, 0x59, 0x5b, 0xc3, + 0x2b], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xed, 0xbb, 0xd2, 0x2b, 0x09, 0x3f, 0x48, 0x40, 0x4d, 0x08, 0x24, 0x48, 0xbd, 0x33, 0x50, + 0x28, 0x47, 0x7d, 0x70, 0x0b, 0x44, 0x94, 0x50, 0xb6, 0x80, 0x07, 0x08, 0x09, 0x5f, 0x78, 0xb9, + 0xd6], + suffix := [] } + ] + +def smtExistMiddleRoot : Bytes := + [0xd3, 0x2d, 0xd0, 0x67, 0x14, 0xf3, 0xce, 0xe1, 0x10, 0xcd, 0xb3, 0x7a, 0xd7, 0xbc, 0x47, 0x60, + 0xd4, 0xe2, 0x91, 0xa5, 0x55, 0x16, 0x0f, 0x54, 0x42, 0x9f, 0x9f, 0x15, 0xdd, 0xb0, 0x4c, 0x4d] + +def smtExistMiddleKey : Bytes := + [0x46, 0x4a, 0x54, 0x4d, 0x75, 0x78, 0x7a, 0x57, 0x58, 0x73, 0x71, 0x34, 0x70, 0x43, 0x6c, 0x46, + 0x50, 0x6e, 0x6b, 0x48] + +def smtExistMiddleValue : Bytes := + [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x46, 0x4a, 0x54, 0x4d, 0x75, 0x78, + 0x7a, 0x57, 0x58, 0x73, 0x71, 0x34, 0x70, 0x43, 0x6c, 0x46, 0x50, 0x6e, 0x6b, 0x48] + +example : verifyExistence concreteHash smtExistMiddle smtSpec smtExistMiddleRoot + smtExistMiddleKey smtExistMiddleValue = true := by native_decide + +/-! ### `testdata/smt/nonexist_left.json` -/ + +def smtNonexistLeftR : ExistenceProof where + key := [0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, + 0x37, 0x6d, 0x64, 0x45] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x44, 0x45, 0x68, 0x7a, 0x30, 0x61, + 0x35, 0x76, 0x35, 0x50, 0x36, 0x61, 0x65, 0x36, 0x51, 0x4c, 0x37, 0x6d, 0x64, 0x45] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x5a, 0xa5, 0xf2, 0x40, 0x07, 0x1f, 0x19, 0x6e, 0x8d, 0x21, 0xe3, 0x8b, 0x3f, 0xa6, 0xe9, 0x42, + 0xd5, 0xc5, 0x29, 0xcd, 0x5f, 0xa0, 0xee, 0xc8, 0x56, 0x07, 0xba, 0x8c, 0xd8, 0xe3, 0x79, 0x85] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x67, 0x32, 0xb1, 0xea, 0xa2, 0xcf, 0x07, 0xfb, 0xc9, 0x45, 0x99, 0xae, 0xcc, 0x2d, 0xf0, 0x57, + 0xd8, 0xef, 0xb0, 0xcc, 0xd7, 0x75, 0xd8, 0x6b, 0x6e, 0xa1, 0x76, 0xbf, 0xaa, 0xd3, 0x67, 0xad] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x07, 0x4e, 0x19, 0xb2, 0xce, 0x98, 0x87, 0xb1, 0x88, 0xca, 0xbd, 0x61, 0xf0, 0xaf, 0x10, 0xd6, + 0x99, 0xc2, 0x06, 0xd4, 0xee, 0xe9, 0xc5, 0xe9, 0x14, 0xbc, 0xfe, 0xa5, 0x96, 0x04, 0x39, 0xf8] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x8c, 0x80, 0x12, 0xca, 0x45, 0x5d, 0x57, 0x13, 0x5b, 0xea, 0x30, 0x5a, 0xd1, 0x08, 0x0c, 0xc0, + 0xa9, 0xd8, 0xde, 0xc0, 0x78, 0xa7, 0x81, 0x37, 0x36, 0xff, 0x87, 0x1b, 0x40, 0x70, 0x8a, 0x72] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x0c, 0x70, 0x64, 0x9c, 0x4e, 0xa1, 0x5d, 0xe4, 0xa2, 0xf2, 0x08, 0x7a, 0x34, 0x0f, 0xa9, 0x3a, + 0xdb, 0x88, 0x0f, 0x85, 0x1d, 0x54, 0x65, 0x48, 0x13, 0x49, 0x80, 0x33, 0x15, 0x20, 0x1e, 0xcd] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xca, 0x5d, 0x1f, 0x4e, 0xe1, 0x91, 0x72, 0xaf, 0x78, 0xff, 0x61, 0xc1, 0x13, 0x33, 0x62, 0x92, + 0xc1, 0x1c, 0x89, 0x88, 0x4e, 0xad, 0x5b, 0x54, 0x1f, 0x54, 0xcc, 0x53, 0x44, 0x9e, 0x2e, 0xdf] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x91, 0xa2, 0x6f, 0x99, 0xa2, 0x85, 0x2c, 0x72, 0xdd, 0x4a, 0x15, 0xc6, 0xb0, 0x44, 0x44, 0x21, + 0xa6, 0xd0, 0x33, 0xf7, 0xf5, 0x70, 0xf1, 0x0c, 0x8c, 0x56, 0x4b, 0xc3, 0xdc, 0xe2, 0xfb, 0xc3] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x6b, 0xdf, 0x78, 0xf0, 0x9e, 0xf3, 0xfc, 0x27, 0x89, 0xb9, 0xa4, 0x8e, 0x5e, 0x74, 0x1e, 0x72, + 0x2d, 0xbf, 0x44, 0x05, 0x0e, 0xc0, 0x52, 0xde, 0x79, 0x13, 0x5f, 0xba, 0xbf, 0x10, 0xcc, 0xd6] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xec, 0xbc, 0x7b, 0x30, 0x2e, 0xae, 0x49, 0xd1, 0x80, 0xb8, 0xd1, 0xf1, 0xfb, 0x36, 0xe7, 0xc5, + 0xd1, 0x9f, 0x84, 0xce, 0x3c, 0x5d, 0x9a, 0x84, 0xe4, 0x91, 0x3e, 0xf7, 0x3a, 0x9c, 0xba, 0xb2] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x10, 0xd3, 0xa9, 0xe2, 0x8e, 0xa1, 0x43, 0xc3, 0xb9, 0x91, 0x0b, 0x1d, 0x40, 0xe6, 0x08, 0x7e, + 0x97, 0x52, 0x0b, 0xc2, 0xa3, 0xdb, 0xe6, 0x6a, 0x80, 0x6b, 0xf2, 0x14, 0x03, 0x9f, 0xdb, 0x1b] } + ] + +def smtNonexistLeft : NonExistenceProof where + key := [0x00, 0x2c, 0x04, 0x1f, 0xe1, 0xdf, 0x37, 0xd8, 0x06, 0xcc, 0x5b, 0x49, 0x3b, 0xed, 0x02, 0x22, + 0x2d, 0x83, 0xb2, 0x5f, 0xfe, 0xbf, 0x9c, 0xb5, 0x29, 0xb4, 0x52, 0x4c, 0xc5, 0x47, 0xfb, 0xeb] + left := none + right := some smtNonexistLeftR + +def smtNonexistLeftRoot : Bytes := + [0x50, 0xbe, 0x82, 0xf8, 0x01, 0x39, 0x65, 0xf5, 0x95, 0x39, 0x24, 0x62, 0xf6, 0xc6, 0x8b, 0x4c, + 0x1d, 0x3d, 0x34, 0x01, 0x21, 0x0a, 0x10, 0x84, 0xf6, 0xf7, 0x3e, 0x3e, 0x2c, 0xaf, 0x06, 0x48] + +def smtNonexistLeftKey : Bytes := + [0x63, 0x6c, 0x53, 0x6e, 0x4d, 0x46, 0x71, 0x4a, 0x4e, 0x61, 0x62, 0x77, 0x6a, 0x7a, 0x51, 0x34, + 0x35, 0x6e, 0x6d, 0x4d] + +example : verifyNonExistence concreteHash smtNonexistLeft smtSpec smtNonexistLeftRoot + smtNonexistLeftKey = true := by native_decide + +/-! ### `testdata/smt/nonexist_right.json` -/ + +def smtNonexistRightL : ExistenceProof where + key := [0x6b, 0x63, 0x39, 0x58, 0x74, 0x46, 0x6e, 0x5a, 0x46, 0x45, 0x78, 0x4d, 0x41, 0x6f, 0x4b, 0x6f, + 0x37, 0x56, 0x6c, 0x5a] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x6b, 0x63, 0x39, 0x58, 0x74, 0x46, + 0x6e, 0x5a, 0x46, 0x45, 0x78, 0x4d, 0x41, 0x6f, 0x4b, 0x6f, 0x37, 0x56, 0x6c, 0x5a] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01, 0xb7, 0x62, 0x63, 0xb0, 0xc4, 0xe8, 0x43, 0x8e, 0x81, 0xf2, 0x1c, 0xdb, 0xff, 0x1e, 0x21, + 0xb8, 0x94, 0xa3, 0xc0, 0xe4, 0xea, 0x08, 0xa0, 0xde, 0xab, 0x7c, 0x1d, 0xe3, 0x29, 0x2c, 0xd1, + 0x6a], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x3a, 0xe2, 0xd9, 0x0a, 0x11, 0x8d, 0xd6, 0xf8, 0xa4, 0x2f, 0x40, 0x06, 0x81, 0x7e, 0x77, + 0x7f, 0x22, 0x54, 0x0e, 0x92, 0x1d, 0xf1, 0xd9, 0x7e, 0xd3, 0x34, 0xa8, 0xb9, 0xde, 0x92, 0xc6, + 0xcd], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x56, 0xa6, 0x2a, 0x01, 0x5a, 0x84, 0xaf, 0x9a, 0x33, 0xca, 0x71, 0x6f, 0x52, 0xed, 0x41, + 0x43, 0x82, 0xbe, 0xd2, 0x7a, 0x70, 0xb0, 0x03, 0x91, 0xf1, 0x5a, 0x54, 0x71, 0xf9, 0x44, 0x43, + 0xd3], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x44, 0xc4, 0x8b, 0xf2, 0xa8, 0x02, 0x19, 0x5f, 0xba, 0x51, 0x64, 0xa7, 0xa6, 0xc1, 0x71, + 0xa9, 0xaf, 0x7a, 0x11, 0x4c, 0x78, 0x80, 0x13, 0x61, 0x08, 0xa5, 0x54, 0x4d, 0x82, 0xfb, 0xac, + 0xba], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x35, 0x46, 0x56, 0x58, 0x2d, 0x1a, 0x82, 0xda, 0x79, 0x65, 0x90, 0x1b, 0x20, 0x35, 0x59, + 0x67, 0x04, 0x41, 0x9e, 0x5d, 0x23, 0x8d, 0xef, 0x48, 0xfd, 0xc0, 0x39, 0x50, 0x62, 0x4e, 0xe5, + 0x18], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x23, 0xea, 0x47, 0xd6, 0x9d, 0x73, 0x7d, 0xb4, 0x71, 0x33, 0x27, 0x39, 0x96, 0x85, 0xb2, + 0xb1, 0x5f, 0xc6, 0x05, 0xd8, 0xb9, 0xfc, 0x63, 0xda, 0xd0, 0x42, 0xcc, 0x7e, 0x2c, 0xa8, 0x6b, + 0x88], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x0f, 0x03, 0x93, 0x08, 0x5c, 0x3d, 0xd3, 0x49, 0xcc, 0x0f, 0x45, 0xcb, 0x55, 0x9f, 0xae, + 0x81, 0xa1, 0xc4, 0xf2, 0x42, 0x31, 0xaf, 0xcb, 0x2b, 0x5a, 0xe5, 0x1f, 0xd8, 0x92, 0x62, 0x14, + 0x93], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xc5, 0xc6, 0x32, 0x71, 0x2f, 0x23, 0x41, 0xf6, 0xa3, 0x1c, 0x3d, 0xb7, 0x42, 0x0c, 0x52, + 0xc8, 0xd3, 0x4d, 0xf3, 0x17, 0x04, 0xce, 0x55, 0x85, 0x63, 0x77, 0xcd, 0x9f, 0x23, 0x22, 0x64, + 0x69], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x92, 0x09, 0x81, 0x7b, 0x26, 0xad, 0x0a, 0x91, 0x84, 0x5b, 0xcb, 0xbd, 0x42, 0x45, 0x3b, + 0xe5, 0xa6, 0xba, 0x6f, 0x1c, 0x47, 0xe4, 0x62, 0x01, 0x4d, 0x6d, 0xe8, 0x96, 0xfe, 0xed, 0xe6, + 0x52], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x46, 0x44, 0x6f, 0x47, 0x23, 0x15, 0x3a, 0x26, 0x5d, 0x03, 0xa7, 0xa2, 0x0f, 0x4b, 0x90, + 0x67, 0x38, 0xd1, 0xaf, 0x82, 0x24, 0x34, 0xe7, 0x71, 0x89, 0x13, 0x4f, 0x45, 0xf2, 0xb2, 0xa8, + 0x0f], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x68, 0x0a, 0xca, 0xa8, 0x37, 0x22, 0xe2, 0x75, 0xea, 0x78, 0xc8, 0x09, 0x14, 0x94, 0x0c, + 0x67, 0xef, 0xd4, 0x8e, 0x5d, 0xa6, 0xb3, 0x31, 0xc8, 0x21, 0xaa, 0xa2, 0xeb, 0x0a, 0xe1, 0x84, + 0xed], + suffix := [] } + ] + +def smtNonexistRight : NonExistenceProof where + key := [0xff, 0xff, 0xed, 0xc8, 0xe4, 0xee, 0x7f, 0x13, 0xc9, 0x89, 0x2b, 0xf6, 0x27, 0x7c, 0xdd, 0x60, + 0xe4, 0xe8, 0xfa, 0xd7, 0x7a, 0xbb, 0x37, 0xca, 0x4f, 0x3b, 0x88, 0x8a, 0x63, 0xb6, 0x0d, 0xf4] + left := some smtNonexistRightL + right := none + +def smtNonexistRightRoot : Bytes := + [0x7b, 0xfe, 0x3d, 0x76, 0x30, 0xeb, 0x1f, 0x47, 0xbe, 0x11, 0xd1, 0x72, 0x4a, 0xba, 0xd7, 0xa1, + 0xb5, 0xde, 0x70, 0xc7, 0x13, 0x1e, 0x7e, 0xd8, 0xed, 0x60, 0xd9, 0x65, 0x6e, 0xa4, 0x98, 0x86] + +def smtNonexistRightKey : Bytes := + [0x68, 0x31, 0x6d, 0x65, 0x68, 0x64, 0x35, 0x6a, 0x77, 0x4f, 0x64, 0x6f, 0x4f, 0x42, 0x64, 0x61, + 0x35, 0x30, 0x68, 0x4e] + +example : verifyNonExistence concreteHash smtNonexistRight smtSpec smtNonexistRightRoot + smtNonexistRightKey = true := by native_decide + +/-! ### `testdata/smt/nonexist_middle.json` -/ + +def smtNonexistMiddleL : ExistenceProof where + key := [0x67, 0x6e, 0x4e, 0x34, 0x35, 0x6d, 0x52, 0x32, 0x68, 0x31, 0x36, 0x74, 0x67, 0x78, 0x6a, 0x64, + 0x6f, 0x38, 0x54, 0x4e] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x67, 0x6e, 0x4e, 0x34, 0x35, 0x6d, + 0x52, 0x32, 0x68, 0x31, 0x36, 0x74, 0x67, 0x78, 0x6a, 0x64, 0x6f, 0x38, 0x54, 0x4e] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0xd9, 0x94, 0x8e, 0x38, 0x63, 0x72, 0xdc, 0x85, 0x89, 0x9e, 0x18, 0x90, 0xe9, 0x88, 0xd8, 0xe4, + 0x76, 0x77, 0xc0, 0xbc, 0x21, 0x1c, 0x65, 0xb5, 0x5b, 0x5f, 0x70, 0x13, 0x4d, 0xc1, 0x5b, 0x0f] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x1c, 0x2c, 0xaf, 0x75, 0x04, 0xcf, 0xca, 0x30, 0xf2, 0x53, 0xfc, 0xe9, 0xc8, 0x20, 0x51, 0xc3, + 0xdd, 0x16, 0x70, 0x58, 0xb0, 0xe2, 0x2d, 0x84, 0x0f, 0x4d, 0x90, 0xd0, 0xa0, 0xb2, 0xa9, 0xf7] }, + { hash := .sha256, + prefixBytes := [0x01, 0x2d, 0xb2, 0x82, 0xd9, 0x12, 0xc7, 0xd3, 0xf1, 0xdf, 0xd2, 0x75, 0x0d, 0xb4, 0x51, 0xad, + 0x6e, 0x81, 0x76, 0xab, 0xdd, 0xef, 0x45, 0xeb, 0x41, 0xfe, 0x18, 0x30, 0xc8, 0x78, 0x9c, 0x17, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x0b, 0xd4, 0xfd, 0x01, 0xf2, 0x78, 0x4f, 0xc6, 0x37, 0xcc, 0x88, 0x6e, 0xc0, 0xdb, 0x6c, 0x44, + 0x65, 0xcd, 0x4b, 0x4c, 0x8e, 0xb7, 0x26, 0x6a, 0xaf, 0x84, 0xe0, 0x12, 0x77, 0x40, 0xaf, 0x2c] }, + { hash := .sha256, + prefixBytes := [0x01, 0x8b, 0xf1, 0x8f, 0x4d, 0xdf, 0x61, 0xff, 0x31, 0xcb, 0x45, 0x07, 0x37, 0xf6, 0xcf, 0x73, + 0x3d, 0x53, 0xd4, 0x0f, 0x99, 0xbc, 0x3d, 0xa5, 0x26, 0x07, 0x17, 0x55, 0xc3, 0x7c, 0xc0, 0x8e, + 0xe1], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x7b, 0xc7, 0x20, 0xcf, 0x72, 0x27, 0x1f, 0x5a, 0xc2, 0x0a, 0xf7, 0x96, 0x24, 0x53, 0x20, + 0x9d, 0x52, 0x78, 0x96, 0x56, 0x72, 0xe2, 0xcf, 0xeb, 0xe5, 0x13, 0x5b, 0xf8, 0x51, 0x87, 0x68, + 0x12], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xf8, 0x50, 0x0c, 0xdc, 0xf5, 0xae, 0x66, 0x4b, 0xde, 0xfc, 0xe1, 0x22, 0x1c, 0x42, 0xa6, + 0x9c, 0xf0, 0x57, 0xb0, 0x71, 0xe3, 0x4a, 0x0a, 0xb9, 0x46, 0x52, 0x65, 0x25, 0xd6, 0xf3, 0xbc, + 0x4d], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x27, 0xe9, 0x3a, 0xec, 0xb0, 0xea, 0x7d, 0x88, 0xfc, 0x13, 0xce, 0x56, 0x80, 0x17, 0x18, 0x7e, + 0xe5, 0xf0, 0x73, 0x61, 0xf4, 0xd9, 0x0e, 0x03, 0x86, 0x6f, 0xb7, 0xf3, 0xf3, 0x7a, 0x39, 0x66] }, + { hash := .sha256, + prefixBytes := [0x01, 0x34, 0x6d, 0x7d, 0x14, 0xc3, 0xa5, 0x52, 0x18, 0x52, 0xf3, 0x72, 0x61, 0xf2, 0x0e, 0x91, + 0xaf, 0x45, 0xc5, 0xc0, 0xf7, 0x72, 0xc1, 0x39, 0x17, 0xb6, 0x7d, 0x6e, 0xb6, 0xbe, 0x91, 0x71, + 0xea], + suffix := [] } + ] + +def smtNonexistMiddleR : ExistenceProof where + key := [0x72, 0x52, 0x50, 0x7a, 0x47, 0x71, 0x57, 0x65, 0x77, 0x4a, 0x6d, 0x6a, 0x38, 0x70, 0x6b, 0x43, + 0x45, 0x32, 0x74, 0x64] + value := [0x76, 0x61, 0x6c, 0x75, 0x65, 0x5f, 0x66, 0x6f, 0x72, 0x5f, 0x72, 0x52, 0x50, 0x7a, 0x47, 0x71, + 0x57, 0x65, 0x77, 0x4a, 0x6d, 0x6a, 0x38, 0x70, 0x6b, 0x43, 0x45, 0x32, 0x74, 0x64] + leaf := + { hash := .sha256, prehashKey := .sha256, prehashValue := .sha256, + length := .noPrefix, prefixBytes := [0x00] } + path := [ + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x03, 0x41, 0x4f, 0x64, 0x02, 0x64, 0x81, 0x78, 0xd0, 0xe7, 0x6d, 0x39, 0x25, 0x0d, 0x2e, 0x4c, + 0xee, 0x54, 0xec, 0x1f, 0x16, 0xe4, 0x51, 0xcb, 0x60, 0x27, 0x56, 0xa0, 0xa3, 0x04, 0x45, 0x07] }, + { hash := .sha256, + prefixBytes := [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00] }, + { hash := .sha256, + prefixBytes := [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xf1, 0x8e, 0x35, 0xdf, 0x2f, 0x21, 0x3a, 0x21, 0xdb, 0x25, 0xd8, 0x56, 0xf3, 0x53, 0x2a, + 0xfb, 0x9b, 0x1f, 0x7f, 0x47, 0x07, 0x3f, 0x6f, 0x00, 0x95, 0x07, 0xdd, 0xac, 0xd6, 0xd7, 0x45, + 0x7c], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x1c, 0x2c, 0xaf, 0x75, 0x04, 0xcf, 0xca, 0x30, 0xf2, 0x53, 0xfc, 0xe9, 0xc8, 0x20, 0x51, 0xc3, + 0xdd, 0x16, 0x70, 0x58, 0xb0, 0xe2, 0x2d, 0x84, 0x0f, 0x4d, 0x90, 0xd0, 0xa0, 0xb2, 0xa9, 0xf7] }, + { hash := .sha256, + prefixBytes := [0x01, 0x2d, 0xb2, 0x82, 0xd9, 0x12, 0xc7, 0xd3, 0xf1, 0xdf, 0xd2, 0x75, 0x0d, 0xb4, 0x51, 0xad, + 0x6e, 0x81, 0x76, 0xab, 0xdd, 0xef, 0x45, 0xeb, 0x41, 0xfe, 0x18, 0x30, 0xc8, 0x78, 0x9c, 0x17, + 0x00], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x0b, 0xd4, 0xfd, 0x01, 0xf2, 0x78, 0x4f, 0xc6, 0x37, 0xcc, 0x88, 0x6e, 0xc0, 0xdb, 0x6c, 0x44, + 0x65, 0xcd, 0x4b, 0x4c, 0x8e, 0xb7, 0x26, 0x6a, 0xaf, 0x84, 0xe0, 0x12, 0x77, 0x40, 0xaf, 0x2c] }, + { hash := .sha256, + prefixBytes := [0x01, 0x8b, 0xf1, 0x8f, 0x4d, 0xdf, 0x61, 0xff, 0x31, 0xcb, 0x45, 0x07, 0x37, 0xf6, 0xcf, 0x73, + 0x3d, 0x53, 0xd4, 0x0f, 0x99, 0xbc, 0x3d, 0xa5, 0x26, 0x07, 0x17, 0x55, 0xc3, 0x7c, 0xc0, 0x8e, + 0xe1], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0x7b, 0xc7, 0x20, 0xcf, 0x72, 0x27, 0x1f, 0x5a, 0xc2, 0x0a, 0xf7, 0x96, 0x24, 0x53, 0x20, + 0x9d, 0x52, 0x78, 0x96, 0x56, 0x72, 0xe2, 0xcf, 0xeb, 0xe5, 0x13, 0x5b, 0xf8, 0x51, 0x87, 0x68, + 0x12], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01, 0xf8, 0x50, 0x0c, 0xdc, 0xf5, 0xae, 0x66, 0x4b, 0xde, 0xfc, 0xe1, 0x22, 0x1c, 0x42, 0xa6, + 0x9c, 0xf0, 0x57, 0xb0, 0x71, 0xe3, 0x4a, 0x0a, 0xb9, 0x46, 0x52, 0x65, 0x25, 0xd6, 0xf3, 0xbc, + 0x4d], + suffix := [] }, + { hash := .sha256, + prefixBytes := [0x01], + suffix := [0x27, 0xe9, 0x3a, 0xec, 0xb0, 0xea, 0x7d, 0x88, 0xfc, 0x13, 0xce, 0x56, 0x80, 0x17, 0x18, 0x7e, + 0xe5, 0xf0, 0x73, 0x61, 0xf4, 0xd9, 0x0e, 0x03, 0x86, 0x6f, 0xb7, 0xf3, 0xf3, 0x7a, 0x39, 0x66] }, + { hash := .sha256, + prefixBytes := [0x01, 0x34, 0x6d, 0x7d, 0x14, 0xc3, 0xa5, 0x52, 0x18, 0x52, 0xf3, 0x72, 0x61, 0xf2, 0x0e, 0x91, + 0xaf, 0x45, 0xc5, 0xc0, 0xf7, 0x72, 0xc1, 0x39, 0x17, 0xb6, 0x7d, 0x6e, 0xb6, 0xbe, 0x91, 0x71, + 0xea], + suffix := [] } + ] + +def smtNonexistMiddle : NonExistenceProof where + key := [0xba, 0x46, 0xe9, 0x1e, 0xd5, 0x6a, 0xc7, 0xbe, 0xa2, 0x90, 0xf3, 0x1a, 0x5b, 0x54, 0x92, 0x09, + 0x02, 0x43, 0xf1, 0x11, 0xa5, 0x36, 0xc4, 0x9f, 0x58, 0x9e, 0x97, 0x8f, 0x2d, 0x3e, 0xe8, 0xdf] + left := some smtNonexistMiddleL + right := some smtNonexistMiddleR + +def smtNonexistMiddleRoot : Bytes := + [0x77, 0x13, 0x01, 0xea, 0xe8, 0x76, 0x4c, 0x61, 0x47, 0x39, 0x9a, 0x99, 0x44, 0xdd, 0x44, 0x54, + 0xe8, 0x65, 0xdb, 0x8b, 0xc3, 0x3e, 0x60, 0xf2, 0x2b, 0xeb, 0xea, 0x1c, 0x9b, 0xf7, 0x02, 0x1e] + +def smtNonexistMiddleKey : Bytes := + [0x36, 0x4e, 0x58, 0x39, 0x31, 0x78, 0x70, 0x52, 0x48, 0x55, 0x4d, 0x79, 0x6e, 0x51, 0x4c, 0x46, + 0x53, 0x32, 0xff, 0xff] + +example : verifyNonExistence concreteHash smtNonexistMiddle smtSpec smtNonexistMiddleRoot + smtNonexistMiddleKey = true := by native_decide + +end Ics23.TestVectors diff --git a/lean/Ics23/Tree.lean b/lean/Ics23/Tree.lean new file mode 100644 index 00000000..710c81e7 --- /dev/null +++ b/lean/Ics23/Tree.lean @@ -0,0 +1,405 @@ +/- +Honest-root Merkle tree model (Option 1). + +The byte-level theorems (`existence_binding_shaped`, etc.) conclude a disjunction +with ambiguity arms (findings F3/F5) because, against an *arbitrary* root, the +verifier accepts inner ops whose prefix/child/suffix are adversarial bytes that +merely hash correctly. In deployment the root is the hash of a tree some honest +full node actually built (the adversary controls the proof, not the root's +provenance). This file models that: an inductive ordered Merkle tree with a +`rootHash`, against which accepted proofs follow *genuine* structure. + +The payoff: both F3 "readings" of a node correspond to real left/right children, +so `membership_sound` (accepted existence proof ⇒ genuine membership, up to a +collision) holds with no ambiguity arm — which strengthens Theorem A and is the +engine for Theorem B. + +Binary trees (all shipped specs are binary). A node's hash mirrors how the +verifier's inner ops combine: `H ih (pre ++ leftHash ++ mid ++ rightHash ++ suf)`, +so a left-child op `{ih, pre, mid++rh++suf}` and a right-child op +`{ih, pre++lh++mid, suf}` both reconstruct it. +-/ +import Ics23.Verify +import Ics23.Soundness +import Ics23.Existence +import Ics23.LeafInj + +namespace Ics23 + +/-- A binary Merkle tree with explicit structural bytes at each node. -/ +inductive MTree where + | leaf : LeafOp → Bytes → Bytes → MTree + | node : HashOp → Bytes → Bytes → Bytes → MTree → MTree → MTree + deriving Inhabited + +/-- The root hash of a tree, mirroring the verifier's leaf/inner hashing. -/ +def rootHash (H : HashFn) : MTree → Option Bytes + | .leaf op k v => applyLeaf H op k v + | .node ih pre mid suf l r => + match rootHash H l, rootHash H r with + | some lh, some rh => some (H ih (pre ++ lh ++ mid ++ rh ++ suf)) + | _, _ => none + +/-- `(key, value)` is a leaf of the tree. -/ +def TreeMember (key val : Bytes) : MTree → Prop + | .leaf _ k v => k = key ∧ v = val + | .node _ _ _ _ l r => TreeMember key val l ∨ TreeMember key val r + +/-- The left-child inner op for a node: child is the left subtree's hash. -/ +def leftChildOp (ih : HashOp) (pre mid suf rh : Bytes) : InnerOp := + { hash := ih, prefixBytes := pre, suffix := mid ++ rh ++ suf } + +/-- The right-child inner op for a node: the left sibling sits in the prefix. -/ +def rightChildOp (ih : HashOp) (pre mid suf lh : Bytes) : InnerOp := + { hash := ih, prefixBytes := pre ++ lh ++ mid, suffix := suf } + +/-- A left-child op applied to the (nonempty) left subtree hash reproduces the +node hash. -/ +theorem leftChildOp_apply (H : HashFn) (ih : HashOp) (pre mid suf lh rh : Bytes) + (hlh : lh.isEmpty = false) : + applyInner H (leftChildOp ih pre mid suf rh) lh + = some (H ih (pre ++ lh ++ mid ++ rh ++ suf)) := by + unfold applyInner leftChildOp + rw [if_neg (by rw [hlh]; simp)] + simp [List.append_assoc] + +/-- A right-child op applied to the (nonempty) right subtree hash reproduces the +node hash. -/ +theorem rightChildOp_apply (H : HashFn) (ih : HashOp) (pre mid suf lh rh : Bytes) + (hrh : rh.isEmpty = false) : + applyInner H (rightChildOp ih pre mid suf lh) rh + = some (H ih (pre ++ lh ++ mid ++ rh ++ suf)) := by + unfold applyInner rightChildOp + rw [if_neg (by rw [hrh]; simp)] + +/-- **F3 resolution (the crux).** For a binary node `pre ++ lh ++ rh` with +`|lh| = |rh| = cs`, the verifier's checks — prefix length in `[p, p+cs]` and +`suffix.length % cs = 0` — pin any accepted split of the node into a `cs`-length +child to *exactly* the two genuine children: the child is the left or right +subtree hash. There is no straddling third reading. -/ +theorem split_pins (pre lh rh topPre m topSuf : Bytes) (cs p : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ rh) + (hpre : pre.length = p) (hlh : lh.length = cs) (hrh : rh.length = cs) + (hm : m.length = cs) (_hcs : 0 < cs) + (hpb1 : p ≤ topPre.length) (_hpb2 : topPre.length ≤ p + cs) + (hsuf : topSuf.length % cs = 0) : + m = lh ∨ m = rh := by + have hlentot : topPre.length + m.length + topSuf.length + = pre.length + lh.length + rh.length := by + have h := congrArg List.length hN + simp only [List.length_append] at h + omega + rw [hm, hpre, hlh, hrh] at hlentot + have hsuflen : topSuf.length = 0 ∨ topSuf.length = cs := by + rcases Nat.eq_zero_or_pos topSuf.length with h0 | hpos + · exact Or.inl h0 + · refine Or.inr ?_ + have hdvd : cs ∣ topSuf.length := Nat.dvd_of_mod_eq_zero hsuf + have hge : cs ≤ topSuf.length := Nat.le_of_dvd hpos hdvd + omega + rcases hsuflen with hs0 | hscs + · -- empty suffix: the child is the right subtree + refine Or.inr ?_ + have hsnil : topSuf = [] := List.length_eq_zero_iff.mp hs0 + rw [hsnil, List.append_nil] at hN + have hlen' : topPre.length = (pre ++ lh).length := by + simp only [List.length_append]; omega + exact (List.append_inj hN hlen').2 + · -- full-cs suffix: the child is the left subtree + refine Or.inl ?_ + simp only [List.append_assoc] at hN + have htplen : topPre.length = pre.length := by omega + have hA := List.append_inj hN htplen + exact (List.append_inj hA.2 (by rw [hm, hlh])).1 + +/-- Tendermint-shaped conformance of a tree to a spec: nodes use the inner-spec +hash with empty `mid`/`suf` (`node = H ih (pre ++ lh ++ rh)`), a node prefix that +is nonempty and not leaf-prefixed (domain separation), and leaves whose op is +exactly the spec leaf op. Models the CometBFT simple-merkle shape. -/ +def WFTree (s : ProofSpec) (b : UInt8) : MTree → Prop + | .leaf op _ _ => op = s.leafSpec + | .node ih pre mid suf l r => + ih = s.innerSpec.hash ∧ mid = [] ∧ suf = [] ∧ + (pre.length : Int) = s.innerSpec.minPrefixLength ∧ + pre ≠ [] ∧ pre.head? ≠ some b ∧ + WFTree s b l ∧ WFTree s b r + +/-- `applyLeaf` / `applyInner` outputs are `cs`-length digests. -/ +theorem applyLeaf_len (H : HashFn) (cs : Nat) (hH : FixedHash H cs) + (leaf : LeafOp) (k v r : Bytes) (h : applyLeaf H leaf k v = some r) : r.length = cs := by + unfold applyLeaf at h + cases hpk : prepareLeafData H leaf.prehashKey leaf.length k with + | none => simp [hpk] at h + | some pk => + cases hpv : prepareLeafData H leaf.prehashValue leaf.length v with + | none => simp [hpk, hpv] at h + | some pv => + rw [hpk, hpv] at h; simp only [Option.some.injEq] at h + rw [← h]; exact hH _ _ + +theorem applyInner_len (H : HashFn) (cs : Nat) (hH : FixedHash H cs) + (op : InnerOp) (c r : Bytes) (h : applyInner H op c = some r) : r.length = cs := by + have := applyInner_image H op c r h + rw [← this]; exact hH _ _ + +/-- A tree's root hash is a `cs`-length digest. -/ +theorem rootHash_len (H : HashFn) (cs : Nat) (hH : FixedHash H cs) : + ∀ (t : MTree) (r : Bytes), rootHash H t = some r → r.length = cs := by + intro t + induction t with + | leaf op k v => + intro r hrh; unfold rootHash at hrh; exact applyLeaf_len H cs hH op k v r hrh + | node ih pre mid suf l r _ _ => + intro root hrh + unfold rootHash at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lh => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rh => + rw [hl, hr] at hrh; simp only [Option.some.injEq] at hrh + rw [← hrh]; exact hH _ _ + +/-- A path fold preserves the `cs`-length digest. -/ +theorem applyPath_len (H : HashFn) (isp : InnerSpec) (cs : Nat) (hH : FixedHash H cs) : + ∀ (p : List InnerOp) (h r : Bytes), h.length = cs → + applyPath H isp h p = some r → r.length = cs := by + intro p + induction p with + | nil => + intro h r hh hap; simp only [applyPath, Option.some.injEq] at hap; rw [← hap]; exact hh + | cons op rest ih => + intro h r hh hap + simp only [applyPath] at hap + cases ha : applyInner H op h with + | none => simp [ha] at hap + | some h' => + simp only [ha] at hap + by_cases g : (h'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 + · simp [g] at hap + · rw [if_neg g] at hap + exact ih h' r (applyInner_len H cs hH op h h' ha) hap + +/-- Any leaf op conforms to itself. -/ +theorem ensureLeaf_self (l : LeafOp) : ensureLeaf l l = true := by + unfold ensureLeaf; simp [hasPrefix_refl] + +/-- The leaf preimage starts with the leaf prefix byte `b`. -/ +theorem applyLeaf_head (H : HashFn) (leaf : LeafOp) (k v r : Bytes) (b : UInt8) + (hpre : leaf.prefixBytes = [b]) (h : applyLeaf H leaf k v = some r) : + ∃ tail, r = H leaf.hash (b :: tail) := by + unfold applyLeaf at h + cases hpk : prepareLeafData H leaf.prehashKey leaf.length k with + | none => simp [hpk] at h + | some pk => + cases hpv : prepareLeafData H leaf.prehashValue leaf.length v with + | none => simp [hpk, hpv] at h + | some pv => + rw [hpk, hpv] at h; simp only [Option.some.injEq] at h + exact ⟨pk ++ pv, by rw [← h, hpre]; rfl⟩ + +/-- From `ensure_inner`, for a binary spec with `min = max` prefix length, the +prefix length lies in `[p, p+cs]` and the suffix length is a multiple of `cs` +(`p = min` = the node prefix length). These are exactly `split_pins`' hypotheses. -/ +theorem split_bounds (op : InnerOp) (s : ProofSpec) (cs p : Nat) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hbin : s.innerSpec.childOrder.length = 2) + (hpp : (p : Int) = s.innerSpec.minPrefixLength) + (hen : ensureInner op s = true) : + p ≤ op.prefixBytes.length ∧ op.prefixBytes.length ≤ p + cs + ∧ op.suffix.length % cs = 0 := by + unfold ensureInner at hen + simp only [Bool.and_eq_true, decide_eq_true_eq] at hen + obtain ⟨⟨⟨⟨⟨⟨_, _⟩, hc3⟩, hc4⟩, hc5⟩, _⟩, hc7⟩ := hen + have hcsInt : s.innerSpec.childSize = (cs : Int) := by omega + rw [hbin] at hc4 + refine ⟨?_, ?_, ?_⟩ + · omega + · -- |prefix| ≤ max + (2-1)*cs = min + cs = p + cs + have : ((op.prefixBytes.length : Int)) ≤ s.innerSpec.minPrefixLength + (cs : Int) := by + rw [hmm]; rw [hcsInt] at hc4; push_cast at hc4 ⊢; omega + omega + · -- (|suffix| : Int) % childSize = 0 → |suffix| % cs = 0 + rw [hcsInt] at hc7 + have : ((op.suffix.length % cs : Nat) : Int) = 0 := by + rw [Int.natCast_emod]; exact hc7 + exact_mod_cast this + +/-- A node split with empty suffix is the *right* child (`ensure_right_most`). -/ +theorem split_right (pre lh rh topPre m topSuf : Bytes) (cs : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ rh) + (hlh : lh.length = cs) (hrh : rh.length = cs) (hm : m.length = cs) + (hsuf0 : topSuf.length = 0) : m = rh := by + have hsnil : topSuf = [] := List.length_eq_zero_iff.mp hsuf0 + rw [hsnil, List.append_nil] at hN + have hlen : topPre.length = (pre ++ lh).length := by + have h := congrArg List.length hN + simp only [List.length_append] at h ⊢; omega + exact (List.append_inj hN hlen).2 + +/-- A node split with a full `cs`-length suffix is the *left* child +(`ensure_left_most`). -/ +theorem split_left (pre lh rh topPre m topSuf : Bytes) (cs : Nat) + (hN : topPre ++ m ++ topSuf = pre ++ lh ++ rh) + (hpre : pre.length ≤ topPre.length) (hlh : lh.length = cs) (hrh : rh.length = cs) + (hm : m.length = cs) (hsuf : topSuf.length = cs) : m = lh := by + have hlen : topPre.length = pre.length := by + have h := congrArg List.length hN + simp only [List.length_append] at h; omega + simp only [List.append_assoc] at hN + exact (List.append_inj (List.append_inj hN hlen).2 (by rw [hm, hlh])).1 + +/-- Core induction: a proof whose leaf hash folds to a real tree's root reaches a +genuine leaf — using `split_pins` to force each step into a real child. -/ +theorem reaches (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hbin : s.innerSpec.childOrder.length = 2) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTree s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + TreeMember key value t ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + -- WFTree leaf ⇒ top = s.leafSpec + simp only [WFTree] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap + -- lh = root, and lh = applyLeaf .. (key,value), root = applyLeaf .. (tk,tv) + subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + -- nonempty path ⇒ root is an inner image; but root is a leaf hash ⇒ collision + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) hpath hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hmid, hsuf, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hmid; subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + -- hrh : H s.innerSpec.hash (pre ++ lhL ++ rhR) = root + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · -- empty path: the proof's leaf hash equals the node hash ⇒ domain collision + subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead + simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · -- nonempty path: peel the root op and force it into a genuine child + rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp))] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + obtain ⟨hb1, hb2, hb7⟩ := split_bounds topOp s cs pre.length hcsspec hmm hbin hppre + (hpath topOp (by simp)) + rcases split_pins pre lhL rhR topOp.prefixBytes m topOp.suffix cs pre.length + hpe rfl (rootHash_len H cs hH l lhL hl) (rootHash_len H cs hH r rhR hr) + hmlen hcs hb1 hb2 hb7 with hml | hmr + · rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hl hpm with hmem | hcol + · exact Or.inl (Or.inl hmem) + · exact Or.inr hcol + · rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hr hpm with hmem | hcol + · exact Or.inl (Or.inr hmem) + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +theorem membership_sound (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hbin : s.innerSpec.childOrder.length = 2) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (ep : ExistenceProof) (root key value : Bytes), + WFTree s b t → + ep.leaf = s.leafSpec → + rootHash H t = some root → + verifyExistence H ep s root key value = true → + TreeMember key value t ∨ HashCollision H := by + intro t ep root key value hwf hep hrh hver + have hr := verifyExistence_root H ep s root key value hver + have hkey : ep.key = key ∧ ep.value = value := by + unfold verifyExistence at hver + simp only [Bool.and_eq_true] at hver + obtain ⟨⟨⟨_, hkk⟩, hvv⟩, _⟩ := hver + exact ⟨by simpa using hkk, by simpa using hvv⟩ + obtain ⟨hk, hv⟩ := hkey + cases hke : ep.key.isEmpty with + | true => simp [calculateExistenceRoot, hke] at hr + | false => + cases hve : ep.value.isEmpty with + | true => simp [calculateExistenceRoot, hke, hve] at hr + | false => + cases hlf : applyLeaf H ep.leaf ep.key ep.value with + | none => simp [calculateExistenceRoot, hke, hve, hlf] at hr + | some lh => + have hap : applyPath H s.innerSpec lh ep.path = some root := by + rw [calculateExistenceRoot_eq H s ep lh hke hve hlf] at hr; exact hr + rw [hep, hk, hv] at hlf + exact reaches H s b cs hH hcs hcsspec hlhash.symm hlpre hmin hmm hbin hLInj + t key value lh ep.path root hwf hlf + (verifyExistence_inners H ep s root key value hver) hrh hap + +/-- **Honest-root Theorem A for the Tendermint spec.** All structural side +conditions are discharged by computation, and joint leaf injectivity is now +*proved* (`leafInj_tendermint`, from varint self-delimiting + the collision +escape). The single remaining hypothesis is the genuine cryptographic assumption: +a fixed 32-byte digest (`FixedHash`). -/ +theorem membership_sound_tendermint (H : HashFn) + (hH : FixedHash H 32) : + ∀ (t : MTree) (ep : ExistenceProof) (root key value : Bytes), + WFTree tendermintSpec 0 t → + ep.leaf = tendermintSpec.leafSpec → + rootHash H t = some root → + verifyExistence H ep tendermintSpec root key value = true → + TreeMember key value t ∨ HashCollision H := + membership_sound H tendermintSpec 0 32 hH (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (leafInj_tendermint H) + +end Ics23 diff --git a/lean/Ics23/TreeNonExist.lean b/lean/Ics23/TreeNonExist.lean new file mode 100644 index 00000000..c20170cf --- /dev/null +++ b/lean/Ics23/TreeNonExist.lean @@ -0,0 +1,1057 @@ +/- +Non-existence soundness (Theorem B) via the honest-root tree model. + +`membership_sound` (Tree.lean) already gives that a non-existence proof's +bracketing neighbors — and any claimed key — are *genuine* members of the real +tree. What remains is the ordered-tree (BST) reasoning: in a key-sorted tree, no +member sits strictly between two position-adjacent leaves. This file builds that. + +Key order is the raw byte order `bytesLt` (the Tendermint / `prehash_key_before_ +comparison = false` case; the SMT case composes with the prehash and is analogous). +-/ +import Ics23.Tree +import Ics23.NonExist +import Ics23.NonExistSound + +namespace Ics23 + +/-- The rightmost leaf's key. -/ +def maxKey : MTree → Bytes + | .leaf _ k _ => k + | .node _ _ _ _ _ r => maxKey r + +/-- The leftmost leaf's key. -/ +def minKey : MTree → Bytes + | .leaf _ k _ => k + | .node _ _ _ _ l _ => minKey l + +/-- A key-sorted (BST) tree: at each node, the left subtree's max key is strictly +below the right subtree's min key, recursively. -/ +def SortedTree : MTree → Prop + | .leaf _ _ _ => True + | .node _ _ _ _ l r => SortedTree l ∧ SortedTree r ∧ bytesLt (maxKey l) (minKey r) = true + +/-- `min ≤ max` for any tree (with `≤` meaning `= ∨ bytesLt`). -/ +theorem minKey_le_maxKey (t : MTree) (hs : SortedTree t) : + minKey t = maxKey t ∨ bytesLt (minKey t) (maxKey t) = true := by + induction t with + | leaf _ k _ => exact Or.inl rfl + | node _ _ _ _ l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + -- minKey node = minKey l, maxKey node = maxKey r + have hl := ihl hsl -- minKey l ≤ maxKey l + have hr := ihr hsr -- minKey r ≤ maxKey r + refine Or.inr ?_ + -- minKey l ≤ maxKey l < minKey r ≤ maxKey r + show bytesLt (minKey l) (maxKey r) = true + have step1 : bytesLt (minKey l) (minKey r) = true := by + rcases hl with h | h + · rw [h]; exact hlr + · exact bytesLt_trans _ _ _ h hlr + rcases hr with h | h + · rw [← h]; exact step1 + · exact bytesLt_trans _ _ _ step1 h + +/-- A member's key is `≤` the tree's max key. -/ +theorem member_le_maxKey (t : MTree) (key value : Bytes) + (hs : SortedTree t) (hm : TreeMember key value t) : + key = maxKey t ∨ bytesLt key (maxKey t) = true := by + induction t with + | leaf _ k _ => + simp only [TreeMember] at hm + exact Or.inl hm.1.symm + | node _ _ _ _ l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [TreeMember] at hm + rcases hm with hml | hmr + · -- in left: key ≤ maxKey l < minKey r ≤ maxKey r + refine Or.inr ?_ + have hkl := ihl hsl hml + have hrr := minKey_le_maxKey r hsr + have hkr : bytesLt key (minKey r) = true := by + rcases hkl with h | h + · rw [h]; exact hlr + · exact bytesLt_trans _ _ _ h hlr + show bytesLt key (maxKey r) = true + rcases hrr with h | h + · rw [← h]; exact hkr + · exact bytesLt_trans _ _ _ hkr h + · exact ihr hsr hmr + +/-- A member's key is `≥` the tree's min key. -/ +theorem minKey_le_member (t : MTree) (key value : Bytes) + (hs : SortedTree t) (hm : TreeMember key value t) : + minKey t = key ∨ bytesLt (minKey t) key = true := by + induction t with + | leaf _ k _ => + simp only [TreeMember] at hm + exact Or.inl hm.1 + | node _ _ _ _ l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [TreeMember] at hm + rcases hm with hml | hmr + · exact ihl hsl hml + · -- in right: minKey l ≤ maxKey l < minKey r ≤ key + refine Or.inr ?_ + have hkr := ihr hsr hmr + have hll := minKey_le_maxKey l hsl + have hlk : bytesLt (maxKey l) key = true := by + rcases hkr with h | h + · rw [← h]; exact hlr + · exact bytesLt_trans _ _ _ hlr h + show bytesLt (minKey l) key = true + rcases hll with h | h + · rw [h]; exact hlk + · exact bytesLt_trans _ _ _ h hlk + +/-- `≤` (`= ∨ bytesLt`) is transitive. -/ +theorem ble_trans (a b c : Bytes) (h1 : a = b ∨ bytesLt a b = true) + (h2 : b = c ∨ bytesLt b c = true) : a = c ∨ bytesLt a c = true := by + rcases h1 with h1 | h1 + · rcases h2 with h2 | h2 + · exact Or.inl (h1.trans h2) + · exact Or.inr (h1 ▸ h2) + · rcases h2 with h2 | h2 + · exact Or.inr (h2 ▸ h1) + · exact Or.inr (bytesLt_trans _ _ _ h1 h2) + +/-- `a ≤ b` and `b < a` are contradictory. -/ +theorem ble_not_gt (a b : Bytes) (h1 : a = b ∨ bytesLt a b = true) + (h2 : bytesLt b a = true) : False := by + rcases h1 with h | h + · rw [h, bytesLt_irrefl] at h2; exact Bool.noConfusion h2 + · have := bytesLt_trans _ _ _ h h2; rw [bytesLt_irrefl] at this; exact Bool.noConfusion this + +/-- `N` is a subtree of `t`. -/ +def IsSubtree : MTree → MTree → Prop + | N, .leaf ih k v => N = .leaf ih k v + | N, .node ih pre mid suf l r => + N = .node ih pre mid suf l r ∨ IsSubtree N l ∨ IsSubtree N r + +/-- A subtree's min key is `≥` the whole tree's min key. -/ +theorem subtree_minKey_le (t : MTree) (hs : SortedTree t) (N : MTree) (hsub : IsSubtree N t) : + minKey t = minKey N ∨ bytesLt (minKey t) (minKey N) = true := by + induction t with + | leaf ih k v => simp only [IsSubtree] at hsub; rw [hsub]; exact Or.inl rfl + | node ih pre mid suf l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtree] at hsub + rcases hsub with hN | hsubl | hsubr + · rw [hN]; exact Or.inl rfl + · exact ihl hsl hsubl -- minKey node = minKey l + · -- minKey node = minKey l ≤ maxKey l < minKey r ≤ minKey N + refine Or.inr ?_ + show bytesLt (minKey l) (minKey N) = true + have h1 : bytesLt (minKey l) (minKey r) = true := by + rcases minKey_le_maxKey l hsl with h | h + · rw [h]; exact hlr + · exact bytesLt_trans _ _ _ h hlr + rcases ihr hsr hsubr with h | h + · rw [← h]; exact h1 + · exact bytesLt_trans _ _ _ h1 h + +/-- A subtree's max key is `≤` the whole tree's max key. -/ +theorem subtree_maxKey_ge (t : MTree) (hs : SortedTree t) (N : MTree) (hsub : IsSubtree N t) : + maxKey N = maxKey t ∨ bytesLt (maxKey N) (maxKey t) = true := by + induction t with + | leaf ih k v => simp only [IsSubtree] at hsub; rw [hsub]; exact Or.inl rfl + | node ih pre mid suf l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtree] at hsub + rcases hsub with hN | hsubl | hsubr + · rw [hN]; exact Or.inl rfl + · -- maxKey N ≤ maxKey l < minKey r ≤ maxKey r = maxKey node + refine Or.inr ?_ + show bytesLt (maxKey N) (maxKey r) = true + have h1 : bytesLt (maxKey N) (minKey r) = true := by + rcases ihl hsl hsubl with h | h + · rw [h]; exact hlr + · exact bytesLt_trans _ _ _ h hlr + rcases minKey_le_maxKey r hsr with h | h + · rw [← h]; exact h1 + · exact bytesLt_trans _ _ _ h1 h + · exact ihr hsr hsubr -- maxKey node = maxKey r + +/-- **BST gap (root case).** In a sorted node, no member sits strictly between +the left subtree's max key and the right subtree's min key. This is the core +ordered-tree fact behind non-existence: adjacent leaves have no member between. -/ +theorem root_gap_no_member (ih : HashOp) (pre mid suf : Bytes) (l r : MTree) + (hs : SortedTree (.node ih pre mid suf l r)) + (key' value' : Bytes) (hm : TreeMember key' value' (.node ih pre mid suf l r)) + (h1 : bytesLt (maxKey l) key' = true) (h2 : bytesLt key' (minKey r) = true) : False := by + obtain ⟨hsl, hsr, _⟩ := hs + simp only [TreeMember] at hm + rcases hm with hml | hmr + · rcases member_le_maxKey l key' value' hsl hml with h | h + · rw [h] at h1; simp [bytesLt_irrefl] at h1 + · have := bytesLt_trans _ _ _ h1 h; simp [bytesLt_irrefl] at this + · rcases minKey_le_member r key' value' hsr hmr with h | h + · rw [← h] at h2; simp [bytesLt_irrefl] at h2 + · have := bytesLt_trans _ _ _ h2 h; simp [bytesLt_irrefl] at this + +/-- **Subtree contiguity.** A member of a sorted tree whose key lies within a +subtree `N`'s key range is a member of `N`. (Sorted trees occupy contiguous key +ranges.) -/ +theorem member_in_subtree_range (t : MTree) (hs : SortedTree t) + (N : MTree) (hsub : IsSubtree N t) (key value : Bytes) (hm : TreeMember key value t) + (hlo : minKey N = key ∨ bytesLt (minKey N) key = true) + (hhi : key = maxKey N ∨ bytesLt key (maxKey N) = true) : + TreeMember key value N := by + induction t with + | leaf ih k v => simp only [IsSubtree] at hsub; subst hsub; exact hm + | node ih pre mid suf l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtree] at hsub + simp only [TreeMember] at hm + rcases hsub with hN | hsubl | hsubr + · subst hN; simp only [TreeMember]; exact hm + · -- N ⊆ l : key ≤ maxKey N ≤ maxKey l < minKey r, so the member is in l + have hkml : key = maxKey l ∨ bytesLt key (maxKey l) = true := + ble_trans _ _ _ hhi (subtree_maxKey_ge l hsl N hsubl) + have hklt : bytesLt key (minKey r) = true := by + rcases hkml with h | h + · rw [h]; exact hlr + · exact bytesLt_trans _ _ _ h hlr + rcases hm with hml | hmr + · exact ihl hsl hsubl hml + · exact absurd (minKey_le_member r key value hsr hmr) (fun h => ble_not_gt _ _ h hklt) + · -- N ⊆ r : minKey l < minKey r ≤ minKey N ≤ key, so the member is in r + have hkmr : minKey r = key ∨ bytesLt (minKey r) key = true := + ble_trans _ _ _ (subtree_minKey_le r hsr N hsubr) hlo + have hrlt : bytesLt (maxKey l) key = true := by + rcases hkmr with h | h + · rw [← h]; exact hlr + · exact bytesLt_trans _ _ _ hlr h + rcases hm with hml | hmr + · exact absurd (member_le_maxKey l key value hsl hml) (fun h => ble_not_gt _ _ h hrlt) + · exact ihr hsr hsubr hmr + +/-- A subtree of a sorted tree is sorted. -/ +theorem subtree_sorted (t : MTree) (hs : SortedTree t) (N : MTree) (hsub : IsSubtree N t) : + SortedTree N := by + induction t with + | leaf _ _ _ => simp only [IsSubtree] at hsub; rw [hsub]; exact hs + | node _ _ _ _ l r ihl ihr => + obtain ⟨hsl, hsr, hlr⟩ := hs + simp only [IsSubtree] at hsub + rcases hsub with hN | hl | hr + · rw [hN]; exact ⟨hsl, hsr, hlr⟩ + · exact ihl hsl hl + · exact ihr hsr hr + +/-- **BST gap (general subtree).** For any subtree `N` of a sorted tree `t`, no +member of `t` sits strictly between `N`'s left-max and right-min keys. -/ +theorem node_gap_no_member (t : MTree) (hs : SortedTree t) + (ih : HashOp) (pre mid suf : Bytes) (l r : MTree) + (hsub : IsSubtree (.node ih pre mid suf l r) t) + (key value : Bytes) (hm : TreeMember key value t) + (h1 : bytesLt (maxKey l) key = true) (h2 : bytesLt key (minKey r) = true) : False := by + have hsN : SortedTree (.node ih pre mid suf l r) := + subtree_sorted t hs _ hsub + have hsl := hsN.1 + have hsr := hsN.2.1 + have hlo : minKey (.node ih pre mid suf l r) = key ∨ + bytesLt (minKey (.node ih pre mid suf l r)) key = true := + ble_trans (minKey l) (maxKey l) key (minKey_le_maxKey l hsl) (Or.inr h1) + have hhi : key = maxKey (.node ih pre mid suf l r) ∨ + bytesLt key (maxKey (.node ih pre mid suf l r)) = true := + ble_trans key (minKey r) (maxKey r) (Or.inr h2) (minKey_le_maxKey r hsr) + have hmN := member_in_subtree_range t hs _ hsub key value hm hlo hhi + exact root_gap_no_member ih pre mid suf l r hsN key value hmN h1 h2 + +/-- `ensure_inner`'s lower prefix bound. -/ +theorem ensureInner_minle (op : InnerOp) (s : ProofSpec) (h : ensureInner op s = true) : + s.innerSpec.minPrefixLength ≤ (op.prefixBytes.length : Int) := by + unfold ensureInner at h + simp only [Bool.and_eq_true, decide_eq_true_eq] at h + exact h.1.1.1.1.2 + +/-- An all-right path (`ensure_right_most`: each step has empty suffix) reaches the +rightmost leaf — the proof's key is `maxKey t`, up to a collision. -/ +theorem reaches_max (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTree s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ op.suffix = []) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + (key = maxKey t ∧ TreeMember key value t) ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTree] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk, hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r _ ihr => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hmid, hsuf, _, hprene, hprehead, _, hwfr⟩ := hwf + subst hmid; subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + have hmr : m = rhR := split_right pre lhL rhR topOp.prefixBytes m topOp.suffix cs + hpe (rootHash_len H cs hH l lhL hl) (rootHash_len H cs hH r rhR hr) hmlen + (by rw [(hpath topOp (by simp)).2]; rfl) + rw [hmr] at hpm + rcases ihr key value lh q rhR hwfr hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hr hpm with ⟨hk, hmem⟩ | hcol + · exact Or.inl ⟨by rw [hk]; rfl, Or.inr hmem⟩ + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- An all-left path (`ensure_left_most`: each step has a full `cs`-suffix) reaches +the leftmost leaf — the proof's key is `minKey t`, up to a collision. -/ +theorem reaches_min (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (key value lh : Bytes) (path : List InnerOp) (root : Bytes), + WFTree s b t → + applyLeaf H s.leafSpec key value = some lh → + (∀ op ∈ path, ensureInner op s = true ∧ op.suffix.length = cs) → + rootHash H t = some root → + applyPath H s.innerSpec lh path = some root → + (key = minKey t ∧ TreeMember key value t) ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro key value lh path root hwf hlh hpath hrh hap + simp only [WFTree] at hwf; subst hwf + rw [rootHash] at hrh + cases path with + | nil => + simp only [applyPath, Option.some.injEq] at hap; subst hap + rcases hLInj key value tk tv _ hlh hrh with ⟨hk, hv⟩ | hc + · exact Or.inl ⟨hk, hk.symm, hv.symm⟩ + · exact Or.inr hc + | cons op rest => + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lh root (by simp) + (fun o ho => (hpath o ho).1) hap + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl _ => + intro key value lh path root hwf hlh hpath hrh hap + obtain ⟨hih, hmid, hsuf, hppre, hprene, hprehead, hwfl, _⟩ := hwf + subst hmid; subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + rcases List.eq_nil_or_concat path with hpnil | ⟨q, topOp, hpc⟩ + · subst hpnil + simp only [applyPath, Option.some.injEq] at hap + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec key value lh b hlpre hlh + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => + rw [hpc2] at hprehead; simp only [List.cons_append, List.head?_cons] at hprehead ⊢ + exact hprehead + · rw [← hlheq, hap]; exact hrh.symm + · rw [List.concat_eq_append] at hpc; subst hpc + obtain ⟨m, hpm, htop, _⟩ := (applyPath_snoc H s.innerSpec q topOp lh root).mp hap + have htopimg := applyInner_image H topOp m root htop + rw [ensureInner_hash topOp s (hpath topOp (by simp)).1] at htopimg + by_cases hpe : topOp.prefixBytes ++ m ++ topOp.suffix = pre ++ lhL ++ rhR + · have hmlen : m.length = cs := + applyPath_len H s.innerSpec cs hH q lh m + (applyLeaf_len H cs hH s.leafSpec key value lh hlh) hpm + have hlow : pre.length ≤ topOp.prefixBytes.length := by + have := ensureInner_minle topOp s (hpath topOp (by simp)).1 + omega + have hml : m = lhL := split_left pre lhL rhR topOp.prefixBytes m topOp.suffix cs + hpe hlow (rootHash_len H cs hH l lhL hl) (rootHash_len H cs hH r rhR hr) hmlen + (hpath topOp (by simp)).2 + rw [hml] at hpm + rcases ihl key value lh q lhL hwfl hlh + (fun o ho => hpath o (List.mem_append.mpr (Or.inl ho))) hl hpm with ⟨hk, hmem⟩ | hcol + · exact Or.inl ⟨by rw [hk]; rfl, Or.inl hmem⟩ + · exact Or.inr hcol + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpe (htopimg.trans hrh.symm)) + +/-- Structure extracted from `ensure_left_neighbor`: after stripping the common +root-side path, the first divergent ops form a left-step, the left remainder is +right-most, and the right remainder is left-most. -/ +theorem ensureLeftNeighbor_spec (isp : InnerSpec) (left right : List InnerOp) + (h : ensureLeftNeighbor isp left right = true) : + ∃ topLeft restL topRight restR, + dropCommonPrefix left.reverse right.reverse + = (some topLeft, restL, some topRight, restR) ∧ + isLeftStep isp topLeft topRight = true ∧ + ensureRightMost isp restL.reverse = true ∧ + ensureLeftMost isp restR.reverse = true := by + unfold ensureLeftNeighbor at h + split at h + · next topLeft restL topRight restR heq => + simp only [Bool.and_eq_true] at h + exact ⟨topLeft, restL, topRight, restR, heq, h.1.1, h.1.2, h.2⟩ + · exact absurd h (by simp) + +/-- Bridge (the padding-vs-navigation subtlety, finding F4/F5): for a binary spec +whose `emptyChild` sentinel is not a full `cs`-byte digest (the Tendermint shape, +`emptyChild = []`), every step of an `ensure_right_most` path has an *empty* +suffix — i.e. it is a genuine right-pad, not an empty-branch placeholder. The +placeholder branch would require `emptyChild.length = cs`, excluded by `hec`. -/ +theorem ensureRightMost_suffix_nil (isp : InnerSpec) (cs : Nat) + (hco : isp.childOrder = [0, 1]) + (hcsspec : isp.childSize.toNat = cs) + (hec : isp.emptyChild.length ≠ cs) + (path : List InnerOp) (h : ensureRightMost isp path = true) : + ∀ op, op ∈ path → op.suffix = [] := by + intro op hop + have hpadeq : getPadding isp (isp.childOrder.length - 1) + = some { minPrefix := (1 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (1 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 1) } := by + unfold getPadding; rw [hco]; rfl + unfold ensureRightMost at h + rw [hpadeq] at h + rw [List.all_eq_true] at h + have hstep := h op hop + rw [Bool.or_eq_true] at hstep + rcases hstep with hp | hr + · -- genuine right-pad: suffix length equals pad.suffix = childSize * 0 = 0 + unfold hasPadding at hp + simp only [Bool.and_eq_true, decide_eq_true_eq] at hp + have hz : (op.suffix.length : Int) = 0 := by have := hp.2; simpa using this + have : op.suffix.length = 0 := by exact_mod_cast hz + exact List.length_eq_zero_iff.mp this + · -- placeholder: forces emptyChild.length = cs, contradicting hec + exfalso + unfold rightBranchesAreEmpty at hr + cases hofp : orderFromPadding isp op with + | none => rw [hofp] at hr; simp at hr + | some idx => + rw [hofp, hco] at hr + simp only [List.length_cons, List.length_nil] at hr + by_cases hrb : (2 - 1 - idx) = 0 + · rw [hrb] at hr; simp at hr + · rw [if_neg hrb] at hr + by_cases hsl : op.suffix.length = isp.childSize.toNat + · rw [if_neg (by omega)] at hr + have h0 : byteRange op.suffix (0 * isp.childSize.toNat) isp.childSize.toNat + == some isp.emptyChild := by + have := List.all_eq_true.mp hr 0 (by simp only [List.mem_range]; omega) + simpa using this + simp only [Nat.zero_mul, byteRange] at h0 + rw [if_pos (by omega)] at h0 + simp only [List.drop_zero, beq_iff_eq, Option.some.injEq] at h0 + rw [List.take_of_length_le (by omega)] at h0 + exact hec (by rw [← h0]; exact hsl.trans hcsspec) + · rw [if_pos hsl] at hr; simp at hr + +/-- `order_from_padding` returns an in-range branch whose padding the op matches. -/ +theorem orderFromPadding_mem (isp : InnerSpec) (op : InnerOp) (idx : Nat) + (h : orderFromPadding isp op = some idx) : + idx < isp.childOrder.length ∧ ∃ pad, getPadding isp idx = some pad ∧ hasPadding op pad = true := by + unfold orderFromPadding at h + have hmem := List.mem_of_find?_eq_some h + have hpred := List.find?_some h + rw [List.mem_range] at hmem + refine ⟨hmem, ?_⟩ + cases hgp : getPadding isp idx with + | none => rw [hgp] at hpred; simp at hpred + | some pad => rw [hgp] at hpred; exact ⟨pad, rfl, hpred⟩ + +/-- For a binary spec, an `is_left_step` pair has a full-`cs` left suffix and an +empty right suffix (orders 0 and 1). -/ +theorem isLeftStep_binary (isp : InnerSpec) (cs : Nat) + (hco : isp.childOrder = [0, 1]) (hcsspec : isp.childSize.toNat = cs) + (l r : InnerOp) (h : isLeftStep isp l r = true) : + l.suffix.length = cs ∧ r.suffix.length = 0 := by + unfold isLeftStep at h + cases hol : orderFromPadding isp l with + | none => rw [hol] at h; simp at h + | some li => + cases hor : orderFromPadding isp r with + | none => rw [hol, hor] at h; simp at h + | some ri => + rw [hol, hor] at h + simp only [decide_eq_true_eq] at h + obtain ⟨hlilt, padl, hpadl, hhpl⟩ := orderFromPadding_mem isp l li hol + obtain ⟨hrilt, padr, hpadr, hhpr⟩ := orderFromPadding_mem isp r ri hor + rw [hco] at hlilt hrilt + simp only [List.length_cons, List.length_nil] at hlilt hrilt + have hli0 : li = 0 := by omega + have hri1 : ri = 1 := by omega + subst hli0; subst hri1 + have hpl0 : getPadding isp 0 + = some { minPrefix := (0 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (0 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 0) } := by + unfold getPadding; rw [hco]; rfl + have hpr1 : getPadding isp 1 + = some { minPrefix := (1 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (1 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 1) } := by + unfold getPadding; rw [hco]; rfl + rw [hpl0, Option.some.injEq] at hpadl; subst hpadl + rw [hpr1, Option.some.injEq] at hpadr; subst hpadr + unfold hasPadding at hhpl hhpr + simp only [Bool.and_eq_true, decide_eq_true_eq] at hhpl hhpr + constructor + · have hz : (l.suffix.length : Int) = isp.childSize * ((2 : Int) - 1 - 0) := hhpl.2 + have he1 : ((2 : Int) - 1 - 0) = 1 := by decide + rw [he1, Int.mul_one] at hz + have : l.suffix.length = isp.childSize.toNat := by omega + rw [this, hcsspec] + · have hz : (r.suffix.length : Int) = isp.childSize * ((2 : Int) - 1 - 1) := hhpr.2 + have he0 : ((2 : Int) - 1 - 1) = 0 := by decide + rw [he0, Int.mul_zero] at hz + exact_mod_cast hz + +/-- Bridge (left-most, mirror of `ensureRightMost_suffix_nil`): every step of an +`ensure_left_most` path has a full `cs`-byte suffix — a genuine left-pad, not a +left-empty-branch placeholder (which would force `emptyChild.length = cs`). -/ +theorem ensureLeftMost_suffix_cs (isp : InnerSpec) (cs : Nat) + (hco : isp.childOrder = [0, 1]) + (hcsspec : isp.childSize.toNat = cs) + (hec : isp.emptyChild.length ≠ cs) + (path : List InnerOp) (h : ensureLeftMost isp path = true) : + ∀ op, op ∈ path → op.suffix.length = cs := by + intro op hop + have hpadeq : getPadding isp 0 + = some { minPrefix := (0 : Int) * isp.childSize + isp.minPrefixLength, + maxPrefix := (0 : Int) * isp.childSize + isp.maxPrefixLength, + suffix := isp.childSize * ((2 : Int) - 1 - 0) } := by + unfold getPadding; rw [hco]; rfl + unfold ensureLeftMost at h + rw [hpadeq] at h + rw [List.all_eq_true] at h + have hstep := h op hop + rw [Bool.or_eq_true] at hstep + rcases hstep with hp | hl + · -- genuine left-pad: suffix length equals pad.suffix = childSize * 2 - childSize = cs + unfold hasPadding at hp + simp only [Bool.and_eq_true, decide_eq_true_eq] at hp + have hz : (op.suffix.length : Int) = isp.childSize * ((2 : Int) - 1 - 0) := hp.2 + have he1 : ((2 : Int) - 1 - 0) = 1 := by decide + rw [he1, Int.mul_one] at hz + have : op.suffix.length = isp.childSize.toNat := by omega + rw [this, hcsspec] + · -- placeholder: forces emptyChild.length = cs, contradicting hec + exfalso + unfold leftBranchesAreEmpty at hl + cases hofp : orderFromPadding isp op with + | none => rw [hofp] at hl; simp at hl + | some idx => + simp only [hofp] at hl + by_cases hlb : idx = 0 + · rw [hlb] at hl; simp at hl + · rw [if_neg hlb] at hl + by_cases hpl : op.prefixBytes.length < idx * isp.childSize.toNat + · rw [if_pos hpl] at hl; simp at hl + · rw [if_neg hpl] at hl + have hmul : isp.childSize.toNat ≤ idx * isp.childSize.toNat := + Nat.le_mul_of_pos_left _ (Nat.one_le_iff_ne_zero.mpr hlb) + have h0 : byteRange op.prefixBytes + ((op.prefixBytes.length - idx * isp.childSize.toNat) + 0 * isp.childSize.toNat) + isp.childSize.toNat == some isp.emptyChild := by + have := List.all_eq_true.mp hl 0 (by simp only [List.mem_range]; omega) + simpa using this + simp only [Nat.zero_mul, Nat.add_zero, byteRange] at h0 + rw [if_pos (by omega)] at h0 + simp only [beq_iff_eq, Option.some.injEq] at h0 + have hlen : ((op.prefixBytes.drop (op.prefixBytes.length - idx * isp.childSize.toNat)).take isp.childSize.toNat).length = isp.emptyChild.length := by rw [h0] + rw [List.length_take, List.length_drop] at hlen + exact hec (by omega) + +/-- **Neighbor walk → divergence node.** Two verifying existence proofs whose +reversed paths share a root-side prefix and then diverge as a left-step (with +right-most / left-most remainders) navigate to a common node `N` (a subtree of the +honest tree): the left proof reaches `maxKey N.left`, the right proof reaches +`minKey N.right` — up to a hash collision. This is the byte→tree bridge: it turns +`ensure_left_neighbor`'s shape into a structural fact about where the proofs land. -/ +theorem neighbor_divergence (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hihash : s.innerSpec.hash = s.leafSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) : + ∀ (t : MTree) (lhLeaf rhLeaf root : Bytes) + (leftKey leftVal rightKey rightVal : Bytes) + (pathL pathR : List InnerOp) + (topLeft topRight : InnerOp) (restL restR : List InnerOp), + WFTree s b t → + applyLeaf H s.leafSpec leftKey leftVal = some lhLeaf → + applyLeaf H s.leafSpec rightKey rightVal = some rhLeaf → + (∀ op ∈ pathL, ensureInner op s = true) → + (∀ op ∈ pathR, ensureInner op s = true) → + rootHash H t = some root → + applyPath H s.innerSpec lhLeaf pathL = some root → + applyPath H s.innerSpec rhLeaf pathR = some root → + dropCommonPrefix pathL.reverse pathR.reverse = (some topLeft, restL, some topRight, restR) → + isLeftStep s.innerSpec topLeft topRight = true → + ensureRightMost s.innerSpec restL.reverse = true → + ensureLeftMost s.innerSpec restR.reverse = true → + (∃ ihN preN lN rN, IsSubtree (.node ihN preN [] [] lN rN) t ∧ + (leftKey = maxKey lN ∨ HashCollision H) ∧ + (rightKey = minKey rN ∨ HashCollision H)) + ∨ HashCollision H := by + intro t + induction t with + | leaf top tk tv => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + cases pathL with + | nil => + exfalso + rw [List.reverse_nil] at hdcp + rw [show dropCommonPrefix [] pathR.reverse + = ((none : Option InnerOp), ([] : List InnerOp), (none : Option InnerOp), + ([] : List InnerOp)) from rfl] at hdcp + exact absurd (congrArg Prod.fst hdcp) (by simp) + | cons op rest => + simp only [WFTree] at hwf; subst hwf + rw [rootHash] at hrh + have hii : IsInnerImage H s root := + applyPath_result_isInnerImage H s (op :: rest) lhLeaf root (by simp) hpathL hapL + exact Or.inr (leafHash_innerImage_collision H s s.leafSpec tk tv root b + hihash.symm hlpre hmin (ensureLeaf_self s.leafSpec) hrh hii) + | node ih pre mid suf l r ihl ihr => + intro lhLeaf rhLeaf root leftKey leftVal rightKey rightVal pathL pathR topLeft topRight restL restR + hwf hlhL hlhR hpathL hpathR hrh hapL hapR hdcp hls hrm hlm + obtain ⟨hih, hmid, hsuf, hppre, hprene, hprehead, hwfl, hwfr⟩ := hwf + subst hmid; subst hsuf; subst hih + rw [rootHash] at hrh + cases hl : rootHash H l with + | none => rw [hl] at hrh; simp at hrh + | some lhL => + cases hr : rootHash H r with + | none => rw [hl, hr] at hrh; simp at hrh + | some rhR => + rw [hl, hr] at hrh + simp only [List.append_nil, Option.some.injEq] at hrh + -- both paths must be nonempty (else a leaf hash equals the node hash) + rcases List.eq_nil_or_concat pathL with hLnil | ⟨qL, topOpL, hLc⟩ + · subst hLnil + simp only [applyPath, Option.some.injEq] at hapL + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec leftKey leftVal lhLeaf b hlpre hlhL + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapL]; exact hrh.symm + rcases List.eq_nil_or_concat pathR with hRnil | ⟨qR, topOpR, hRc⟩ + · subst hRnil + simp only [applyPath, Option.some.injEq] at hapR + obtain ⟨tail, hlheq⟩ := applyLeaf_head H s.leafSpec rightKey rightVal rhLeaf b hlpre hlhR + rw [← hihash] at hlheq + refine Or.inr (leaf_inner_domain_collision H s.innerSpec.hash (b :: tail) + (pre ++ lhL ++ rhR) b (by simp) ?_ ?_) + · cases hpc2 : pre with + | nil => exact absurd hpc2 hprene + | cons x xs => rw [hpc2] at hprehead; simpa using hprehead + · rw [← hlheq, hapR]; exact hrh.symm + rw [List.concat_eq_append] at hLc hRc; subst hLc; subst hRc + simp only [List.reverse_append, List.reverse_singleton, List.singleton_append] at hdcp + obtain ⟨mL, hpmL, htopL, _⟩ := (applyPath_snoc H s.innerSpec qL topOpL lhLeaf root).mp hapL + obtain ⟨mR, hpmR, htopR, _⟩ := (applyPath_snoc H s.innerSpec qR topOpR rhLeaf root).mp hapR + have hmLlen : mL.length = cs := applyPath_len H s.innerSpec cs hH qL lhLeaf mL + (applyLeaf_len H cs hH s.leafSpec leftKey leftVal lhLeaf hlhL) hpmL + have hmRlen : mR.length = cs := applyPath_len H s.innerSpec cs hH qR rhLeaf mR + (applyLeaf_len H cs hH s.leafSpec rightKey rightVal rhLeaf hlhR) hpmR + have htopimgL := applyInner_image H topOpL mL root htopL + rw [ensureInner_hash topOpL s (hpathL topOpL (by simp))] at htopimgL + have htopimgR := applyInner_image H topOpR mR root htopR + rw [ensureInner_hash topOpR s (hpathR topOpR (by simp))] at htopimgR + have hlhLlen := rootHash_len H cs hH l lhL hl + have hrhRlen := rootHash_len H cs hH r rhR hr + have hlowL : pre.length ≤ topOpL.prefixBytes.length := by + have := ensureInner_minle topOpL s (hpathL topOpL (by simp)); omega + have hlowR : pre.length ≤ topOpR.prefixBytes.length := by + have := ensureInner_minle topOpR s (hpathR topOpR (by simp)); omega + unfold dropCommonPrefix at hdcp + by_cases heq : eqPS topOpL topOpR = true + · -- common root step: both proofs navigate into the SAME child; recurse + rw [if_pos heq] at hdcp + unfold eqPS at heq + simp only [Bool.and_eq_true, beq_iff_eq] at heq + obtain ⟨hpreEq, hsufEq⟩ := heq + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ rhR + · -- both top ops genuinely match the node split: mL = mR + have hcat : topOpL.prefixBytes ++ mL = topOpL.prefixBytes ++ mR := by + have hee : (topOpL.prefixBytes ++ mL) ++ topOpL.suffix + = (topOpL.prefixBytes ++ mR) ++ topOpL.suffix := by + rw [hpeL]; rw [hpreEq, hsufEq] at *; rw [hpeR] + exact (List.append_inj hee (by simp [hmLlen, hmRlen])).1 + have hmEq : mL = mR := List.append_cancel_left hcat + obtain ⟨hb1, hb2, hb7⟩ := split_bounds topOpL s cs pre.length hcsspec hmm + (by rw [hco]; rfl) hppre (hpathL topOpL (by simp)) + rcases split_pins pre lhL rhR topOpL.prefixBytes mL topOpL.suffix cs pre.length + hpeL rfl hlhLlen hrhRlen hmLlen hcs hb1 hb2 hb7 with hmlL | hmrL + · rw [hmlL] at hpmL + rw [← hmEq, hmlL] at hpmR + rcases ihl lhLeaf rhLeaf lhL leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfl hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hl hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, lN, rN, by simp only [IsSubtree]; exact Or.inr (Or.inl hsub), h1, h2⟩ + · exact Or.inr hc + · rw [hmrL] at hpmL + rw [← hmEq, hmrL] at hpmR + rcases ihr lhLeaf rhLeaf rhR leftKey leftVal rightKey rightVal qL qR + topLeft topRight restL restR hwfr hlhL hlhR + (fun o ho => hpathL o (List.mem_append.mpr (Or.inl ho))) + (fun o ho => hpathR o (List.mem_append.mpr (Or.inl ho))) + hr hpmL hpmR hdcp hls hrm hlm with hex | hc + · obtain ⟨ihN, preN, lN, rN, hsub, h1, h2⟩ := hex + exact Or.inl ⟨ihN, preN, lN, rN, by simp only [IsSubtree]; exact Or.inr (Or.inr hsub), h1, h2⟩ + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + · -- divergence here: this node IS the neighbor node N + rw [if_neg heq] at hdcp + simp only [Prod.mk.injEq, Option.some.injEq] at hdcp + obtain ⟨htL, hrestL, htR, hrestR⟩ := hdcp + subst htL; subst htR + rw [← hrestL, List.reverse_reverse] at hrm + rw [← hrestR, List.reverse_reverse] at hlm + obtain ⟨hsufL, hsufR⟩ := isLeftStep_binary s.innerSpec cs hco hcsspec topOpL topOpR hls + by_cases hpeL : topOpL.prefixBytes ++ mL ++ topOpL.suffix = pre ++ lhL ++ rhR + · by_cases hpeR : topOpR.prefixBytes ++ mR ++ topOpR.suffix = pre ++ lhL ++ rhR + · have hmlL : mL = lhL := split_left pre lhL rhR topOpL.prefixBytes mL topOpL.suffix cs + hpeL hlowL hlhLlen hrhRlen hmLlen hsufL + have hmrR : mR = rhR := split_right pre lhL rhR topOpR.prefixBytes mR topOpR.suffix cs + hpeR hlhLlen hrhRlen hmRlen hsufR + rw [hmlL] at hpmL + rw [hmrR] at hpmR + have hqLspec : ∀ op ∈ qL, ensureInner op s = true ∧ op.suffix = [] := fun op hop => + ⟨hpathL op (List.mem_append.mpr (Or.inl hop)), + ensureRightMost_suffix_nil s.innerSpec cs hco hcsspec hec qL hrm op hop⟩ + have hqRspec : ∀ op ∈ qR, ensureInner op s = true ∧ op.suffix.length = cs := fun op hop => + ⟨hpathR op (List.mem_append.mpr (Or.inl hop)), + ensureLeftMost_suffix_cs s.innerSpec cs hco hcsspec hec qR hlm op hop⟩ + refine Or.inl ⟨s.innerSpec.hash, pre, l, r, Or.inl rfl, ?_, ?_⟩ + · rcases reaches_max H s b cs hH hihash hlpre hmin hLInj l leftKey leftVal lhLeaf qL lhL + hwfl hlhL hqLspec hl hpmL with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · rcases reaches_min H s b cs hH hihash hlpre hmin hLInj r rightKey rightVal rhLeaf qR rhR + hwfr hlhR hqRspec hr hpmR with ⟨hk, _⟩ | hc + · exact Or.inl hk + · exact Or.inr hc + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeR (htopimgR.trans hrh.symm)) + · exact Or.inr (hashCollision_of H s.innerSpec.hash _ _ hpeL (htopimgL.trans hrh.symm)) + +/-- A verifying existence proof navigates: its leaf hash folds along its path to +the claimed root, and every path op is spec-conformant. (Extracted from the body +of `membership_sound`.) -/ +theorem verifyExistence_navigates (H : HashFn) (s : ProofSpec) (p : ExistenceProof) (root : Bytes) + (hep : p.leaf = s.leafSpec) + (hver : verifyExistence H p s root p.key p.value = true) : + ∃ lh, applyLeaf H s.leafSpec p.key p.value = some lh ∧ + applyPath H s.innerSpec lh p.path = some root ∧ + (∀ op ∈ p.path, ensureInner op s = true) := by + have hr := verifyExistence_root H p s root p.key p.value hver + cases hke : p.key.isEmpty with + | true => simp [calculateExistenceRoot, hke] at hr + | false => + cases hve : p.value.isEmpty with + | true => simp [calculateExistenceRoot, hke, hve] at hr + | false => + cases hlf : applyLeaf H p.leaf p.key p.value with + | none => simp [calculateExistenceRoot, hke, hve, hlf] at hr + | some lh => + have hap : applyPath H s.innerSpec lh p.path = some root := by + rw [calculateExistenceRoot_eq H s p lh hke hve hlf] at hr; exact hr + refine ⟨lh, ?_, hap, verifyExistence_inners H p s root p.key p.value hver⟩ + rw [← hep]; exact hlf + +/-- **Theorem B (non-existence soundness), honest-root tree model — two-sided.** +The honest-root analog of `membership_sound`: for a key-sorted honest tree, a +two-sided non-existence proof for `key` and an existence proof for `key` cannot +both verify without a hash collision. The neighbor walk pins the bracketing +proofs to a divergence node `N`; the absent key, were it a genuine member, would +sit in the forbidden gap between `maxKey N.left` and `minKey N.right`, which +`node_gap_no_member` rules out in a sorted tree. -/ +theorem nonexistence_sound_tree (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTree s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep lp rp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + -- the absent key is a genuine member of the honest tree (or a collision) + rcases membership_sound H s b cs hH hcs hcsspec hlhash hlpre hmin hmm hbin hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · -- bracketing proofs verify and bracket the key + obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hnb : ensureLeftNeighbor s.innerSpec lp.path rp.path = true := by + unfold verifyNonExistence at hne + simp only [hnl, hnr, Bool.and_eq_true] at hne + exact hne.2 + -- both bracketing proofs navigate + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + -- the neighbor walk decomposes + obtain ⟨topLeft, restL, topRight, restR, hdcp, hls, hrm, hlm⟩ := + ensureLeftNeighbor_spec s.innerSpec lp.path rp.path hnb + -- ... and pins both proofs to a divergence node N + rcases neighbor_divergence H s b cs hH hcs hcsspec hlhash.symm hlpre hmin hmm hco hec hLInj + t lhLeaf rhLeaf root lp.key lp.value rp.key rp.value lp.path rp.path topLeft topRight restL restR + hwf hlapL hrapL hlinn hrinn hroot hlap hrap hdcp hls hrm hlm with hdiv | hc + · obtain ⟨ihN, preN, lN, rN, hsub, hLeq, hReq⟩ := hdiv + rcases hLeq with hLeq | hc + · rcases hReq with hReq | hc + · -- maxKey N.left < key < minKey N.right, but key is a member: contradiction + rw [hkfc, hkfc] at hllt hrlt + exact (node_gap_no_member t hsort ihN preN [] [] lN rN hsub key value hmem + (by rw [← hLeq]; exact hllt) (by rw [← hReq]; exact hrlt)).elim + · exact hc + · exact hc + · exact hc + · exact hc + +/-- **Theorem B for the Tendermint spec (two-sided).** Structural side conditions +discharged by computation, joint leaf injectivity now *proved* +(`leafInj_tendermint`); the single remaining hypothesis is the genuine +cryptographic assumption (`FixedHash`). Mirrors `membership_sound_tendermint`. -/ +theorem nonexistence_sound_tree_tendermint (H : HashFn) + (hH : FixedHash H 32) + (t : MTree) (hwf : WFTree tendermintSpec 0 t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep lp rp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = tendermintSpec.leafSpec) + (hlpleaf : lp.leaf = tendermintSpec.leafSpec) (hrpleaf : rp.leaf = tendermintSpec.leafSpec) + (hne : verifyNonExistence H nep tendermintSpec root key = true) + (hex : verifyExistence H ep tendermintSpec root key value = true) : + HashCollision H := + nonexistence_sound_tree H tendermintSpec 0 32 hH (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (by decide) + (fun k => by simp [keyForComparison, tendermintSpec]) (leafInj_tendermint H) + t hwf hsort root key value hroot nep ep lp rp hnl hnr hepleaf hlpleaf hrpleaf hne hex + +/-- **Theorem B, honest-root tree model — left-only.** A non-existence proof with +only a left neighbor claims `key` lies beyond the rightmost leaf: the verifier +requires the neighbor's path to be `ensure_right_most`, so the neighbor *is* the +rightmost leaf (`reaches_max`) and `maxKey t < key`. A verifying existence proof +for `key` would make it a genuine member with `key ≤ maxKey t` +(`member_le_maxKey`) — contradiction, so a hash collision occurred. -/ +theorem nonexistence_sound_tree_leftOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTree s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep lp : ExistenceProof) + (hnl : nep.left = some lp) (hnr : nep.right = none) + (hepleaf : ep.leaf = s.leafSpec) (hlpleaf : lp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + rcases membership_sound H s b cs hH hcs hcsspec hlhash hlpre hmin hmm hbin hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hlver, hllt⟩ := verifyNonExistence_left H s root key nep lp hnl hne + have hrm := verifyNonExistence_leftOnly H s root key nep lp hnl hnr hne + obtain ⟨lhLeaf, hlapL, hlap, hlinn⟩ := verifyExistence_navigates H s lp root hlpleaf hlver + rcases reaches_max H s b cs hH hlhash.symm hlpre hmin hLInj + t lp.key lp.value lhLeaf lp.path root hwf hlapL + (fun op hop => ⟨hlinn op hop, + ensureRightMost_suffix_nil s.innerSpec cs hco hcsspec hec lp.path hrm op hop⟩) + hroot hlap with ⟨hk, _⟩ | hc + · rw [hkfc, hkfc] at hllt + exact (ble_not_gt key (maxKey t) + (member_le_maxKey t key value hsort hmem) (hk ▸ hllt)).elim + · exact hc + · exact hc + +/-- **Theorem B, honest-root tree model — right-only.** Mirror of +`nonexistence_sound_tree_leftOnly`: the right neighbor's `ensure_left_most` path +makes it the leftmost leaf (`reaches_min`) with `key < minKey t`, while a +verifying existence proof would force `minKey t ≤ key` (`minKey_le_member`). -/ +theorem nonexistence_sound_tree_rightOnly (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTree s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep rp : ExistenceProof) + (hnl : nep.left = none) (hnr : nep.right = some rp) + (hepleaf : ep.leaf = s.leafSpec) (hrpleaf : rp.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + have hbin : s.innerSpec.childOrder.length = 2 := by rw [hco]; rfl + rcases membership_sound H s b cs hH hcs hcsspec hlhash hlpre hmin hmm hbin hLInj + t ep root key value hwf hepleaf hroot hex with hmem | hc + · obtain ⟨hrver, hrlt⟩ := verifyNonExistence_right H s root key nep rp hnr hne + have hlm := verifyNonExistence_rightOnly H s root key nep rp hnl hnr hne + obtain ⟨rhLeaf, hrapL, hrap, hrinn⟩ := verifyExistence_navigates H s rp root hrpleaf hrver + rcases reaches_min H s b cs hH hlhash.symm hlpre hmin hLInj + t rp.key rp.value rhLeaf rp.path root hwf hrapL + (fun op hop => ⟨hrinn op hop, + ensureLeftMost_suffix_cs s.innerSpec cs hco hcsspec hec rp.path hlm op hop⟩) + hroot hrap with ⟨hk, _⟩ | hc + · rw [hkfc, hkfc] at hrlt + exact (ble_not_gt (minKey t) key + (minKey_le_member t key value hsort hmem) (hk ▸ hrlt)).elim + · exact hc + · exact hc + +/-- **Theorem B, honest-root tree model — total.** Every proof shape the verifier +accepts is covered: two-sided, left-only, right-only (a no-neighbor proof never +verifies, `verifyNonExistence_none`). For a key-sorted honest tree, *any* +verifying non-existence proof for `key` together with a verifying existence +proof for `key` yields a hash collision. -/ +theorem nonexistence_sound_tree_total (H : HashFn) (s : ProofSpec) (b : UInt8) (cs : Nat) + (hH : FixedHash H cs) (hcs : 0 < cs) + (hcsspec : s.innerSpec.childSize.toNat = cs) + (hlhash : s.leafSpec.hash = s.innerSpec.hash) + (hlpre : s.leafSpec.prefixBytes = [b]) + (hmin : 1 ≤ s.innerSpec.minPrefixLength) + (hmm : s.innerSpec.minPrefixLength = s.innerSpec.maxPrefixLength) + (hco : s.innerSpec.childOrder = [0, 1]) + (hec : s.innerSpec.emptyChild.length ≠ cs) + (hkfc : ∀ k, keyForComparison H s k = k) + (hLInj : ∀ k₁ v₁ k₂ v₂ r, applyLeaf H s.leafSpec k₁ v₁ = some r → + applyLeaf H s.leafSpec k₂ v₂ = some r → (k₁ = k₂ ∧ v₁ = v₂) ∨ HashCollision H) + (t : MTree) (hwf : WFTree s b t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = s.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = s.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = s.leafSpec) + (hne : verifyNonExistence H nep s root key = true) + (hex : verifyExistence H ep s root key value = true) : + HashCollision H := by + cases hnl : nep.left with + | none => + cases hnr : nep.right with + | none => + rw [verifyNonExistence_none H s root key nep hnl hnr] at hne + exact Bool.noConfusion hne + | some rp => + exact nonexistence_sound_tree_rightOnly H s b cs hH hcs hcsspec hlhash hlpre hmin hmm + hco hec hkfc hLInj t hwf hsort root key value hroot nep ep rp hnl hnr hepleaf + (hrleaf rp hnr) hne hex + | some lp => + cases hnr : nep.right with + | none => + exact nonexistence_sound_tree_leftOnly H s b cs hH hcs hcsspec hlhash hlpre hmin hmm + hco hec hkfc hLInj t hwf hsort root key value hroot nep ep lp hnl hnr hepleaf + (hlleaf lp hnl) hne hex + | some rp => + exact nonexistence_sound_tree H s b cs hH hcs hcsspec hlhash hlpre hmin hmm hco hec + hkfc hLInj t hwf hsort root key value hroot nep ep lp rp hnl hnr hepleaf + (hlleaf lp hnl) (hrleaf rp hnr) hne hex + +/-- **Theorem B for the Tendermint spec — total.** All structural side conditions +discharged by computation; the only remaining hypothesis is collision resistance +(`FixedHash`). Subsumes the two-sided and one-sided cases. -/ +theorem nonexistence_sound_tree_tendermint_total (H : HashFn) + (hH : FixedHash H 32) + (t : MTree) (hwf : WFTree tendermintSpec 0 t) (hsort : SortedTree t) + (root key value : Bytes) (hroot : rootHash H t = some root) + (nep : NonExistenceProof) (ep : ExistenceProof) + (hepleaf : ep.leaf = tendermintSpec.leafSpec) + (hlleaf : ∀ p, nep.left = some p → p.leaf = tendermintSpec.leafSpec) + (hrleaf : ∀ p, nep.right = some p → p.leaf = tendermintSpec.leafSpec) + (hne : verifyNonExistence H nep tendermintSpec root key = true) + (hex : verifyExistence H ep tendermintSpec root key value = true) : + HashCollision H := + nonexistence_sound_tree_total H tendermintSpec 0 32 hH (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) (by decide) (by decide) + (fun k => by simp [keyForComparison, tendermintSpec]) (leafInj_tendermint H) + t hwf hsort root key value hroot nep ep hepleaf hlleaf hrleaf hne hex + +end Ics23 diff --git a/lean/Ics23/Types.lean b/lean/Ics23/Types.lean new file mode 100644 index 00000000..63eb8e0d --- /dev/null +++ b/lean/Ics23/Types.lean @@ -0,0 +1,112 @@ +/- +ICS23 proto types, modeled in Lean. + +These mirror `proto/cosmos/ics23/v1/proofs.proto` and the Rust generated types +in `rust/src/cosmos.ics23.v1.rs`. Modeling decisions (kept deliberately faithful +to the verifier's soundness-relevant surface): + +* Bytes are `List UInt8`. +* `HashOp`/`LengthOp` are inductives rather than the proto's `i32` enums. Only + the operations the verifier actually supports are represented; an unsupported + proto value corresponds to an input the verifier rejects. +* `ProofSpec.leafSpec`/`innerSpec` and `ExistenceProof.leaf` are non-optional + here. In the proto/Rust they are `Option`, and a missing value causes an + immediate `bail!`. Dropping the `None` cases only removes inputs the verifier + rejects, so it is a sound abstraction for a soundness proof (it can only + enlarge the accepted set, never shrink it). +* Spec integer fields (`childSize`, `minPrefixLength`, ...) are `Int`, matching + the `i32` proto fields, so that malformed (e.g. negative) specs are + representable and ruled out explicitly by `WellFormed` rather than by typing. +* `childOrder` entries are `Nat` (they are always non-negative indices). +-/ + +namespace Ics23 + +/-- A byte string. -/ +abbrev Bytes := List UInt8 + +/-- Hash operations supported by the verifier (`do_hash` in `rust/src/ops.rs`). -/ +inductive HashOp where + | noHash + | sha256 + | sha512 + | keccak256 + | ripemd160 + | bitcoin + | sha512256 + | blake2b512 + | blake2s256 + | blake3 + deriving Repr, DecidableEq, BEq, Inhabited + +instance : LawfulBEq HashOp where + eq_of_beq {a b} h := by cases a <;> cases b <;> first | rfl | exact absurd h (by decide) + rfl {a} := by cases a <;> rfl + +/-- Length-prefix operations supported by the verifier (`do_length`). -/ +inductive LengthOp where + | noPrefix + | varProto + | require32Bytes + | require64Bytes + | fixed32Big + | fixed32Little + | fixed64Big + | fixed64Little + deriving Repr, DecidableEq, BEq, Inhabited + +instance : LawfulBEq LengthOp where + eq_of_beq {a b} h := by cases a <;> cases b <;> first | rfl | exact absurd h (by decide) + rfl {a} := by cases a <;> rfl + +/-- `LeafOp`: how a (key, value) pair is transformed into a leaf hash. -/ +structure LeafOp where + hash : HashOp + prehashKey : HashOp + prehashValue : HashOp + length : LengthOp + prefixBytes : Bytes -- proto `prefix`; renamed: `prefix` is a Lean keyword + deriving Repr, DecidableEq, BEq, Inhabited + +/-- `InnerOp`: one step up the tree — `hash(prefix ++ child ++ suffix)`. -/ +structure InnerOp where + hash : HashOp + prefixBytes : Bytes -- proto `prefix` + suffix : Bytes + deriving Repr, DecidableEq, BEq, Inhabited + +/-- `InnerSpec`: store-specific structure of inner nodes. -/ +structure InnerSpec where + childOrder : List Nat + childSize : Int + minPrefixLength : Int + maxPrefixLength : Int + emptyChild : Bytes + hash : HashOp + deriving Repr, DecidableEq, BEq, Inhabited + +/-- `ProofSpec`: the full parameterization for a given merkle store. -/ +structure ProofSpec where + leafSpec : LeafOp + innerSpec : InnerSpec + minDepth : Int + maxDepth : Int + prehashKeyBeforeComparison : Bool + deriving Repr, DecidableEq, BEq, Inhabited + +/-- `ExistenceProof`: key/value plus the path of inner ops up to the root. -/ +structure ExistenceProof where + key : Bytes + value : Bytes + leaf : LeafOp + path : List InnerOp + deriving Repr, DecidableEq, BEq, Inhabited + +/-- `NonExistenceProof`: the left and right neighbors bracketing an absent key. -/ +structure NonExistenceProof where + key : Bytes + left : Option ExistenceProof + right : Option ExistenceProof + deriving Repr, DecidableEq, BEq, Inhabited + +end Ics23 diff --git a/lean/Ics23/Varint.lean b/lean/Ics23/Varint.lean new file mode 100644 index 00000000..8d0a4dd5 --- /dev/null +++ b/lean/Ics23/Varint.lean @@ -0,0 +1,57 @@ +/- +The varint length prefix is self-delimiting: `varintEncode n ++ rest` parses +back to `(n, rest)`. This is the A1 ingredient for length-prefixed specs +(IAVL/Tendermint), the analogue of the fixed-length argument used for the SMT +shape. From it, `doLength .varProto` is injective in its data argument. +-/ +import Ics23.Ops + +namespace Ics23 + +/-- Decode a leading unsigned LEB128 varint, returning the value and the +remaining bytes. Inverse of `varintEncode` on the prefix. -/ +def varintDecode : List UInt8 → Option (Nat × List UInt8) + | [] => none + | b :: rest => + if b.toNat < 0x80 then + some (b.toNat, rest) + else + match varintDecode rest with + | some (n, rest') => some (b.toNat % 0x80 + 0x80 * n, rest') + | none => none + +/-- Decoding the encoding of `n` followed by anything recovers `n` and the +remainder exactly. -/ +theorem varintDecode_roundtrip (n : Nat) (rest : Bytes) : + varintDecode (varintEncode n ++ rest) = some (n, rest) := by + induction n using Nat.strongRecOn with + | _ n ih => + rw [varintEncode] + by_cases hn : n < 0x80 + · have ht : (UInt8.ofNat n).toNat = n := by simp; omega + simp only [if_pos hn, List.cons_append, List.nil_append, varintDecode, ht] + · have hb : (UInt8.ofNat (n % 0x80 + 0x80)).toNat = n % 0x80 + 0x80 := by + simp; omega + have hge : ¬ (UInt8.ofNat (n % 0x80 + 0x80)).toNat < 0x80 := by rw [hb]; omega + have hlt : n / 0x80 < n := Nat.div_lt_self (by omega) (by omega) + rw [if_neg hn] + simp only [List.cons_append, varintDecode, if_neg hge, ih (n / 0x80) hlt, + Option.some.injEq, Prod.mk.injEq, and_true] + rw [hb]; omega + +/-- `varintEncode` is self-delimiting under concatenation. -/ +theorem varintEncode_append_inj (n m : Nat) (x y : Bytes) + (h : varintEncode n ++ x = varintEncode m ++ y) : n = m ∧ x = y := by + have h1 := varintDecode_roundtrip n x + have h2 := varintDecode_roundtrip m y + rw [h, h2] at h1 + simp only [Option.some.injEq, Prod.mk.injEq] at h1 + exact ⟨h1.1.symm, h1.2.symm⟩ + +/-- `doLength .varProto` is injective in its data. -/ +theorem doLength_varProto_inj (a b : Bytes) + (h : doLength .varProto a = doLength .varProto b) : a = b := by + simp only [doLength, Option.some.injEq] at h + exact (varintEncode_append_inj a.length b.length a b h).2 + +end Ics23 diff --git a/lean/Ics23/Verify.lean b/lean/Ics23/Verify.lean new file mode 100644 index 00000000..f8cd5c2f --- /dev/null +++ b/lean/Ics23/Verify.lean @@ -0,0 +1,79 @@ +/- +The existence verifier, mirroring `verify_existence` / `check_existence_spec` / +`calculate_existence_root_for_spec` in `rust/src/verify.rs`. + +Abstraction note: the IAVL-specific prefix sanity checks (`ensure_leaf_prefix`, +`ensure_inner_prefix` in `rust/src/api.rs`) are *omitted* here. They fire only +when the spec equals the IAVL spec and can only reject additional proofs. Leaving +them out enlarges the accepted set, so a soundness theorem proved against this +(more permissive) model implies the same property for the stricter Rust code. +-/ +import Ics23.Ops + +namespace Ics23 + +/-- `has_prefix`: is `pre` a prefix of `data`? -/ +def hasPrefix (pre data : Bytes) : Bool := + pre.length ≤ data.length && pre == data.take pre.length + +/-- `ensure_leaf`: the proof's leaf op must match the spec's leaf op. -/ +def ensureLeaf (leaf leafSpec : LeafOp) : Bool := + leafSpec.hash == leaf.hash + && leafSpec.prehashKey == leaf.prehashKey + && leafSpec.prehashValue == leaf.prehashValue + && leafSpec.length == leaf.length + && hasPrefix leafSpec.prefixBytes leaf.prefixBytes + +/-- `ensure_inner`: an inner op must conform to the inner spec, and in +particular must not carry the leaf prefix (domain separation). -/ +def ensureInner (inner : InnerOp) (s : ProofSpec) : Bool := + let isp := s.innerSpec + let maxLeftChildBytes : Int := ((isp.childOrder.length : Int) - 1) * isp.childSize + inner.hash == isp.hash + && (!hasPrefix s.leafSpec.prefixBytes inner.prefixBytes) + && (isp.minPrefixLength ≤ (inner.prefixBytes.length : Int)) + && ((inner.prefixBytes.length : Int) ≤ isp.maxPrefixLength + maxLeftChildBytes) + && (isp.childSize > 0) + && (isp.maxPrefixLength < isp.minPrefixLength + isp.childSize) + && ((inner.suffix.length : Int) % isp.childSize = 0) + +/-- `check_existence_spec`: the leaf and every inner op conform to the spec, and +the depth bounds are respected when `minDepth ≠ 0` (matching the Rust gate). -/ +def checkExistenceSpec (p : ExistenceProof) (s : ProofSpec) : Bool := + ensureLeaf p.leaf s.leafSpec + && (if s.minDepth ≠ 0 then + (s.minDepth ≤ (p.path.length : Int)) && ((p.path.length : Int) ≤ s.maxDepth) + else true) + && p.path.all (fun step => ensureInner step s) + +/-- Fold the inner ops over the leaf hash, enforcing the spec's `child_size` +guard at each step (the `hash.len() > child_size && child_size >= 32` bail). -/ +def applyPath (H : HashFn) (isp : InnerSpec) : Bytes → List InnerOp → Option Bytes + | h, [] => some h + | h, step :: rest => + match applyInner H step h with + | none => none + | some h' => + if (h'.length : Int) > isp.childSize ∧ isp.childSize ≥ 32 then none + else applyPath H isp h' rest + +/-- `calculate_existence_root_for_spec`: compute the root the proof claims. -/ +def calculateExistenceRoot (H : HashFn) (s : ProofSpec) + (p : ExistenceProof) : Option Bytes := + if p.key.isEmpty then none + else if p.value.isEmpty then none + else match applyLeaf H p.leaf p.key p.value with + | none => none + | some h => applyPath H s.innerSpec h p.path + +/-- `verify_existence`: spec conformance, key/value binding, and root match. -/ +def verifyExistence (H : HashFn) (p : ExistenceProof) (s : ProofSpec) + (root key value : Bytes) : Bool := + checkExistenceSpec p s + && p.key == key + && p.value == value + && (match calculateExistenceRoot H s p with + | some r => r == root + | none => false) + +end Ics23 diff --git a/lean/README.md b/lean/README.md new file mode 100644 index 00000000..df49783f --- /dev/null +++ b/lean/README.md @@ -0,0 +1,146 @@ +# ICS23 formal model (Lean 4) + +A mechanized model of the ICS23 verifier with machine-checked soundness proofs, +per [`docs/rfc/001-formal-verification.md`](../docs/rfc/001-formal-verification.md). +Property catalogue: [`docs/verification/properties.md`](../docs/verification/properties.md). + +## Build + +Requires [`elan`](https://github.com/leanprover/elan) (the toolchain is pinned in +`lean-toolchain`; `lake` fetches it automatically). + +```sh +cd lean +lake build +``` + +A clean build prints one expected warning — the *abstract-root* +`nonexistence_sound` (NonExistSound.lean) is the one deliberate `sorry`: an +opaque root carries no tree structure, so byte-order cannot be connected to +tree position (findings F3/F4). Both theorems are instead proved in the +honest-root tree models (below). Everything else is proof-complete. + +## Layout + +| File | Mirrors | Contents | +|------|---------|----------| +| `Ics23/Types.lean` | `proofs.proto`, `cosmos.ics23.v1.rs` | proto types | +| `Ics23/Ops.lean` | `rust/src/ops.rs` | `applyLeaf`, `applyInner`, `doHash` family, `doLength` | +| `Ics23/Verify.lean` | `rust/src/verify.rs` | existence verifier | +| `Ics23/NonExist.lean` | `rust/src/verify.rs` | non-existence verifier | +| `Ics23/Specs.lean` | `rust/src/api.rs` | IAVL / Tendermint / SMT specs | +| `Ics23/Varint.lean` | — | varint self-delimiting lemmas (A1) | +| `Ics23/Soundness.lean` | — | `WellFormed`, collisions, Theorem C | +| `Ics23/Existence.lean` | — | Theorem A, byte-level (`existence_binding`) | +| `Ics23/NonExistSound.lean` | — | byte order; abstract-root Theorem B (the `sorry`) | +| `Ics23/Order.lean` | — | order lemmas for the neighbor checks | +| `Ics23/LeafInj.lean` | — | joint leaf injectivity, proved for all three specs | +| `Ics23/Tree.lean` | — | honest-root `MTree` model; Theorem A (`membership_sound`) | +| `Ics23/TreeNonExist.lean` | — | Theorem B, total (`nonexistence_sound_tree_total`) | +| `Ics23/SmtTree.lean` | — | sparse (SMT/JMT) model; Theorem A (`membership_sound_smt`) | +| `Ics23/SmtNonExist.lean` | — | Theorem B for SMT (`nonexistence_sound_smt_total`) | +| `Ics23/IavlTree.lean` | — | IAVL model (`WFTreeI`); Theorem A (`membership_sound_iavl`) | +| `Ics23/IavlNonExist.lean` | — | Theorem B for IAVL (`nonexistence_sound_iavl_total`) | +| `Ics23/IavlPrefix.lean` | — | IAVL prefix structure; F3 witness | +| `Ics23/Sha256.lean` | — | pure-Lean SHA-256 (validated, incl. padding boundaries) | +| `Ics23/Executable.lean` | — | end-to-end executable runs, forgery refutations | +| `Ics23/Corpus.lean` | — | regression corpus (proven accept/reject facts) | +| `Ics23/TestVectors.lean` | `testdata/` | GENERATED differential vectors (`rust/examples/lean_testdata.rs`) | + +The model is parameterized over an abstract hash family and makes no +collision-resistance assumption: soundness theorems conclude by exhibiting a +`HashCollision`. See the modeling-assumptions section of the property catalogue +for where (and why) the model intentionally differs from the Rust. + +## Status + +- **Model complete:** existence and non-existence verifiers, both executable + over an abstract hash family. +- **Proved:** + - Spec well-formedness certificates for all three shipped specs (Theorem C: + `iavl_wellFormed`, `tendermint_wellFormed`, `smt_wellFormed`). + - Regression corpus: spec-level invariant violations (domain separation, + child-size, prefix-window, malformed specs, depth bounds) as machine-checked + facts (`Ics23/Corpus.lean`). + - Building blocks of Theorem A: `innerImage_inj` (preimage cancellation), + `applyInner_inj` (one step injective up to a collision), and + `applyPath_sameops_inj` (folding a shared op-list is injective up to a + collision) — the inductive backbone. + - The varint length prefix is self-delimiting (`varintEncode_append_inj`, + `Varint.lean`), giving leaf-encoding injectivity (A1) for length-prefixed + specs; `doLength_varProto_inj` / `doLength_noPrefix_inj`. + - **Same-shape existence binding (Theorem A) for all three shipped leaf + shapes**: `existence_binding_sameshape` (general, parameterized by length + injectivity) with corollaries `existence_binding_sameshape_noPrefix` (SMT/ + JMT) and `existence_binding_sameshape_varProto` (IAVL / Tendermint). Two + proofs sharing tree shape that bind one key to two values force a hash + collision — the value-swap forgery, end to end. + - **Equal-length binding** `existence_binding_eqlen` — strengthens the above + to proofs of equal *depth* with arbitrary (differing) inner ops, concluding + the honest disjunction `HashCollision ∨ PositionalAmbiguity` (the F3 + obstacle). Built on `applyPath_eqlen_merge`. + - **Same-leaf binding, any depth** `existence_binding_sameleaf` — the strongest + result: same leaf op, *arbitrary differing-length* paths ⇒ `HashCollision ∨ + PositionalAmbiguity`. Built on the root-side structural core `applyPath_merge` + (+ `applyPath_snoc`) and leaf/inner domain separation + (`leafHash_innerImage_collision`). Instantiated for all three shipped specs: + `existence_binding_{iavl,tendermint,smt}` (side conditions closed by `decide`). + - **Finding F3 is formalized and machine-checked** (`PositionalAmbiguity`, + witnesses in `Executable.lean`/`IavlPrefix.lean`): the general + `existence_binding` is correctly stated as a disjunction, since a + collision-only conclusion is provably too strong byte-level. + - Byte-ordering facts behind the neighbor checks: `bytesLt_irrefl`, + `bytesLt_ne` (`NonExistSound.lean`). + - **General existence binding — fully proved** (`existence_binding_shaped`): + for the production-spec shape, two proofs binding one key to two values under + one root — with *no* assumption on their leaf ops or paths — yield the honest + three-way disjunction `HashCollision ∨ PositionalAmbiguity ∨ LeafAmbiguity`. + The ambiguity arms are real machine-checkable obstructions (F3 + leaf-level + analogue); collapsing them needs the symbolic-Merkle model. Built on + `applyPath_merge`, `ensureLeaf_eq`, `leafHash_innerImage_collision`. + - **Honest-root Theorem A** (`Tree.lean`): `membership_sound` — an existence + proof verifying against `root = rootHash t` of a real tree implies genuine + membership, no ambiguity arm (`split_pins` resolves F3 against a real + node). Instantiated: `membership_sound_tendermint` with leaf injectivity + *proved* (`LeafInj.lean`), leaving `FixedHash` as the only assumption. + - **Honest-root Theorem B, total** (`TreeNonExist.lean`): + `nonexistence_sound_tree_total` — for a key-sorted well-formed tree, any + verifying non-existence proof plus a verifying existence proof for the + same key yields a `HashCollision`, covering all verifier-accepted shapes + (two-sided / left-only / right-only). Instantiated: + `nonexistence_sound_tree_tendermint_total`. + - **SMT/JMT instantiation** (`SmtTree.lean`, `SmtNonExist.lean`): both + theorems for the sparse model, where empty subtrees hash to the + `empty_child` placeholder and keys sort by their SHA-256 prehash + (`keyForComparison`). One added assumption, `EmptyChildFree` (no exhibited + preimage of the all-zero placeholder — the standard SMT assumption): + `membership_sound_smt`, `nonexistence_sound_smt_total`. + - **IAVL instantiation** (`IavlTree.lean`, `IavlNonExist.lean`): both + theorems for the IAVL shape — variable 4–12 byte prefixes and 33-byte + amino child slots — via `split_pins_var`, which pins a node split from + the suffix length alone (no prefix pinning, so `min ≠ max` is fine): + `membership_sound_iavl`, `nonexistence_sound_iavl_total`. **Honest-root + Theorems A and B now cover all three shipped specs.** +- **Stated, deliberately unproved (the one whitelisted `sorry`):** + - Abstract-root Theorem B (`nonexistence_sound`, NonExistSound.lean) — an + opaque root has no tree structure to connect byte-order to position + (F3/F4); adjacency is inherently a statement about a real tree, which is + exactly what the honest-root theorems above capture. +- **Executable end to end:** a concrete SHA-256 (`Sha256.lean`, validated + against the vectors in `rust/src/ops.rs` plus padding-boundary regressions) + and `concreteHash` make the verifier runnable; `Executable.lean` computes + real roots and refutes value-swap / wrong-shape forgeries by + `native_decide`. +- **Phase 2a differential oracle:** `rust/examples/lean_testdata.rs` decodes + the shared `testdata/` vectors and generates `TestVectors.lean`, so + `lake build` re-verifies all 18 vectors against the model with real + SHA-256; CI fails on regeneration drift. Its first run caught a real bug: + `Sha256.pad`'s truncating `Nat` subtraction dropped the spill-over padding + block for lengths `≡ 56..62 (mod 64)` — missed by every Tendermint/SMT + preimage, exposed by IAVL's 57-byte leaf preimages. (Executable layer only; + the soundness theorems are abstract over `HashFn`.) +- **CI:** `.github/workflows/lean.yml` builds all proofs and fails if any + unexpected `sorry` appears (exactly one is whitelisted). +- **Next:** transcribe the Zellic findings into the corpus; optionally extend + the differential oracle to the negative/malformed unit-test vectors + (`testdata/TestCheckAgainstSpecData.json` etc.). diff --git a/lean/lake-manifest.json b/lean/lake-manifest.json new file mode 100644 index 00000000..876b891d --- /dev/null +++ b/lean/lake-manifest.json @@ -0,0 +1,6 @@ +{"version": "1.2.0", + "packagesDir": ".lake/packages", + "packages": [], + "name": "ics23", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lean/lakefile.toml b/lean/lakefile.toml new file mode 100644 index 00000000..15af6254 --- /dev/null +++ b/lean/lakefile.toml @@ -0,0 +1,9 @@ +name = "ics23" +defaultTargets = ["Ics23"] + +# Intentionally dependency-free for the first increment: Lean core + `omega` +# cover the model and the proofs landed so far. Mathlib can be added later if a +# proof genuinely needs it (this keeps the build fast and the trusted base small). + +[[lean_lib]] +name = "Ics23" diff --git a/lean/lean-toolchain b/lean/lean-toolchain new file mode 100644 index 00000000..af9e5d33 --- /dev/null +++ b/lean/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.30.0 diff --git a/rust/Cargo.toml b/rust/Cargo.toml index 512d2608..ca4909bc 100644 --- a/rust/Cargo.toml +++ b/rust/Cargo.toml @@ -12,6 +12,10 @@ version = "0.12.0" [workspace] members = ["codegen", "no-std-check"] +# `kani` cfg is set only under the Kani model checker (see src/kani_proofs.rs). +[lints.rust] +unexpected_cfgs = {level = "warn", check-cfg = ['cfg(kani)']} + # See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html [dependencies] anyhow = {version = "1.0.40", default-features = false} diff --git a/rust/examples/lean_testdata.rs b/rust/examples/lean_testdata.rs new file mode 100644 index 00000000..1eca924b --- /dev/null +++ b/rust/examples/lean_testdata.rs @@ -0,0 +1,241 @@ +//! Phase 2a differential oracle: generate `lean/Ics23/TestVectors.lean` from +//! the shared `testdata/` vectors the Rust and Go suites verify. +//! +//! Each vector's hex protobuf `CommitmentProof` is decoded and re-emitted as a +//! literal of the Lean model's proof types, together with a `native_decide` +//! acceptance check mirroring the Rust call (`verify_membership` / +//! `verify_non_membership`). `lake build` then re-verifies every shared vector +//! against the Lean model with real SHA-256 — any accept/reject divergence +//! between the model and the implementations fails the proof build. +//! +//! Run from `rust/`: `cargo run --example lean_testdata` +//! CI regenerates the file and fails if it drifts from the committed copy. + +use anyhow::{bail, Context, Result}; +use prost::Message; +use serde::Deserialize; +use std::fmt::Write as _; +use std::fs; + +#[derive(Deserialize)] +struct TestVector { + root: String, + proof: String, + key: String, + value: String, +} + +fn hash_op(i: i32) -> Result<&'static str> { + Ok(match i { + 0 => ".noHash", + 1 => ".sha256", + 2 => ".sha512", + 3 => ".keccak256", + 4 => ".ripemd160", + 5 => ".bitcoin", + 6 => ".sha512256", + 7 => ".blake2b512", + 8 => ".blake2s256", + 9 => ".blake3", + _ => bail!("unknown HashOp {i}"), + }) +} + +fn length_op(i: i32) -> Result<&'static str> { + Ok(match i { + 0 => ".noPrefix", + 1 => ".varProto", + 3 => ".fixed32Big", + 4 => ".fixed32Little", + 5 => ".fixed64Big", + 6 => ".fixed64Little", + 7 => ".require32Bytes", + 8 => ".require64Bytes", + _ => bail!("unsupported LengthOp {i}"), + }) +} + +/// A Lean `Bytes` literal, wrapped at 16 bytes per line at the given indent. +fn bytes_lit(b: &[u8], indent: &str) -> String { + if b.is_empty() { + return "[]".to_string(); + } + let mut out = String::from("["); + for (i, byte) in b.iter().enumerate() { + if i > 0 { + if i % 16 == 0 { + out.push_str(",\n"); + out.push_str(indent); + } else { + out.push_str(", "); + } + } + write!(out, "0x{byte:02x}").unwrap(); + } + out.push(']'); + out +} + +/// Emit `def : ExistenceProof where ...` (where-style keeps every +/// structure brace at a fixed shallow column, as Lean's indentation-sensitive +/// structure-instance syntax requires). +fn emit_exist_def(out: &mut String, name: &str, p: &ics23::ExistenceProof) -> Result<()> { + let leaf = p.leaf.as_ref().context("existence proof without leaf")?; + writeln!(out, "def {name} : ExistenceProof where").unwrap(); + writeln!(out, " key := {}", bytes_lit(&p.key, " ")).unwrap(); + writeln!(out, " value := {}", bytes_lit(&p.value, " ")).unwrap(); + writeln!(out, " leaf :=").unwrap(); + writeln!( + out, + " {{ hash := {}, prehashKey := {}, prehashValue := {},", + hash_op(leaf.hash)?, + hash_op(leaf.prehash_key)?, + hash_op(leaf.prehash_value)?, + ) + .unwrap(); + writeln!( + out, + " length := {}, prefixBytes := {} }}", + length_op(leaf.length)?, + bytes_lit(&leaf.prefix, " "), + ) + .unwrap(); + if p.path.is_empty() { + writeln!(out, " path := []").unwrap(); + } else { + writeln!(out, " path := [").unwrap(); + for (i, op) in p.path.iter().enumerate() { + writeln!(out, " {{ hash := {},", hash_op(op.hash)?).unwrap(); + writeln!( + out, + " prefixBytes := {},", + bytes_lit(&op.prefix, " ") + ) + .unwrap(); + writeln!( + out, + " suffix := {} }}{}", + bytes_lit(&op.suffix, " "), + if i + 1 == p.path.len() { "" } else { "," } + ) + .unwrap(); + } + writeln!(out, " ]").unwrap(); + } + out.push('\n'); + Ok(()) +} + +fn emit_vector(out: &mut String, dir: &str, stem: &str, spec_name: &str) -> Result<()> { + let path = format!("../testdata/{dir}/{stem}.json"); + let contents = fs::read_to_string(&path).with_context(|| path.clone())?; + let data: TestVector = serde_json::from_str(&contents)?; + let proto_bin = hex::decode(&data.proof)?; + let parsed = ics23::CommitmentProof::decode(proto_bin.as_slice())?; + let root = hex::decode(&data.root)?; + let key = hex::decode(&data.key)?; + + // camelCase vector name: iavl/exist_left -> iavlExistLeft + let mut name = String::from(dir); + for part in stem.split('_') { + let mut cs = part.chars(); + if let Some(c) = cs.next() { + name.push(c.to_ascii_uppercase()); + name.push_str(cs.as_str()); + } + } + + writeln!(out, "/-! ### `testdata/{dir}/{stem}.json` -/\n").unwrap(); + match parsed.proof { + Some(ics23::commitment_proof::Proof::Exist(ep)) => { + if data.value.is_empty() { + bail!("{path}: existence vector without value"); + } + let value = hex::decode(&data.value)?; + emit_exist_def(out, &name, &ep)?; + writeln!(out, "def {name}Root : Bytes :=").unwrap(); + writeln!(out, " {}\n", bytes_lit(&root, " ")).unwrap(); + writeln!(out, "def {name}Key : Bytes :=").unwrap(); + writeln!(out, " {}\n", bytes_lit(&key, " ")).unwrap(); + writeln!(out, "def {name}Value : Bytes :=").unwrap(); + writeln!(out, " {}\n", bytes_lit(&value, " ")).unwrap(); + writeln!( + out, + "example : verifyExistence concreteHash {name} {spec_name} {name}Root\n \ + {name}Key {name}Value = true := by native_decide\n" + ) + .unwrap(); + } + Some(ics23::commitment_proof::Proof::Nonexist(np)) => { + if !data.value.is_empty() { + bail!("{path}: non-existence vector with value"); + } + let left = match &np.left { + None => "none".to_string(), + Some(ep) => { + emit_exist_def(out, &format!("{name}L"), ep)?; + format!("some {name}L") + } + }; + let right = match &np.right { + None => "none".to_string(), + Some(ep) => { + emit_exist_def(out, &format!("{name}R"), ep)?; + format!("some {name}R") + } + }; + writeln!(out, "def {name} : NonExistenceProof where").unwrap(); + writeln!(out, " key := {}", bytes_lit(&np.key, " ")).unwrap(); + writeln!(out, " left := {left}").unwrap(); + writeln!(out, " right := {right}\n").unwrap(); + writeln!(out, "def {name}Root : Bytes :=").unwrap(); + writeln!(out, " {}\n", bytes_lit(&root, " ")).unwrap(); + writeln!(out, "def {name}Key : Bytes :=").unwrap(); + writeln!(out, " {}\n", bytes_lit(&key, " ")).unwrap(); + writeln!( + out, + "example : verifyNonExistence concreteHash {name} {spec_name} {name}Root\n \ + {name}Key = true := by native_decide\n" + ) + .unwrap(); + } + _ => bail!("{path}: unsupported proof variant"), + } + Ok(()) +} + +fn main() -> Result<()> { + let mut out = String::new(); + out.push_str( + "/-\nShared test vectors (Phase 2a differential oracle). GENERATED FILE — do not\n\ + edit by hand; regenerate with `cargo run --example lean_testdata` in `rust/`.\n\n\ + Each vector under `testdata/{iavl,tendermint,smt}/` is the decoded protobuf\n\ + `CommitmentProof` the Rust and Go suites verify, re-checked here against the\n\ + Lean model with real SHA-256 (`native_decide`). An accept/reject divergence\n\ + between the model and the implementations fails this build.\n-/\n\ + import Ics23.Executable\n\nnamespace Ics23.TestVectors\n\nopen Ics23\n\n", + ); + + let stems = [ + "exist_left", + "exist_right", + "exist_middle", + "nonexist_left", + "nonexist_right", + "nonexist_middle", + ]; + for (dir, spec_name) in [ + ("iavl", "iavlSpec"), + ("tendermint", "tendermintSpec"), + ("smt", "smtSpec"), + ] { + for stem in stems { + emit_vector(&mut out, dir, stem, spec_name)?; + } + } + + out.push_str("end Ics23.TestVectors\n"); + fs::write("../lean/Ics23/TestVectors.lean", &out)?; + println!("wrote lean/Ics23/TestVectors.lean"); + Ok(()) +} diff --git a/rust/src/kani_proofs.rs b/rust/src/kani_proofs.rs new file mode 100644 index 00000000..2c33c620 --- /dev/null +++ b/rust/src/kani_proofs.rs @@ -0,0 +1,152 @@ +//! Kani proof harnesses for Property D (implementation safety): overflow and +//! index-bounds safety of the arithmetic in the verifier internals — the +//! slice-indexing in the non-existence padding logic is the Dragonberry-class +//! surface. +//! +//! Run with `cargo kani` (the `kani` cfg is set only under Kani, so these are +//! invisible to normal builds). See `docs/rfc/001-formal-verification.md`. +//! +//! These harnesses are intentionally over the *arithmetic*, mirrored from the +//! verifier, rather than the full functions: the `anyhow`/`Result` error paths +//! pull in formatting machinery that explodes CBMC's formula. Panic-freedom of +//! the `Result`-returning entry points (`do_length`, `proto_len`) is left to a +//! later pass that stubs formatting. + +/// `do_length` is panic-free for `NoPrefix` and the fixed-width ops: the +/// `data.len() as u32 / u64` casts and `to_be/le_bytes` extends cannot panic. +/// (`VarProto` and `Require*` route through `anyhow` construction, which blows up +/// CBMC's formula; they are excluded here.) +#[kani::proof] +fn do_length_fixed_no_panic() { + use crate::ics23::LengthOp; + use crate::ops::do_length; + let choice: u8 = kani::any(); + kani::assume(choice < 5); + let op = match choice { + 0 => LengthOp::NoPrefix, + 1 => LengthOp::Fixed32Big, + 2 => LengthOp::Fixed32Little, + 3 => LengthOp::Fixed64Big, + _ => LengthOp::Fixed64Little, + }; + let len: usize = kani::any(); + kani::assume(len <= 4); + let data = alloc::vec![0u8; len]; + let _ = do_length(op, &data); +} + +/// `ensure_inner`'s prefix bound `max_prefix_length + (child_order.len()-1) * +/// child_size` is overflow-free in `i32` for well-formed bounds (cf. the +/// IAVL/Tendermint/SMT specs). A malformed spec with an enormous `child_size` +/// could overflow it — tracked as a finding; this pins the safe precondition. +#[kani::proof] +fn ensure_inner_prefix_bound_no_overflow() { + let child_order_len: usize = kani::any(); + let child_size: i32 = kani::any(); + let max_prefix_length: i32 = kani::any(); + kani::assume((2..=16).contains(&child_order_len)); + kani::assume((1..=128).contains(&child_size)); + kani::assume((0..=4096).contains(&max_prefix_length)); + + let max_left_child_bytes = (child_order_len as i32 - 1) + .checked_mul(child_size) + .expect("child_order/child_size product fits i32"); + let _bound = max_prefix_length + .checked_add(max_left_child_bytes) + .expect("inner prefix bound fits i32"); +} + +/// `get_padding` computes `prefix = idx * child_size` and +/// `suffix = child_size * (child_order.len() - 1 - idx)`. Both are overflow-free +/// in `i32` for well-formed bounds. +#[kani::proof] +fn get_padding_no_overflow() { + let n: usize = kani::any(); + let idx: i32 = kani::any(); + let child_size: i32 = kani::any(); + kani::assume((2..=16).contains(&n)); + kani::assume((0..=(n as i32 - 1)).contains(&idx)); + kani::assume((1..=128).contains(&child_size)); + + let _prefix = idx.checked_mul(child_size).expect("prefix offset fits i32"); + let _suffix = child_size + .checked_mul(n as i32 - 1 - idx) + .expect("suffix size fits i32"); +} + +/// The slice accesses in `left_branches_are_empty`, +/// `op.prefix[from .. from + child_size]` with `from = actual_prefix + i*child_size` +/// and `actual_prefix = prefix.len() - left_branches*child_size` (via +/// `checked_sub`), are always in bounds — so the padding scan never panics on an +/// out-of-range slice. This is the Dragonberry-relevant safety property. +#[kani::proof] +#[kani::unwind(17)] +fn left_branches_slice_in_bounds() { + let prefix_len: usize = kani::any(); + let left_branches: usize = kani::any(); + let child_size: usize = kani::any(); + kani::assume((1..=64).contains(&child_size)); + kani::assume((1..=16).contains(&left_branches)); + + if let Some(actual_prefix) = prefix_len.checked_sub(left_branches * child_size) { + let mut i = 0usize; + while i < left_branches { + let from = actual_prefix + i * child_size; + // models `op.prefix[from .. from + child_size]` + assert!( + from + child_size <= prefix_len, + "left-branch slice in bounds" + ); + i += 1; + } + } +} + +/// `right_branches_are_empty` guards `op.suffix.len() == child_size` (a *single* +/// child) but then reads `op.suffix[i*child_size .. (i+1)*child_size]` for +/// `i in 0..right_branches`. For binary specs (`child_order.len() == 2`, +/// `right_branches <= 1`) the only access is `i = 0`, which is in bounds — this +/// covers all currently supported stores (IAVL/Tendermint/SMT). +/// +/// NOTE (finding): for a spec with `child_order.len() > 2`, `right_branches` +/// can exceed 1 while the guard still admits a `child_size`-long suffix, so the +/// `i = 1` access would be out of bounds (a panic). The left/right empty-branch +/// checks are asymmetric: the left side sizes the prefix by +/// `left_branches * child_size`, the right side only checks a single +/// `child_size`. No supported store is ternary, but this is latent. See +/// `docs/verification/properties.md`. +#[kani::proof] +#[kani::unwind(2)] +fn right_branches_slice_in_bounds_binary() { + let child_size: usize = kani::any(); + let suffix_len: usize = kani::any(); + let right_branches: usize = kani::any(); + kani::assume((1..=64).contains(&child_size)); + kani::assume(right_branches == 1); // binary spec: at most one right sibling + kani::assume(suffix_len == child_size); // the `suffix.len() == child_size` guard + + let mut i = 0usize; + while i < right_branches { + let from = i * child_size; + // models `op.suffix[from .. from + child_size]` + assert!( + from + child_size <= suffix_len, + "right-branch slice in bounds (binary)" + ); + i += 1; + } +} + +/// `decompress_exist` resolves a compressed path index with +/// `lookup.get(x as usize)` for an attacker-controlled `i32` x. This is +/// panic-free for any x and any lookup table: a negative or out-of-range index +/// wraps under `as usize` and `get` returns `None` (the caller maps that to an +/// empty path), so the compressed-batch decode cannot panic on the index. +#[kani::proof] +fn decompress_index_no_panic() { + let len: usize = kani::any(); + kani::assume(len <= 4); + let lookup: alloc::vec::Vec = alloc::vec![0u8; len]; + let x: i32 = kani::any(); + let _ = lookup.get(x as usize); +} diff --git a/rust/src/lib.rs b/rust/src/lib.rs index 4799357b..3d92a3a3 100644 --- a/rust/src/lib.rs +++ b/rust/src/lib.rs @@ -11,6 +11,9 @@ mod host_functions; mod ops; mod verify; +#[cfg(kani)] +mod kani_proofs; + mod ics23 { include!("cosmos.ics23.v1.rs");