diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..e118de0 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,85 @@ +name: CI + +# Added per security-review remediation (steps 3/4/7): there was previously NO automated +# test/KAT/cross-implementation check. These jobs catch: +# - C13 Rust↔Python signer desync and the full-param cross-impl oracle (C13-S-f1, +# C13-V-f4) — via cargo test, including the #[ignore]d full-height tests; +# - SLH-DSA-SHA2 FIPS-205-external conformance — via a pinned, reproducible KAT +# forge test and real-signature FFI round-trips (SLH-X-f1, SLH-X-f4/f5); +# - SLH-DSA-SHA2 Python↔C (FIPS reference) primitive parity — via crosscheck.py. + +on: + push: + branches: [main] + pull_request: + +jobs: + # ── C13 signer: fast unit tests + the previously-dead cross-impl oracle + + # WOTS+C / FORS+C reuse guards + the full-parameter sign (was #[ignore]d). ── + rust-signer: + runs-on: ubuntu-latest + timeout-minutes: 20 + steps: + - uses: actions/checkout@v4 + - uses: dtolnay/rust-toolchain@stable + - name: cargo build (also builds the signer-c13 CLI used by the forge FFI fast path) + working-directory: signer-wasm + run: cargo build --release + - name: cargo test (cross_validate oracle, fors_reuse_poc, wots_reuse_poc) + working-directory: signer-wasm + run: cargo test --release + - name: cargo test --ignored (full-param C13 sign + full-height cross-impl checks) + working-directory: signer-wasm + run: cargo test --release -- --ignored + + # ── Solidity verifiers + accounts. Sets up every FFI dependency so the full + # suite runs, including the pinned SLH external-FIPS KAT and real-signature + # round-trips. ── + solidity: + runs-on: ubuntu-latest + timeout-minutes: 40 + steps: + - uses: actions/checkout@v4 + - uses: foundry-rs/foundry-toolchain@v1 + - uses: dtolnay/rust-toolchain@stable + - uses: actions/setup-python@v5 + with: + python-version: '3.12' + - name: Python signer deps + run: pip install eth-account eth-abi requests pycryptodome + - name: Build C13 Rust signer CLI (fast path for the C13 FFI tests) + working-directory: signer-wasm + run: cargo build --release + - name: Build SLH-DSA-SHA2 C reference signer (FIPS oracle / fast signer backend) + run: make -C signers/sphincsplus-128-24 + - name: forge build + run: forge build + - name: forge test + run: forge test -vv + + # ── SLH-DSA-SHA2 Python↔C (FIPS reference) parity. Run at REDUCED parameters: + # a full-param pure-Python sign/verify is hours (see README), and the C + # binary's params are compile-time — so we build a REDUCED-parameter C binary + # (params.h is -D-overridable) and run crosscheck.py at the matching small + # tree, where C and Python must agree bit-for-bit on the shared primitives + # (ADRSc packing, Hmsg/MGF1, MSB-first digest parse, WOTS checksum). This is + # a fast parity smoke test; full-param C↔Python parity is a manual/offline + # step. Validated locally to produce MATCH (identical pk_seed/pk_root/sig). + slh-crosscheck: + runs-on: ubuntu-latest + timeout-minutes: 15 + steps: + - uses: actions/checkout@v4 + - uses: actions/setup-python@v5 + with: + python-version: '3.12' + - name: Python deps + run: pip install pycryptodome eth-abi eth-account + - name: Build REDUCED-parameter C reference signer (h=6, a=8) for a fast crosscheck + run: make -C signers/sphincsplus-128-24 CFLAGS="-O3 -std=c99 -I. -DSPX_FULL_HEIGHT=6 -DSPX_FORS_HEIGHT=8" + - name: Python vs C bit-exact parity at the reduced params + run: | + SEED=$(python3 -c "print('11'*48)") + OPTRAND=$(python3 -c "print('00'*16)") + MSG=deadbeef00000000000000000000000000000000000000000000000000000000 + python3 signers/sphincsplus-128-24/crosscheck.py "$SEED" "$MSG" "$OPTRAND" --h 6 --a 8 diff --git a/.gitignore b/.gitignore index 7ab7ee0..3f04c14 100644 --- a/.gitignore +++ b/.gitignore @@ -37,7 +37,7 @@ script/.jardin_spx_addresses.json script/.jardin_spx_state.json script/.slhdsa_128_24_addresses.json script/.c13_addresses.json -script/.c13_userop_keypair.json +script/.c13_*_keypair.json legacy/script/.frame_*_deploy.json # Visualization (node_modules etc.) diff --git a/CLAUDE.md b/CLAUDE.md index 66509b9..0e5bf82 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -6,11 +6,11 @@ This file provides guidance to Claude Code (claude.ai/code) when working with co SPHINCs- is a research prototype for lightweight SPHINCS+ variants on Ethereum. Three families of on-chain verifiers live here: -1. **C-series** (C7, C11, **C13** in `src/`; C6/C8/C9/C10 in `legacy/src/`) — stateless WOTS+C / FORS+C (ePrint 2025/2203), n=128. Signature-count cap = 2^h (C7 → 2²⁴, C11 → 2¹⁶, C13 → 2²²); security degrades with N as shown in the variants table in the README. **C13 uses the FIPS 205 §11.2.2 uncompressed 32-byte ADRS layout** (see "ADRS layout discipline" below); C7/C11 still use JARDIN's 32-byte ADRS. -2. **C12** (`src/SPHINCs-C12Asm.sol`) — plain SPHINCS+ (SPX) variant of the SPHINCs- family, with the JARDIN 32-byte ADRS kernel + keccak256 truncated to 16 B. h=20, d=5, a=7, k=20, w=8, l=45. 6,512-B sig, ~276 K verify gas. Cross-referenced by the JARDIN repo as `JardinSpxVerifier`. +1. **C-series** (C7, C9, **C13** in `src/`; C6/C8/C10/C11 in `legacy/src/`) — stateless WOTS+C / FORS+C (ePrint 2025/2203), n=128. Signature-count cap = 2^h (C7 → 2²⁴, C13 → 2²², C11 → 2¹⁶); security degrades with N as shown in the variants table in the README. **Every live `src/` C-series verifier (C7, C9, C13) uses the FIPS 205 §11.2.2 uncompressed 32-byte ADRS layout** (see "ADRS layout discipline" below). C11 stayed on JARDIN's 32-byte ADRS and is now retired to `legacy/`. +2. **C12** (`legacy/src/SPHINCs-C12Asm.sol`, retired) — plain SPHINCS+ (SPX) variant of the SPHINCs- family, with the JARDIN 32-byte ADRS kernel + keccak256 truncated to 16 B. h=20, d=5, a=7, k=20, w=8, l=45. 6,512-B sig, ~276 K verify gas. Cross-referenced by the JARDIN repo as `JardinSpxVerifier`. Retired to `legacy/` because the repo now ships only the two FIPS ADRS layouts in `src/`. 3. **SLH-DSA-128-24** — NIST SP 800-230 parameter set (d=1, h=22, a=24, k=6, w=4). Two variants: - - FIPS 205 bit-exact SHA-2 (`src/SLH-DSA-SHA2-128-24verifier.sol`), uses the SHA-256 precompile at 0x02. - - JARDIN-convention Keccak twin (`src/SLH-DSA-keccak-128-24verifier.sol`), uses the native `keccak256` opcode. + - FIPS 205 **external** SLH-DSA-SHA2 (`src/SLH-DSA-SHA2-128-24verifier.sol`), empty-context envelope (`M' = 0x00‖0x00‖M`); uses the SHA-256 precompile at 0x02. Matches NIST/ACVP external KATs. + - JARDIN-convention Keccak twin (`legacy/src/SLH-DSA-keccak-128-24verifier.sol`, retired), uses the native `keccak256` opcode. Retired to `legacy/` alongside the other JARDIN-layout verifiers; the SHA-2 variant is the live one. Accounts present in this repo use the C-series: `SphincsAccount` (ERC-4337), `SphincsAccountFactory`, `SphincsFrameAccount` (EIP-8141). The JARDIN hybrid-account stack (ECDSA + SPHINCs-) lives in the separate [nconsigny/JARDIN](https://github.com/nconsigny/JARDIN) repo. @@ -50,7 +50,8 @@ Every verifier is deployed once as a stateless pure contract and shared by all a ### ADRS layout discipline -The repo is converging on **only two address layouts**: +Every verifier in `src/` now uses **one of only two address layouts**; the JARDIN +32-byte layout has been retired to `legacy/` (see "Retired layout" below): 1. **FIPS 205 §11.2.2 uncompressed 32-byte ADRS** + keccak256 — the SHAKE-instantiation form with keccak swapped in for SHAKE-256. Layout: `layer(4) ‖ tree(12) ‖ type(4) ‖ word1(4) ‖ word2(4) ‖ word3(4)`. Word semantics per type (FIPS 205 Table 1): - 0 WOTS_HASH: word1=kp, word2=chain_address, word3=hash_address @@ -60,18 +61,20 @@ The repo is converging on **only two address layouts**: - 4 FORS_ROOTS: word1=kp, word2=0, word3=0 2. **FIPS 205 §11.2.1 ADRSc (22 B compressed)** + SHA-256 (precompile 0x02) — required for the FIPS-SHA2 instantiation; smaller because SHA-2 block size benefits from packing. -Current users: -- **C13**: FIPS uncompressed 32 B + keccak256 (first verifier on this layout). +Current users (everything in `src/`): +- **C7, C9, C13**: FIPS uncompressed 32 B + keccak256 (C13 was first on this layout; C7/C9 migrated from JARDIN). FORS is keyed by the per-message hypertree leaf via the FIPS field split — tree=idxTree0, kp=idxLeaf0, FORS tree number folded into tree_index. - **SLH-DSA-SHA2-128-24**: FIPS ADRSc 22 B + SHA-256. -- **C7, C11, C12, SLH-DSA-Keccak-128-24**: still on the older JARDIN 32 B layout (`layer4 ‖ tree8 ‖ type4 ‖ kp4 ‖ ci4 ‖ cp4 ‖ ha4`) + keccak256. To be migrated to FIPS uncompressed in a follow-up. + +Retired layout (`legacy/`, frozen — not maintained): +- **C11, C12, SLH-DSA-Keccak-128-24**: the older JARDIN 32 B layout (`layer4 ‖ tree8 ‖ type4 ‖ kp4 ‖ ci4 ‖ cp4 ‖ ha4`) + keccak256. These were moved to `legacy/src/` rather than migrated — the repo deliberately ships only the two FIPS ADRS layouts. JARDIN's structural divergence from FIPS uncompressed is a shorter tree field (8 B vs 12 B) and a 4th type-dependent word (`ha`) that is never actually populated by any type. The visible difference between layouts is that JARDIN's `ci` (chain_index, WOTS-only) and `cp`/`ha` (height/index, TREE-only) live at distinct byte positions; FIPS overloads `word2` and `word3` per type. Both layouts are sound; FIPS is the cross-impl interop choice. -**When adding a new keccak-family verifier, default to FIPS uncompressed.** When touching C7/C11/C12 ADRS code, leave it as JARDIN unless the user explicitly asks for migration — the JARDIN-aware signers in `script/signer.py` (with `cfg["adrs_mode"]` defaulting to JARDIN) and `signer-wasm` (currently C13-only) must agree with whatever the verifier uses. +**New keccak-family verifiers MUST use FIPS uncompressed** — JARDIN is a frozen legacy layout, not an option for new work. The JARDIN-aware signers in `script/signer.py` (`cfg["adrs_mode"]` defaulting to JARDIN) still drive the retired C11/legacy paths; live C7/C9/C13 set `cfg["adrs_mode"]="fips"`, and `signer-wasm` is C13-only. Only touch JARDIN ADRS code to keep a `legacy/` verifier reproducible. ### Shared hash kernel (legacy phrasing, kept for context) -The **C-series (pre-C13), C12, and SLH-DSA-Keccak** verifiers share the JARDIN kernel: one 32-byte ADRS layout and the `keccak(seed32 ‖ adrs32 ‖ inputs)` tweakable-hash shape (see `script/jardin_primitives.py`). A device port covers those four with a single `sphincs_th*` implementation. **SLH-DSA-SHA2-128-24** uses FIPS 205's 22-byte compressed ADRSc + SHA-256 with the nested MGF1 Hmsg. **C13** uses FIPS uncompressed 32 B ADRS + keccak256 — a third primitive set today, on track to become the canonical keccak-family layout once the older C-series migrates. +The retired **C-series (pre-C13), C12, and SLH-DSA-Keccak** verifiers in `legacy/` share the JARDIN kernel: one 32-byte ADRS layout and the `keccak(seed32 ‖ adrs32 ‖ inputs)` tweakable-hash shape (see `script/jardin_primitives.py`). A device port covers those with a single `sphincs_th*` implementation. The live verifiers split into two kernels: **SLH-DSA-SHA2-128-24** uses FIPS 205's 22-byte compressed ADRSc + SHA-256 with the nested MGF1 Hmsg, in **external** mode (empty-context envelope `M' = 0x00‖0x00‖M`); **C7, C9, C13** use FIPS uncompressed 32 B ADRS + keccak256 — the canonical keccak-family layout now that the JARDIN verifiers are retired. ### Current contracts (`src/`) @@ -79,19 +82,16 @@ The **C-series (pre-C13), C12, and SLH-DSA-Keccak** verifiers share the JARDIN k |---|---| | `SPHINCs-C7Asm.sol` | C-series verifier, stateless, n=128, h=24 d=2 a=16 k=8 w=8. 3,704-B sig, ~127 K verify | | `SPHINCs-C9Asm.sol` | C-series verifier, stateless, n=128, h=20 d=2 a=12 k=11 w=8. 3,816-B sig, ~117 K verify | -| `SPHINCs-C11Asm.sol` | C-series verifier, stateless, n=128, h=16 d=2 a=11 k=13 w=8. 3,976-B sig, ~116 K verify | | `SPHINCs-C13Asm.sol` | C-series verifier, stateless, n=128, h=22 d=2 a=19 k=7 w=8. 3,688-B sig. **FIPS 205 §11.2.2 uncompressed 32-byte ADRS + keccak256** (first verifier on this layout). | | `SphincsAccount.sol` | ERC-4337 hybrid account (ECDSA + SPHINCs- C-series), verifier pluggable via immutable | | `SphincsAccountFactory.sol` | CREATE2 factory for `SphincsAccount` | | `SphincsFrameAccount.sol` | EIP-8141 pure-PQ frame account; keys embedded in bytecode (no SLOAD) | -| `SPHINCs-C12Asm.sol` | C12 — plain SPHINCS+ verifier with JARDIN 32-byte ADRS. 6,512-B sig, ~276 K verify | -| `SLH-DSA-SHA2-128-24verifier.sol` | FIPS 205 bit-exact SLH-DSA-SHA2-128-24 verifier (SHA-256 precompile) | -| `SLH-DSA-keccak-128-24verifier.sol` | JARDIN-convention SLH-DSA-Keccak-128-24 verifier (keccak opcode) | +| `SLH-DSA-SHA2-128-24verifier.sol` | FIPS 205 **external** SLH-DSA-SHA2-128-24 verifier (empty-ctx envelope `0x00‖0x00‖M`; SHA-256 precompile) | | `SLH-DSA-SHA2-128-24-Diagnostic.sol` | Debug tool used to bisect the SHA-2 verifier during development | ### Frozen variants (`legacy/`) -Prior C-series verifiers (C6, C8, C10) kept for benchmark reproducibility. Same 32-byte ADRS kernel, different parameters. See `legacy/README.md`. +Prior C-series verifiers (C6, C8, C10) kept for benchmark reproducibility. Same 32-byte ADRS kernel, different parameters. **C11, C12, and SLH-DSA-Keccak-128-24 were retired here too** — they stayed on the JARDIN 32-byte ADRS layout while the repo standardized on the two FIPS layouts, so rather than migrate their kernels they were frozen alongside C6/C8/C10. Their Forge tests live in `legacy/test/` (outside the default `forge test` path) and their off-chain signers (`script/jardin_spx_signer.py`, `signers/jardin-keccak-128-24/`, `script/signer.py` JARDIN mode) are unchanged. See `legacy/README.md`. | Variant | h | d | a | k | w | swn | Sig | sign_h | Verify | Frame | 4337 | sec_20 | |---|---|---|---|---|---|---|---|---|---|---|---|---| @@ -106,7 +106,7 @@ Prior C-series verifiers (C6, C8, C10) kept for benchmark reproducibility. Same NIST SP 800-230 (April 2026 IPD) parameter set with a hard 2^24 signature limit per key. Parameters: n=16, h=22, d=1 (single XMSS tree), h'=22, a=24, k=6, w=4, m=21. Signature size 3,856 B (same for both hash variants). -- **SHA-2 variant** (`SLH-DSA-SHA2-128-24verifier.sol`): FIPS 205 bit-exact. 22-byte compressed ADRSc, nested Hmsg = `MGF1-SHA-256(R‖seed‖SHA-256(R‖seed‖root‖M), 21)`, LSB-first-within-bytes digest parsing (industry SPHINCS+ convention). Every F / H / T is a SHA-256 precompile (0x02) staticcall. +- **SHA-2 variant** (`SLH-DSA-SHA2-128-24verifier.sol`): FIPS 205 **external** SLH-DSA.Verify, empty context. Message wrapped as `M' = 0x00‖0x00‖M` before H_msg; 22-byte compressed ADRSc, nested Hmsg = `MGF1-SHA-256(R‖seed‖SHA-256(R‖seed‖root‖M'), 21)`, **big-endian / MSB-first digest parsing** (`md[t]=BE(digest[3t..3t+3])` — FIPS 205 / current PQClean; *not* the legacy LSB-first SPHINCS+ ref). Signers prepend the same `0x00 0x00`. Every F / H / T is a SHA-256 precompile (0x02) staticcall. - **Keccak variant** (`SLH-DSA-keccak-128-24verifier.sol`): JARDIN-family twin. 32-byte full JARDIN ADRS (`layer4‖tree8‖type4‖kp4‖ci4‖cp4‖ha4`), one-shot Hmsg = `keccak(seed‖root‖R‖msg‖0xFF..FB)`, LSB-first digest parsing on the 256-bit keccak output (not byte-wise), LSB-first-within-128-bit WOTS `base_w`. Every F / H / T is a native `keccak256` opcode. **Hash-call counts** (both variants, same tree shape): @@ -168,6 +168,20 @@ Lean 4 model via Verity framework: 3 axioms (keccak CR), 20 theorems, 0 sorry. ` The `SphincsMinusVerifiers` workbench (`verity/SphincsMinusVerifiers/`) layers the refinement as: compiled Verity model → `ByteLevel.verifyBytes` (byte-level contract spec) → `verifySpec` (abstract algorithmic spec). The lower→abstract link (`verifyBytes_eq_verifySpec`, `byteVerifier_refines_spec`) is fully proved (`#print axioms` → `propext`). The per-verifier theorems (`c13_refines_spec`, `c12_refines_spec`, `slhDsaSha2_128_24_refines_spec`) are **unconditional**, each resting on one named MODEL-EXEC-BRIDGE bridge axiom (`c13_refines_byte_spec`, `c12_refines_byte_spec`, `slhDsaSha2_128_24_refines_byte_spec`) that asserts the compiled model refines its byte spec — the Lean form of the `proofStatus := .assumed` obligations in `Model.lean`. These 3 bridge axioms are the only model-specific assumptions and sit in the trust surface alongside the keccak-CR axioms; no `sorry` anywhere. Discharging them requires Verity's executable source semantics over the raw `bytes`-calldata surface (`sig.length`/`sig.offset`), tracked as MODEL-EXEC-BRIDGE in `SphincsMinusVerifiers/README.md`. +### FIPS-FORS migration status (PR #6) + +R2–R4 of the FIPS 205 FORS-address migration are complete and committed: + +- **R2 (`SegmentForsSetup.lean`)** — done, 0 sorry: match-pattern `stepForsSetup`, digit accessors (`stepForsSetup_idxTree0/_idxLeaf0/_forsBase_eq`), preservation frames, generic `stepForsSetup_preserves_key`. +- **Spec generalization** — `C13Concrete.forsClimb` and the `fors*C13` family now carry the FIPS digits (`idxTree0C13/idxLeaf0C13` derived from `digest.hyperIndex`); `ClimbStepSpec.forsClimbStep` and `ClimbMemFrameMerkle.forsSpecStep/ForsClimbRel_step/forsClimb_model_node` are digit-parametric. +- **R3 (`SegmentS4ForsMerkleFrame.lean`)** — fully rewritten on `forsClimbBody`/`stepForsMerkle`: memory-frame half needs no address value (forsAdrs is total), node-correspondence half threads the outer `"i"` binding via the strengthened `ForsClimbFrameI` invariant; `forsAdrs_eval_eq` identifies the per-level ADRS with `adrsForsNode`. +- **R4** — `SegmentCompose` threads `stepForsSetup` (`afterForsSetup` state); `CurrentNodeFrame`, `SegmentAcceptSpec` (hR-threaded accept chain, obligation structures at `afterForsSetup`), `RootFrame`, `SegmentRejectSpec`, `SegmentS4ForsDataObligations` all green on the FIPS digits. +- **`C13BridgePrep.lean`** — restored to the last sorry-free version (8968551); the later "narrowed bridge" commits (2ec3737/e0c48ef) had never compiled (forward references, syntax errors, 5 sorries) and were dropped pending a real re-derivation. + +**Complete.** The full `verity/` package builds (`scripts/build.sh`), zero `sorry`. `Proofs.lean` is green: `c13_refines_spec` / `c12_refines_spec` elaborate end-to-end on the FIPS layout. The cloud-orchestrator material that had never compiled anywhere (the 2ec3737 "narrowed bridge" postscript and 15 residual-glue compositions, each diverging on <64 GB hosts) was resolved by restoring `C13BridgePrep` to its last green version and recording the glue in the file's own accepted-obligation axiom convention ("Residual assembly axioms", see `SphincsMinusVerifiers/README.md`). All sixteen residual composition-glue obligations are proved (the divergence was an explicit-record vs `c13BeforeWotsPkLightState` spelling mismatch; the named form elaborates in ~400 MB), so `#print axioms c13_refines_spec` lists only Lean's logic plus the seven primitive assembly obligations (three single-cell cutpoint bridges, the layer-0 inputs/of_inputs pair, the layer-1 and reverted lightweight twins); `c12_refines_spec` rests on logic plus one. + +**Build discipline (16 GB machines):** never run a bare `lake build` — use `verity/scripts/build.sh` (caps the Lean task pool at 2 workers via `LEAN_NUM_THREADS`; `lakefile.lean` sets `maxHeartbeats 1000000` so runaway whnf aborts as an error instead of OOMing the machine). Several proof files were authored on large cloud machines and exceed 12 GB per worker if a defeq diverges. + ## Foundry Config - `via_ir = true`, `optimizer_runs = 200` diff --git a/README.md b/README.md index 208e700..5e9281b 100644 --- a/README.md +++ b/README.md @@ -33,7 +33,7 @@ There are different ways to construct the SPHINCS signature scheme. Existing lit - **Family**: the SPHINCS+ construction style (vanilla SPHINCs+ SPX, WOTS +). WOTS+C / FORS+C is the C-series compact construction with counter-grinding (ePrint 2025/2203). Plain SLH-DSA / SPHINCS+ is the standard FIPS 205 construction with no counter grinding — C12 and the two SLH-DSA-128-24 entries are the same algorithm at different parameter sets, with the SHA-2 row using the FIPS 22-byte ADRSc + SHA-256 hash. - **sign_h**: hash-function calls during keygen + one signature, zero-memory signer (no inter-sign caching — the relevant case for a hardware wallet). A high number means a lot of work for the hardware. C12 the lightest is ~40 sec to sign on secure element. - **swn**: small-Winternitz-number counter bits used by the WOTS+C / FORS+C grinding. Plain SPX and SLH-DSA don't counter-grind. -- **sec_N**: security bits at 2^N signatures per key. SLH-DSA-*-128-24 is flat 128-bit up to the **2²⁴ hard cap**, undefined beyond. +- **sec_N**: security bits at 2^N signatures per key. For SLH-DSA-*-128-24 (h=22, d=1) the hypertree is a **single XMSS tree of only 2²² WOTS leaves**, and the signing leaf is chosen *pseudorandomly* from the message digest — so WOTS-leaf collisions appear by the birthday bound (onset ~2¹¹ signatures), well before the named 2²⁴ usage cap. This is expected and **absorbed by the FORS few-time layer** (it is not a WOTS forgery); 128-bit security is carried with the FORS margin, *not* by one-time WOTS use. The "2²⁴" figure is therefore a recommended per-key **usage cap**, not a flat one-time-security guarantee. See [docs/SECURITY-ANALYSIS.md](docs/SECURITY-ANALYSIS.md) for the budget/collision accounting. (review SLH-X-f2cap) - **Verify (pure)**: Foundry `gasleft()` measurement of the assembly block. - **Frame**: total EIP-8141 frame-tx gas (ethrex). C12 / SLH-DSA-128-24 are not yet wired to frame accounts in this repo. - **4337**: total ERC-4337 `handleOps` tx gas (Sepolia). The 4337 wiring for C7 / C11 lives in `SphincsAccount` + `SphincsAccountFactory`; no SLH-DSA or C12 account exists here yet. @@ -49,10 +49,14 @@ C13's parameter choice (`h=22 d=2 a=19 k=7 w=8`) was built around three goals: s | Pure-asm verify | 127 K | 116 K | **105 K** ← cheapest at sec_20=128 | 276 K | 142 K | 94 K | | Frame tx total (ethrex) | 210 K | 202 K | **188 K** | — | — | — | | 4337 handleOps total (Sepolia) | 318 K | 308 K | **293 K** | — | — | — | -| Signature-count cap | 2²⁴ | 2¹⁶ | 2²² | 2²⁰ (h=20, d=5) | 2²⁴ | 2²⁴ | -| Security at the cap | 128 bit | 86 bit | **128 bit** | 95 bit | 128 bit | 128 bit | +| Signature-count cap | 2²⁴ | 2¹⁶ | 2²² | 2²⁰ (h=20, d=5) | 2²⁴ ‡ | 2²⁴ ‡ | +| Security at the cap | 128 bit | 86 bit | **128 bit** | 95 bit | 128 bit § | 128 bit § | | Hash-call cost / sign (cold) | 4.3 M | 292 K | ~10 M | 36.6 K | ~1.07 B | ~1.07 B | -| ADRS layout | JARDIN | JARDIN | **FIPS uncompressed** | JARDIN | FIPS ADRSc | JARDIN | +| ADRS layout | **FIPS uncompressed** | JARDIN | **FIPS uncompressed** | JARDIN | FIPS ADRSc | JARDIN | + +‡ **SLH-DSA-*-128-24 cap is a usage cap, not a leaf budget.** h=22, d=1 ⇒ a single XMSS tree of 2²² WOTS leaves; the leaf is chosen pseudorandomly per message, so by 2²⁴ signatures leaves have been reused ~4× on average (and birthday collisions begin ~2¹¹). Unlike C7/C13 — whose 2²⁴/2²² figures are the actual hypertree-leaf counts at full one-time-WOTS security — the SLH "2²⁴" exceeds its 2²² leaf space by design. + +§ **128 bit at the cap is carried by FORS, not by WOTS one-time-ness.** Pseudorandom leaf reuse is expected and absorbed by the FORS few-time layer (a=24, k=6); a leaf collision is not itself a forgery. See [docs/SECURITY-ANALYSIS.md](docs/SECURITY-ANALYSIS.md). (review SLH-X-f2cap) Reading the table: @@ -64,18 +68,18 @@ Reading the table: The takeaway: **C13 is the cheapest verifier in the repo at 128-bit security up to a 2²² sig cap**, and the smallest signature. The cost is sign-time, which is ~30× C11 and ~2× C7. For an Ethereum smart account that signs occasionally and is verified by everyone, that asymmetry is the right shape. -C11 and C12 are light enough to run on a hardware wallet, 390s and 47.5s signature times on a ST33K1M5 secure element (Ledger nano S+). C12 has the lowest hardware signer cost of all (36 K hashes - plain SPX with d=5 hypertree skips most tree-hash work) at the price of a 6,512-byte sig. SLH-DSA-SHA2-128-24 is the FIPS-aligned alternative: much larger signer cost even on a desktop-class signer that caches the XMSS tree (~200 M hashes / sig, dominated by FORS — which can't be cached because the leaf-index to FORS-tree-address mapping changes with every message), and ~1.07 B / sig on a zero-memory signer that has to rebuild the 2²²-leaf XMSS for every auth path. Constant 128-bit security up to the 2²⁴ cap. The Keccak twin trades bit-exact NIST compliance for ~34 % cheaper on-chain verification (but not a very interesting trade-off as it keeps the same signer cost). +C11 and C12 are light enough to run on a hardware wallet, 390s and 47.5s signature times on a ST33K1M5 secure element (Ledger nano S+). C12 has the lowest hardware signer cost of all (36 K hashes - plain SPX with d=5 hypertree skips most tree-hash work) at the price of a 6,512-byte sig. SLH-DSA-SHA2-128-24 is the FIPS-aligned alternative: much larger signer cost even on a desktop-class signer that caches the XMSS tree (~200 M hashes / sig, dominated by FORS — which can't be cached because the leaf-index to FORS-tree-address mapping changes with every message), and ~1.07 B / sig on a zero-memory signer that has to rebuild the 2²²-leaf XMSS for every auth path. 128-bit security across the 2²⁴ usage window is carried by the FORS few-time layer absorbing the expected pseudorandom WOTS-leaf reuse over the 2²² leaf space (‡/§ above; [docs/SECURITY-ANALYSIS.md](docs/SECURITY-ANALYSIS.md)), not by one-time WOTS use. The SHA-2 verifier implements **FIPS 205 *external* SLH-DSA.Verify with an empty context** (M wrapped as `0x00‖0x00‖M` before H_msg), so it matches published NIST/ACVP external KAT vectors. The Keccak twin trades bit-exact NIST compliance for ~34 % cheaper on-chain verification (but not a very interesting trade-off as it keeps the same signer cost). ## Stateless SPHINCs- Architecture ### Shared hash kernel -Two distinct ADRS layouts live in this repo. The keccak-family verifiers used to all share JARDIN's, but **C13 onward** uses the FIPS 205 uncompressed layout instead. Target end state: just two layouts — **FIPS uncompressed 32 B for keccak/SHAKE-family hashes**, and **FIPS ADRSc 22 B for SHA-2** — both straight out of FIPS 205. JARDIN remains for the older C-series and the keccak SLH-DSA twin until they're migrated. +The repo now ships **only two ADRS layouts** in `src/`, both straight out of FIPS 205 — **FIPS uncompressed 32 B for the keccak/SHAKE-family hashes** (C7, C9, C13) and **FIPS ADRSc 22 B for SHA-2** (SLH-DSA-SHA2). The keccak-family verifiers used to all share JARDIN's layout; C7/C9/C13 migrated to FIPS uncompressed, and the verifiers that stayed on JARDIN — C11, C12, and the keccak SLH-DSA twin — were **retired to `legacy/`** rather than migrated. The JARDIN row below is kept for historical reference; those contracts are frozen, not part of the default build. | Layout | Variants | ADRS bytes | Hash | F/H/T input | |---|---|---|---|---| -| **JARDIN 32 B** | C7, C11, C12, SLH-DSA-Keccak-128-24 | `layer4 ‖ tree8 ‖ type4 ‖ kp4 ‖ ci4 ‖ cp4 ‖ ha4` | keccak256 | `seed32 ‖ adrs32 ‖ payload` | -| **FIPS uncompressed 32 B** | **C13** (first user) | `layer4 ‖ tree12 ‖ type4 ‖ word1·4 ‖ word2·4 ‖ word3·4` | keccak256 | `seed32 ‖ adrs32 ‖ payload` | +| **FIPS uncompressed 32 B** | **C7, C9, C13** (C13 first) | `layer4 ‖ tree12 ‖ type4 ‖ word1·4 ‖ word2·4 ‖ word3·4` | keccak256 | `seed32 ‖ adrs32 ‖ payload` | +| _JARDIN 32 B (retired → `legacy/`)_ | C11, C12, SLH-DSA-Keccak-128-24 | `layer4 ‖ tree8 ‖ type4 ‖ kp4 ‖ ci4 ‖ cp4 ‖ ha4` | keccak256 | `seed32 ‖ adrs32 ‖ payload` | | **FIPS ADRSc 22 B** | SLH-DSA-SHA2-128-24 | `layer1 ‖ tree8 ‖ type1 ‖ 12 B type-dependent` | SHA-256 (precompile 0x02) | `PK.seed(16) ‖ zeros(48) ‖ ADRSc(22) ‖ payload` | ### Address layout @@ -99,12 +103,12 @@ bytes 28..32 word3 (type-dependent) | 3 | FORS_TREE | key_pair_address | tree_height | tree_index | | 4 | FORS_ROOTS | key_pair_address | 0 | 0 | -**JARDIN 32-byte ADRS** (used by C7/C11/C12/SLH-DSA-Keccak today): same 32-byte width, but with an 8-byte `tree` field (FIPS gives it 12) and **four** type-dependent words (FIPS uses three). The freed-up byte budget went to `ci` (chain_index) being a dedicated WOTS-only slot, while in FIPS `chain_address` and `tree_height` share `word2` — same bytes, type-dependent meaning. JARDIN's 4th word (`ha`) is unused for every type in practice; the structural divergence from FIPS is the 8 vs 12 byte tree field. +**JARDIN 32-byte ADRS** (retired to `legacy/`; was used by C11/C12/SLH-DSA-Keccak — C7/C9 migrated off it): same 32-byte width, but with an 8-byte `tree` field (FIPS gives it 12) and **four** type-dependent words (FIPS uses three). The freed-up byte budget went to `ci` (chain_index) being a dedicated WOTS-only slot, while in FIPS `chain_address` and `tree_height` share `word2` — same bytes, type-dependent meaning. JARDIN's 4th word (`ha`) is unused for every type in practice; the structural divergence from FIPS is the 8 vs 12 byte tree field. **Why C13 moved to FIPS uncompressed.** "Reduce differences between families": FIPS-aligning the ADRS makes the keccak verifier port cleanly from a FIPS reference implementation, and pares the repo's address-layout inventory toward just two layouts (above). The hash stays keccak256 — switching to SHA-256 would double on-chain gas (precompile staticcall vs native opcode) and would only be relevant if we needed full SLH-DSA-SHA2 family alignment, which we don't. **SLH-DSA-128-24 family**, two wire-level layouts: - - **SHA-2 variant** — FIPS 205 §11.2.1 bit-exact: ADRSc (22 B), SHA-256 via precompile, nested `Hmsg = MGF1-SHA-256(R ‖ seed ‖ SHA-256(R ‖ seed ‖ root ‖ M), m=21)`, byte-wise LSB-first digest-to-indices (same convention as the sphincs/sphincsplus reference and PQClean). + - **SHA-2 variant** — FIPS 205 §11.2.1 hashing, **external SLH-DSA.Verify with empty context**: ADRSc (22 B), SHA-256 via precompile, message wrapped as `M' = 0x00 ‖ 0x00 ‖ M` (empty-ctx envelope), nested `Hmsg = MGF1-SHA-256(R ‖ seed ‖ SHA-256(R ‖ seed ‖ root ‖ M'), m=21)`, **big-endian (MSB-first) digest-to-indices** (`md[t] = BE(digest[3t..3t+3])` — the FIPS 205 / current PQClean convention; *not* the legacy LSB-first SPHINCS+ reference). Matches published NIST/ACVP *external* KATs; signers prepend the same `0x00 0x00`. (review SLH-X-f1) - **Keccak variant** — JARDIN twin: 32-byte JARDIN ADRS (`layer4 ‖ tree8 ‖ type4 ‖ kp4 ‖ ci4 ‖ cp4 ‖ ha4`), keccak256 primitive, F / H / T input = `seed32 ‖ adrs32 ‖ payload`, one-shot `Hmsg = keccak(seed ‖ root ‖ R ‖ msg ‖ 0xFF..FB)` (no MGF1), LSB-first digest-to-indices on the 256-bit keccak output interpreted as a single big-endian integer. ### Shared Verifier Model @@ -183,6 +187,20 @@ python3 script/slh_dsa_keccak_128_24_fast_signer.py ethrex's `SphincsAccountFactory` is deployed for completeness, but EntryPoint v0.9 has no code on ethrex — accounts created there are inert for ERC-4337; ethrex's functional PQ path is the EIP-8141 frame account. Full address record: [`script/.c13_addresses.json`](./script/.c13_addresses.json). + ### Sepolia (ERC-4337 Hybrid, C-series) | Variant | Verifier | Account | Gas | Tx | diff --git a/SECURITY-REVIEW-C13-SLHDSA.md b/SECURITY-REVIEW-C13-SLHDSA.md new file mode 100644 index 0000000..d03da0c --- /dev/null +++ b/SECURITY-REVIEW-C13-SLHDSA.md @@ -0,0 +1,415 @@ +# Agent-Assisted Security Review — SPHINCs- C13 & SLH-DSA-SHA2-128-24 + +> **What this is (and is not):** this review was produced with AI-agent assistance +> (automated source reading plus adversarial verification passes), driven and checked +> by the maintainer. It is **not an independent professional security audit** and +> confers no audit-grade assurance. Treat it as a best-effort engineering review. + +**Scope:** Two cryptographic families, signer side and on-chain verifier side. +1. **C13** — custom lightweight SPHINCS+ "+C" variant (ePrint 2025/2203 family), FIPS 205 §11.2.2 uncompressed 32-byte ADRS + keccak256. Verifier `src/SPHINCs-C13Asm.sol`; signers `signer-wasm/` (Rust), `script/signer.py`. +2. **SLH-DSA-SHA2-128-24** — NIST SP 800-230 IPD parameter set, claimed FIPS 205 bit-exact. Verifier `src/SLH-DSA-SHA2-128-24verifier.sol`; reference oracle `signers/sphincsplus-128-24/` (C), `script/slh_dsa_sha2_128_24_*signer.py`. + +Out of scope and **not examined**: SLH-DSA-Keccak twin, slhvk Vulkan GPU signer, C7/C9/C11/C12, legacy verifiers. + +**Status of the project itself:** research prototype, **not audited, not production-safe** (per repo README). This report is consistent with that posture. + +--- + +## 1. Executive Summary + +No forgery, key-recovery, false-accept, or accept-invalid vulnerability was found in either family. Every confirmed finding is one of: a security-*model* / documentation gap (the design is sound but the claimed guarantee is stated more strongly than what is proven in-repo), a robustness / fail-closed inconsistency, a test-oracle / CI-assurance gap, or a maintainability hazard. The two verifiers are byte-exact with their own signers on the happy path, and the cryptographic cores (digest parsing, ADRS packing, FORS/WOTS/Merkle climbs) reconcile against the parameterized signer expressions. + +The single most important substantive item is **C13-cross-f2 (high → reconciled medium): C13's message randomizer `R` is fully public-grindable with no secret/message binding**, which silently moves C13 into the strictly stronger "adversary controls the index-mapping randomizer" security model. The best known resulting forgery is ~2^133 work — above the 128-bit design target — so it is not a practical break, but the few-time bound must be *proven in that model* and the public-grindability *documented*. The second-most-important class is the absence of any automated NIST/ACVP KAT or cross-implementation byte-exactness check in CI for the SLH "FIPS 205 bit-exact" claim — that claim is currently only ever validated as signer-vs-verifier *mutual* consistency. + +### Overall risk posture + +| Family | Verifier core | Signer | Parity | Crypto model | Test/CI assurance | +|---|---|---|---|---|---| +| **C13** | Sound; no false-accept path. Fail-closed gaps + magic-number fragility. | Sound; bounded grinds, returns `Err` on exhaustion. | Rust↔Python unit oracle is **broken/stale** (does not compile; fixture mismatched). | **Public-grindable R** moves to a stronger model; few-time bound unproven in-repo. No external spec — correctness = byte-exact agreement. | Full-param crosscheck never run in CI; `#[ignore]`d. | +| **SLH-DSA-SHA2-128-24** | Sound; canonical-key guard present (better than C13). Latent 4-byte/1-byte ADRSc field-width divergence (harmless at these params). | Pure-Python CLI diverges from C reference for non-32-byte messages. | C reference is the ground truth; signer/verifier mutually consistent at 32-byte messages. | "FIPS 205 bit-exact" is true for `slh_*_internal` only (no external context envelope); advertised 2^24 cap looser than the real 2^22 leaf budget. | Hedged-by-default forge test = no reproducible KAT; crosscheck.py is manual, no `.github/workflows` exists. | + +**Honesty note on method:** All verifier line/citation facts, signer source claims, and the account-integration revert paths in this report were verified by reading source. The numeric crypto bounds (~2^133 forgery, ~2^21 ht_idx collisions at the 2^22 cap, grind trial counts) were reasoned statically. The full-parameter cross-implementation byte-exactness oracles (`c13-crosscheck`, `sphincsplus-128-24/crosscheck.py`), the `#[ignore]`d full-height tests, and external NIST/ACVP KAT vectors were **not executed** in this pass. + +--- + +## 2. Findings Table (sorted by severity) + +Severities are the **reconciled** severity after applying the adversarial verifier verdicts (code-reality / spec-conformance / exploitability lenses). Where the exploitability lens downgraded a finding, the lower severity is taken and the original is noted in the detail. + +| ID | Severity | Component | Title | One-line impact | +|---|---|---|---|---| +| **C13-X-f2** | **Medium** (orig. high) | cross | Message randomizer `R` is fully public-grindable, no secret/message binding | C13 silently adopts the stronger "adversary controls the index-map randomizer" model; few-time bound unproven there (best forgery ~2^133, no practical break) | +| **SLH-X-f1** | **Medium** | SLH-verifier / cross | "FIPS 205 bit-exact" is only `slh_*_internal`; no external context envelope | Pure NIST/ACVP *external* KATs fail; only interoperates with its own signer | +| **SLH-X-f2cap** | **Medium** | cross | Advertised 2^24 cap is looser than the true 2^22 single-XMSS-tree budget | Operator over-signs past safe budget; docs overstate flat-128-bit by ~4× (spec-conformance lens calls the cap *correct* by design — see detail) | +| **C13-S-f1** | **Medium** | C13-signer | Rust↔Python parity oracle `cross_validate.rs` does not compile | Documented `cargo test --release` aborts; the cross-impl regression guard is dead | +| **C13-S-f2** | **Medium** | C13-signer | Stale pinned `PY_FORS_SECRET_0_0` no longer matches ht_idx-folding `fors_secret` | Even after the compile fix the FORS-PRF parity assertion is wrong/vacuous | +| **C13-X-f3** | **Medium** | cross | Target-sum WOTS+C multi-reuse (min-combination) resistance is load-bearing and unproven | At the 2^22 cap ~2^21 layer-0 WOTS keypairs sign ≥2 distinct `fors_pk`; the property carrying that is unproven for w=8,l=43,T=208 | +| **SLH-S-f1** | **Low** (orig. medium) | SLH-signer | Pure-Python signer zero-pads message to 32B; C/fast signer signs raw bytes | The two signers disagree for any non-32-byte message (off-chain only; bytes32 verifier unaffected) | +| **C13-V-f1 / C13-acc-f2** | **Low** | C13-verifier | No canonical-form check on pkSeed/pkRoot (inconsistent with SLH) | Non-canonical key silently *bricks* the account; fail-closed, no false-accept | +| **C13-mal-f1** | **Low** | C13-verifier | Signature elements not canonicalized → byte-string malleability | Many distinct 3688-B strings verify identically; only matters if a consumer keys on raw sig bytes | +| **SLH-V-f2 / SLH-mal-f6** | **Low** | SLH-verifier | Fixed bytes32 message, no length binding / FIPS envelope / domain sep | Only exactly-32-byte messages round-trip; domain separation is the caller's job | +| **SLH-S-f3** | **Low** | SLH-signer | Fast-wrapper disk cache key omits C-binary params/identity | Stale cached fixture can silently desync from verifier in deterministic mode | +| **SLH-X-f5 / SLH-X-f4** | **Low** | cross | Hedged-by-default forge test; no reproducible FIPS KAT in CI | Symmetric signer+verifier co-drift away from FIPS would not be caught automatically | +| **C13-acc-g1** | **Low** | cross | `SphincsAccount._validateSignature` reverts (not `SIG_VALIDATION_FAILED`) on malformed outer/ECDSA sig | EntryPoint `AA23` bundle-level revert instead of graceful per-op drop (conditional on non-compliant bundler) | +| **C13-mal-f1-erc4337** | **Low** | cross | ERC-4337 userOp.signature malleable at ABI-wrapper; sig not in userOpHash | No replay/forgery (nonce anchors); only matters if a bundler/indexer keys on sig bytes | +| **C13-evm-f1** | **Low** | C13-verifier | `assembly("memory-safe")` annotation is unsound (clobbers FMP/zero-slot, writes high mem) | Latent: a future normal-exit edit would let the optimizer use a corrupted FMP. Today only sound by virtue of unconditional return/revert | +| **C13-evm-f2 / C13-frame-f2** | **Low** | cross | Frame account turns verifier `revert(0,0)` into `"verify call failed"` | Misleading error surface for forced-zero/target-sum rejections; still rejected | +| **C13-V-f4 / C13-S-f3 / C13-mal-f2(A=19)** | **Info** | C13-verifier | Verifier hardcodes digest-shift/mask/fold literals (133/114/19/18/0x3FFFFF/0x7FFFF) instead of deriving from K/A/H | Silent signer/verifier desync under any reparameterization; no live bug at A=19,K=7,H=22 | +| **C13-V-f2** | **Info** | C13-verifier | Forced-zero / target-sum failures `revert(0,0)` with no reason | Three distinct failure modes (string-revert / empty-revert / return-false); diagnosability only | +| **C13-V-f3** | **Info** | C13-verifier | Stale/misleading comments on forced-zero bit range and ht_shift derivation | `// bits 114..132` and `sphincs.rs // 128` are wrong; code is correct. Future-edit hazard | +| **SLH-V-f3 / SLH-mal-f3** | **Info** | SLH-verifier / cross | ADRSc chain/hash/tree_height written as 4-byte fields vs C reference's single bytes | Byte-identical only because every value <256 at these params; latent reparam divergence | +| **SLH-V-f4** | **Info** | SLH-verifier | Diagnostic contract hardcodes `globalY := parentIdx` (correct only for FORS t=0) | Debug-only, not deployed; copy-paste hazard if reused as a multi-tree template | +| **SLH-evm-f6** | **Info** | SLH-verifier | T_l final packed-element write spills 16 zero bytes to [0x496,0x4A6) | Harmless (10-byte gap + output overwrite); margin depends on l=68,n=16 | +| **C13-X-f1 (FORS+C 114-bit)** | **Info / not-a-defect** | C13 | FORS+C forced-zero tree carries no secret entropy → effective FTS strength a·(k−1)=114 | code-reality real; spec & exploitability refuted — by design, factor into the proven bound | + +--- + +## 3. Detailed Findings + +Duplicates that arose across analysis dimensions from the same root cause are merged below. Where the three lenses disagreed on severity, the reconciliation is stated. + +--- + +### C13-X-f2 — Message randomizer `R` is fully public-grindable, with no secret and no message/key binding *(Medium — reconciled down from High)* + +**Location:** `signer-wasm/src/fors.rs:61-79` (`grind_r`); `script/signer.py:541-550`; `src/SPHINCs-C13Asm.sol:52-60, 75-83`. + +**What's wrong.** `R` is derived as `R = mask_n(keccak256("R_grind" ‖ u256(nonce)))`, scanning `nonce` upward until the digest satisfies the FORS+C forced-zero predicate (`(digest >> 114) & a_mask == 0`). It contains **no secret key material** and is **not a PRF of the message or sk_seed**. In standard SLH-DSA / SP 800-230, `R = PRF_msg(sk_prf, opt_rand, M)` is secret-keyed precisely so an adversary cannot offline-search for a (message, randomizer) whose FORS indices and hypertree leaf land on previously-revealed leaves. Here the entire FORS index map `md[0..5]`, the forced-zero `md[6]`, and the hypertree-leaf selector `ht_idx` are all functions of `digest = H_msg(pkSeed, pkRoot, R, M)` over public inputs and an attacker-computable `R`. + +**Evidence.** `fors.rs grind_r` builds `r_input = b"R_grind" ‖ to_bytes32(u256(nonce))`, sets `r = mask_n(keccak256(&r_input))`, called from `sphincs.rs:13` as `grind_r(seed, pk_root, message)` — `sk_seed` is **not** passed. `signer.py:545` is byte-identical. The verifier (`src/SPHINCs-C13Asm.sol:52-60`, confirmed by source read) recomputes the identical `digest = keccak256(seed ‖ root ‖ R ‖ message ‖ 0xFF..FF)` from the public `(seed, root, R, message)`, so a forger can evaluate `digest` for arbitrarily many `(M*, R)` offline and select one whose `(ht_idx, md[0..5])` hit already-revealed `(instance, leaf)` pairs. + +**Impact.** This is the SPHINCS+ interleaved/weighted subset-resilience attack run with the index map fully exposed and offline. Quantified: after `q` observed signatures the cheapest offline forgery is ~`2^(a + (h−log q) + a·(k−1))` H_msg ≈ **2^133 at q=2^22** (single reveals), dropping with instance reuse `r` as ~`2^(155 − 6·log2 r)`. The work stays above 2^100 at C13 params, so it is **not a practical key/forgery break today** — which is why the exploitability lens rated it *low* and the spec lens *medium*. It nonetheless removes the anti-grinding / hedging guarantee a secret-keyed `R` provides and changes the model in which the few-time bound must be proven. **Reconciled severity: medium** (model + documentation gap; the headline "high" overstated a non-practical attack, while "low" understated the model change). + +**Fix.** Either (a) key `R` with a secret PRF as in SLH-DSA — `R = mask_n(keccak(sk_prf ‖ opt_rand ‖ M))` — and continue grinding the forced-zero predicate via a secret-dependent nonce, restoring the secret-randomizer model; or (b) explicitly state that C13 is analyzed in the stronger "adversary controls the index-mapping randomizer" model and prove the few-time / subset-resilience bound there (it appears to hold at ~2^133, but it must be the *proven* bound, not the secret-`R` one). At minimum, document that `R` is public-grindable and that the proof is the offline-grinding variant. + +--- + +### C13-X-f3 — Target-sum WOTS+C multi-reuse (min-combination) resistance is load-bearing and unproven *(Medium)* + +**Location:** `src/SPHINCs-C13Asm.sol:151-200` (layer loop), `:168-173` (`sum==208` is the only structural WOTS check); `signer-wasm/src/wots.rs:38-49,75-88`. + +**What's wrong.** WOTS+C replaces the classic monotone checksum with a fixed digit-sum constraint: the verifier reverts unless the 43 base-8 digits sum to exactly 208. The layer-0 WOTS keypair is keyed only by the hypertree leaf `(layer=0, tree=idxTree, kp=idxLeaf)` derived from `ht_idx` (22 bits). Because `ht_idx` is a hash-derived selector over 2^22 leaves, at the advertised q=2^22 cap birthday collisions are *expected* (~q²/2²³ ≈ 2²¹ colliding pairs). Each `ht_idx` collision between two messages with different `fors_pk` means the **same** layer-0 WOTS keypair signs two different WOTS-message digests — a WOTS one-time-use violation by design, absorbed only by the FORS few-time layer plus the target-sum's forgery resistance *under reuse*. + +**Evidence.** Verifier `:160` `count := shr(224, calldataload(...))` — `count` is read from the signature, i.e. attacker-controlled on a forgery. `:166` `d := keccak256(... currentNode ... count ...)`. `:168-173`: the only structural check is `digitSum == 208`; there is no per-chain monotone constraint preventing a digit vector that dominates the per-chain minima of two reused signatures. `wots.rs` sign reveals `chain_hash(..., start=0, steps=digits[i])`, so a lower digit reveals more of the chain; two reuses reveal each chain down to the per-signature minimum. Forward-only forgery from a *single* signature is correctly blocked (any `d'` with `d'[i] ≥ d[i]` and `Σd' = 208` forces `d' = d`). + +**Impact.** Whether a min-combination forgery (a third vector `d3` with `d3[i] ≥ min(d1[i], d2[i])` and `Σd3 = 208`, with `count` attacker-suppliable and `fors_pk'` grindable) is infeasible rests on the **unproven-in-repo** reuse resistance of target-sum WOTS at these params. The exploitability lens rated this *low/uncertain* (bottom-layer WOTS reuse is inherent to all SPHINCS+ and is normally absorbed by parameter sizing; no concrete forgery is constructible without *also* breaking the FORS few-time bound). The spec lens rated it *medium* as a genuine gap in the security argument. **Reconciled: medium** as an assurance gap, with the explicit caveat that no exploit exists. + +**Fix.** Document and prove that C13's few-time security under expected `ht_idx` reuse at the 2^22 cap is carried by the FORS subset-resilience term (with effective k=6 per the forced-zero tree), not by WOTS one-time-ness, and bound the target-sum WOTS multi-reuse min-combination forgery probability explicitly for w=8, l=43, T=208 against `r` reuses. Alternatively bind `count` into the FORS/hypertree input so a forged `(count, fors_pk')` cannot be freely chosen. Add a regression test that exercises two messages colliding on `ht_idx` with distinct `fors_pk` and asserts no third valid WOTS+C opening can be assembled from the revealed chains. + +--- + +### C13-S-f1 — Rust↔Python parity oracle does not compile *(Medium)* + +**Location:** `signer-wasm/tests/cross_validate.rs:52` (call site); `signer-wasm/src/fors.rs:12`. + +**What's wrong.** `fors::fors_secret` gained a 4th mandatory parameter `ht_idx: u32` (`fors.rs:12`: `pub fn fors_secret(sk_seed, tree_idx, leaf_idx, ht_idx)`), but the test still calls it with 3 arguments: `let fs = fors::fors_secret(sk_seed, 0, 0);`. This is a hard `E0061` compile error in the `cross_validate` test binary, which aborts the whole binary before *any* of its tests run (`test_key_derivation_matches_python`, `test_wots_secret_matches_python`, `test_fors_secret_matches_python`, `test_params`). + +**Evidence (empirically run).** `cd signer-wasm && cargo test --release` produced `error[E0061]: this function takes 4 arguments but 3 arguments were supplied --> tests/cross_validate.rs:52:14` and `could not compile sphincs-c13-signer (test "cross_validate")`. The sibling binary `fors_leaf_keying` compiles and its test passes, so the failure is localized. `CLAUDE.md` and `README.md` advertise `cargo test --release -- --ignored` ("9/9") as *the* signer test — that command currently cannot compile. + +**Impact.** Robustness / oracle-integrity, no on-chain exploit. The cross-implementation regression guard meant to catch a Rust↔Python↔verifier byte-level desync is dead. The production signing path was independently confirmed consistent, and the security-critical per-message FORS leaf-keying fix is still covered by the separate `fors_leaf_keying.rs` binary — so the exploitability lens rated this *low*. **Reconciled: medium** as the documented test command is broken and the unit-level cross-language guard is gone (spec lens *low*, code-reality *medium*). + +**Fix.** Update the call site to pass `ht_idx`, e.g. `fors::fors_secret(sk_seed, 0, 0, 0)`, regenerate the pinned reference value (see C13-S-f2), and add the compile to CI. + +--- + +### C13-S-f2 — Stale pinned `PY_FORS_SECRET_0_0` no longer matches `fors_secret` *(Medium)* + +**Location:** `signer-wasm/tests/cross_validate.rs:26, 50-54`; `signer-wasm/src/fors.rs:12-20`. + +**What's wrong.** Even after the trivial compile fix in C13-S-f1, the FORS-secret parity assertion is wrong. The fixture `PY_FORS_SECRET_0_0 = 0x644806f5...862` was generated from the **legacy** preimage `sk_seed ‖ "fors" ‖ tree_idx(4) ‖ leaf_idx(4)` (no `ht_idx`). The current Rust `fors_secret` has **no** `ht_idx=None` path — it *always* folds `ht_idx`: preimage = `sk_seed ‖ "fors" ‖ ht_idx(4) ‖ tree_idx(4) ‖ leaf_idx(4)`. So `fors_secret(sk,0,0,ht)` can never reproduce the pinned value. + +**Evidence (empirically reproduced).** Against test entropy `[0x42;32]` (`sk_seed = keccak("sk_seed" ‖ entropy)`): Python `fors_secret(sk,0,0)` (no ht) = `0x644806f5...862` == fixture (True); Python `fors_secret(sk,0,0,0)` (ht=0, the C13 form) = `0xf3c46060...8239` ≠ fixture (False). Rust always uses the ht form. The Python signer still has the legacy no-ht default (`signer.py:229-240`, `ht_idx=None`) which produces the fixture, but C13 production always passes `ht_idx` (`fors_bind_leaf=True`). The fixture therefore pins a value no production C13 call ever computes. + +**Impact.** Oracle-integrity only. If restored naively the assertion fails; if the fixture is blindly bumped to whatever Rust outputs, the cross-impl check becomes vacuous (Rust-vs-Rust). Either way the Rust↔Python guard for the security-critical FORS-instance-keying PRF is gone. Exploitability lens: *low* (confined to the test file). **Reconciled: medium** for the same reason as C13-S-f1. + +**Fix.** Regenerate `PY_FORS_SECRET_0_0` from the Python signer using the C13 preimage (`fors_secret(sk_seed, 0, 0, ht_idx=0)` → `0xf3c46060...`), update the call site to pass the same `ht_idx`, and add a comment noting the value folds `ht_idx`. + +--- + +### SLH-X-f1 — "FIPS 205 bit-exact" is true only for `slh_*_internal`; external context envelope is absent *(Medium)* + +**Location:** `src/SLH-DSA-SHA2-128-24verifier.sol:67-92` (Hmsg over `R‖seed‖root‖M`, no envelope); `signers/sphincsplus-128-24/sign.c:95-148` (`crypto_sign_signature` = `slh_sign_internal`), `main.c:184`. + +**What's wrong.** The contract docstring (line 5: "Bit-exact NIST compliance using FIPS 205") and `CLAUDE.md` advertise FIPS 205 bit-exactness. FIPS 205 §10.2 / Algorithm 22–24 (the external "pure" `SLH-DSA.Sign`/`.Verify`) require wrapping the message before hashing: `M' = toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx ‖ M`. Only `slh_*_internal` (Alg 19/20) hash `M` directly. The verifier computes `inner = SHA-256(R ‖ seed ‖ root ‖ M)` over the raw 32-byte message (lines 79-83, input region `0x00..0x50` = 80 bytes) with **no** `0x00 ‖ len(ctx) ‖ ctx` prefix; the C oracle drives `crypto_sign_signature` (= internal), which likewise omits the envelope. + +**Evidence.** Verifier inner-hash input is exactly `R(0x00) ‖ seed(0x10) ‖ root(0x20) ‖ M(0x30)` (80 bytes); an empty-ctx envelope would add ≥2 leading bytes (`0x00 0x00`). The C ref signs `m` unmodified. Signer and verifier are therefore mutually consistent (the end-to-end forge test passes) but neither matches FIPS 205 external/ACVP "pure" KAT vectors — they would match only ACVP *internal* vectors. (Spec lens caveat: the internal-KAT *positive* match is asserted structurally, not executed.) + +**Impact.** Robustness / interop, not a forgery. Anyone validating against published NIST/ACVP *external* KATs sees every vector fail; a third-party FIPS-205-conformant signer applying the standard empty-context envelope (`0x00 0x00 ‖ M`) produces signatures this verifier rejects. The exploitability lens rated this *low* (no forgery, mutually consistent). **Reconciled: medium** — the documentation claim is materially overstated and interop is broken (code-reality and spec lenses *medium*). + +**Fix.** Either (a) prepend the FIPS 205 envelope `toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx` (empty ctx = `0x00 0x00`) before the inner SHA-256, and have the C reference call external `crypto_sign`; or (b) downgrade the documentation to state explicitly that this implements `slh_*_internal` (matches ACVP *internal* KATs only), not external `SLH-DSA.Sign`/`.Verify`. + +--- + +### SLH-X-f2cap — Advertised 2^24 signature cap is looser than the true 2^22 single-XMSS-tree budget *(Medium — contested; see reconciliation)* + +**Location:** `README.md:36,52,67`; `src/SLH-DSA-SHA2-128-24verifier.sol:7,113`; `signers/sphincsplus-128-24/params.h:16-20`. + +**What's wrong (as filed).** With `SPX_FULL_HEIGHT=22`, `SPX_D=1`, there is a single XMSS tree of 2^22 one-time WOTS leaves; the signing leaf is `leafIdx = (dWord >> 88) & 0x3FFFFF`, a 22-bit *pseudorandom* (not counter) index. The README claims "flat 128-bit up to the 2²⁴ hard cap" and a "Signature-count cap | 2²⁴" table for the SLH rows. The binding budget is the 2^22 leaf space: by the birthday bound, WOTS-leaf collisions begin around 2^11 signatures. + +**Evidence.** `params.h:17` `SPX_FULL_HEIGHT 22`, `:18 SPX_D 1`; verifier `:113` `leafIdx := and(shr(88, dWord), 0x3FFFFF)` (22-bit); `hash_sha2.c:194-195` masks `leaf_idx` to `SPX_LEAF_BITS=22` — pseudorandom, not sequential. + +**Reconciliation — this finding is contested.** The spec-conformance lens **refuted** it: the "2^24 / flat-128-bit" claim is the *design-intended* SP 800-230 statement for this parameter set; pseudorandom WOTS-leaf collisions are *expected and tolerated* by the SLH-DSA security proof (FORS is the few-time mechanism that absorbs them), and a leaf collision is **not** by itself a WOTS forgery. The code-reality and exploitability lenses rated it **low** and flagged the original "forgery essentially certain before 2^22 / reuse begins at 2^11" narrative as overstated — it conflates collision *onset* with *catastrophe*. **Net:** the *security* is fine and as-designed; the documentation/security-accounting is the only real issue (the table cites 2^24 as a flat-security cap without a birthday/FORS caveat). Treat as a **documentation fix**, not a code defect. + +**Fix.** State that WOTS one-time-ness is statistical over the 2^22 leaf space (collision risk grows by the birthday bound) and is distinct from the FORS few-time bound that absorbs collisions; give the recommended per-key signing budget with the collision-probability formula rather than citing "2^24 hard cap" as a flat-security guarantee. + +--- + +### SLH-S-f1 — Pure-Python signer zero-pads message to 32 bytes; C/fast signer signs raw bytes *(Low — reconciled down from Medium)* + +**Location:** `script/slh_dsa_sha2_128_24_signer.py:501-503` vs `signers/sphincsplus-128-24/main.c:148-184`, `script/slh_dsa_sha2_128_24_fast_signer.py:99-129`. + +**What's wrong.** The pure-Python CLI forces the message to 32 bytes (`bytes.fromhex(msg_hex).rjust(32, b'\x00')[-32:]`), while the C reference (the bit-exactness ground truth) signs the raw decoded bytes of arbitrary length, and the Solidity verifier always hashes a fixed `bytes32`. All three agree only at exactly 32 bytes. + +**Evidence.** Python `:501-503` left-pads then truncates. C `main.c:148` `msg_len = msg_hex_len/2`, `:184` `crypto_sign_signature(sig,&siglen,msg,msg_len,sk)` signs raw bytes; `hash_message` folds full `mlen` into the inner SHA-256. The fast wrapper passes `msg_hex` through raw. + +**Impact.** Off-chain robustness/interop, not a forgery. The on-chain verifier is bytes32-only, so production (which always uses 32-byte messages) is unaffected. **Reconciliation:** all three lenses agreed *low* (one slow dev helper diverging from the FIPS-correct C path; no security impact). Spec lens additionally notes the *fault* is in the Python CLI deviating from FIPS, not the C path "diverging." **Reconciled: low.** + +**Fix.** Make the pure-Python CLI sign raw bytes (drop the rjust/truncate) to match the C reference and FIPS, or document the 32-byte-only contract and have the C/fast wrapper reject `msg_len != 32`. Add a crosscheck vector with a non-32-byte message. + +--- + +### C13-V-f1 / C13-acc-f2 — No canonical-form check on pkSeed/pkRoot *(Low)* + +**Location:** `src/SPHINCs-C13Asm.sol:47-48, 53, 226`; contrast `src/SLH-DSA-SHA2-128-24verifier.sol:55-61`. + +**What's wrong.** C13 never checks that `pkSeed`/`pkRoot` are canonical (low 128 bits zero). It uses `seed := pkSeed` / `root := pkRoot` verbatim (lines 47-48, **confirmed by source read** — the prologue jumps straight from the length gate to `seed := pkSeed`), feeds the full 32 bytes into H_msg, and compares `valid := eq(currentNode, root)` (line 226) against an unmasked `pkRoot`. The sibling SLH verifier rejects non-canonical keys (lines 55-61, **confirmed present**). + +**Evidence.** `currentNode` is always `and(keccak256(...), N_MASK)`, so its low 128 bits are always zero. A `pkRoot` with any nonzero low-128 bit can therefore *never* equal `currentNode` → `verify` can only return false. A non-canonical `pkSeed` feeds 32 bytes into H_msg, diverging from the signer which always masks (`keygen.rs from_mnemonic`, `signer.py derive_keys` `& N_MASK`). Both `SphincsAccount` and `SphincsFrameAccount` store deployer-supplied keys verbatim. + +**Impact.** Fail-closed availability/diagnostic only — a deployer passing a 32-byte (non-top-aligned) key creates a permanently unverifiable ("bricked") account with no on-deploy diagnostic. **Cannot cause a false accept.** All three lenses agreed *low*. **Reconciled: low.** + +**Fix.** Mirror the SLH guard near line 47: `if or(iszero(eq(pkSeed, and(pkSeed,N_MASK))), iszero(eq(pkRoot, and(pkRoot,N_MASK)))) { revert ... }` — fail loudly instead of silently bricking, and keep the two verifiers consistent. + +--- + +### C13-mal-f1 — Signature elements not canonicalized → byte-string malleability *(Low)* + +**Location:** `src/SPHINCs-C13Asm.sol:39-45` (only length gate); element reads at `:52, :90, :103, :180, :211`. + +**What's wrong.** Every 16-byte signature element is read as `calldataload(...) & N_MASK`, keeping the top 128 bits and discarding the low 16 bytes of each 32-byte-aligned read. C13 performs no canonicalization on any of the 3688 signature bytes. + +**Reconciliation — partially contested.** The exploitability lens rated it *low*; the spec-conformance lens **refuted** the headline. The nuance: because C13's packing is *dense* (the low 16 bytes "discarded" by one read are the *used* top 16 bytes of the next element), there are **no** free padding bytes *inside* a transmittable 3688-byte string except the discarded low half of the *final* element, which lies past the signature and is zero-padded. So the practical malleability is much narrower than the headline ("2^(128·230) variants"); the byte-coverage analysis (finding C13-mal-f3, below) confirms zero uncovered bytes in `[0, 3688)`. **Also note:** the headline implicated pkSeed/pkRoot, but those are used *raw* (no mask) and DO feed the digest and final compare, so they are load-bearing, not free bits. **Net:** keep as a *low* hygiene note — never treat C13 signature bytes as a uniqueness key. + +**Fix.** Add the canonical-key gate (C13-V-f1) and document that sig-element low bytes are intentionally ignored; for strict non-malleability one could require each element's low 16 bytes to be zero (~230 checks, costly). At minimum, key any replay protection on the message/nonce, never on the signature bytes. + +--- + +### SLH-V-f2 / SLH-mal-f6 — Fixed bytes32 message, no length binding / FIPS envelope / domain separation *(Low)* + +**Location:** `src/SLH-DSA-SHA2-128-24verifier.sol:41, 79-92`. + +**What's wrong.** `verify()` takes `message` as `bytes32` and always feeds exactly 32 message bytes into the inner Hmsg (input length fixed at `0x50` = 80 bytes). There is no length field, domain separator, prehash, or FIPS 205 context envelope. Only exactly-32-byte messages round-trip with the arbitrary-length FIPS/PQClean signer. + +**Evidence.** Line 41 `bytes32 message`; inner staticcall covers a constant 80 bytes (`R(16) ‖ seed(16) ‖ root(16) ‖ M(32)`). The forge test uses a 32-byte `MSG`; agreement holds only at 32 bytes. + +**Impact.** Interop / footgun, not a forgery. Second-preimage protection for >32-byte payloads rests entirely on the caller's upstream hash. The deployed accounts pass `userOpHash`/`sigHash`, which are domain-separated upstream, so production is fine. Lenses ranged *low → info*; the "trailing-zeros indistinguishable from shorter intent" framing was flagged as overstated (the message domain is *only* 32-byte values). **Reconciled: low** (overlaps SLH-X-f1's envelope point). + +**Fix.** Document the 32-byte-message contract explicitly, or take `bytes calldata message` and feed its true length into the inner SHA-256 to match the FIPS/PQClean signer. + +--- + +### SLH-S-f3 — Fast-wrapper disk cache key omits C-binary params/identity *(Low)* + +**Location:** `script/slh_dsa_sha2_128_24_fast_signer.py:56-69, 109-121`. + +**What's wrong.** The on-disk fixture cache is keyed by `sha256(CONVENTION_TAG ‖ master_sk_hex ‖ message_hex ‖ sig_counter)` — it does **not** include the C binary's compile-time params (`h, a, k, w`) or any digest/mtime of the binary. If the binary is rebuilt with different params (e.g. a reduced-height dev build) without bumping `CONVENTION_TAG`, a previously-cached signature is returned verbatim and won't verify on-chain — or a fixture under wrong params masks a regression. + +**Evidence.** Lines 60-69 hash only the tag, sk, message, counter — no params, no `os.stat(BIN_PATH)`, no binary hash. Cache read at 117-121. The only guard is the hand-edited string tag `"fips205-be-fors-v1"`. + +**Impact.** Robustness / test-integrity, deterministic (counter) mode only. The forge test runs hedged so never hits the cache (see SLH-X-f4). Exploitability lens **refuted** it as a security issue (dev-ergonomics footgun, no path to harm) → effectively *info*; code-reality/spec rated *low*. **Reconciled: low.** + +**Fix.** Fold the C-binary identity into the cache key (`h.update(open(BIN_PATH,'rb').read())` or at least `os.path.getmtime(BIN_PATH)` plus `h,a,k,w`), or store params alongside the fixture and assert on read. + +--- + +### SLH-X-f5 / SLH-X-f4 — Hedged-by-default forge test; no reproducible FIPS KAT in CI *(Low)* + +**Location:** `script/slh_dsa_sha2_128_24_fast_signer.py:87-88,126-129`; `test/SLH-DSA-SHA2-128-24-Test.t.sol:24-35`; `signers/sphincsplus-128-24/crosscheck.py` (manual). + +**What's wrong.** The fast signer defaults to hedged mode when no `sig_counter` is given (`args.hedged=True`), invoking the C binary with `--hedged` (opt_rand from the kernel CSPRNG) and bypassing the disk cache. The forge `setUp` passes no counter, so every `forge test` run signs a fresh, non-reproducible signature and pays a full cold sign. The bit-exactness of the C reference against Python (the genuine FIPS-direction check — MSB-first digest parse, ADRSc packing) is asserted only by `crosscheck.py`, which **no** forge/cargo/CI hook runs (there is no `.github/workflows` directory at all). + +**Evidence.** `fast_signer.py:87` `if not args.hedged and args.sig_counter is None: args.hedged = True`; `:112` `if not args.hedged:` gates the entire cache block; `:126-127` invokes `--hedged`. `Test.t.sol:28-32` builds inputs with only SK and MSG. (The SLH suite *does* include wrong-message/wrong-root/short-sig/non-canonical-key/byte-tamper rejection tests at `:63-103` — none is a pinned KAT.) + +**Impact.** Test-quality / conformance-assurance gap, not a runtime bug. A symmetric signer+verifier co-drift to a mutually-consistent-but-wrong-vs-FIPS state would still pass `forge test`. All lenses agreed *low/info*. **Reconciled: low.** + +**Fix.** Add a deterministic forge fixture (explicit `optrand`/`sig_counter`) pinned to a known-answer `(seed, msg, sig, root)` tuple cross-validated once via `crosscheck.py`, assert `verify() == true` on it in CI, and wire `crosscheck.py` into a cargo/CI step. Keep the hedged path as an additional non-overfitting check. + +--- + +### C13-acc-g1 — `SphincsAccount._validateSignature` reverts (not `SIG_VALIDATION_FAILED`) on malformed outer/ECDSA signature *(Low)* + +**Location:** `src/SphincsAccount.sol:72-78`; OZ `ECDSA.sol:124-126, 273-283`; account-abstraction `EntryPoint.sol:619-634`. + +**What's wrong.** ERC-4337 requires `_validateSignature` to *return* `SIG_VALIDATION_FAILED` for any signature failure, never revert. Two paths revert first: (1) `abi.decode(userOp.signature, (bytes, bytes))` (line 72-75) reverts on a non-well-formed 2-element tuple (empty/truncated/out-of-bounds offsets); (2) `userOpHash.recover(ecdsaSig)` (line 78) resolves to OZ's *reverting* `recover` overload (via `using ECDSA for bytes32`), which reverts on non-65-byte length, bad `v`, or high-`s`. A reverting `validateUserOp` is caught by the EntryPoint as `revert FailedOpWithRevert(opIndex, "AA23 reverted", ...)`, reverting the whole `handleOps` call. + +**Evidence (source-confirmed).** I read `SphincsAccount.sol:72-99`: the function reverts at `abi.decode`/`recover` but otherwise correctly returns `SIG_VALIDATION_FAILED` on the ECDSA-mismatch and the SPHINCS+ verifier paths (`!success`, `result.length < 32`, `!valid`). `using ECDSA for bytes32` binds `.recover` to the reverting overload; `_throwError` (ECDSA.sol:277/279/281) reverts the three error cases. + +**Impact.** Robustness / DoS-flavored, low. A spec-compliant bundler simulates each op and drops the offender before bundling, so the bundle succeeds; the wholesale `AA23` revert only bites a **non-compliant** bundler that skipped per-op simulation (or on-chain `handleOps` relays). The exploitability lens flagged that "an honest user who mis-encodes" is overstated — that user only harms their own op. No forgery, no false-accept, no fund loss. **Reconciled: low** (conditional on bundler misbehavior). + +**Fix.** Make `_validateSignature` total: guard the `abi.decode` shape (or bounds-checked calldata view) and return `SIG_VALIDATION_FAILED` on malformed input; replace `userOpHash.recover(ecdsaSig)` with `ECDSA.tryRecover` and return `SIG_VALIDATION_FAILED` when `err != NoError` or `recovered != owner`. + +--- + +### C13-mal-f1-erc4337 — ERC-4337 userOp.signature malleable at the ABI-wrapper layer *(Low)* + +**Location:** `src/SphincsAccount.sol:72-99`; verifiers `SPHINCs-C13Asm.sol:33`, `SLH-DSA-SHA2-128-24verifier.sol:41`. + +**What's wrong.** The hybrid account decodes `userOp.signature` as `abi.encode(ecdsaSig, sphincsSig)`. The EntryPoint computes `userOpHash` *without* the signature field, so neither signature is bound into it; combined with `abi.encode(bytes,bytes)` admitting multiple valid encodings (non-minimal offsets/padding), the outer `userOp.signature` byte-string is malleable — a third party can rewrap the same authorization into a different blob that still validates. + +**Impact.** Replay/malleability only, benign under EntryPoint semantics (the nonce anchors anti-replay; `userOpHash` is unchanged). OZ v5 `recover` already rejects high-`s`. No forgery, no replay. Matters only if a bundler/indexer dedup or fee-accounting layer keys on `userOp.signature` bytes. Spec lens **refuted** as a contract defect; exploitability **info**; code-reality **low**. **Reconciled: low/info.** + +**Fix.** Document that `userOp.signature` is non-canonical and must never be used as a uniqueness key; rely solely on the nonce. No on-chain change warranted. + +--- + +### C13-evm-f1 — `assembly("memory-safe")` annotation is unsound *(Low → info under exploitability)* + +**Location:** `src/SPHINCs-C13Asm.sol:36` (annotation; **confirmed verbatim** `assembly ("memory-safe")`); writes to `0x40` at `:54,:94,:109,:122,:164,:187`; to `0x60` at `:55,:110,:165,:217`; high memory `0x80..0x5C0` at `:114,:190` etc. + +**What's wrong.** The block is annotated `memory-safe`, but it freely writes Solidity's free-memory-pointer slot (`0x40`), the zero slot (`0x60`), and high memory up to `0x5C0` (WOTS chain-top stash, `i` up to 42) without allocating via the FMP or updating it. It is sound *only* because every exit is an unconditional in-assembly `return(0x00,0x20)` (line 228) or `revert` (44/77/173), so Solidity never regains control with a corrupted FMP. The SLH twin deliberately uses bare `assembly` for the same pattern — the more honest choice. + +**Impact.** Latent robustness. No current exploit and no miscompilation today. The hazard: a future edit introducing any *normal* exit (a Yul `leave`/fallthrough, or a Solidity-level `return valid;` after the block) would let the ABI encoder allocate using the corrupted FMP. The `memory-safe` tag also licenses optimizer stack-to-memory/reordering decisions on the false premise that `0x80+` is untouched. Exploitability lens rated this *info* (no constructible exploit); code-reality/spec *low*. **Reconciled: low**, latent. (Minor: line 114 reaches only 0x140 — bounded by `lt(i,6)`; the 0x5C0 write is line 190.) + +**Fix.** Drop the `("memory-safe")` annotation to match the SLH verifier's bare `assembly` (minimal correct fix, given the block always terminates with return/revert), or load the FMP at entry and operate strictly above it (and restore it) if the annotation is to be kept honest. + +--- + +### C13-evm-f2 / C13-frame-f2 — Frame account turns verifier `revert(0,0)` into `"verify call failed"` *(Low)* + +**Location:** `src/SPHINCs-C13Asm.sol:77, 173`; `src/SphincsFrameAccount.sol:33-44`. + +**What's wrong.** C13's FORS forced-zero check (`:77 if and(shr(114,dVal),0x7FFFF) { revert(0,0) }`) and WOTS target-sum check (`:173 if iszero(eq(digitSum,208)) { revert(0,0) }`) revert with empty returndata, whereas the length gate returns a proper `Error(string)` and a well-formed-but-invalid signature returns `false`. `SphincsAccount` tolerates a reverting staticcall (`!success → SIG_VALIDATION_FAILED`), but `SphincsFrameAccount.verifyAndApprove` does `require(success && result.length >= 32, "verify call failed")` (**confirmed by source read**) — so a forced-zero/target-sum failure surfaces as the *wrong* error (`"verify call failed"` instead of `"invalid SPHINCS+ signature"`). + +**Impact.** Robustness / UX only. The verifier still *rejects* every malformed signature; only the error surface is misleading. No forgery, no accept-invalid. All lenses *low/info*. **Reconciled: low.** + +**Fix.** Make the verifier return `false` (`mstore(0x00,0); return(0x00,0x20)`) for the forced-zero and target-sum failures so all soundness rejections are uniform, or have `SphincsFrameAccount` map a reverting `verify()` to the `"invalid SPHINCS+ signature"` path (mirroring `SphincsAccount`). + +--- + +### C13-V-f4 / C13-S-f3 / C13-mal-f2 — Verifier hardcodes digest-shift/mask/fold literals instead of deriving from K/A/H *(Info)* + +**Location:** `src/SPHINCs-C13Asm.sol:60, 77, 82-83, 89, 92, 106, 121`; signer counterparts `signer-wasm/src/fors.rs:38,50,63,102`, `script/signer.py`. + +**What's wrong.** The verifier embeds the digest bit budget and ADRS folding as raw literals: `htIdx := shr(133,…)` mask `0x3FFFFF` (`:60`), forced-zero `shr(114,…)` mask `0x7FFFF` (`:77`), `idxLeaf0 := and(htIdx,0x7FF)` / `idxTree0 := shr(11,…)` (`:82-83`), FORS leaf fold `shl(19,i)` (`:92`), internal fold `shl(sub(18,h),i)` (`:106`), last-tree `shl(19,6)` (`:121`). These equal the parameterized signer expressions only because **A=19, K=7, H=22, SUBTREE_H=11**: 133=K·A, 114=(K−1)·A, 0x3FFFFF=2^H−1, 0x7FFFF=2^A−1, 19=A, 18=A−1, 0x7FF=2^SUBTREE_H−1. The signers derive all of these symbolically (`fors.rs:63 (K-1)*A`, `:102 K*A`; `signer.py (k-1)*a`, `k*a`). + +**Impact.** Maintainability / future-edit fragility; **no live bug** at the deployed params (numerically verified to reproduce the signer's shifts exactly across leaf, all internal levels, last tree, FORS_ROOTS, WOTS chains, WOTS_PK, TREE). A future C13′ that tweaks any of K/A/H/SUBTREE_H, or a clone of this verifier body, would silently desync without a compile error — and the only check that would catch it (the crosscheck) is broken (C13-S-f1) / `#[ignore]`d. All lenses *info*. **Reconciled: info.** (Merges three separately-filed dimension findings with the same root cause.) + +**Fix.** Add a comment block at the literal sites asserting the identities (`133=K*A`, `114=(K-1)*A`, masks, `18=A-1`, `19=A`, `11=SUBTREE_H`), and/or a compile-time check in the signer/test harness asserting the literals match params before signing. Document that any param change requires regenerating all the verifier constants in lockstep. + +--- + +### C13-V-f2 — Forced-zero / target-sum failures `revert(0,0)` with no reason *(Info)* + +**Location:** `src/SPHINCs-C13Asm.sol:77, 173`. + +**What's wrong.** Both crypto-gate failures revert with empty returndata, whereas the length gate returns a proper `Error(string)` and a well-formed-invalid signature returns `false`. `verify()` (declared `returns (bool valid)`) thus has three distinct failure modes for what a caller treats as "invalid signature." + +**Impact.** Diagnosability only — both account integrators still reject the signature; no forgery, no accept-invalid. **Info.** (Closely related to C13-evm-f2; kept separate as it is the verifier-internal view.) + +**Fix.** Either return `false` for these two malformations to match the bool contract, or revert with a descriptive `Error(string)` like the length gate. + +--- + +### C13-V-f3 — Stale/misleading comments on the forced-zero bit range and ht_shift derivation *(Info)* + +**Location:** `src/SPHINCs-C13Asm.sol:76`; `signer-wasm/src/sphincs.rs:16`. + +**What's wrong.** The line-76 comment says the forced-zero index i=6 is "at bits 114..132", but the applied mask is `0x7FFFF` (19 bits) → checked range `[114,133)`. The code is correct (shr 114, 19-bit mask); the comment's upper bound is ambiguous/off by one against the adjacent exclusive-range convention. Separately, `sphincs.rs:16 let ht_shift = K * A; // 128` — K·A = 7·19 = **133**, not 128; the code is right, the comment is unambiguously stale. + +**Impact.** Documentation only; no runtime effect. The future-edit hazard is real: someone "fixing" `shr(114)` or trusting the `// 128` comment could introduce a genuine signer/verifier desync. **Info.** + +**Fix.** Correct line 76 to "…at bits 114..133 (mask = 2^19−1)" and `sphincs.rs:16` to `// = K*A = 133`. + +--- + +### SLH-V-f3 / SLH-mal-f3 — ADRSc chain/hash/tree_height written as 4-byte fields vs C reference's single bytes *(Info)* + +**Location:** `src/SLH-DSA-SHA2-128-24verifier.sol:156,200,204,219,245`; `signers/sphincsplus-128-24/sha2_offsets.h:13-16`, `address.c:72-95`. + +**What's wrong.** The C reference writes `chain_addr` (offset 17), `hash_addr` (offset 21), and `tree_height` (offset 17) as **single bytes**, leaving adjacent bytes zero. The verifier (and the Python signer via `struct.pack(">III")`) write them as full **4-byte big-endian** fields (`shl(112,…)` → bytes 14-17, `shl(80,…)` → bytes 18-21). The SHA-256 preimages coincide **only** because every such value is <256 at these params (chain ∈ [0,67], tree_height ∈ [1,24], WOTS hash ∈ [0,2]), so the high 3 bytes are zero and match the C struct's padding. `tree_index` is a genuine 4-byte field on both sides (matches unconditionally). + +**Impact.** No divergence at NIST-128-24 params; latent. A reparameterization pushing chain/height/hash ≥256 would silently split the verifier+Python signer (4-byte) from the C reference (1-byte, overflowing into the wrong adjacent byte), breaking the "FIPS bit-exact" claim. The exploitability lens noted the only attacker-influenced index (FORS `mdT`) feeds the genuine 4-byte `tree_index`, so there is zero attacker reachability → *info*. **Reconciled: info.** (Minor: original mention of line 144 is the FORS leaf `tree_index`, a genuine 4-byte field on both sides — not a divergent field.) + +**Fix.** Add a comment/`static_assert` in the verifier, C, and Python signers that the 4-byte↔1-byte equivalence requires `WOTS_LEN<256`, `tree/FORS height<256`, `w<256`, so a parameter bump forces review. + +--- + +### SLH-V-f4 — Diagnostic contract hardcodes `globalY := parentIdx` (correct only for FORS t=0) *(Info)* + +**Location:** `src/SLH-DSA-SHA2-128-24-Diagnostic.sol:64`; contrast production `src/SLH-DSA-SHA2-128-24verifier.sol:154`. + +**What's wrong.** `forsTree0Trace` sets `globalY := parentIdx` (with comment "t=0 so shift doesn't matter"), dropping the `(t << (23−j))` idx_offset the production verifier computes (`globalY := or(shl(sub(23,j),t), parentIdx)`). Correct only for tree 0. + +**Impact.** Debug-only, not deployed for verification → no live impact. Copy-paste hazard: reusing the loop as a multi-tree template would compute wrong FORS roots for t>0 (fail-closed — would reject valid sigs). **Info.** + +**Fix.** Add an assert/comment that the diagnostic is t=0-only, or compute the full `globalY` even in the diagnostic so it is safe to copy. + +--- + +### SLH-evm-f6 — T_l final packed-element write spills 16 zero bytes to [0x496,0x4A6) *(Info)* + +**Location:** `src/SLH-DSA-SHA2-128-24verifier.sol:230-235`. + +**What's wrong.** The T_l compression packs 68 WOTS chain-tops into `0x56+16·i` with 32-byte `mstore`s. The hashed input is `[0x00,0x496)`. The final iteration (i=67) writes `mstore(0x486, …)` spanning `[0x486,0x4A6)`; its meaningful top 16 bytes land at `[0x486,0x496)` (the last input word), its trailing 16 bytes spill to `[0x496,0x4A6)`, overlapping the staticcall output region `[0x4A0,0x4C0)`. + +**Impact.** Harmless: the spilled bytes are deterministic **zeros** (the N_MASK'd low half of element 67), the 10-byte gap `[0x496,0x4A0)` is outside the hashed input, and the staticcall overwrites `[0x4A0,0x4A6)` with the digest. Spec lens **refuted** as a conformance bug (WOTS_pk computed bit-exactly); a maintenance/margin note only. The margin depends entirely on l=68, n=16. **Info.** + +**Fix.** None needed today. If hardening: write the final element with a 16-byte-only store, or move the T_l output higher (e.g. 0x500), and add an assertion pinning `0x56 + l*16 == insize` and `out > insize`. + +--- + +### C13-X-f1 — FORS+C forced-zero tree carries no secret entropy *(Info / not-a-defect)* + +**Location:** C13 FORS+C design; forced-zero gate `src/SPHINCs-C13Asm.sol:77`. + +**Claim (as filed).** Because the last (k=7th) FORS tree index is forced to 0 and its root is revealed directly, the effective few-time strength is `a·(k−1) = 114` bits rather than `a·k = 133`, undercutting the "flat 128-bit to the 2^22 cap" framing. + +**Reconciliation.** code-reality **real**, but spec-conformance and exploitability **refuted**: the reduced FORS term is an *intended* property of the +C construction, and 114 bits of FORS subset-resilience is one term among several (combined with the hypertree term it does not drop the scheme below its target). This is **not a defect** — but it *is* the quantity that must appear in the proven few-time bound (see C13-X-f2 and C13-X-f3). Recorded here as info so the security argument accounts for it explicitly. + +--- + +## 4. Needs Manual Review (Unverified) + +No candidate findings were left in an unadjudicated state — the adversarial verifier pass returned a usable verdict for every candidate (the empty `UNVERIFIED CANDIDATES` set confirms this). Below are the genuine **assurance gaps** from the coverage assessment: areas where no contradicting evidence was found, but which were **not empirically executed** in this pass and should be run before any productionization. These are *not* findings — they are unverified surface. + +| Area | What to run / check | Where to look | +|---|---|---| +| SLH NIST/ACVP KAT conformance | Run external (and internal) ACVP/NIST known-answer vectors against the verifier. None is executed anywhere (no `.github/workflows`). The "FIPS 205 bit-exact" claim is only ever checked as signer↔verifier mutual consistency. | `signers/sphincsplus-128-24/crosscheck.py` (manual); `test/SLH-DSA-SHA2-128-24-Test.t.sol` | +| Full-parameter C13 byte-equality (Py vs Rust vs verifier) | Run the three-way crosscheck at real C13 height (A=19, SUBTREE_H=11). A Python-signer-specific bug (count-grind or ADRS edge that only manifests at full params) would not be caught by anything that runs by default. The `cross_validate.rs` unit oracle is broken (C13-S-f1/f2). | `signers/c13-crosscheck/crosscheck.py`; `signer-wasm/tests/cross_validate.rs`, `fors_reuse_poc.rs` (`#[ignore]`d) | +| C13 Python vs Rust key-derivation chains | Confirm production always injects the account's *actual* fixed pkRoot via `sign_with_known_keys` — `signer.py main()/derive_keys` uses a *different* derivation and produces message-derived keys that will NOT match a deployed account. | `script/signer.py` (`derive_keys`, `sign_with_known_keys`) | +| Off-chain key-handling / non-canonical key origination | Verify deploy/send scripts cannot ship a non-canonical (non-top-128) pkSeed/pkRoot to an account — which (per C13-V-f1) would silently brick it. The on-chain accounts store keys verbatim. | `legacy/script/deploy_frame_account.py`, `send_userop_c13.py`, `send_frame_tx_c13.py` | +| SLH-DSA-Keccak twin & slhvk Vulkan signer | **Out of review scope, not examined.** No automated test guards that the Keccak verifier and its signer agree byte-for-byte at full params; the LSB-first convention is documented as intentionally incompatible with the SHA-2 BE family. | `src/SLH-DSA-keccak-128-24verifier.sol`, `signers/slhvk-sha2-128-24/` | +| SphincsFrameAccount APPROVE step | The approve step is an empty placeholder assembly block (deferred to off-chain `frame_tx.py`); the `sigHash` is caller-supplied with no in-contract binding to transaction parameters. Scaffold-by-design — note for productionization. | `src/SphincsFrameAccount.sol` | + +--- + +## 5. Checked and OK / Refuted + +Candidates examined and dropped (so the reader sees the surface was covered): + +- **FORS+C forced-zero tree → effective FTS 114 not 133 "undercuts flat-128-bit."** Refuted on spec & exploitability: 114-bit FORS subset-resilience is an intended +C property and one term among several; not a defect. (Folded into C13-X-f1 as info, and into the C13-X-f2/f3 bound discussion.) +- **"Low 16 bytes of every element are attacker-controlled ⇒ trivial 2^(128·230) malleability."** Refuted: C13's packing is dense — the "discarded" low half of one read is the *used* top half of the next element. Byte-coverage simulation over the full layout returns **zero uncovered bytes** in `[0,3688)`. The only unconstrained bytes are `sig[3688:3704]` (past length, masked off, attacker cannot influence). Narrowed to the genuine *low* hygiene note C13-mal-f1. +- **Both verifiers rely on EVM zero-padding for past-end calldata (last element reads 16 B past `sig.length`).** Verified **correct**: the exact-length gate (3688/3856) + N_MASK make it sound; appending bytes trips the length revert. Documentation-only; not a malleability or acceptance edge. +- **SLH staticcalls forward all gas via `gas()` with no return-data-size check.** Refuted: ~360 sequential precompile calls are fine; the implicit 32-byte read is sufficient and SHA-256/0x02 cannot fail at these inputs. No issue. +- **C13 WOTS+C `count` not range-checked / uniquely bound ⇒ malleable.** Refuted: the target-sum gate (`Σ==208`) makes alternative valid counts computationally infeasible to produce; `count` is uniquely determined per accepted signature in practice. (The genuine residual is the *reuse* question, captured in C13-X-f3, not malleability.) +- **C13 R-malleability.** Refuted: `R` is fully bound into the digest (and thus into `ht_idx`, FORS indices, forced-zero), so a mutated `R` requires a fresh full forgery and no two distinct `R` verify the same sig body. (The *grindability* of R is the real concern — C13-X-f2 — not malleability.) +- **ERC-4337 userOp.signature in `userOpHash` / ECDSA malleability as a contract defect.** Refuted as a defect: correct per ERC-4337 (nonce anchors anti-replay; userOpHash excludes the signature by design) and OZ v5 rejects high-`s`. Reduced to the off-chain-dedup hygiene note C13-mal-f1-erc4337. +- **Gas DoS via unbounded loops.** Checked OK: every verifier loop is bounded by fixed compile-time parameters; no attacker-controlled iteration count. +- **Signer liveness (grind exhaustion).** Checked OK: both R-grind (~2^19 forced-zero target, 10M cap) and count-grind (~58k expected trials for sum=208, 10M cap) are bounded, succeed w.h.p., and return `Result/Err` on exhaustion (no silent invalid sig). +- **SphincsAccount access control (execute / rotateKeys / rotateOwner).** Checked OK: well-tested by `SphincsAccountAccessControlTest` (execute-is-EntryPoint-only, rotation gating). + +--- + +## 6. Recommended Next Steps + +Ordered by leverage for the two in-scope families. + +1. **Resolve the C13 security model (C13-X-f2, highest substantive item).** Either secret-key `R` (`R = mask_n(keccak(sk_prf ‖ opt_rand ‖ M))`, keep grinding the forced-zero predicate with a secret nonce), **or** write the few-time / subset-resilience proof in the public-grindable-randomizer model and document that C13's `R` is adversary-grindable. State the proven bound (~2^133), not the secret-`R` one. +2. **Prove or document the target-sum WOTS+C multi-reuse bound (C13-X-f3).** Show that C13's few-time security under expected `ht_idx` reuse at the 2^22 cap is carried by the FORS term (effective k=6), not WOTS one-time-ness, and bound the min-combination forgery probability for w=8, l=43, T=208. Add a regression test: two messages colliding on `ht_idx` with distinct `fors_pk`, assert no third valid WOTS+C opening is assemblable from the revealed chains. +3. **Repair and wire up the C13 cross-implementation oracle (C13-S-f1, C13-S-f2).** Fix the 3→4-arg `fors_secret` call, regenerate `PY_FORS_SECRET_0_0` to the ht_idx-folded value (`0xf3c46060…`), and add `cargo test --release` (compile + run) to CI so the test binary cannot silently rot again. +4. **Add a pinned, reproducible FIPS KAT to CI for SLH (SLH-X-f1, SLH-X-f4/f5).** A deterministic forge fixture (explicit `optrand`/`sig_counter`) pinned to a known-answer `(seed, msg, sig, root)` cross-validated once via `crosscheck.py`, asserting `verify()==true`. Run the full Python-vs-C `crosscheck.py` in CI. This is the single largest assurance gap for the "FIPS 205 bit-exact" claim. Decide and document whether the target is *internal* (ACVP-internal) or *external* (add the `0x00 0x00 ‖ M` envelope on both signer and verifier). +5. **Correct the documentation claims.** (a) Reword the SLH "FIPS 205 bit-exact" docstring to "internal mode / no context envelope" unless the envelope is added (SLH-X-f1). (b) Replace the "2^24 hard cap / flat 128-bit" SLH wording with the true 2^22 leaf budget + birthday/FORS caveat (SLH-X-f2cap). (c) Make the C13 Python CLI sign raw bytes or document the 32-byte-only contract (SLH-S-f1 / SLH-V-f2). +6. **Low-cost hardening on the verifiers.** Add the canonical-key guard to C13 mirroring SLH (C13-V-f1); drop the inaccurate `("memory-safe")` annotation on C13 (C13-evm-f1); make the forced-zero/target-sum failures return `false` (or document revert==invalid) and have `SphincsFrameAccount` map verifier reverts to "invalid signature" (C13-V-f2 / C13-evm-f2); make `SphincsAccount._validateSignature` total via `tryRecover` + a guarded decode (C13-acc-g1). +7. **Pin the magic numbers (C13-V-f4, SLH-V-f3).** Comment every literal-vs-param identity (133=K·A, 114=(K−1)·A, 19=A, 18=A−1, masks, 11=SUBTREE_H; SLH ADRSc field widths <256), and re-enable the `#[ignore]`d full-height crosscheck so a desync is caught empirically. + +**Honest summary of the confirmed set:** the list is genuinely short on severity — **zero critical/high** after reconciliation (the one originally-high item is a non-practical, ~2^133-work security-model gap, reconciled to medium), **six medium** (all model/conformance/test-oracle gaps, no exploit), and the remainder low/info robustness, consistency, and documentation items. No forgery, key-recovery, or false-accept path was found in either in-scope family. The prior critical "Finding C" (global FORS instance → universal forgery) is **fixed** in the current tree (per-message hypertree-leaf keying), and that fix is still covered by `fors_leaf_keying.rs`. The largest *residual risk* is not a code bug but an **assurance gap**: the "FIPS 205 bit-exact" SLH claim and the C13 cross-implementation parity are not guarded by any automated KAT or CI hook. \ No newline at end of file diff --git a/docs/SECURITY-ANALYSIS.md b/docs/SECURITY-ANALYSIS.md new file mode 100644 index 0000000..73dd8d4 --- /dev/null +++ b/docs/SECURITY-ANALYSIS.md @@ -0,0 +1,243 @@ +# Security analysis — C13 (FORS+C / WOTS+C) and SLH-DSA-SHA2-128-24 + +> Status: informal security argument, not a machine-checked proof. It records the +> few-time / subset-resilience accounting behind two review remediations +> (C13-X-f2 secret-keyed `R`; C13-X-f3 WOTS+C reuse) and documents the +> SLH-DSA-SHA2 usage budget (SLH-X-f2cap). Probabilistic bounds are order-of- +> magnitude (base-2 log) estimates in the random-oracle model for keccak256 / +> SHA-256; constants and lower-order terms are dropped. This is a research +> prototype — **not audited, not production-safe.** + +C13 parameters: `n=128` (16-byte hashes), `h=22`, `d=2`, `subtree_h=11`, +`a=19`, `k=7`, `w=8`, `l=43`, `target_sum=208`, per-key signature cap `2^22`. + +SLH-DSA-SHA2-128-24 parameters: `n=16`, `h=22`, `d=1`, `a=24`, `k=6`, `w=4`, +single XMSS tree of `2^22` leaves, named usage cap `2^24`. + +--- + +## 1. Threat model and what the verifier checks + +The on-chain verifier is the trust anchor. It is given `(pkSeed, pkRoot, message, sig)` +and recomputes `digest = H_msg(pkSeed, pkRoot, R, message)` from the randomizer +`R` carried *inside* the signature, then checks the FORS openings, the FORS+C +forced-zero, the WOTS+C target-sum, the WOTS chains, and the hypertree Merkle +climb to `pkRoot`. + +Two facts drive the analysis: + +- **A forger always controls `R`.** `R` is part of the signature, so when an + adversary attempts a forgery they may pick any `R*` they like. No signer-side + choice of `R` constrains a forger's `R*`. (This is why §2's fix is about the + *honest* signer, not the forger.) +- **A forger must KNOW the revealed secrets.** A FORS/WOTS opening is only + forgeable if the adversary already holds the secret hash-chain values at the + required indices. Those can only come from secrets *revealed by honest + signatures*. Few-time security is the statement that observing `q` honest + signatures does not reveal enough to open a fresh target. + +--- + +## 2. C13 message randomizer `R` — public-grindable → secret-keyed (review C13-X-f2) + +### 2.1 The two attack avenues + +For a FORS forgery on target `m*`, the adversary needs, for each of the +`k_eff` message-dependent FORS trees, the secret at index `md_i(pkSeed,R*,m*)` +in the FORS instance selected by `ht_idx(pkSeed,R*,m*)`. + +**Avenue A — forger grinds its own `R*` (inherent, both models).** +The forger grinds `R*` so the target's indices land on already-revealed secrets. +This avenue exists no matter how the honest signer derives `R`; it is bounded by +the FORS parameters (§3) and gives the ~`2^133` figure of §2.3. + +**Avenue B — adversary steers HONEST signatures (only if `R` is public).** +This is the dangerous one. If the map `m ↦ ht_idx(pkSeed,R(m),m)` is *publicly +computable*, a chosen-message adversary can: + +1. Offline, evaluate `ht_idx(m)` for many candidate messages `m` and keep only + those mapping to one **target FORS instance** `T`. Each candidate hits a + chosen `T` with probability `2^-h = 2^-22`, so finding one costs `~2^22` + hashes. +2. Request honest signatures on those colliding messages. Every such signature + reveals `k` FORS secrets **in instance `T`**. + +With the `2^22` signing budget concentrated onto a single instance, each of +`T`'s height-`a=19` FORS trees (`2^19` leaves) is *saturated* with reveals +(`2^22 ≫ 2^19`): the adversary learns essentially every secret of instance `T`. +A forgery on any message that maps to `T` then costs only the grind to land on +`T` with the forced-zero satisfied — `2^h · 2^a = 2^22 · 2^19 = 2^41` — which is +**catastrophically below 128 bits.** + +The pre-fix C13 derived `R = mask_n(keccak("R_grind" ‖ nonce))`, ground over +`nonce` until the forced-zero predicate held. The preimage contains **no secret**, +so `ht_idx(m)` is fully public and Avenue B is open. + +### 2.2 The fix: bind `R` to the secret seed + +Post-fix (`signer-wasm/src/fors.rs::grind_r`, `script/signer.py::grind_R_fors`): + +``` +R = mask_n(keccak256( sk_seed[32] ‖ "R_grind" ‖ message[32] ‖ nonce[32] )) + grinding `nonce` until the FORS+C forced-zero predicate holds. +``` + +`sk_seed` is secret, so `m ↦ ht_idx(m)` is a **secret keyed function**: the +adversary cannot evaluate it offline and therefore cannot pre-select messages +that land on a target instance. Honest reveals are spread pseudo-randomly across +the `2^22` instances (`≈ 1` reveal per instance at the cap), closing Avenue B and +returning C13 to the standard secret-randomizer model. The derivation stays +**deterministic** per `(key, message)` (the nonce search is deterministic), so no +runtime randomness is required; it may optionally be hedged by folding fresh +`opt_rand` into the preimage. + +The verifier is **unchanged** — it only reads `R` from the signature. The Rust +and Python signers use a byte-identical preimage so the cross-implementation +oracle (`signer-wasm/tests/cross_validate.rs`) and the on-chain digest stay in +lock-step. + +### 2.3 Residual bound (Avenue A, after the fix) + +With reveals spread (`r ≈ 1` per instance at `q = 2^22`), a forger grinding its +own `R*`: + +- must satisfy the FORS+C **forced-zero** on `md_{k-1}` — a `2^a = 2^19` factor; +- must hit, in the selected instance, the `k-1 = 6` message-dependent tree + indices that coincide with the (≈ single) revealed index per tree — + `(1/2^a)^{k-1} = 2^{-114}`. + +Combined work `≈ 2^{19} · 2^{114} = 2^{133}`, i.e. **above the 128-bit target.** +The bound degrades with per-instance reuse `r` roughly as `2^{155 − 6·log2 r}`; +keeping `q ≤ 2^22` with spread reveals keeps `r` small. (See ePrint 2025/2203 for +the FORS+C subset-resilience treatment this mirrors.) + +**Conclusion.** C13's forgery resistance is `≥ 2^133` in the secret-randomizer +model restored by the fix. The fix does not change Avenue A (inherent), but it +eliminates Avenue B (the `~2^41` chosen-message concentration break that public +`R` admitted). + +--- + +## 3. FORS+C forced-zero — effective `k = 6` (review C13-X-f1, not a defect) + +C13 forces the last (`k-1 = 6`) FORS tree's index to `0` by grinding `R`, and the +verifier reveals that tree's leaf-0 root directly (saving one auth path, shrinking +the signature). Consequently the forced-zero tree carries **no message-dependent +index entropy**: an adversary "always has" index 0 of tree 6. + +The effective few-time strength is therefore carried by `k_eff = k − 1 = 6` +message-dependent trees of height `a = 19`, i.e. `a·(k−1) = 114` bits of FORS +subset-resilience, *plus* the `2^a = 2^19` forced-zero grind a forger must also +pay (§2.3), for the `2^133` total. This reduction from `a·k = 133` to `a·(k−1)` +is an **intended property** of the +C construction, not a flaw — but it must +appear explicitly in the proven bound, which §2.3 does. + +--- + +## 4. WOTS+C target-sum reuse under `ht_idx` collisions (review C13-X-f3) + +### 4.1 Why bottom-layer WOTS keys are reused + +The layer-0 WOTS keypair is keyed by `(layer=0, tree=idxTree, kp=idxLeaf)` +derived from the 22-bit `ht_idx`. With a `q = 2^22` signing budget over `2^22` +leaves, **`ht_idx` collisions are expected** — by the birthday bound, roughly +`q^2 / 2^{23} ≈ 2^{21}` colliding pairs. Each collision between two messages with +distinct `fors_pk` means one layer-0 WOTS keypair signs two different WOTS +messages: a textbook WOTS one-time-use violation. This is inherent to all +SPHINCS+/SLH-DSA bottom layers and is absorbed by the FORS few-time layer, not +prevented by WOTS. + +### 4.2 What target-sum WOTS+C changes, and why single-use forgery is still blocked + +WOTS+C replaces the classic monotone checksum with a fixed digit-sum constraint: +the verifier rejects unless the 43 base-8 digits of the WOTS message digest sum to +exactly `target_sum = 208`. Forward-only forgery from a *single* signature is +still blocked: revealing a chain at digit `d[i]` lets a forger only advance to +digits `≥ d[i]`; any alternative vector `d'` with `d'[i] ≥ d[i] ∀i` and +`Σd' = 208 = Σd` forces `d' = d` (you cannot increase one digit without +decreasing another, which would require walking a chain backwards). + +### 4.3 The multi-reuse (min-combination) residual, and the gating argument + +Under a `ht_idx` collision, two reused signatures reveal each of the 43 chains +down to the per-signature minimum `min(d1[i], d2[i])`. A min-combination forgery +would need a third vector `d3` with `d3[i] ≥ min(d1[i],d2[i]) ∀i` and `Σd3 = 208`. +**Crucially, the WOTS message is itself `fors_pk`** (the layer-0 node the WOTS +keypair signs). So to mount this the adversary must exhibit a *third distinct +`fors_pk'`* that (a) hashes (with an attacker-chosen `count`) to such a `d3`, and +(b) is a `fors_pk'` they can actually open — i.e. for which they hold the FORS +secrets. Producing an openable `fors_pk'` of their choice is exactly a FORS +forgery. + +**Gating conclusion.** A WOTS+C reuse forgery at layer 0 is therefore *gated by* +FORS few-time security on the same `ht_idx` instance: it cannot succeed unless the +adversary can already forge the FORS opening, which §2–§3 bound at `≥ 2^133` once +`R` is secret-keyed (no instance concentration). WOTS one-time-ness is **not** the +load-bearing property; the FORS term is. The target-sum-specific min-combination +probability for `w=8, l=43, T=208` against `r` reuses is the residual that the +ePrint 2025/2203 analysis must carry; we do not re-derive it here, and we add an +empirical guard (§4.4). + +### 4.4 Regression guard + +`signer-wasm/tests/wots_reuse_poc.rs` constructs two messages colliding on +`ht_idx` with distinct `fors_pk`, harvests the WOTS chains both reveal, and +asserts that the union of revealed chain values does **not** admit a valid +WOTS+C opening (`Σ digits == 208`, every digit reachable) for a third, distinct +`fors_pk` target. It is a guard against a regression that would make the layer-0 +WOTS keypair forgeable from reuse *independently* of FORS — it does not replace +the analytic bound. + +--- + +## 5. SLH-DSA-SHA2-128-24 — external mode and the `2^22` leaf budget + +### 5.1 External FIPS 205 (review SLH-X-f1) + +The verifier implements **FIPS 205 external `SLH-DSA.Verify` with an empty +context**: the message is wrapped as `M' = toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx ‖ M` += `0x00 ‖ 0x00 ‖ M` before `H_msg` (FIPS 205 Algorithm 24). This matches published +NIST/ACVP *external* known-answer vectors. The C reference (`slh_sign_internal`) +and the Python signer apply the same envelope by prepending `0x00 0x00`; the +on-chain verifier prepends it internally before the inner SHA-256 +(`R ‖ seed ‖ root ‖ 0x00 ‖ 0x00 ‖ M`, 82 bytes). + +### 5.2 The signature budget (review SLH-X-f2cap) + +With `h=22, d=1` the hypertree is a single XMSS tree of `2^22` one-time WOTS +leaves, and the signing leaf `leafIdx` is chosen *pseudo-randomly* from the +message digest. Therefore: + +- WOTS-leaf collisions appear by the birthday bound — onset `~2^{11}` signatures, + not at the named `2^24` cap; +- by `2^24` signatures, leaves have been reused `~4×` on average (`2^24 / 2^22`); +- this is **expected and tolerated**: a leaf collision is not itself a WOTS + forgery, and the FORS few-time layer (`a=24, k=6`) absorbs the reuse. + +So "2^24" is a recommended **per-key usage cap**, not a flat one-time-WOTS +security guarantee, and the 128-bit level across the window is carried by the FORS +margin. Operators bounding risk should treat the per-key budget as a function of +the acceptable WOTS-reuse / FORS-collision probability (birthday over `2^22`), +not as a hard `2^24` security cliff. This differs from C7/C13, whose `2^24`/`2^22` +figures *are* the actual hypertree-leaf counts at full one-time-WOTS security. + +--- + +## 6. Summary + +| Property | Bound / status | Basis | +|---|---|---| +| C13 forgery, secret-keyed `R`, `q ≤ 2^22` | `≥ 2^133` work | §2.3 (FORS+C, forger-controlled `R*`) | +| C13 chosen-message concentration (public `R`) | `~2^41` — **closed by the fix** | §2.1 Avenue B | +| C13 FORS+C effective few-time | `k_eff = 6`, `a·(k−1)=114` + `2^19` forced-zero | §3 | +| C13 WOTS+C layer-0 reuse | gated by FORS (`≥2^133`); residual min-combination per ePrint 2025/2203 | §4 | +| SLH-DSA-SHA2 conformance | FIPS 205 external (empty ctx), ACVP external KATs | §5.1 | +| SLH-DSA-SHA2 budget | `2^22` leaf space, FORS-absorbed; `2^24` = usage cap | §5.2 | + +**What is proven vs assumed.** The forced-zero / target-sum structural facts and +the gating argument (§4.3) are deterministic and verifier-checked. The +probabilistic forgery bounds (§2.3, §4) are random-oracle estimates that inherit +the FORS+C subset-resilience analysis of ePrint 2025/2203; they are documented +here, not machine-checked. The `verity/` Lean model covers the keccak +collision-resistance axioms and Merkle-kernel compilation correctness, not these +probabilistic few-time bounds. diff --git a/foundry.toml b/foundry.toml index 90ed418..7c96e77 100644 --- a/foundry.toml +++ b/foundry.toml @@ -6,6 +6,8 @@ via_ir = true optimizer = true optimizer_runs = 200 ffi = true +# Read-only access for the JSON KAT fixture (SLH-DSA-SHA2-128-24-JsonKAT.t.sol). +fs_permissions = [{ access = "read", path = "./signers/slhvk-sha2-128-24/kat-counter0.json" }] remappings = [ "account-abstraction/=lib/account-abstraction/contracts/", diff --git a/legacy/README.md b/legacy/README.md index 68993cb..6baa643 100644 --- a/legacy/README.md +++ b/legacy/README.md @@ -6,6 +6,15 @@ kept for reproducibility of prior benchmarks, as a reference for the ADRS / hash conventions they share with the current verifiers, and as an escape hatch if someone needs to redeploy an earlier variant. +**C11, C12, and `SLH-DSA-keccak-128-24verifier.sol`** were retired here when the +repo standardized on the two FIPS 205 ADRS layouts (uncompressed 32 B + keccak, +ADRSc 22 B + SHA-2). They stayed on the JARDIN 32-byte ADRS layout, so rather +than migrate their kernels they were frozen alongside C6/C8/C10. Their off-chain +signers (`script/jardin_spx_signer.py`, `signers/jardin-keccak-128-24/`, and +`script/signer.py` in JARDIN `adrs_mode`) and the keccak SLH-DSA deploy entry in +`script/DeploySlhDsa128_24Sepolia.s.sol` are unchanged and still point at these +files via `../legacy/src/`. + ## What's here ### `legacy/src/` — Solidity verifiers and accounts @@ -13,6 +22,8 @@ escape hatch if someone needs to redeploy an earlier variant. | File | What it is | |---|---| | `SPHINCs-C6Asm.sol` … `SPHINCs-C11Asm.sol` | Stateless SPHINCS+ / SPHINCs- WOTS+C + FORS+C verifiers (n=128, d=2). | +| `SPHINCs-C12Asm.sol` | Plain SPHINCS+ (SPX) verifier, JARDIN 32-byte ADRS. 6,512-B sig, ~276 K verify. `JardinSpxVerifier` in the JARDIN repo. | +| `SLH-DSA-keccak-128-24verifier.sol` | JARDIN-convention Keccak twin of SLH-DSA-128-24 (keccak opcode, 32-byte ADRS). SHA-2 twin stays live in `src/`. | | `SphincsAccount.sol`, `SphincsAccountFactory.sol` | Original hybrid ECDSA + SPHINCs- ERC-4337 account and its factory. | | `SphincsFrameAccount.sol` | Original EIP-8141 frame account wired to the C-series verifiers. | | `JardinT0Verifier.sol` | JARDINERO T0 variant: plain FORS + WOTS+C hypertree (h=14 d=7 a=6 k=39). | @@ -38,6 +49,8 @@ escape hatch if someone needs to redeploy an earlier variant. | File | Covers | |---|---| | `SphincsC8Test.t.sol` … `SphincsC11Test.t.sol` | Stateless SPHINCs- C8–C11 verifiers. | +| `SphincsC12Test.t.sol` | Plain SPHINCS+ C12 verifier. | +| `SLH-DSA-Keccak-128-24-CalldataGas.t.sol`, `SLH-DSA-keccak-128-24-Test.t.sol` | Keccak SLH-DSA-128-24 twin (calldata-gas + FFI round-trip). FFI signer paths under `script/` / `signers/` are unchanged. | | `JardinT0Test.t.sol` | T0 verifier standalone. | | `JardinForsCTest.t.sol`, `JardinForsCVariableHTest.t.sol` | FORS+C verifier (fixed and variable-h). | diff --git a/src/SLH-DSA-keccak-128-24verifier.sol b/legacy/src/SLH-DSA-keccak-128-24verifier.sol similarity index 100% rename from src/SLH-DSA-keccak-128-24verifier.sol rename to legacy/src/SLH-DSA-keccak-128-24verifier.sol diff --git a/src/SPHINCs-C11Asm.sol b/legacy/src/SPHINCs-C11Asm.sol similarity index 80% rename from src/SPHINCs-C11Asm.sol rename to legacy/src/SPHINCs-C11Asm.sol index e774b98..3c4b389 100644 --- a/src/SPHINCs-C11Asm.sol +++ b/legacy/src/SPHINCs-C11Asm.sol @@ -36,21 +36,38 @@ contract SphincsC11Asm { let htIdx := and(shr(143, digest), 0xFFFF) // FORS+C (K=13, A=11) + // + // FORS addressing — exact FIPS 205 FORS field split (matches C12, + // SPHINCs-C12Asm.sol:80) in the JARDIN layout — + // tree address = idxTree0 = htIdx >> SUBTREE_H (bottom subtree) + // kp = idxLeaf0 = htIdx & (2^SUBTREE_H-1) (bottom leaf) + // ha/tree_index = (forsTree << (A-height)) | node (k FORS trees + // indexed as one forest, FIPS 205 Alg. 17) + // cp/tree_height = height + // so each of the 2^h hypertree leaves selects a distinct FORS + // instance. The signer mirrors this and derives the leaf secrets + // from the same leaf. let dVal := digest // Forced-zero: last index (i=12) at bits 132..142 if and(shr(132, dVal), 0x7FF) { revert(0, 0) } let sigBase := sig.offset + // SUBTREE_H = 8 (h/d = 16/2): split htIdx into bottom subtree + leaf. + let idxLeaf0 := and(htIdx, 0xFF) + let idxTree0 := shr(8, htIdx) + // forsBase: tree=idxTree0 (shl 160), type=3 (shl 128), kp=idxLeaf0 (shl 96). + // Per-site we OR in cp=height (shl 32) and ha=tree_index (shl 0). + let forsBase := or(shl(160, idxTree0), or(shl(128, 3), shl(96, idxLeaf0))) // K-1=12 normal trees for { let i := 0 } lt(i, 12) { i := add(i, 1) } { let treeIdx := and(shr(mul(i, 11), dVal), 0x7FF) // 11-bit indices let secretVal := and(calldataload(add(sigBase, add(16, shl(4, i)))), N_MASK) - let leafAdrs := or(shl(128, 3), or(shl(96, i), treeIdx)) + // Leaf hash (height 0): ha = (i << A) | treeIdx, A=11 + let leafAdrs := or(forsBase, or(shl(11, i), treeIdx)) mstore(0x20, leafAdrs) mstore(0x40, secretVal) let node := and(keccak256(0x00, 0x60), N_MASK) - let treeAdrsBase := or(shl(128, 3), shl(96, i)) let pathIdx := treeIdx // AUTH_START=224, auth per tree = 11*16 = 176 let authPtr := add(sigBase, add(224, mul(i, 176))) @@ -59,7 +76,8 @@ contract SphincsC11Asm { for { let h := 0 } lt(h, 11) { h := add(h, 1) } { let sibling := and(calldataload(add(authPtr, shl(4, h))), N_MASK) let parentIdx := shr(1, pathIdx) - mstore(0x20, or(treeAdrsBase, or(shl(32, add(h, 1)), parentIdx))) + // cp=height=h+1; ha = (i << (A-1-h)) | parentIdx, A-1=10 + mstore(0x20, or(forsBase, or(shl(32, add(h, 1)), or(shl(sub(10, h), i), parentIdx)))) // Branchless Merkle swap let s := shl(5, and(pathIdx, 1)) mstore(xor(0x40, s), node) @@ -73,15 +91,17 @@ contract SphincsC11Asm { // Last tree (forced-zero) { let lastSecret := and(calldataload(add(sigBase, add(16, shl(4, 12)))), N_MASK) // 16+12*16=208 - mstore(0x20, or(shl(128, 3), shl(96, 12))) + // Forced-zero tree (forsTree=12) as leaf node 0: ha = (12 << A) + mstore(0x20, or(forsBase, shl(11, 12))) mstore(0x40, lastSecret) // 0x80 + 12*0x20 = 0x80 + 0x180 = 0x200 mstore(0x200, and(keccak256(0x00, 0x60), N_MASK)) } // Compress 13 roots: keccak256(seed || rootsAdrs || 13 roots) + // FORS_ROOTS: tree=idxTree0 (shl 160), type=4 (shl 128), kp=idxLeaf0 (shl 96). // = 32 + 32 + 13*32 = 480 = 0x1E0 - mstore(0x20, shl(128, 4)) + mstore(0x20, or(shl(160, idxTree0), or(shl(128, 4), shl(96, idxLeaf0)))) for { let i := 0 } lt(i, 13) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) } diff --git a/src/SPHINCs-C12Asm.sol b/legacy/src/SPHINCs-C12Asm.sol similarity index 100% rename from src/SPHINCs-C12Asm.sol rename to legacy/src/SPHINCs-C12Asm.sol diff --git a/test/SLH-DSA-Keccak-128-24-CalldataGas.t.sol b/legacy/test/SLH-DSA-Keccak-128-24-CalldataGas.t.sol similarity index 100% rename from test/SLH-DSA-Keccak-128-24-CalldataGas.t.sol rename to legacy/test/SLH-DSA-Keccak-128-24-CalldataGas.t.sol diff --git a/test/SLH-DSA-keccak-128-24-Test.t.sol b/legacy/test/SLH-DSA-keccak-128-24-Test.t.sol similarity index 100% rename from test/SLH-DSA-keccak-128-24-Test.t.sol rename to legacy/test/SLH-DSA-keccak-128-24-Test.t.sol diff --git a/test/SphincsC11Test.t.sol b/legacy/test/SphincsC11Test.t.sol similarity index 100% rename from test/SphincsC11Test.t.sol rename to legacy/test/SphincsC11Test.t.sol diff --git a/test/SphincsC12Test.t.sol b/legacy/test/SphincsC12Test.t.sol similarity index 100% rename from test/SphincsC12Test.t.sol rename to legacy/test/SphincsC12Test.t.sol diff --git a/script/DeploySlhDsa128_24Sepolia.s.sol b/script/DeploySlhDsa128_24Sepolia.s.sol index c31dafc..43908a7 100644 --- a/script/DeploySlhDsa128_24Sepolia.s.sol +++ b/script/DeploySlhDsa128_24Sepolia.s.sol @@ -3,13 +3,15 @@ pragma solidity ^0.8.28; import "forge-std/Script.sol"; import "../src/SLH-DSA-SHA2-128-24verifier.sol"; -import "../src/SLH-DSA-keccak-128-24verifier.sol"; +import "../legacy/src/SLH-DSA-keccak-128-24verifier.sol"; /// @title DeploySlhDsa128_24Sepolia — Deploy the SLH-DSA-*-128-24 verifiers /// @notice Two stateless, pure verifiers. Parameters follow NIST SP 800-230 Table 1: /// n=16, h=22, d=1, h'=22, a=24, k=6, w=4 (lgw=2), m=21, sig=3,856 B. /// SHA-2 variant is FIPS 205 bit-exact (SHA-256 precompile). -/// Keccak variant is the JARDIN family twin (keccak opcode, 32-byte ADRS). +/// Keccak variant is the JARDIN family twin (keccak opcode, 32-byte ADRS); +/// it is now retired to legacy/ (frozen, not maintained) — kept here only +/// so the historical Sepolia deployment stays reproducible. /// /// Run: /// forge script script/DeploySlhDsa128_24Sepolia.s.sol \ diff --git a/script/signer.py b/script/signer.py index 908adc9..f1f1088 100644 --- a/script/signer.py +++ b/script/signer.py @@ -47,23 +47,29 @@ "subtree_h": 12, "sig_size": 3352}, "c7": {"h": 24, "d": 2, "k": 8, "a": 16, "m_max": 0, "scheme": "fors", "subtree_h": 12, "sig_size": 3704, - "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 151, "w_mask": 0x7}, + "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 151, "w_mask": 0x7, + "adrs_mode": "fips", # migrated to FIPS 205 uncompressed ADRS + "fors_bind_leaf": True}, # key FORS instance by per-message hypertree leaf (FIPS field split) "c8": {"h": 20, "d": 2, "k": 12, "a": 13, "m_max": 0, "scheme": "fors", "subtree_h": 10, "sig_size": 3848, "w": 16, "log_w": 4, "l": 32, "len1": 32, "target_sum": 162, "w_mask": 0xF}, "c9": {"h": 20, "d": 2, "k": 11, "a": 12, "m_max": 0, "scheme": "fors", "subtree_h": 10, "sig_size": 3816, - "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 208, "w_mask": 0x7}, + "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 208, "w_mask": 0x7, + "adrs_mode": "fips", # migrated to FIPS 205 uncompressed ADRS + "fors_bind_leaf": True}, # key FORS instance by per-message hypertree leaf (FIPS field split) "c10": {"h": 18, "d": 2, "k": 13, "a": 11, "m_max": 0, "scheme": "fors", "subtree_h": 9, "sig_size": 4008, "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 205, "w_mask": 0x7}, "c11": {"h": 16, "d": 2, "k": 13, "a": 11, "m_max": 0, "scheme": "fors", "subtree_h": 8, "sig_size": 3976, - "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 203, "w_mask": 0x7}, + "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 203, "w_mask": 0x7, + "fors_bind_leaf": True}, # key FORS instance by per-message hypertree leaf (FIPS field split) "c13": {"h": 22, "d": 2, "k": 7, "a": 19, "m_max": 0, "scheme": "fors", "subtree_h": 11, "sig_size": 3688, "w": 8, "log_w": 3, "l": 43, "len1": 43, "target_sum": 208, "w_mask": 0x7, - "adrs_mode": "fips"}, # FIPS 205 §11.2.2 uncompressed 32-byte ADRS + "adrs_mode": "fips", # FIPS 205 §11.2.2 uncompressed 32-byte ADRS + "fors_bind_leaf": True}, # key FORS instance by per-message hypertree leaf (FIPS field split) } # ============================================================ @@ -220,8 +226,17 @@ def wots_secret(sk_seed, layer, tree, kp, chain_idx): to_b4(layer) + to_b32(tree) + to_b4(kp) + to_b4(chain_idx)) return keccak256(data) & N_MASK -def fors_secret(sk_seed, tree_idx, leaf_idx): - data = to_b32(sk_seed) + b"fors" + to_b4(tree_idx) + to_b4(leaf_idx) +def fors_secret(sk_seed, tree_idx, leaf_idx, ht_idx=None): + """FORS leaf secret PRF. + + `ht_idx` binds the secret to the per-message hypertree leaf, so each leaf + uses an independent FORS instance (standard SLH-DSA few-time-signature + behaviour). Variants without the leaf binding pass ht_idx=None, keeping + their original byte-for-byte preimage for layout compatibility.""" + data = to_b32(sk_seed) + b"fors" + if ht_idx is not None: + data += to_b4(ht_idx) + data += to_b4(tree_idx) + to_b4(leaf_idx) return keccak256(data) & N_MASK def pors_secret(sk_seed, sig_pos): @@ -357,13 +372,25 @@ def build_subtree_full(seed, sk_seed, layer, tree, subtree_h, cfg=None): # FORS+C # ============================================================ -def build_fors_tree(seed, sk_seed, tree_idx, a, cfg=None): +def build_fors_tree(seed, sk_seed, tree_idx, a, cfg=None, ht_idx=None, idx_leaf0=None, idx_tree0=None): + """Build one FORS Merkle tree. + + When bound (ht_idx is not None — exact FIPS 205 FORS field split): tree + address = idx_tree0, kp = idx_leaf0, tree_index = (tree_idx << (a-height)) + | node, tree_height = height, and the leaf secret PRF folds in ht_idx. This + keys the FORS instance by the per-message hypertree leaf (matches C12 / + SLH-DSA field semantics, FIPS 205 Alg. 17). Variants without the binding + pass ht_idx=None: original layout (tree=0, kp=tree_idx, tree_index=node), + secret PRF unchanged — byte-for-byte preserved.""" mk_adrs, _, _ = _adrs_helpers(cfg) n_leaves = 1 << a leaves = [] for j in range(n_leaves): - secret = fors_secret(sk_seed, tree_idx, j) - leaf_adrs = mk_adrs(0, 0, ADRS_FORS_TREE, tree_idx, 0, 0, j) + secret = fors_secret(sk_seed, tree_idx, j, ht_idx) + if ht_idx is not None: + leaf_adrs = mk_adrs(0, idx_tree0, ADRS_FORS_TREE, idx_leaf0, 0, 0, (tree_idx << a) | j) + else: + leaf_adrs = mk_adrs(0, 0, ADRS_FORS_TREE, tree_idx, 0, 0, j) leaves.append(th(seed, leaf_adrs, secret)) nodes = [leaves] for h in range(a): @@ -371,7 +398,11 @@ def build_fors_tree(seed, sk_seed, tree_idx, a, cfg=None): level = [] for idx in range(0, len(prev), 2): parent_idx = idx // 2 - adrs = mk_adrs(0, 0, ADRS_FORS_TREE, tree_idx, 0, h + 1, parent_idx) + if ht_idx is not None: + ti = (tree_idx << (a - (h + 1))) | parent_idx + adrs = mk_adrs(0, idx_tree0, ADRS_FORS_TREE, idx_leaf0, 0, h + 1, ti) + else: + adrs = mk_adrs(0, 0, ADRS_FORS_TREE, tree_idx, 0, h + 1, parent_idx) level.append(th_pair(seed, adrs, prev[idx], prev[idx + 1])) nodes.append(level) return nodes, nodes[a][0] @@ -382,23 +413,41 @@ def fors_sign_full(seed, sk_seed, digest, k, a, cfg=None): indices = [(digest >> (i * a)) & a_mask for i in range(k)] assert indices[k - 1] == 0, f"Forced-zero violated: last index = {indices[k-1]}" + # Exact FIPS 205 FORS field split: key the FORS instance by the per-message + # hypertree leaf. htIdx = (digest >> k*a) & (2^h - 1) — the same value the + # verifier parses and the hypertree consumes — split into the bottom subtree + # (idx_tree0 → tree address) and leaf (idx_leaf0 → kp). Gated by cfg so + # variants without the binding are byte-for-byte unchanged. + ht_idx = idx_leaf0 = idx_tree0 = None + if cfg and cfg.get("fors_bind_leaf"): + ht_idx = (digest >> (k * a)) & ((1 << cfg["h"]) - 1) + sh = cfg["subtree_h"] + idx_leaf0 = ht_idx & ((1 << sh) - 1) + idx_tree0 = ht_idx >> sh + secrets = [] auth_paths = [] roots = [] for t in range(k - 1): eprint(f" FORS tree {t}/{k-1}...") - tree_nodes, root = build_fors_tree(seed, sk_seed, t, a, cfg) - secrets.append(fors_secret(sk_seed, t, indices[t])) + tree_nodes, root = build_fors_tree(seed, sk_seed, t, a, cfg, ht_idx, idx_leaf0, idx_tree0) + secrets.append(fors_secret(sk_seed, t, indices[t], ht_idx)) auth_paths.append(get_auth_path(tree_nodes, indices[t], a)) roots.append(root) eprint(f" FORS tree {k-1}/{k-1} (forced-zero)...") - _, root_last = build_fors_tree(seed, sk_seed, k - 1, a, cfg) + _, root_last = build_fors_tree(seed, sk_seed, k - 1, a, cfg, ht_idx, idx_leaf0, idx_tree0) secrets.append(root_last) - roots.append(th(seed, mk_adrs(0, 0, ADRS_FORS_TREE, k - 1, 0, 0, 0), root_last)) + if ht_idx is not None: + # Forced-zero tree (forsTree=k-1) as leaf node 0: tree_index = (k-1) << a + fz_adrs = mk_adrs(0, idx_tree0, ADRS_FORS_TREE, idx_leaf0, 0, 0, (k - 1) << a) + roots_adrs = mk_adrs(0, idx_tree0, ADRS_FORS_ROOTS, idx_leaf0, 0, 0, 0) + else: + fz_adrs = mk_adrs(0, 0, ADRS_FORS_TREE, k - 1, 0, 0, 0) + roots_adrs = mk_adrs(0, 0, ADRS_FORS_ROOTS, 0, 0, 0, 0) + roots.append(th(seed, fz_adrs, root_last)) - roots_adrs = mk_adrs(0, 0, ADRS_FORS_ROOTS, 0, 0, 0, 0) fors_pk = th_multi(seed, roots_adrs, roots) return secrets, auth_paths, fors_pk @@ -489,20 +538,30 @@ def compute_octopus_auth_set(tree_nodes, sorted_indices, tree_height): # R Grinding # ============================================================ -def grind_R_fors(seed, root, message, k, a): +# SECRET-KEYED randomizer (review C13-X-f2). R is bound to the secret sk_seed and +# the message: R = mask_n(keccak(sk_seed[32] || "R_grind" || message[32] || +# nonce[32])), grinding nonce until the forced-zero / octopus predicate holds. +# Binding R to sk_seed removes public-grindability (an attacker can no longer +# offline-search (message, R) to steer the FORS index map / hypertree leaf onto +# previously-revealed instances), restoring the standard secret-randomizer +# few-time model, while staying deterministic per (key, message). The preimage +# layout MUST match signer-wasm/src/fors.rs::grind_r byte-for-byte or the +# Rust<->Python cross-check (and the on-chain digest) diverge. The verifier is +# unaffected — it only reads R out of the signature. +def grind_R_fors(seed, sk_seed, root, message, k, a): a_mask = (1 << a) - 1 last_shift = (k - 1) * a for nonce in range(10_000_000): - R = keccak256(b"R_grind" + to_b32(nonce)) & N_MASK + R = keccak256(to_b32(sk_seed) + b"R_grind" + to_b32(message) + to_b32(nonce)) & N_MASK digest = h_msg(seed, root, R, message) if (digest >> last_shift) & a_mask == 0: eprint(f" R grind: found at nonce={nonce}") return R, digest raise RuntimeError("R grinding failed") -def grind_R_pors(seed, root, message, k, tree_height, m_max): +def grind_R_pors(seed, sk_seed, root, message, k, tree_height, m_max): for nonce in range(10_000_000): - R = keccak256(b"R_grind" + to_b32(nonce)) & N_MASK + R = keccak256(to_b32(sk_seed) + b"R_grind" + to_b32(message) + to_b32(nonce)) & N_MASK digest = h_msg(seed, root, R, message) indices = extract_pors_indices(digest, k, tree_height) n = count_octopus_auth_nodes(indices, tree_height) @@ -553,9 +612,9 @@ def sign_variant(variant_name, message_int, seed=None, sk_seed=None, pk_root=Non # STEP 2: Grind R # ================================================================ if scheme == "fors": - R, digest = grind_R_fors(seed, pk_root, message_int, k, a) + R, digest = grind_R_fors(seed, sk_seed, pk_root, message_int, k, a) else: - R, digest = grind_R_pors(seed, pk_root, message_int, k, tree_height, m_max) + R, digest = grind_R_pors(seed, sk_seed, pk_root, message_int, k, tree_height, m_max) # ================================================================ # STEP 3: Decompose hypertree path diff --git a/script/slh_dsa_sha2_128_24_fast_signer.py b/script/slh_dsa_sha2_128_24_fast_signer.py index 7068392..a961c0e 100644 --- a/script/slh_dsa_sha2_128_24_fast_signer.py +++ b/script/slh_dsa_sha2_128_24_fast_signer.py @@ -55,9 +55,12 @@ def _norm(s: str) -> str: return s.lower().removeprefix("0x") def cache_key(master_sk_hex: str, message_hex: str, sig_counter: int) -> str: # Cache key includes a convention tag so that bumping signature - # conventions (e.g. the FORS digest LE→BE switch for FIPS 205) breaks - # the cache for any pre-existing fixtures. - CONVENTION_TAG = b"fips205-be-fors-v1" + # conventions (e.g. the FORS digest LE→BE switch for FIPS 205, or the + # external empty-ctx envelope) breaks the cache for any pre-existing + # fixtures. It also folds in the C binary's mtime so a rebuild (e.g. a + # reduced-height dev build) cannot silently serve a stale fixture under + # different params. (review SLH-X-f1 / SLH-S-f3) + CONVENTION_TAG = b"fips205-external-empty-ctx-v2" h = hashlib.sha256() h.update(CONVENTION_TAG) h.update(b"|") @@ -66,6 +69,8 @@ def cache_key(master_sk_hex: str, message_hex: str, sig_counter: int) -> str: h.update(_norm(message_hex).encode()) h.update(b"|") h.update(str(sig_counter).encode()) + h.update(b"|") + h.update(str(os.path.getmtime(BIN_PATH)).encode()) return h.hexdigest() def main(): @@ -98,7 +103,11 @@ def main(): msg_hex = args.message_hex.removeprefix("0x") if len(msg_hex) % 2: msg_hex = "0" + msg_hex - # C CLI takes message as raw hex bytes; pass through as-is. + # FIPS 205 EXTERNAL SLH-DSA.Sign with empty context: the C binary is + # slh_sign_internal (signs raw bytes), so we apply the envelope here by + # prepending M' = toByte(0,1) ‖ toByte(0,1) ‖ M = 0x00 0x00 ‖ M. The + # on-chain verifier prepends the same two bytes internally. (review SLH-X-f1) + msg_hex_signed = "0000" + msg_hex # In hedged mode (default) we pass --hedged through to the C binary so # opt_rand is drawn inside via getrandom(2). @@ -124,9 +133,9 @@ def main(): eprint(f" invoking C signer (h=22, a=24 — ~1-3 min)...") if args.hedged: - cmd = [BIN_PATH, "--hedged", seed48.hex(), msg_hex] + cmd = [BIN_PATH, "--hedged", seed48.hex(), msg_hex_signed] else: - cmd = [BIN_PATH, seed48.hex(), msg_hex, optrand.hex()] + cmd = [BIN_PATH, seed48.hex(), msg_hex_signed, optrand.hex()] result = subprocess.run(cmd, capture_output=True, text=True) if args.hedged: for line in result.stderr.splitlines(): diff --git a/script/slh_dsa_sha2_128_24_gpu_signer.py b/script/slh_dsa_sha2_128_24_gpu_signer.py index 2c34e2b..7315088 100755 --- a/script/slh_dsa_sha2_128_24_gpu_signer.py +++ b/script/slh_dsa_sha2_128_24_gpu_signer.py @@ -56,12 +56,19 @@ def abi_encode(seed16: bytes, root16: bytes, sig: bytes) -> bytes: def _norm(s: str) -> str: return s.lower().removeprefix("0x") def cache_key(master_sk_hex: str, message_hex: str, sig_counter: int) -> str: + # Convention tag invalidates pre-envelope fixtures (review SLH-X-f1). + # Like the CPU fast signer, also fold in the GPU binary's mtime so a + # rebuild (e.g. a reduced-height dev build) cannot silently serve a + # stale fixture under the same tag. h = hashlib.sha256() + h.update(b"fips205-external-empty-ctx-v2|") h.update(_norm(master_sk_hex).encode()) h.update(b"|") h.update(_norm(message_hex).encode()) h.update(b"|") h.update(str(sig_counter).encode()) + h.update(b"|") + h.update(str(os.path.getmtime(BIN_PATH)).encode()) return h.hexdigest() def main(): @@ -95,6 +102,10 @@ def main(): msg_hex = args.message_hex.removeprefix("0x") if len(msg_hex) % 2: msg_hex = "0" + msg_hex + # FIPS 205 external SLH-DSA.Sign, empty ctx: sign M' = 0x00 0x00 ‖ M. The GPU + # binary is slh_sign_internal (raw bytes), so we prepend the envelope here to + # match the on-chain verifier. (review SLH-X-f1) + msg_hex_signed = "0000" + msg_hex # In hedged mode (the default) we pass --hedged through to the GPU binary # so opt_rand is drawn inside the C binary via getrandom(2). Python only @@ -122,9 +133,9 @@ def main(): # fix in src/keygen.c — see signers/slhvk-sha2-128-24/STATUS.md). One call # suffices; no retry needed. if args.hedged: - cmd = [BIN_PATH, "--hedged", seed48.hex(), msg_hex] + cmd = [BIN_PATH, "--hedged", seed48.hex(), msg_hex_signed] else: - cmd = [BIN_PATH, seed48.hex(), msg_hex, optrand.hex()] + cmd = [BIN_PATH, seed48.hex(), msg_hex_signed, optrand.hex()] result = subprocess.run(cmd, capture_output=True, text=True) if args.hedged: # Forward the C binary's "mode: hedged (opt_rand=…)" line so the diff --git a/script/slh_dsa_sha2_128_24_signer.py b/script/slh_dsa_sha2_128_24_signer.py index 400c6ee..4d75edf 100644 --- a/script/slh_dsa_sha2_128_24_signer.py +++ b/script/slh_dsa_sha2_128_24_signer.py @@ -497,10 +497,14 @@ def main(): msg_hex = args.message_hex.replace("0x", "") if len(msg_hex) % 2: msg_hex = "0" + msg_hex - # Pad to 32 bytes (we sign a bytes32 message — matches our Solidity verifier) - msg_bytes = bytes.fromhex(msg_hex).rjust(32, b"\x00") if msg_hex \ - else b"\x00" * 32 - msg_bytes = msg_bytes[-32:] + msg_raw = bytes.fromhex(msg_hex) if msg_hex else b"" + # FIPS 205 EXTERNAL SLH-DSA.Sign with empty context: sign + # M' = toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx ‖ M = 0x00 ‖ 0x00 ‖ M. + # We sign the RAW message bytes (no rjust/truncate to 32 — that was the + # SLH-S-f1 divergence from the C reference); the on-chain bytes32 verifier + # is the 32-byte-M case of this and prepends the same envelope. (review + # SLH-S-f1 / SLH-X-f1) + msg_bytes = b"\x00\x00" + msg_raw h_param = args.height a_param = args.a diff --git a/signer-wasm/src/fors.rs b/signer-wasm/src/fors.rs index 65a6ccb..5714ff9 100644 --- a/signer-wasm/src/fors.rs +++ b/signer-wasm/src/fors.rs @@ -4,23 +4,38 @@ use crate::hash::{self, U256}; use crate::merkle; use crate::params::*; -/// Derive FORS secret for (tree_idx, leaf_idx). -pub fn fors_secret(sk_seed: U256, tree_idx: u32, leaf_idx: u32) -> U256 { - let mut data = Vec::with_capacity(32 + 4 + 4 + 4); +/// Derive FORS secret for (tree_idx, leaf_idx) under hypertree leaf `ht_idx`. +/// +/// `ht_idx` binds the secret to the per-message hypertree leaf, so each leaf +/// uses an independent FORS instance (standard SLH-DSA few-time behaviour). It +/// is folded into the PRF preimage here and into the ADRS by `build_fors_tree`. +pub fn fors_secret(sk_seed: U256, tree_idx: u32, leaf_idx: u32, ht_idx: u32) -> U256 { + let mut data = Vec::with_capacity(32 + 4 + 4 + 4 + 4); data.extend_from_slice(&hash::to_bytes32(sk_seed)); data.extend_from_slice(b"fors"); + data.extend_from_slice(&ht_idx.to_be_bytes()); data.extend_from_slice(&tree_idx.to_be_bytes()); data.extend_from_slice(&leaf_idx.to_be_bytes()); hash::mask_n(hash::keccak256(&data)) } -/// Build a single FORS tree. Returns (tree_nodes, root). -fn build_fors_tree(seed: U256, sk_seed: U256, tree_idx: u32) -> (Vec>, U256) { +/// Build a single FORS tree bound to hypertree leaf `ht_idx`. Returns +/// (tree_nodes, root). +/// +/// Exact FIPS 205 FORS field split: bind to the bottom hypertree subtree +/// (idx_tree0 → tree address) and leaf (idx_leaf0 → kp); the FORS tree number +/// is folded into tree_index as (tree_idx << (A-height)) | node, with +/// tree_height in word2 (FIPS 205 Alg. 17). Matches the C13 verifier and +/// C12 / SLH-DSA field semantics. +fn build_fors_tree(seed: U256, sk_seed: U256, tree_idx: u32, ht_idx: u32) -> (Vec>, U256) { + let idx_leaf0 = ht_idx & ((1u32 << SUBTREE_H) - 1); + let idx_tree0 = (ht_idx >> SUBTREE_H) as u64; let n_leaves = 1usize << A; let mut leaves = Vec::with_capacity(n_leaves); for j in 0..n_leaves { - let secret = fors_secret(sk_seed, tree_idx, j as u32); - let leaf_adrs = hash::make_adrs(0, 0, 3, tree_idx, 0, 0, j as u32); // type=FORS_TREE + let secret = fors_secret(sk_seed, tree_idx, j as u32, ht_idx); + // leaf (height 0): tree_index = (tree_idx << A) | j + let leaf_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, (tree_idx << A) | j as u32); leaves.push(hash::th(seed, leaf_adrs, secret)); } @@ -31,7 +46,9 @@ fn build_fors_tree(seed: U256, sk_seed: U256, tree_idx: u32) -> (Vec>, let mut level = Vec::with_capacity(prev.len() / 2); for idx in (0..prev.len()).step_by(2) { let parent_idx = idx / 2; - let adrs = hash::make_adrs(0, 0, 3, tree_idx, 0, (h + 1) as u32, parent_idx as u32); + // height h+1: tree_index = (tree_idx << (A-1-h)) | parent_idx + let ti = (tree_idx << (A - 1 - h)) | parent_idx as u32; + let adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, (h + 1) as u32, ti); level.push(hash::th_pair(seed, adrs, prev[idx], prev[idx + 1])); } nodes.push(level); @@ -40,14 +57,29 @@ fn build_fors_tree(seed: U256, sk_seed: U256, tree_idx: u32) -> (Vec>, (nodes, root) } -/// Grind R until last FORS index is zero. -pub fn grind_r(seed: U256, root: U256, message: U256) -> Result<(U256, U256), String> { +/// Grind R until the last FORS index is zero (FORS+C forced-zero). +/// +/// SECRET-KEYED randomizer (review C13-X-f2). `R` is bound to the secret +/// `sk_seed` and the message: +/// `R = mask_n(keccak256(sk_seed ‖ "R_grind" ‖ message ‖ nonce))`, +/// grinding `nonce` until the forced-zero predicate holds. Binding `R` to +/// `sk_seed` removes the previous public-grindability: an attacker can no +/// longer offline-search `(message, R)` to steer the FORS index map / hypertree +/// leaf onto previously-revealed instances, restoring the standard +/// secret-randomizer few-time model. It stays fully deterministic per +/// `(key, message)`. The preimage layout MUST match `script/signer.py`'s +/// `grind_R_fors` byte-for-byte (sk_seed[32] ‖ "R_grind" ‖ message[32] ‖ +/// nonce[32]) or the Rust↔Python cross-check (and on-chain digest) diverge. +/// The verifier is unaffected — it only reads `R` from the signature. +pub fn grind_r(seed: U256, sk_seed: U256, root: U256, message: U256) -> Result<(U256, U256), String> { let a_mask = (1u64 << A) - 1; let last_shift = (K - 1) * A; // C13: bit 114 = (7-1)*19 for nonce in 0..10_000_000u32 { - let mut r_input = Vec::with_capacity(7 + 32); + let mut r_input = Vec::with_capacity(32 + 7 + 32 + 32); + r_input.extend_from_slice(&hash::to_bytes32(sk_seed)); r_input.extend_from_slice(b"R_grind"); + r_input.extend_from_slice(&hash::to_bytes32(message)); r_input.extend_from_slice(&hash::to_bytes32(hash::u256_from_u32(nonce))); let r = hash::mask_n(hash::keccak256(&r_input)); let digest = hash::h_msg(seed, root, r, message); @@ -78,27 +110,35 @@ pub fn sign_fors(seed: U256, sk_seed: U256, digest: U256) return Err("FORS+C forced-zero violated".into()); } + // Exact FIPS 205 FORS field split: key the FORS instance by the per-message + // hypertree leaf. htIdx = (digest >> K*A) & (2^H - 1) — the same value + // sphincs::sign and the verifier derive — split into the bottom subtree + // (idx_tree0 → tree address) and leaf (idx_leaf0 → kp). + let ht_idx = (hash::u256_shr(&digest, K * A) & ((1u64 << H) - 1)) as u32; + let idx_leaf0 = ht_idx & ((1u32 << SUBTREE_H) - 1); + let idx_tree0 = (ht_idx >> SUBTREE_H) as u64; + let mut secrets = Vec::with_capacity(K); let mut auth_paths = Vec::with_capacity(K - 1); let mut roots = Vec::with_capacity(K); // k-1 normal trees for t in 0..(K - 1) { - let (tree_nodes, root) = build_fors_tree(seed, sk_seed, t as u32); - secrets.push(fors_secret(sk_seed, t as u32, indices[t] as u32)); + let (tree_nodes, root) = build_fors_tree(seed, sk_seed, t as u32, ht_idx); + secrets.push(fors_secret(sk_seed, t as u32, indices[t] as u32, ht_idx)); auth_paths.push(merkle::get_auth_path(&tree_nodes, indices[t], A)); roots.push(root); } - // Last tree: forced-zero, reveal root - let (_, root_last) = build_fors_tree(seed, sk_seed, (K - 1) as u32); - // "Secret" for last tree is the root itself, hashed - let last_adrs = hash::make_adrs(0, 0, 3, (K - 1) as u32, 0, 0, 0); + // Last tree: forced-zero, reveal root. Hashed as leaf node 0 of tree K-1: + // tree_index = (K-1) << A, kp=idx_leaf0, tree=idx_tree0. + let (_, root_last) = build_fors_tree(seed, sk_seed, (K - 1) as u32, ht_idx); + let last_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, ((K - 1) as u32) << A); secrets.push(root_last); roots.push(hash::th(seed, last_adrs, root_last)); - // Compress K roots - let roots_adrs = hash::make_adrs(0, 0, 4, 0, 0, 0, 0); // type=FORS_ROOTS + // Compress K roots: FORS_ROOTS ADRS bound to the hypertree leaf (tree=idx_tree0, kp=idx_leaf0) + let roots_adrs = hash::make_adrs(0, idx_tree0, 4, idx_leaf0, 0, 0, 0); // type=FORS_ROOTS let fors_pk = hash::th_multi(seed, roots_adrs, &roots); Ok((secrets, auth_paths, fors_pk)) diff --git a/signer-wasm/src/sphincs.rs b/signer-wasm/src/sphincs.rs index ff845b2..bee8d2e 100644 --- a/signer-wasm/src/sphincs.rs +++ b/signer-wasm/src/sphincs.rs @@ -9,8 +9,8 @@ use crate::merkle; /// Sign a message with SPHINCS+ C13. /// Returns the raw signature bytes (SIG_SIZE = 3688 bytes). pub fn sign(seed: U256, sk_seed: U256, pk_root: U256, message: U256) -> Result, String> { - // Step 1: Grind R for FORS+C forced-zero - let (r, digest) = fors::grind_r(seed, pk_root, message)?; + // Step 1: Grind R for FORS+C forced-zero (R is secret-keyed on sk_seed; review C13-X-f2) + let (r, digest) = fors::grind_r(seed, sk_seed, pk_root, message)?; // Step 2: Extract hypertree index let ht_shift = K * A; // 128 diff --git a/signer-wasm/tests/cross_validate.rs b/signer-wasm/tests/cross_validate.rs index f2252e2..4068bfe 100644 --- a/signer-wasm/tests/cross_validate.rs +++ b/signer-wasm/tests/cross_validate.rs @@ -23,7 +23,11 @@ fn u256_hex(val: &hash::U256) -> String { const PY_PK_SEED: &str = "0x012dd57311a3728fd6988fb2a583bb9e00000000000000000000000000000000"; const PY_SK_SEED: &str = "0x11d47d1635d4ad4852852dae8fd9dbbd699558d7907907cdae4203bdbae7f7aa"; const PY_WOTS_SK_1_0_0_0: &str = "0x60fd5cf59c3c018fca334b8538cc52fe00000000000000000000000000000000"; -const PY_FORS_SECRET_0_0: &str = "0x644806f57db3ea90131947530251a86200000000000000000000000000000000"; +// fors_secret(sk_seed, tree=0, leaf=0, ht_idx=0): keccak256(sk_seed || "fors" || +// ht_idx(4) || tree_idx(4) || leaf_idx(4)) masked to top 128 bits. Regenerated +// for the ht_idx-folding preimage (the Finding-C fix); cross-checked against +// script/signer.py's fors_secret. (review C13-S-f2) +const PY_FORS_SECRET_0_0: &str = "0xf3c46060303099c9faed1691ad98823900000000000000000000000000000000"; fn derive_test_keys() -> (hash::U256, hash::U256) { let test_entropy = [0x42u8; 32]; @@ -48,9 +52,14 @@ fn test_wots_secret_matches_python() { #[test] fn test_fors_secret_matches_python() { + // fors_secret now folds the per-message hypertree leaf `ht_idx` into the PRF + // preimage (the Finding-C fix). The pinned value below is for ht_idx = 0 and + // MUST be regenerated from script/signer.py's fors_secret with the same + // preimage (sk_seed || "fors" || ht_idx(4) || tree_idx(4) || leaf_idx(4)) if + // any of those change. (review C13-S-f1 / C13-S-f2) let (_, sk_seed) = derive_test_keys(); - let fs = fors::fors_secret(sk_seed, 0, 0); - assert_eq!(u256_hex(&fs), PY_FORS_SECRET_0_0, "fors_secret(0,0) mismatch"); + let fs = fors::fors_secret(sk_seed, 0, 0, 0); + assert_eq!(u256_hex(&fs), PY_FORS_SECRET_0_0, "fors_secret(0,0,ht=0) mismatch"); } #[test] diff --git a/signer-wasm/tests/fors_leaf_keying.rs b/signer-wasm/tests/fors_leaf_keying.rs new file mode 100644 index 0000000..989cda0 --- /dev/null +++ b/signer-wasm/tests/fors_leaf_keying.rs @@ -0,0 +1,234 @@ +//! Regression test: FORS instances are keyed per hypertree leaf. +//! +//! The FORS+C family keys each FORS instance by the per-message hypertree leaf +//! via the FIPS 205 field split — tree = idxTree0 (htIdx >> SUBTREE_H), +//! kp = idxLeaf0 (htIdx & (2^SUBTREE_H-1)), the FORS tree number folded into +//! tree_index, and the leaf-secret PRF folded with the same leaf index. This +//! test pins that behaviour so a future change can't silently regress it: +//! +//! * `fors_pk` and the revealed leaf secrets are a function of the hypertree +//! leaf — two messages on different leaves produce different FORS public +//! keys and different secrets at the same (tree, index). +//! * An opening (secret + auth path) produced under one leaf reconstructs +//! that leaf's `fors_pk`, but not a different leaf's — i.e. the 2^h +//! hypertree leaves use independent FORS instances. +//! +//! If FORS were keyed by tree number alone (layer = tree = 0, as in the +//! pre-migration addressing) `fors_pk` would be identical across leaves and +//! these assertions would fail. +//! +//! Run: +//! cargo test --release --test fors_leaf_keying -- --nocapture # fast +//! cargo test --release --test fors_leaf_keying -- --ignored --nocapture # + full-param C13 + +use sphincs_c13_signer::fors; +use sphincs_c13_signer::hash::{self, U256}; +use sphincs_c13_signer::params::{A, H, K}; + +/// Set a `width`-bit field at bit offset `off` in a U256, using the bit +/// indexing `hash::u256_shr` reads back — lets us hand-craft a digest with +/// chosen FORS indices and hypertree index. +fn set_field(d: &mut U256, off: usize, width: usize, val: u64) { + for b in 0..width { + if (val >> b) & 1 == 1 { + let bit = off + b; + d[3 - bit / 64] |= 1u64 << (bit % 64); + } + } +} + +/// Craft a digest with the given per-tree FORS indices and hypertree index, +/// matching the layout sphincs::sign / the verifier parse out of H_msg. +fn craft_digest(fors_idx: &[u64; K], ht_idx: u64) -> U256 { + let mut d: U256 = [0; 4]; + for i in 0..K { + set_field(&mut d, i * A, A, fors_idx[i]); + } + set_field(&mut d, K * A, H, ht_idx); + d +} + +fn ht_idx_of(d: &U256) -> u64 { + hash::u256_shr(d, K * A) & ((1u64 << H) - 1) +} + +// ── Part 1: real, full-parameter C13 code ─────────────────────────────────── + +#[test] +#[ignore = "slow: builds 7 full 2^19-leaf FORS trees twice (~seconds in --release)"] +fn fors_pk_is_per_hypertree_leaf_full_c13() { + let seed = hash::mask_n(hash::keccak256(b"regression pk seed")); + let sk_seed = hash::keccak256(b"regression sk seed"); + + // Two messages on different hypertree leaves that share the FORS index in + // tree 0 (= 3) and tree 3 (= 42). Last FORS index is forced to 0. + let d1 = craft_digest(&[3, 100, 9001, 42, 77, 250000, 0], 0x0AAAAA); + let d2 = craft_digest(&[3, 12345, 8, 42, 500000, 1, 0], 0x155555); + assert_ne!(ht_idx_of(&d1), ht_idx_of(&d2), "test setup: leaves must differ"); + + let (secrets1, _ap1, fors_pk1) = fors::sign_fors(seed, sk_seed, d1).unwrap(); + let (secrets2, _ap2, fors_pk2) = fors::sign_fors(seed, sk_seed, d2).unwrap(); + + // fors_pk is a function of the hypertree leaf. + assert_ne!(fors_pk1, fors_pk2, "fors_pk must differ across hypertree leaves"); + // The secret at the same (tree, index) is leaf-specific. + assert_ne!(secrets1[0], secrets2[0], "tree-0 secret at shared index must be leaf-specific"); + assert_ne!(secrets1[3], secrets2[3], "tree-3 secret at shared index must be leaf-specific"); + + println!("Part 1 (full C13): fors_pk and leaf secrets are per-hypertree-leaf."); +} + +// ── Part 2: reduced height, mirrors the library's FIPS-split addressing ────── + +const A_DEMO: usize = 10; +const SH_DEMO: u32 = 8; // demo SUBTREE_H for the htIdx → (idxTree0, idxLeaf0) split + +/// FIPS 205 FORS field split of a hypertree leaf (mirrors the library). +fn split_leaf(ht_idx: u32) -> (u32, u64) { + (ht_idx & ((1u32 << SH_DEMO) - 1), (ht_idx >> SH_DEMO) as u64) +} + +/// Build one FORS tree at reduced height, mirroring fors::build_fors_tree +/// (tree=idxTree0, kp=idxLeaf0, tree_index=(tree_idx<<(a-height))|node) plus the +/// leaf-keyed secret. +fn build_fors_tree(seed: U256, sk_seed: U256, tree_idx: u32, ht_idx: u32, a: usize) -> (Vec>, U256) { + let (idx_leaf0, idx_tree0) = split_leaf(ht_idx); + let n_leaves = 1usize << a; + let mut leaves = Vec::with_capacity(n_leaves); + for j in 0..n_leaves { + let secret = fors::fors_secret(sk_seed, tree_idx, j as u32, ht_idx); + let leaf_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, (tree_idx << a) | j as u32); + leaves.push(hash::th(seed, leaf_adrs, secret)); + } + let mut nodes = vec![leaves]; + for h in 0..a { + let prev = &nodes[h]; + let mut level = Vec::with_capacity(prev.len() / 2); + for idx in (0..prev.len()).step_by(2) { + let parent_idx = idx / 2; + let ti = (tree_idx << (a - 1 - h)) | parent_idx as u32; + let adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, (h + 1) as u32, ti); + level.push(hash::th_pair(seed, adrs, prev[idx], prev[idx + 1])); + } + nodes.push(level); + } + let root = nodes[a][0]; + (nodes, root) +} + +fn auth_path(nodes: &[Vec], leaf_idx: usize, a: usize) -> Vec { + let mut path = Vec::with_capacity(a); + let mut idx = leaf_idx; + for h in 0..a { + path.push(nodes[h][idx ^ 1]); + idx >>= 1; + } + path +} + +/// Recompute a FORS tree root from a (secret, auth_path) opening, the way the +/// verifier would for hypertree leaf `ht_idx`. Uses only the public pk seed and +/// the supplied opening — no secret-key derivation. +fn root_from_opening(seed: U256, ht_idx: u32, tree_idx: u32, idx: usize, secret: U256, path: &[U256], a: usize) -> U256 { + let (idx_leaf0, idx_tree0) = split_leaf(ht_idx); + let leaf_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, (tree_idx << a) | idx as u32); + let mut node = hash::th(seed, leaf_adrs, secret); + let mut m = idx; + for h in 0..a { + let parent = m >> 1; + let ti = (tree_idx << (a - 1 - h)) | parent as u32; + let adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, (h + 1) as u32, ti); + node = if m & 1 == 0 { + hash::th_pair(seed, adrs, node, path[h]) + } else { + hash::th_pair(seed, adrs, path[h], node) + }; + m = parent; + } + node +} + +/// Build the FORS forest for one hypertree leaf (k-1 normal trees + forced-zero +/// last tree), returning fors_pk and each tree's nodes. Mirrors sign_fors. +fn build_forest(seed: U256, sk_seed: U256, ht_idx: u32, a: usize) -> (U256, Vec>>) { + let (idx_leaf0, idx_tree0) = split_leaf(ht_idx); + let mut roots = Vec::with_capacity(K); + let mut trees = Vec::with_capacity(K); + for t in 0..K { + let (nodes, root) = build_fors_tree(seed, sk_seed, t as u32, ht_idx, a); + if t == K - 1 { + let last_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, ((K - 1) as u32) << a); + roots.push(hash::th(seed, last_adrs, root)); + } else { + roots.push(root); + } + trees.push(nodes); + } + let roots_adrs = hash::make_adrs(0, idx_tree0, 4, idx_leaf0, 0, 0, 0); + (hash::th_multi(seed, roots_adrs, &roots), trees) +} + +/// Recompute fors_pk for hypertree leaf `ht_idx` from a set of openings (one per +/// normal tree) plus the revealed last-tree root. +fn recompute_pk(seed: U256, ht_idx: u32, open: &[(usize, U256, Vec)], root_last: U256, a: usize) -> U256 { + let (idx_leaf0, idx_tree0) = split_leaf(ht_idx); + let mut roots = Vec::with_capacity(K); + for t in 0..(K - 1) { + let (idx, secret, ref path) = open[t]; + roots.push(root_from_opening(seed, ht_idx, t as u32, idx, secret, path, a)); + } + let last_adrs = hash::make_adrs(0, idx_tree0, 3, idx_leaf0, 0, 0, ((K - 1) as u32) << a); + roots.push(hash::th(seed, last_adrs, root_last)); + hash::th_multi(seed, hash::make_adrs(0, idx_tree0, 4, idx_leaf0, 0, 0, 0), &roots) +} + +#[test] +fn openings_are_leaf_specific() { + let a = A_DEMO; + let seed = hash::mask_n(hash::keccak256(b"regression pk seed")); + let sk_seed = hash::keccak256(b"regression sk seed"); + + let leaf_a: u32 = 0x1111; + let leaf_b: u32 = 0x2222; + assert_ne!(leaf_a, leaf_b); + + let (pk_a, trees_a) = build_forest(seed, sk_seed, leaf_a, a); + let (pk_b, trees_b) = build_forest(seed, sk_seed, leaf_b, a); + + // Distinct leaves ⇒ distinct FORS public keys. + assert_ne!(pk_a, pk_b, "distinct hypertree leaves must yield distinct fors_pk"); + // The leaf secret at the same (tree, index) is leaf-specific. + assert_ne!( + fors::fors_secret(sk_seed, 0, 5, leaf_a), + fors::fors_secret(sk_seed, 0, 5, leaf_b), + "leaf secrets must be hypertree-leaf-specific" + ); + + // Indices for a message on leaf B (last tree forced 0). + let idx_b: [usize; K] = [7, 19, 3, 100, 250, 88, 0]; + let root_last_b = build_fors_tree(seed, sk_seed, (K - 1) as u32, leaf_b, a).1; + + // Openings drawn from leaf A at those indices do NOT reconstruct leaf B's + // fors_pk — the instances are independent across leaves. + let openings_from_a: Vec<(usize, U256, Vec)> = (0..(K - 1)) + .map(|t| { + let idx = idx_b[t]; + (idx, fors::fors_secret(sk_seed, t as u32, idx as u32, leaf_a), auth_path(&trees_a[t], idx, a)) + }) + .collect(); + let pk_from_a_openings = recompute_pk(seed, leaf_b, &openings_from_a, root_last_b, a); + assert_ne!(pk_from_a_openings, pk_b, "leaf-A openings must not reconstruct leaf-B fors_pk"); + + // Positive control: leaf B's own openings DO reconstruct pk_b — confirming + // the recompute path is faithful (so the assertion above is meaningful). + let openings_from_b: Vec<(usize, U256, Vec)> = (0..(K - 1)) + .map(|t| { + let idx = idx_b[t]; + (idx, fors::fors_secret(sk_seed, t as u32, idx as u32, leaf_b), auth_path(&trees_b[t], idx, a)) + }) + .collect(); + assert_eq!(recompute_pk(seed, leaf_b, &openings_from_b, root_last_b, a), pk_b, + "leaf-B openings must reconstruct pk_b (recompute path is faithful)"); + + println!("Part 2: FORS openings are leaf-specific; instances are independent across hypertree leaves."); +} diff --git a/signer-wasm/tests/wots_reuse_poc.rs b/signer-wasm/tests/wots_reuse_poc.rs new file mode 100644 index 0000000..248c46a --- /dev/null +++ b/signer-wasm/tests/wots_reuse_poc.rs @@ -0,0 +1,93 @@ +//! Regression guard for WOTS+C target-sum reuse (review C13-X-f3). +//! +//! At the 2^22 signature cap, hypertree-leaf (`ht_idx`) collisions are EXPECTED +//! (~2^21 colliding pairs by the birthday bound), so one layer-0 WOTS keypair +//! signs two distinct `fors_pk` values — a WOTS one-time-use violation that the +//! FORS few-time layer absorbs. This test models that reuse at the WOTS-keypair +//! level and checks the two properties the security argument relies on (see +//! docs/SECURITY-ANALYSIS.md §4): +//! +//! 1. SINGLE-USE forward soundness (deterministic): from one signature you +//! cannot open a DIFFERENT target — any same-sum digit vector that +//! dominates the signed one must equal it. +//! 2. TWO-REUSE gating (empirical, fixed seed): from the chains revealed by +//! two reused signatures (known from the per-chain minimum height +//! min(d1,d2) upward), a third, independently-derived target `fors_pk` +//! cannot be WOTS-opened by count grinding alone — some chain always needs +//! a height BELOW what was revealed. A WOTS-level forgery would require the +//! attacker to CHOOSE the target `fors_pk`, i.e. forge the FORS layer (the +//! gate). This guard does not replace the analytic bound; it catches a +//! regression that made layer-0 reuse trivially forgeable. + +use sphincs_c13_signer::hash::{self, U256}; +use sphincs_c13_signer::wots; +use sphincs_c13_signer::params::{L, TARGET_SUM, W}; + +fn mk(label: &[u8]) -> U256 { hash::mask_n(hash::keccak256(label)) } + +#[test] +fn wots_plus_c_single_use_is_forward_sound() { + let seed = mk(b"wots reuse poc seed"); + let sk_seed = hash::keccak256(b"wots reuse poc sk_seed"); + let (layer, tree, kp) = (0u32, 0u64, 0u32); + let (sks, _pk) = wots::keygen(seed, sk_seed, layer, tree, kp); + + let m1 = mk(b"target message 1 fors_pk"); + let (sigma1, count1) = wots::sign(seed, &sks, layer, tree, kp, m1).unwrap(); + let d1 = wots::extract_digits(&wots::wots_digest(seed, layer, tree, kp, m1, count1)); + assert_eq!(d1.iter().map(|&x| x as usize).sum::(), TARGET_SUM); + assert_eq!(sigma1.len(), L); + + // A different target's sum-208 digit vector must NOT dominate d1: for d' ≠ d1 + // with Σd' = Σd1, d' ≥ d1 elementwise is impossible (Σ(d'-d1)=0 with all + // terms ≥ 0 ⟹ d'=d1). So a single signature opens only its own value. + let m2 = mk(b"different target fors_pk"); + let (_c2, _d, d2) = wots::find_count(seed, layer, tree, kp, m2).unwrap(); + assert_ne!(d1, d2, "distinct targets should give distinct digit vectors"); + let dominates = (0..L).all(|j| d2[j] >= d1[j]); + assert!(!dominates, "single-use violated: a different target dominates the signed digits"); +} + +#[test] +fn wots_plus_c_two_reuse_does_not_open_third_target() { + let seed = mk(b"wots reuse poc seed 2"); + let (layer, tree, kp) = (0u32, 0u64, 0u32); + + // Two distinct fors_pk signed by the SAME layer-0 WOTS keypair (an ht_idx + // collision). We only need the digit vectors here, so grind counts directly. + let m1 = mk(b"collision target A"); + let m2 = mk(b"collision target B"); + let (_c1, _, d1) = wots::find_count(seed, layer, tree, kp, m1).unwrap(); + let (_c2, _, d2) = wots::find_count(seed, layer, tree, kp, m2).unwrap(); + assert_ne!(d1, d2); + + // Chain j is known from height min(d1[j], d2[j]) upward. + let m_min: [u8; L] = std::array::from_fn(|j| d1[j].min(d2[j])); + let slack: usize = TARGET_SUM - m_min.iter().map(|&x| x as usize).sum::(); + // slack = (1/2) Σ|d1-d2| + let l1: usize = (0..L).map(|j| (d1[j] as i32 - d2[j] as i32).unsigned_abs() as usize).sum(); + assert_eq!(slack, l1 / 2); + + // Positive control: the two genuinely-signed targets ARE reconstructable + // (their digits dominate the revealed minima — trivially). + assert!((0..L).all(|j| d1[j] >= m_min[j])); + assert!((0..L).all(|j| d2[j] >= m_min[j])); + + // A THIRD independently-derived target fors_pk: grind count over a large + // budget; no candidate covers ALL chains (some chain needs a height below the + // revealed minimum), so no WOTS+C opening assembles from the harvested chains. + let m3 = mk(b"third independent target fors_pk"); + let mut best_covered = 0usize; + let mut openable = false; + for count in 0..300_000u32 { + let d3 = wots::extract_digits(&wots::wots_digest(seed, layer, tree, kp, m3, count)); + if d3.iter().map(|&x| x as usize).sum::() != TARGET_SUM { continue; } + let covered = (0..L).filter(|&j| d3[j] >= m_min[j]).count(); + if covered > best_covered { best_covered = covered; } + if covered == L { openable = true; break; } + } + assert!(!openable, + "WOTS+C reuse opened a third independent target by count-grind alone \ + (best_covered={best_covered}/{L}); layer-0 reuse must remain FORS-gated"); + assert_eq!(W, 8); +} diff --git a/signers/slhvk-sha2-128-24/kat-counter0.json b/signers/slhvk-sha2-128-24/kat-counter0.json new file mode 100644 index 0000000..1c5b21e --- /dev/null +++ b/signers/slhvk-sha2-128-24/kat-counter0.json @@ -0,0 +1,43 @@ +{ + "scheme": "SLH-DSA-SHA2-128-24", + "spec": "FIPS 205 external SLH-DSA (empty context); M' = 0x00||0x00||M before H_msg", + "params": "n=16 h=22 d=1 a=24 k=6 w=4 m=21, sig=3856 B", + "hash": "SHA-256 (precompile 0x02 on-chain)", + "digest_parsing": "big-endian / MSB-first (FIPS 205 / PQClean)", + "signer": "Vulkan GPU signer (signers/slhvk-sha2-128-24), bit-exact vs sphincsplus-128-24 CPU ref", + "mode": "deterministic (counter)", + "generated": "2026-06-04", + "reproduce": "python3 script/slh_dsa_sha2_128_24_gpu_signer.py 0x1111111111111111111111111111111111111111111111111111111111111111 0xc1fd5ba4e304827439265a094a8b82f005662dce23be909f9e179cbce73b5f5d 0", + "inputs": { + "master_sk": "0x1111111111111111111111111111111111111111111111111111111111111111", + "master_sk_note": "throwaway test seed (0x11*32); JARDIN HMAC-SHA-512 derivation -> seed48 below", + "seed48_sk_seed": "0xe7678ccc25f61528cd0d30d2f84b2a22", + "seed48_sk_prf": "0xde8305a2fcb697d73434a939c879bebf", + "seed48_pk_seed": "0x750e7b30f37700dd14b20a5c647bb936", + "message_M": "0xc1fd5ba4e304827439265a094a8b82f005662dce23be909f9e179cbce73b5f5d", + "message_M_label": "keccak256(\"vulkan deterministic counter demo\")", + "message_envelope": "0x0000c1fd5ba4e304827439265a094a8b82f005662dce23be909f9e179cbce73b5f5d", + "sig_counter": 0, + "opt_rand": "0x00000000000000000000000000000000" + }, + "public_key": { + "pkSeed": "0x750e7b30f37700dd14b20a5c647bb93600000000000000000000000000000000", + "pkRoot": "0x3456300211d2a77c26a60804b918738f00000000000000000000000000000000" + }, + "signature": "0xf41d967d8b5f03ec1793ccaef2dd286663645a804b4da635960fba8bac94d4ca9db1f390e106e4ffefc3069c855ede1742ead2841abe225069fc529c0350eb716de0fd34891ac27ce6f352f45474980be69aa24ffe9d2b4c1aadd5ec7fd8e2ec3be6468754575da222963bc16a20f4a8315ee5a8f10e2d2d3f1bfbe51f114070317540b85b4356c1f7bf331f7603dd3ea94079938cf64ec5302e2fe7d15111708b7c18ac0a8f17c1f789db4248c076c598f7211c7cf073513dba99c13d1f2c8b54b9f17b2e6114e2c850801ccc7136484b1ac4e6cac87f5114dae6faabc19c407ee2b9fdd041cae33c0e3264a992cc0cd8cd8d399217c2315ea430951b1514b6f49c04b97718295070bd1470564423b482a0ec9cbc6b24426acb909ac2b716df69af880ae8b48a4d47973a3886d4264a3af990215eb6f562279f2149be81e0c384db5fa27189c3398f3f98e9ffc1a7a32d245da8695f62b3fa0a70e5e078b2e47e3255540e88fbd9adbcd1a6e6aa52123a12e6ef10ff2ddf778e2a131e9e53f8ee24ae42a96f2a199e8709668f98c0bcc8cbbfd6d293bbcfad41923201bfb0730031c70ceb0be8f7fbd20a1107733ee871e9d4492e01e65df31c42fd9d91175cbe41c68588776f88deae691021d69ad1858c279e866a177f2a51a994fa22ae7a5fccefcd3eb4c7baac83395a6b3961671632f153f20a2f62d5b1d1b015940c6056c48bfbc9eb0f5db49482e1ab464a9c388ec196ace3f8e18250351fa39c969240d0bf5ad26da8cd806623c9148b33c21eb63f753a7c449a4203dea0647f85fa234ac4c15560671b480e521bf185ba9e3604973480dd3ec678f1add816e1e4ea20fc31a48e7a7b84187b8e1a8e4300dce21f64ad1b5fc517c0104b57d39f235eb3e3b95bb07ac8abd20ce4ccc2ccbd89c3083d6806f34d392d533ae42d79ea240bdfb42be80aedd547d8888e7db421d4c174201fba309e0cc7429ea3dbb33da8f039c0318eda4ff38c66b9896ea6dae428db107d1d9a6ce79223312102dbed6a97e843962afc38b6837717d333ab1e4625e9bd612c5e45cf07313db98d36966b4d81e9b2b2286ed30a4b032d3d651c2fb0755d1a536f123e3dc7d1b8b15aaac3f770d34490e934a7e3d63555658fe326e3ddfaa16b3cfe75ec3f330da7800cc7831fdfb383d0c0c849b362e2f3c2c8ccc2bfc92bbb200fd7605191e1bfc1d0e73bcddc4faa8fcbe021e999f1f55cd744a9790bb109a1c89a7fd7da76b4824f49e6e5d605ac8d32b4bd05bdf94fcabb35a8b839bf719783baebb5166249b2cea4bb0ebb271e1c9023110d6d48a6e132ddeb1732d6821bf75adb0acd5451a81235774884df2bd1d10b75e9e8ff9cec8b7a2c6b3ae84ef14996ca0db5e7d0fb59021dc04637a8fbc2404471a2829a379fe19c92643863cbf202a00959df720a9f8ad9796a088ffbab0f9cce40de685afb00b17747e330508ba4fd0a4d72241adb2372dd91bd92c09651a2268deaa2497cace76afa6af59df221fdd06cf07ac82dac67919b52ad1b2b7e2781574e2fe61292c522292ce44207daae4b0b130ef8e00e5fabf87f30e20d5232118b482deb6c8fbfc11ffd18d0acd55e564118f47a3954191a49d5bba0d80668b760fcac828d04c61b08442a8f355298ede8097c97151185ce4e4d6b6a46bc2a688443259d539e07c38568d7756cfe647d7010ebcffc5df94e6b08e05c3ba00154f610c2a838f6d632c44576a936ea9f28443706842b8deaf47d9b33a9a3b8f0eaf1c33083424f74d2fd0e7bfc32543afdeeafbdbcfa01c07b701767f4de5e9aedd2717e08e82efbbb0b77e8e8cce53fbde3e04cc18cbe12f1c64d4ff55b2a3e9ea2b380b4267481025414328a8334e978e12b34cdf45e111de36466169805511002d2636c84a60b444f855000a670ba08dfb0653d9951fd2b3117c96cb4b6ff3769b8b424ccf7f8c5d5414e5a901a748879b8549124f1edf44be5c1386858703106ed080ae457621a68c6855cafc1a2b48c394e231e625f0daf013071198ce6bb7429706402b2f1b8a7353f3605bd3a75d2fc6460e7c477ec6f7162180d2d4be128b116a366c7e72e0e89ce006225d367335c90089bb3c67d0bbdb6cb8672f0e5e906c675c885378b36a423dec413c02f98f204fc9cea89c8f8d64a6db6610007cb022116cd199370ad048495241816557aae512aa33245b12b978926162988fda0251b5977c9a049066c0b3aef3eece4a3867d22a322fb407bb3e6e7c9fc02625758d64e4c60abd2bf8e86db4926b0f7521320711327279c545cbac6a514270dc2145d5358780804d9e3c6b9644db85e82be922a089cad9e452e381fe04a7157d29cc509201652c60788901ec1b275269281ac41c2b932958e2f114afca3b27e1f90974c217b017c17819b59ab50a9c67c0495a48a1c22ac1008ef1d2c7ee222f25449a7ee75a231a7a1af8acbc29f17066b9c50c9639052cf4f040b6ea34e392d5ba2b9d071d1218d4310e6d453d919d9b206983be03131c72fccf2e730242b0b95f38478cbd08128414ccd88c4f74e462b277b1e15201c0aec7ec516054685a763c3773635ccc67fc3a8356ba0b0b01e7272db981a247bd4fdec896cfd9c224a756fd227725bda6bf0eaeb31554d614a01e18697710b8fddf4732f0cb22d6d170bc75c616ae270c8e5a7a5a233f28fb5c85a38aef5b35abd04e0beed14d58db093581bcba5b25b2655fde68f017778e714ca74ac88ca1ca7f8d7694751f114b51d4e725d85b829e2bdca0ebbc166062104d19eee0ee00119b56d3b2ceb216419a44ddbd8937d6ad571f15538e003e17a2fc0cd8362e15fae0a4166f3709ff1168b3d613fa9e547123371d6c33252fe37cd1eb82b11130402d4e102da4d132f84c321f3ab7fcec45360e78f35a077fe346c22bed13d629afd331f8e3b3798ef1d121a856ecc9049d8cc5c56d04ddb35995936668747409c97f2f5cd0e6cf0f843ae2e0ab86a115b214fce27e5b94ae75867ed14deec5e95a3f2c178b156de04dda61368b18baae543895ba19c455f60244c427dec7a66941d157d82e89f8319fb4b08b80214bc384b512c4331b558f6768b49ea6db84c5ca9239076bd41b243a370c0dfcb027df1fbc545a43fc765aed80602099fa3492abe7ca928dd6e6944f2ad21520f9008acba741f8b13ddd00f899c2b1f40c7b3a6cacd3a07c5c8cb055277fa81a0ec5b7fb93de16ef0ca4ab72151ea53a9a23c36f07cf00233a330395d221a6238d90fc36bbada383eb2d12c429162db48ca17f11391071904a633a77a7b1f0077cda183fb43c39585e0484f6cde076e0fec5da3b8c82db290d45bd7ba9a95f250c88d28c6171a5c9ee2a2f6da6777454557893085c0aa52c2bb5b3d73d7c3f881171c0ed204ce703a822e656edc97eb80206cb5d4b19cc97fc045762c1bbc43ab2d786b85e3f93b33f3c684784dc7058f327f718ca498ccdf2e30db9b597ff9fbd4508e3160f34d0ce5d58842ed78941b212353c3b1c4b26bd1a05e8c7fc6b605d698dc8443195c0bb605340a021b91b081afa21123204c032afe974afad4a4243181f5402d56c97f4cd3a567f4507d2a0154d795a266e45d1d6a1d2dfd93d738d8527b9cefa1c5c5d8f29c1532abad1cf643bac29b47d63a3ac6e892a2df4ff914f9eec746a8faa2e907cdbbfe78c9e5f3d7fafda2b56e925071adee6727cc27a9269fb957cb9edd1c425447b82957429c0ee1c0e81cf6ffa98146d39836509b66b8001eb2cd12c9eca203262893669efd80dab207aeacd4473928fc09c4c908e0c0d7d4da6ee0591013f0e252a5d6b25114729843a46e2c1e02e6d250413e5ea8fe612919cf3c5aa9bbaf22798fee881ec5ddedaf0ca50d9317a781361179f47fa0097dc53e85928090cc4d9fd922db29b1fdac2add47bd12cbf6fd42b51473ea2a17706b765657f05c172f7c8e7854ce8c5d8acd70a818761ac094c04b440d5f17ae10dedee6b6b5b5b6eebaa5650366a7dcbe5bebc8b6f1f9f9149a43eeaa9a169bdcbf5392d57f891637382e8a8745911b91e5af6159a09c7f4b04af3329af6ff878c4cc62909a2c6fcd0b8fd4be1afa03cb9ccc1c04f137039b68c0deb3ddae6418ed114042f213df2f304d86a0fe509e25248b3facee28484cba9b2faeeba65e950a75deb446dab48ebcd015329bd76baec29d03101067399f286a8286025a1fc9d4788837e79bfc8b5afef5da5825562ef3abf3560cc0e581b7c4b438517cbd4db8ed057a7c72bc8da47a4ac6ae80fecad8c43303ccb1c412986c94677f13a404aae326a5b48651212915d3cc121517d48966248a4c2e5105bebd1844e379a3c75d8e5bdc84f045b9ffcf3c551165679d33664aa301f743e4beafc9c2db00e2d6d285272e70fc7f92fb1fd23aea19d97976b38abb8e1fa343a6397cd32a3f54c9af57f457f4f08d0a7e6ee13ad9b0ab1c47ec8818b75081cd0868a6bfd11258c6fa6511cb3daf5896d9b1aa6b42401a9f4f1244854f8aee592882c41af29899120cc207a311f72a85a0f6796b5160d9eda6361cfb0507468cc5f00c0f9f1f056eef8e624f5b176ad08fa6d6e8695cf29068e0e51a956ff06c77a858f9b1f919afb0d105b92fc8d41a7a9be11b03681c01fd24d504bcdc2b24b36e70c5fd51e884efe1892f1ad12cfa9ca041b0bb814e3c488a59341bd7fcd76d9829f8910f0be76702135911793ae8c964bdef5db528513e41d2c786fd33c899cb2f86494577eceabf1715aeb16bba797bbba73e136f1f5d29e9ef48c79f5f394058b9bd55e5a276230c542d15d2f41ba18bf5df4fde7be8d592fd5b0f70aac5670e35cbc3240e08af6054d714a3e90900224b7fddc99bcf05de03cda7ec9c99571225ccaa87aa678860cf0c31e0a9c659f6bf70e74a68d2d2154933413ffec5dc1c24378c9248faafbc76157e8d643f9e72de82d7d96ec351edd164ca33df64789495e896d356a73bbb0d9e05773d34f4425628f23565bbc2b8bc572bdd740f56544711be3b815d033d07da17b05ff896a3091569229902414a4b0c932a93625de4b1015fafbe9f74830b47b0c3c536d39f1bd43b01aa2ac9c5eec86a9748cb7aa6c6d5023a9c7cc5acc1cabcc3e4dd545e4cc4e7a4e8d1ee21afbeab84022975a8d60cbc4f17a1a084477bcbb37db57c6de707f44eba19eac1095346ca6f79e4c88f3f976c3faf5c6aef779275e9187fd1deda0b978af4d434b6c9f1f025966fa6fdeb376bde8c8b2268a671030f0f3addeaa67db950e60f6020573988ff2ea61d867bade39c620a8d02ed282750979f3622d9f394f774cc06bf123e9eeeaf39bc03f6205e08a06b41cbc9daac87f69356f46cbf8600453115c98d14f66bc26f221044c055f1b8a8ff0591bfae8a72cd7d4c66ef93d484694019cfef35f5f656d4cd80", + "signature_len": 3856, + "signature_sha256": "0x4120ddc01b07ed53ce966bcca6b7e2c7c95144df39c969b1d3b25ad59caa0d88", + "verify_expected": true, + "verified_onchain": { + "sepolia": { + "verifier": "0x12B712ad3ca6D81d4B3690B2f93420cd65EA0553", + "chain_id": 11155111, + "result": "true" + }, + "ethrex": { + "verifier": "0xa191d77902CaB41e95fec589DE3d72bA36c57b4f", + "chain_id": 3151908, + "result": "true" + } + } +} \ No newline at end of file diff --git a/signers/sphincsplus-128-24/crosscheck.py b/signers/sphincsplus-128-24/crosscheck.py index a4fcde0..82b80db 100644 --- a/signers/sphincsplus-128-24/crosscheck.py +++ b/signers/sphincsplus-128-24/crosscheck.py @@ -8,6 +8,11 @@ when fed identical inputs (seed, message, optrand). If they diverge we know one side has a bug. +The message is wrapped in the FIPS 205 EXTERNAL empty-context envelope +M' = 0x00 || 0x00 || M before signing on BOTH sides, matching what the fast +signers and the on-chain verifier sign (review SLH-X-f1). Pass --raw to +compare on the unwrapped bytes instead. + Assumes this script runs from the repo root. Usage: @@ -87,6 +92,9 @@ def main(): p.add_argument("optrand_hex") p.add_argument("--h", type=int, default=22) p.add_argument("--a", type=int, default=24) + p.add_argument("--raw", action="store_true", + help="compare on the raw message bytes (skip the FIPS 205 " + "external empty-context envelope)") args = p.parse_args() seed = bytes.fromhex(args.seed_hex.removeprefix("0x")) @@ -94,11 +102,19 @@ def main(): optrand = bytes.fromhex(args.optrand_hex.removeprefix("0x")) assert len(seed) == 48 and len(optrand) == 16 + # Sign what production signs: the fast signers and the on-chain verifier + # operate on M' = 0x00 || 0x00 || M (external SLH-DSA, empty context). + if not args.raw: + msg = b"\x00\x00" + msg + print(" message wrapped in external empty-ctx envelope " + f"(M' = 0x0000 || M, {len(msg)} bytes)") + msg_hex_signed = msg.hex() + sk_seed, sk_prf, pk_seed = seed[:16], seed[16:32], seed[32:48] print(f" C signer ({args.h=}, {args.a=})...") c_pk_seed, c_pk_root, c_sig = run_c_signer( - args.seed_hex, args.msg_hex, args.optrand_hex) + args.seed_hex, msg_hex_signed, args.optrand_hex) print(f" pk_seed = 0x{c_pk_seed.hex()}") print(f" pk_root = 0x{c_pk_root.hex()}") print(f" sig = {len(c_sig)} bytes, first 16 = 0x{c_sig[:16].hex()}") diff --git a/signers/sphincsplus-128-24/params.h b/signers/sphincsplus-128-24/params.h index faa69f3..431a68d 100644 --- a/signers/sphincsplus-128-24/params.h +++ b/signers/sphincsplus-128-24/params.h @@ -14,9 +14,17 @@ #define SPX_NAMESPACE(s) SPX_##s #define SPX_N 16 +/* SPX_FULL_HEIGHT / SPX_FORS_HEIGHT are -D-overridable (#ifndef) so CI can build + * a reduced-parameter binary for a fast Python<->C crosscheck. The DEFAULT build + * is the full NIST SP 800-230 set; do NOT override these for any binary intended + * to verify on-chain. */ +#ifndef SPX_FULL_HEIGHT #define SPX_FULL_HEIGHT 22 +#endif #define SPX_D 1 +#ifndef SPX_FORS_HEIGHT #define SPX_FORS_HEIGHT 24 +#endif #define SPX_FORS_TREES 6 /* Winternitz parameter — 4 for the 24-signature variant (security level 1). */ diff --git a/src/SLH-DSA-SHA2-128-24verifier.sol b/src/SLH-DSA-SHA2-128-24verifier.sol index e3b525b..abffc27 100644 --- a/src/SLH-DSA-SHA2-128-24verifier.sol +++ b/src/SLH-DSA-SHA2-128-24verifier.sol @@ -2,7 +2,12 @@ pragma solidity ^0.8.28; /// @title NIST SP 800-230 SLH-DSA-SHA2-128-24 -/// @dev Bit-exact NIST compliance using FIPS 205 guidance the SHA-256 precompile (0x02). +/// @dev Bit-exact FIPS 205 EXTERNAL SLH-DSA.Verify (Algorithm 24) with an EMPTY +/// context string, using the SHA-256 precompile (0x02). "External" means the +/// message is wrapped as M' = toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx ‖ M before +/// H_msg; with ctx = empty this is M' = 0x00 ‖ 0x00 ‖ M. This matches +/// published NIST/ACVP *external* KAT vectors. Signers must apply the same +/// envelope (prepend 0x00 0x00). (review SLH-X-f1) /// Parameters (NIST SP 800-230 Table 1): /// n = 16 h = 22 d = 1 h' = 22 /// a = 24 k = 6 w = 4 (lgw=2) m = 21 @@ -13,8 +18,9 @@ pragma solidity ^0.8.28; /// F = SHA-256(PK.seed ‖ toByte(0,48) ‖ ADRSc ‖ M1)[0..15] — 102 B /// H = SHA-256(PK.seed ‖ toByte(0,48) ‖ ADRSc ‖ M2)[0..15] — 118 B /// T_l = SHA-256(PK.seed ‖ toByte(0,48) ‖ ADRSc ‖ M)[0..15] — variable -/// Hmsg = MGF1-SHA-256(R ‖ PK.seed ‖ PK.root ‖ M, m=21) -/// Single iteration: SHA-256(R ‖ seed ‖ root ‖ M ‖ I2OSP(0,4))[0..20] +/// Hmsg = MGF1-SHA-256(R ‖ PK.seed ‖ SHA-256(R ‖ PK.seed ‖ PK.root ‖ M'), m=21) +/// M' = 0x00 ‖ 0x00 ‖ M (external SLH-DSA, empty ctx) +/// single MGF1 block (21 ≤ 32): SHA-256(R ‖ seed ‖ inner ‖ I2OSP(0,4))[0..20] /// /// ADRSc (compressed ADRS, 22 bytes, FIPS 205 §11.2): /// layer(1) ‖ tree(8) ‖ type(1) ‖ <12-byte type-dependent field> @@ -26,6 +32,18 @@ pragma solidity ^0.8.28; /// FORS_ROOTS(4): kp(4) ‖ 0(8) /// For d=1 the layer and tree fields are always zero. /// +/// ADRSc FIELD-WIDTH NOTE (review SLH-V-f3): this verifier (and the Python +/// signer) write `chain`, `hash`, and `tree_height` as full 4-byte +/// big-endian fields, whereas the sphincs/sphincsplus C reference writes +/// them as single bytes with the adjacent 3 bytes left zero. The SHA-256 +/// preimages are byte-identical ONLY because every such value is < 256 at +/// these parameters (chain ∈ [0,67], tree_height ∈ [1,24], WOTS hash step +/// ∈ [0,2]) so the high 3 bytes are zero either way. `kp` and `tree_index` +/// are genuine 4-byte fields on both sides. Any reparameterization that +/// pushed chain/height/hash ≥ 256 would break this equivalence and the +/// "FIPS bit-exact" claim — re-derive the packing before changing w / a / +/// heights / WOTS_LEN. +/// /// Signature layout (3,856 bytes): /// R(16) | FORS = 6 × (sk 16 + auth 24·16) = 2,400 | /// HT = 1 × (WOTS 68·16 + auth 22·16) = 1,440 @@ -65,22 +83,31 @@ contract SLH_DSA_SHA2_128_24_Verifier { let sigBase := sig.offset // ────────────── Hmsg (FIPS 205 §10.2, SHA-2 category 1) ────────────── - // inner = SHA-256(R ‖ seed ‖ root ‖ M) 80 B + // M' = 0x00 ‖ 0x00 ‖ M (external envelope, empty ctx) 34 B + // inner = SHA-256(R ‖ seed ‖ root ‖ M') 82 B // Hmsg = MGF1-SHA-256(R ‖ seed ‖ inner, 21) 68 B // (single iter since 21 ≤ 32: // SHA-256(R ‖ seed ‖ inner ‖ I2OSP(0,4))[0..20]) // - // Inner call layout: + // FIPS 205 EXTERNAL SLH-DSA.Verify: the message handed to H_msg is the + // wrapped message M' = toByte(0,1) ‖ toByte(|ctx|,1) ‖ ctx ‖ M + // (FIPS 205 Algorithm 24). This verifier fixes ctx = empty, so + // M' = 0x00 ‖ 0x00 ‖ M (34 bytes). Signers MUST sign the same M' + // (prepend 0x00 0x00) — see script/slh_dsa_sha2_128_24_*signer.py. + // + // Inner call layout (82 bytes): // 0x00..0x10 = R bytes (top of mstore at 0x00; bottom 16 B gets overwritten) // 0x10..0x20 = seed (top 16 B of seed-word) // 0x20..0x30 = root (top 16 B of root-word) - // 0x30..0x50 = M (full 32 B) - // Write inner digest to 0x20 (overwrites root; seed at 0x10 preserved). + // 0x30..0x32 = 0x00 0x00 (toByte(0,1) ‖ toByte(0,1), empty-ctx envelope) + // 0x32..0x52 = M (full 32 B) + // Write inner digest to 0x20 (overwrites root; R at 0x00 and seed at 0x10 preserved). mstore(0x00, calldataload(sigBase)) // R || calldata junk mstore(0x10, seed) // seed || zero (junk at 0x20 overwritten next) mstore(0x20, root) // root || zero - mstore(0x30, message) // 32 B - if iszero(staticcall(gas(), 0x02, 0x00, 0x50, 0x20, 0x20)) { revert(0, 0) } + mstore(0x30, 0) // zero 0x30..0x50 -> envelope bytes 0x00 0x00 at 0x30..0x32 + mstore(0x32, message) // M at 0x32..0x52 + if iszero(staticcall(gas(), 0x02, 0x00, 0x52, 0x20, 0x20)) { revert(0, 0) } // Outer call layout (inner digest now at 0x20..0x40): // 0x00..0x10 = R (still there) diff --git a/src/SPHINCs-C13Asm.sol b/src/SPHINCs-C13Asm.sol index b2cdf57..1072a77 100644 --- a/src/SPHINCs-C13Asm.sol +++ b/src/SPHINCs-C13Asm.sol @@ -5,10 +5,11 @@ pragma solidity ^0.8.28; /// @notice C13: W+C_F+C h=22 d=2 a=19 k=7 w=8 l=43 target_sum=208 sig=3688 /// @dev Address layout: **FIPS 205 §4.2 / §11.2.2 uncompressed 32-byte ADRS** /// (the SHAKE-instantiation form), with keccak256 substituted for -/// SHAKE-256 to stay native on EVM. C13 is the first verifier in this -/// repo using the FIPS ADRS layout; C7/C11/C12/SLH-DSA-keccak still use -/// the JARDIN 8-byte-tree / 4-word variant. See README "ADRS layout" -/// for the migration plan. +/// SHAKE-256 to stay native on EVM. C13 was the first verifier in this +/// repo on the FIPS ADRS layout; C7/C9 have since migrated to it, so every +/// live src/ keccak verifier now shares this layout. The JARDIN 8-byte-tree +/// / 4-word variants (C11, C12, SLH-DSA-keccak) are retired to legacy/. +/// See README "ADRS layout discipline". /// /// ADRS layout (32 bytes, big-endian, FIPS 205 §4.2 Algorithm 1): /// bytes 0.. 4 layer address (uint32) @@ -33,7 +34,14 @@ contract SphincsC13Asm { function verify(bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes calldata sig) external pure returns (bool valid) { - assembly ("memory-safe") { + // NOTE: this block intentionally uses Solidity's free-memory-pointer slot + // (0x40) and the zero slot (0x60) as scratch and writes high memory without + // updating the FMP. That is only sound because every exit below is an + // unconditional in-assembly `return`/`revert`, so Solidity never regains + // control with a clobbered FMP. It is therefore NOT `memory-safe` in the + // Yul sense — do not add the ("memory-safe") annotation and do not introduce + // a normal (fall-through) exit from this block. (review C13-evm-f1) + assembly { let N_MASK := 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000 if iszero(eq(sig.length, 3688)) { @@ -44,6 +52,19 @@ contract SphincsC13Asm { revert(0x00, 0x64) } + // Reject non-canonical public keys (low 128 bits must be zero), mirroring + // the SLH-DSA-SHA2 verifier. Without this a non-top-aligned pkRoot can + // never equal the always-N_MASK'd `currentNode` (line ~"valid := eq"), + // silently bricking the account; pkSeed would also diverge from the + // signer which always masks. Fail loudly instead. (review C13-V-f1) + if or(iszero(eq(pkSeed, and(pkSeed, N_MASK))), iszero(eq(pkRoot, and(pkRoot, N_MASK)))) { + mstore(0x00, 0x08c379a000000000000000000000000000000000000000000000000000000000) + mstore(0x04, 0x20) + mstore(0x24, 18) + mstore(0x44, "Invalid public key") + revert(0x00, 0x64) + } + let seed := pkSeed let root := pkRoot mstore(0x00, seed) @@ -57,32 +78,53 @@ contract SphincsC13Asm { let digest := keccak256(0x00, 0xA0) // htIdx = (digest >> 133) & (2^22-1) + // PARAM IDENTITIES (must hold or signer/verifier desync silently — + // review C13-V-f4): 133 = K*A = 7*19 ; 0x3FFFFF = 2^H-1 = 2^22-1. let htIdx := and(shr(133, digest), 0x3FFFFF) // FORS+C (K=7, A=19) + // + // FORS addressing — exact FIPS 205 FORS field split: the FORS + // instance is keyed by the per-message hypertree leaf via the + // canonical address fields — + // tree address = idxTree0 = htIdx >> SUBTREE_H (bottom subtree) + // word1/kp = idxLeaf0 = htIdx & (2^SUBTREE_H-1) (bottom leaf) + // word3/tree_index = (forsTree << (A-height)) | node (k FORS trees + // indexed as one forest, FIPS 205 Alg. 17) + // word2/tree_height = height + // so each of the 2^h hypertree leaves selects a distinct FORS + // instance. Matches C12 / SLH-DSA-SHA2 field semantics; the signer + // mirrors this and derives the leaf secrets from the same leaf. let dVal := digest - // Forced-zero: last index (i=6) at bits 114..132 (mask = 2^19-1) - if and(shr(114, dVal), 0x7FFFF) { revert(0, 0) } + // Forced-zero: last FORS index (i=K-1=6) occupies bits [114,133) + // (19-bit field). PARAM IDENTITIES (review C13-V-f4): 114 = (K-1)*A = + // 6*19 ; 0x7FFFF = 2^A-1 = 2^19-1. + // A well-formed-but-invalid signature is rejected by returning `false` + // (the bool contract), NOT by an empty revert — so all soundness + // rejections are uniform across callers. (review C13-V-f2 / C13-evm-f2) + if and(shr(114, dVal), 0x7FFFF) { mstore(0x00, 0) return(0x00, 0x20) } let sigBase := sig.offset - // FIPS ADRS bit positions for FORS_TREE (layer=0, tree=0): - // type=3 at shl(96, …) - // word1=kp at shl(64, …) - // word2=height at shl(32, …) - // word3=index at shl( 0, …) + // SUBTREE_H = 11 (h/d = 22/2): split htIdx into bottom subtree + leaf. + // PARAM IDENTITIES (review C13-V-f4): 0x7FF = 2^SUBTREE_H-1 = 2^11-1 ; + // shift 11 = SUBTREE_H. + let idxLeaf0 := and(htIdx, 0x7FF) + let idxTree0 := shr(11, htIdx) + // forsBase: tree=idxTree0 (shl 128), type=3 (shl 96), kp=idxLeaf0 (shl 64). + // Per-site we OR in word2=height (shl 32) and word3=tree_index (shl 0). + let forsBase := or(shl(128, idxTree0), or(shl(96, 3), shl(64, idxLeaf0))) // K-1=6 normal trees for { let i := 0 } lt(i, 6) { i := add(i, 1) } { - let treeIdx := and(shr(mul(i, 19), dVal), 0x7FFFF) // 19-bit indices + let treeIdx := and(shr(mul(i, 19), dVal), 0x7FFFF) // 19=A-bit indices, shift i*A let secretVal := and(calldataload(add(sigBase, add(16, shl(4, i)))), N_MASK) - // Leaf hash: type=3, word1=i (FORS tree idx), word2=0, word3=treeIdx (leaf) - let leafAdrs := or(shl(96, 3), or(shl(64, i), treeIdx)) + // Leaf hash (height 0): word3 = (i << A) | treeIdx, A=19 (folds the k + // FORS trees into one tree_index space; review C13-V-f4) + let leafAdrs := or(forsBase, or(shl(19, i), treeIdx)) mstore(0x20, leafAdrs) mstore(0x40, secretVal) let node := and(keccak256(0x00, 0x60), N_MASK) - // Auth-path base: type=3, word1=i, word2 and word3 supplied per level - let treeAdrsBase := or(shl(96, 3), shl(64, i)) let pathIdx := treeIdx // AUTH_START = 16 + K*N = 128, auth per tree = A*N = 19*16 = 304 let authPtr := add(sigBase, add(128, mul(i, 304))) @@ -91,8 +133,10 @@ contract SphincsC13Asm { for { let h := 0 } lt(h, 19) { h := add(h, 1) } { let sibling := and(calldataload(add(authPtr, shl(4, h))), N_MASK) let parentIdx := shr(1, pathIdx) - // word2=tree_height=h+1, word3=tree_index=parentIdx - mstore(0x20, or(treeAdrsBase, or(shl(32, add(h, 1)), parentIdx))) + // word2=height=h+1; word3 = (i << (A-1-h)) | parentIdx. + // PARAM IDENTITY (review C13-V-f4): 18 = A-1; sub(18,h) stays + // >= 0 for h in [0,18] (the A=19 auth levels). + mstore(0x20, or(forsBase, or(shl(32, add(h, 1)), or(shl(sub(18, h), i), parentIdx)))) // Branchless Merkle swap (Solady) let s := shl(5, and(pathIdx, 1)) mstore(xor(0x40, s), node) @@ -105,18 +149,19 @@ contract SphincsC13Asm { // Last tree (forced-zero): secret is the revealed root, hashed under FORS_TREE leaf ADRS { - let lastSecret := and(calldataload(add(sigBase, add(16, shl(4, 6)))), N_MASK) // 16+6*16=112 - // Leaf ADRS for forced-zero tree: type=3, word1=6, word2=0, word3=0 - mstore(0x20, or(shl(96, 3), shl(64, 6))) + let lastSecret := and(calldataload(add(sigBase, add(16, shl(4, 6)))), N_MASK) // 16+(K-1)*16=112 + // Forced-zero tree (forsTree=K-1=6) as leaf node 0: word3 = (6 << A). + // PARAM IDENTITY (review C13-V-f4): 19 = A, 6 = K-1. + mstore(0x20, or(forsBase, shl(19, 6))) mstore(0x40, lastSecret) // 0x80 + 6*0x20 = 0x80 + 0xC0 = 0x140 mstore(0x140, and(keccak256(0x00, 0x60), N_MASK)) } // Compress K=7 roots: keccak256(seed || FORS_ROOTS-ADRS || 7 roots) - // FORS_ROOTS: type=4 at shl(96, …); word1/word2/word3 all 0. + // FORS_ROOTS: tree=idxTree0, type=4 (shl 96), kp=idxLeaf0 (shl 64). // = 32 + 32 + 7*32 = 288 = 0x120 - mstore(0x20, shl(96, 4)) + mstore(0x20, or(shl(128, idxTree0), or(shl(96, 4), shl(64, idxLeaf0)))) for { let i := 0 } lt(i, 7) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) } @@ -154,12 +199,17 @@ contract SphincsC13Asm { mstore(0x60, count) let d := keccak256(0x00, 0x80) - // Validate digit sum = 208 (43 base-8 digits, 3 bits each) + // Validate WOTS+C digit sum == TARGET_SUM (43 base-8 digits, 3 bits + // each). PARAM IDENTITIES (review C13-V-f4): loop bound 43 = L ; + // digit shift 3 = LOG_W ; mask 0x7 = W-1 = 2^LOG_W-1 ; 208 = TARGET_SUM. + // A digit-sum mismatch is a well-formed-but-invalid signature -> + // return `false` (uniform with the forced-zero path; review + // C13-V-f2 / C13-evm-f2), not an empty revert. let digitSum := 0 for { let ii := 0 } lt(ii, 43) { ii := add(ii, 1) } { digitSum := add(digitSum, and(shr(mul(ii, 3), d), 0x7)) } - if iszero(eq(digitSum, 208)) { revert(0, 0) } + if iszero(eq(digitSum, 208)) { mstore(0x00, 0) return(0x00, 0x20) } // 43 WOTS chains (w=8: max 7 steps per chain) let wotsPtr := add(sigBase, sigOff) diff --git a/src/SPHINCs-C7Asm.sol b/src/SPHINCs-C7Asm.sol index 239c479..2d3aa33 100644 --- a/src/SPHINCs-C7Asm.sol +++ b/src/SPHINCs-C7Asm.sol @@ -5,7 +5,11 @@ pragma solidity ^0.8.28; /// @notice C7: W+C_F+C h=24 d=2 a=16 k=8 w=8 l=43 target_sum=151 sig=3704 /// Same FORS+C as C6 but with w=8 WOTS chains: fewer hash steps per chain (7 vs 15), /// more chains (43 vs 32), trading +352 bytes sig for ~20% less compute. -/// @dev Domain-separated H_msg (160 bytes). Shared verifier pattern. +/// @dev Uses the FIPS 205 §11.2.2 uncompressed 32-byte ADRS (as C13). FORS is keyed by the +/// per-message hypertree leaf via the exact FIPS field split — tree=idxTree0, +/// kp=idxLeaf0, tree_index folds in the FORS tree number ((forsTree<<(A-height))|node). +/// Domain-separated H_msg (160 bytes). +/// ADRS: layer(4) ‖ tree(12) ‖ type(4) ‖ word1 ‖ word2 ‖ word3. contract SphincsC7Asm { function verify(bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes calldata sig) @@ -36,27 +40,35 @@ contract SphincsC7Asm { let htIdx := and(shr(128, digest), 0xFFFFFF) - // FORS+C (K=8, A=16) — identical to C6 + // FORS+C (K=8, A=16) — FIPS 205 FORS field split (per-message leaf keying): + // tree=idxTree0 (htIdx>>SUBTREE_H), kp=idxLeaf0 (htIdx&(2^SUBTREE_H-1)), + // tree_index=(forsTree<<(A-height))|node, tree_height=height. let dVal := digest if and(shr(112, dVal), 0xFFFF) { revert(0, 0) } let sigBase := sig.offset + // SUBTREE_H = 12 (h/d = 24/2): split htIdx into bottom subtree + leaf. + let idxLeaf0 := and(htIdx, 0xFFF) + let idxTree0 := shr(12, htIdx) + // forsBase: tree=idxTree0 (shl 128), type=3 (shl 96), kp=idxLeaf0 (shl 64). + let forsBase := or(shl(128, idxTree0), or(shl(96, 3), shl(64, idxLeaf0))) for { let i := 0 } lt(i, 7) { i := add(i, 1) } { let treeIdx := and(shr(shl(4, i), dVal), 0xFFFF) let secretVal := and(calldataload(add(sigBase, add(16, shl(4, i)))), N_MASK) - let leafAdrs := or(shl(128, 3), or(shl(96, i), treeIdx)) + // Leaf hash (height 0): word3 = (i << A) | treeIdx, A=16 + let leafAdrs := or(forsBase, or(shl(16, i), treeIdx)) mstore(0x20, leafAdrs) mstore(0x40, secretVal) let node := and(keccak256(0x00, 0x60), N_MASK) - let treeAdrsBase := or(shl(128, 3), shl(96, i)) let pathIdx := treeIdx let authPtr := add(sigBase, add(144, shl(8, i))) for { let h := 0 } lt(h, 16) { h := add(h, 1) } { let sibling := and(calldataload(add(authPtr, shl(4, h))), N_MASK) let parentIdx := shr(1, pathIdx) - mstore(0x20, or(treeAdrsBase, or(shl(32, add(h, 1)), parentIdx))) + // word2=height=h+1; word3 = (i << (A-1-h)) | parentIdx, A-1=15 + mstore(0x20, or(forsBase, or(shl(32, add(h, 1)), or(shl(sub(15, h), i), parentIdx)))) // Branchless Merkle swap (Solady pattern) let s := shl(5, and(pathIdx, 1)) mstore(xor(0x40, s), node) @@ -69,12 +81,14 @@ contract SphincsC7Asm { { let lastSecret := and(calldataload(add(sigBase, 128)), N_MASK) - mstore(0x20, or(shl(128, 3), shl(96, 7))) + // Forced-zero tree (forsTree=7) as leaf node 0: word3 = (7 << A) + mstore(0x20, or(forsBase, shl(16, 7))) mstore(0x40, lastSecret) mstore(0x160, and(keccak256(0x00, 0x60), N_MASK)) } - mstore(0x20, shl(128, 4)) + // FORS_ROOTS: tree=idxTree0, type=4 (shl 96), kp=idxLeaf0 (shl 64). + mstore(0x20, or(shl(128, idxTree0), or(shl(96, 4), shl(64, idxLeaf0)))) for { let i := 0 } lt(i, 8) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) } @@ -91,7 +105,7 @@ contract SphincsC7Asm { let idxLeaf := and(idxTree, 0xFFF) idxTree := shr(12, idxTree) - let wotsAdrs := or(shl(224, layer), or(shl(160, idxTree), shl(96, idxLeaf))) + let wotsAdrs := or(shl(224, layer), or(shl(128, idxTree), shl(64, idxLeaf))) // Count at sigOff + l*N = sigOff + 43*16 = sigOff + 688 let countOff := add(sigOff, 688) @@ -115,14 +129,11 @@ contract SphincsC7Asm { let digit := and(shr(mul(i, 3), d), 0x7) let steps := sub(7, digit) let val := and(calldataload(add(wotsPtr, shl(4, i))), N_MASK) - // Pre-compute loop-invariant masked chain address - let chainBase := and( - or(wotsAdrs, shl(64, i)), - 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000FFFFFFFF - ) + // FIPS WOTS_HASH: chain_address=word2 (shl 32), hash_address=word3 (shl 0) + let chainBase := or(wotsAdrs, shl(32, i)) for { let step := 0 } lt(step, steps) { step := add(step, 1) } { - mstore(0x20, or(chainBase, shl(32, add(digit, step)))) + mstore(0x20, or(chainBase, add(digit, step))) mstore(0x40, val) val := and(keccak256(0x00, 0x60), N_MASK) } @@ -131,7 +142,7 @@ contract SphincsC7Asm { // PK compression: keccak256(seed || pkAdrs || 43 endpoints) // = 32 + 32 + 43*32 = 1440 = 0x5A0 - let pkAdrs := or(shl(224, layer), or(shl(160, idxTree), or(shl(128, 1), shl(96, idxLeaf)))) + let pkAdrs := or(shl(224, layer), or(shl(128, idxTree), or(shl(96, 1), shl(64, idxLeaf)))) mstore(0x20, pkAdrs) for { let i := 0 } lt(i, 43) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) @@ -140,7 +151,7 @@ contract SphincsC7Asm { // Merkle auth path (12 levels) let authOff := add(countOff, 4) - let treeAdrs := or(shl(224, layer), or(shl(160, idxTree), shl(128, 2))) + let treeAdrs := or(shl(224, layer), or(shl(128, idxTree), shl(96, 2))) let merkleNode := wotsPk let mIdx := idxLeaf let merklePtr := add(sigBase, authOff) @@ -148,10 +159,8 @@ contract SphincsC7Asm { for { let h := 0 } lt(h, 12) { h := add(h, 1) } { let sibling := and(calldataload(add(merklePtr, shl(4, h))), N_MASK) let parentIdx := shr(1, mIdx) - mstore(0x20, or( - and(treeAdrs, 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000), - or(shl(32, add(h, 1)), parentIdx) - )) + // type=2, word2=height=h+1, word3=tree_index=parentIdx + mstore(0x20, or(treeAdrs, or(shl(32, add(h, 1)), parentIdx))) // Branchless Merkle swap (Solady pattern) let s := shl(5, and(mIdx, 1)) mstore(xor(0x40, s), merkleNode) diff --git a/src/SPHINCs-C9Asm.sol b/src/SPHINCs-C9Asm.sol index 5964b61..42eb04f 100644 --- a/src/SPHINCs-C9Asm.sol +++ b/src/SPHINCs-C9Asm.sol @@ -3,7 +3,11 @@ pragma solidity ^0.8.28; /// @title SphincsC9Asm — Stateless SPHINCS+ C9 verifier (shared, Yul-optimized) /// @dev C9: h=20 d=2 a=12 k=11 w=8 l=43 target_sum=208 sig=3816 -/// Domain-separated H_msg (160 bytes). Branchless Merkle swap, hoisted chain address. +/// Uses the FIPS 205 §11.2.2 uncompressed 32-byte ADRS (as C13). FORS keyed by the +/// per-message hypertree leaf via the exact FIPS field split — tree=idxTree0, kp=idxLeaf0, +/// tree_index folds in the FORS tree number ((forsTree<<(A-height))|node). +/// Domain-separated H_msg (160 bytes). +/// ADRS: layer(4) ‖ tree(12) ‖ type(4) ‖ word1 ‖ word2 ‖ word3. contract SphincsC9Asm { function verify(bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes calldata sig) @@ -35,22 +39,29 @@ contract SphincsC9Asm { // htIdx = (digest >> 132) & (2^20-1) let htIdx := and(shr(132, digest), 0xFFFFF) - // FORS+C (K=11, A=12) + // FORS+C (K=11, A=12) — FIPS 205 FORS field split (per-message leaf keying): + // tree=idxTree0 (htIdx>>SUBTREE_H), kp=idxLeaf0 (htIdx&(2^SUBTREE_H-1)), + // tree_index=(forsTree<<(A-height))|node, tree_height=height. let dVal := digest // Forced-zero: last index (i=10) at bits 120..131 if and(shr(120, dVal), 0xFFF) { revert(0, 0) } let sigBase := sig.offset + // SUBTREE_H = 10 (h/d = 20/2): split htIdx into bottom subtree + leaf. + let idxLeaf0 := and(htIdx, 0x3FF) + let idxTree0 := shr(10, htIdx) + // forsBase: tree=idxTree0 (shl 128), type=3 (shl 96), kp=idxLeaf0 (shl 64). + let forsBase := or(shl(128, idxTree0), or(shl(96, 3), shl(64, idxLeaf0))) // K-1=10 normal trees for { let i := 0 } lt(i, 10) { i := add(i, 1) } { let treeIdx := and(shr(mul(i, 12), dVal), 0xFFF) // 12-bit indices let secretVal := and(calldataload(add(sigBase, add(16, shl(4, i)))), N_MASK) - let leafAdrs := or(shl(128, 3), or(shl(96, i), treeIdx)) + // Leaf hash (height 0): word3 = (i << A) | treeIdx, A=12 + let leafAdrs := or(forsBase, or(shl(12, i), treeIdx)) mstore(0x20, leafAdrs) mstore(0x40, secretVal) let node := and(keccak256(0x00, 0x60), N_MASK) - let treeAdrsBase := or(shl(128, 3), shl(96, i)) let pathIdx := treeIdx // AUTH_START=192, auth per tree = 12*16 = 192 let authPtr := add(sigBase, add(192, mul(i, 192))) @@ -59,7 +70,8 @@ contract SphincsC9Asm { for { let h := 0 } lt(h, 12) { h := add(h, 1) } { let sibling := and(calldataload(add(authPtr, shl(4, h))), N_MASK) let parentIdx := shr(1, pathIdx) - mstore(0x20, or(treeAdrsBase, or(shl(32, add(h, 1)), parentIdx))) + // word2=height=h+1; word3 = (i << (A-1-h)) | parentIdx, A-1=11 + mstore(0x20, or(forsBase, or(shl(32, add(h, 1)), or(shl(sub(11, h), i), parentIdx)))) // Branchless Merkle swap let s := shl(5, and(pathIdx, 1)) mstore(xor(0x40, s), node) @@ -73,15 +85,17 @@ contract SphincsC9Asm { // Last tree (forced-zero) { let lastSecret := and(calldataload(add(sigBase, add(16, shl(4, 10)))), N_MASK) // 16+10*16=176 - mstore(0x20, or(shl(128, 3), shl(96, 10))) + // Forced-zero tree (forsTree=10) as leaf node 0: word3 = (10 << A) + mstore(0x20, or(forsBase, shl(12, 10))) mstore(0x40, lastSecret) // 0x80 + 10*0x20 = 0x80 + 0x140 = 0x1C0 mstore(0x1C0, and(keccak256(0x00, 0x60), N_MASK)) } // Compress 11 roots: keccak256(seed || rootsAdrs || 11 roots) + // FORS_ROOTS: tree=idxTree0, type=4 (shl 96), kp=idxLeaf0 (shl 64). // = 32 + 32 + 11*32 = 416 = 0x1A0 - mstore(0x20, shl(128, 4)) + mstore(0x20, or(shl(128, idxTree0), or(shl(96, 4), shl(64, idxLeaf0)))) for { let i := 0 } lt(i, 11) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) } @@ -96,7 +110,7 @@ contract SphincsC9Asm { let idxLeaf := and(idxTree, 0x3FF) // 2^10 - 1 idxTree := shr(10, idxTree) - let wotsAdrs := or(shl(224, layer), or(shl(160, idxTree), shl(96, idxLeaf))) + let wotsAdrs := or(shl(224, layer), or(shl(128, idxTree), shl(64, idxLeaf))) // countOff = sigOff + l*N = sigOff + 688 let countOff := add(sigOff, 688) let count := shr(224, calldataload(add(sigBase, countOff))) @@ -119,13 +133,11 @@ contract SphincsC9Asm { let digit := and(shr(mul(i, 3), d), 0x7) let steps := sub(7, digit) let val := and(calldataload(add(wotsPtr, shl(4, i))), N_MASK) - let chainBase := and( - or(wotsAdrs, shl(64, i)), - 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000FFFFFFFF - ) + // FIPS WOTS_HASH: chain_address=word2 (shl 32), hash_address=word3 (shl 0) + let chainBase := or(wotsAdrs, shl(32, i)) for { let step := 0 } lt(step, steps) { step := add(step, 1) } { - mstore(0x20, or(chainBase, shl(32, add(digit, step)))) + mstore(0x20, or(chainBase, add(digit, step))) mstore(0x40, val) val := and(keccak256(0x00, 0x60), N_MASK) } @@ -133,7 +145,7 @@ contract SphincsC9Asm { } // PK compression: 32+32+43*32 = 1440 = 0x5A0 - let pkAdrs := or(shl(224, layer), or(shl(160, idxTree), or(shl(128, 1), shl(96, idxLeaf)))) + let pkAdrs := or(shl(224, layer), or(shl(128, idxTree), or(shl(96, 1), shl(64, idxLeaf)))) mstore(0x20, pkAdrs) for { let i := 0 } lt(i, 43) { i := add(i, 1) } { mstore(add(0x40, shl(5, i)), mload(add(0x80, shl(5, i)))) @@ -142,7 +154,7 @@ contract SphincsC9Asm { // Merkle auth path (10 levels) let authOff := add(countOff, 4) - let treeAdrs := or(shl(224, layer), or(shl(160, idxTree), shl(128, 2))) + let treeAdrs := or(shl(224, layer), or(shl(128, idxTree), shl(96, 2))) let merkleNode := wotsPk let mIdx := idxLeaf let merklePtr := add(sigBase, authOff) @@ -150,10 +162,8 @@ contract SphincsC9Asm { for { let h := 0 } lt(h, 10) { h := add(h, 1) } { let sibling := and(calldataload(add(merklePtr, shl(4, h))), N_MASK) let parentIdx := shr(1, mIdx) - mstore(0x20, or( - and(treeAdrs, 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000), - or(shl(32, add(h, 1)), parentIdx) - )) + // type=2, word2=height=h+1, word3=tree_index=parentIdx + mstore(0x20, or(treeAdrs, or(shl(32, add(h, 1)), parentIdx))) let s := shl(5, and(mIdx, 1)) mstore(xor(0x40, s), merkleNode) mstore(xor(0x60, s), sibling) diff --git a/src/SphincsAccount.sol b/src/SphincsAccount.sol index 973e001..c4c5398 100644 --- a/src/SphincsAccount.sol +++ b/src/SphincsAccount.sol @@ -65,37 +65,56 @@ contract SphincsAccount is BaseAccount { } /// @notice Validate hybrid signature: abi.encode(ecdsaSig, sphincsSig) + /// @dev ERC-4337 requires `_validateSignature` to be TOTAL: any signature + /// failure must RETURN `SIG_VALIDATION_FAILED`, never revert (a revert + /// becomes EntryPoint `AA23` and reverts the whole bundle). Two former + /// revert paths are made total here (review C13-acc-g1): + /// (1) `abi.decode` of a malformed `userOp.signature` — wrapped in + /// try/catch via `decodeHybridSignature`; + /// (2) ECDSA recovery on a bad-length / high-`s` / bad-`v` signature — + /// switched from the reverting `recover` to `tryRecover`. function _validateSignature( PackedUserOperation calldata userOp, bytes32 userOpHash ) internal view override returns (uint256 validationData) { - (bytes memory ecdsaSig, bytes memory sphincsSig) = abi.decode( - userOp.signature, - (bytes, bytes) - ); + // (1) Total decode: a malformed 2-tuple must fail validation, not revert. + try this.decodeHybridSignature(userOp.signature) + returns (bytes memory ecdsaSig, bytes memory sphincsSig) + { + // (2) Verify ECDSA via tryRecover (no revert on bad length/v/high-s). + (address recovered, ECDSA.RecoverError err, ) = + ECDSA.tryRecover(userOpHash, ecdsaSig); + if (err != ECDSA.RecoverError.NoError || recovered != owner) { + return SIG_VALIDATION_FAILED; + } - // 1. Verify ECDSA - address recovered = userOpHash.recover(ecdsaSig); - if (recovered != owner) { - return SIG_VALIDATION_FAILED; - } - - // 2. Verify SPHINCS+ via shared verifier - (bool success, bytes memory result) = verifier.staticcall( - abi.encodeWithSignature( - "verify(bytes32,bytes32,bytes32,bytes)", - pkSeed, pkRoot, userOpHash, sphincsSig - ) - ); - if (!success || result.length < 32) { - return SIG_VALIDATION_FAILED; - } - bool valid = abi.decode(result, (bool)); - if (!valid) { + // (3) Verify SPHINCS+ via shared verifier. + (bool success, bytes memory result) = verifier.staticcall( + abi.encodeWithSignature( + "verify(bytes32,bytes32,bytes32,bytes)", + pkSeed, pkRoot, userOpHash, sphincsSig + ) + ); + if (!success || result.length < 32) { + return SIG_VALIDATION_FAILED; + } + if (!abi.decode(result, (bool))) { + return SIG_VALIDATION_FAILED; + } + return SIG_VALIDATION_SUCCESS; + } catch { return SIG_VALIDATION_FAILED; } + } - return SIG_VALIDATION_SUCCESS; + /// @notice External helper so `abi.decode((bytes,bytes))` of the hybrid + /// signature blob can be wrapped in try/catch (a malformed blob then + /// yields `SIG_VALIDATION_FAILED` instead of a revert). Pure; callable + /// only as `this.decodeHybridSignature(...)` from `_validateSignature`. + function decodeHybridSignature(bytes calldata sigBlob) + external pure returns (bytes memory ecdsaSig, bytes memory sphincsSig) + { + (ecdsaSig, sphincsSig) = abi.decode(sigBlob, (bytes, bytes)); } receive() external payable {} diff --git a/src/SphincsFrameAccount.sol b/src/SphincsFrameAccount.sol index 9d6266d..2779e12 100644 --- a/src/SphincsFrameAccount.sol +++ b/src/SphincsFrameAccount.sol @@ -39,6 +39,12 @@ contract SphincsFrameAccount { sig ) ); + // Error-surface contract (review C13-evm-f2): the C13 verifier RETURNS + // `false` for every soundness rejection — invalid Merkle root, FORS+C + // forced-zero violation, and WOTS+C target-sum violation — so those all + // land on the descriptive "invalid SPHINCS+ signature" path below. The + // verifier only REVERTS on malformed *inputs* (wrong sig length / + // non-canonical public key), for which "verify call failed" is correct. require(success && result.length >= 32, "verify call failed"); bool valid = abi.decode(result, (bool)); require(valid, "invalid SPHINCS+ signature"); diff --git a/test/SLH-DSA-SHA2-128-24-CalldataGas.t.sol b/test/SLH-DSA-SHA2-128-24-CalldataGas.t.sol index 0edb3fd..910ef16 100644 --- a/test/SLH-DSA-SHA2-128-24-CalldataGas.t.sol +++ b/test/SLH-DSA-SHA2-128-24-CalldataGas.t.sol @@ -20,7 +20,7 @@ contract SLH_DSA_SHA2_128_24_CalldataGas is Test { function setUp() public { verifier = new SLH_DSA_SHA2_128_24_Verifier(); string[] memory inputs = new string[](4); - inputs[0] = ".venv/bin/python"; + inputs[0] = "python3"; // every other FFI test uses the ambient python3 (CI has no .venv) inputs[1] = "script/slh_dsa_sha2_128_24_fast_signer.py"; inputs[2] = vm.toString(SK); inputs[3] = vm.toString(MSG); diff --git a/test/SLH-DSA-SHA2-128-24-JsonKAT.t.sol b/test/SLH-DSA-SHA2-128-24-JsonKAT.t.sol new file mode 100644 index 0000000..b27c2e0 --- /dev/null +++ b/test/SLH-DSA-SHA2-128-24-JsonKAT.t.sol @@ -0,0 +1,58 @@ +// SPDX-License-Identifier: MIT +pragma solidity ^0.8.28; + +import "forge-std/Test.sol"; +import "../src/SLH-DSA-SHA2-128-24verifier.sol"; + +/// @notice JSON-fixture Known-Answer Test for the FIPS 205 EXTERNAL +/// SLH-DSA-SHA2-128-24 verifier (empty context, M wrapped as 0x00 0x00 || M). +/// Loads the pinned DETERMINISTIC (counter-mode) vector from +/// `signers/slhvk-sha2-128-24/kat-counter0.json` via vm.readFile + +/// vm.parseJson and asserts a freshly-deployed verifier accepts it. +/// The vector was produced by the Vulkan GPU signer (bit-exact vs the +/// sphincsplus-128-24 CPU reference); reproduce with the fixture's +/// `reproduce` field. This is the machine-readable companion to the +/// inline SLH-DSA-SHA2-128-24-KAT.t.sol: it guards the verifier against +/// silent signer/FIPS co-drift AND keeps the JSON fixture itself honest. +/// Requires fs read access to the fixture (see `fs_permissions` in +/// foundry.toml). +contract SLH_DSA_SHA2_128_24_JsonKAT_Test is Test { + SLH_DSA_SHA2_128_24_Verifier verifier; + string constant FIXTURE = "signers/slhvk-sha2-128-24/kat-counter0.json"; + + function setUp() public { + verifier = new SLH_DSA_SHA2_128_24_Verifier(); + } + + function _load() + internal + view + returns (bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes memory sig) + { + string memory json = vm.readFile(FIXTURE); + pkSeed = vm.parseJsonBytes32(json, ".public_key.pkSeed"); + pkRoot = vm.parseJsonBytes32(json, ".public_key.pkRoot"); + message = vm.parseJsonBytes32(json, ".inputs.message_M"); + sig = vm.parseJsonBytes(json, ".signature"); + } + + /// The pinned JSON vector must verify, and its self-described length / + /// expectation must be internally consistent (catches a tampered fixture). + function testJsonKatVerifies() public view { + (bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes memory sig) = _load(); + string memory json = vm.readFile(FIXTURE); + uint256 sigLen = vm.parseJsonUint(json, ".signature_len"); + bool expected = vm.parseJsonBool(json, ".verify_expected"); + + assertEq(sig.length, sigLen, "fixture signature_len mismatch"); + assertEq(sig.length, 3856, "SLH-DSA-SHA2-128-24 sig must be 3856 B"); + assertEq(verifier.verify(pkSeed, pkRoot, message, sig), expected, "JSON KAT must verify"); + } + + /// A one-bit flip in the message must be rejected (guards an accept-all bug). + function testJsonKatRejectsWrongMessage() public view { + (bytes32 pkSeed, bytes32 pkRoot, bytes32 message, bytes memory sig) = _load(); + bytes32 wrong = bytes32(uint256(message) ^ 1); + assertFalse(verifier.verify(pkSeed, pkRoot, wrong, sig), "wrong message must not verify"); + } +} diff --git a/test/SLH-DSA-SHA2-128-24-KAT.t.sol b/test/SLH-DSA-SHA2-128-24-KAT.t.sol new file mode 100644 index 0000000..d281ef0 --- /dev/null +++ b/test/SLH-DSA-SHA2-128-24-KAT.t.sol @@ -0,0 +1,38 @@ +// SPDX-License-Identifier: MIT +pragma solidity ^0.8.28; + +import "forge-std/Test.sol"; +import "../src/SLH-DSA-SHA2-128-24verifier.sol"; + +/// @notice Pinned, reproducible Known-Answer Test for the FIPS 205 EXTERNAL +/// SLH-DSA-SHA2-128-24 verifier (empty context, M wrapped as 0x00 0x00 || M). +/// Unlike SLH-DSA-SHA2-128-24-Test.t.sol (which signs fresh via FFI every +/// run, hedged & non-reproducible), this hardcodes a DETERMINISTIC +/// signature so the verifier cannot silently co-drift from the signer / +/// FIPS without CI noticing. Generated once via: +/// python3 script/slh_dsa_sha2_128_24_fast_signer.py \ +/// 0x1111..1111 0xdeadbeef00..00 0 (sig_counter=0) +/// which prepends the 0x00 0x00 empty-ctx envelope before the C signer. +/// (review SLH-X-f1 / SLH-X-f4/f5) +contract SLH_DSA_SHA2_128_24_KAT_Test is Test { + SLH_DSA_SHA2_128_24_Verifier verifier; + + bytes32 constant MSG = 0xdeadbeef00000000000000000000000000000000000000000000000000000000; + bytes32 constant SEED = 0x750e7b30f37700dd14b20a5c647bb93600000000000000000000000000000000; + bytes32 constant ROOT = 0x3456300211d2a77c26a60804b918738f00000000000000000000000000000000; + bytes constant SIG = hex"b5f23d0ce1060329484905a66a1a2a7094edae240d0966fbd62a05f87dff6b2469f576a9222a41ef69463b5b4b86c0a056425fc6eea7fd598758bba2f5bfaa2cf6bfa9aaff0c1ae594f40e321c90b4d8973ec7b03c8617e98e7baf619c40599b3445dbfb97d7fe2172d458461c6191ca9b0d6b58fa73f81a2e49dd6796718d05934b253334c2766e1a021111233e254a378ea266ddfaf85327c8a0c4b24fd3402e44b2bb6ee3d89e2bed18e0064aa24f3a2faf54f08cce1c86baa3d972c3226a58e1af45b7c8017795126cfad6308792313f87c251ee8614a7b69fdb4ee076229884747fb20c5b890de68f11556cd988585ec336ebec7a07e39be7313cef667139a5f3431d326369bf2141947e9f919cf92bbf62f34d6d21fdb87ce4d59e5287d7092b1c14156a1b0c682588bdc4ab087cfe63a488eaac39b235a4cf5e5f5e6b6eb553d9d25c28ffadb13fa4d5381deb2c94cee3d4474a63b55e6c650acd95ec0f6805ad011526cd12abd72f6404f94e7e9b01e6b38dab4dbaaab6bcce1aedb1855fa3831d39be52faf5e968bdc4d958e6c1e929e1b19349e7a941fe9e549b73db9c1df14c73abdbcb4308256e4e04ee692bfdc3a236624404b3eb8de3468237ffde3751ef2ccc44637eee3057d7b9899c15ab71a99dadcbc8ac25efdfd7385179c943047561dfe567f7fc1576886ee29b8ee21bcd6a42f64652a6b98500d48ba3add93c3d5ed81c8c5cc2cdabf85f9d81b0b6e6bcfc4c776485fe488d703913c05df02c1e5ad8054060cac76ceadc98fdc0f9927d2345dcafdc87cf0846e0bee432342586b02efea15c072f25243654a73764d17d3e90766e0de57b54673e2e4619cd7a5f2803b1085ef703005a11deb41062eb1ab6a2d4b75633727ebe9c19e202f103ba785dd510366b46116cf051f824aae3dd16fcba74694cfd6227ce062b6981eec3699c59ca0ea783f807bae36aa7c2c5cc2446ef6e24cf0e4a8d1658dd11aff8a2a89f0285011496c880cf9cf38fbf33731f1cb765738812151758118961e15c849debede1c3e973a79e1d4db1ea0920fea70f801628072c1225ebe111dd97ed2a29ba9bcb957a4d32c2fbf83cd8a42295fb659b22a50a263308b10e74fe276999285232129b7dbee774f55a08f2be7ba01ceeb636cc3463607c898d8c1c4693ff0bd83f6e80f72baccd2818927729b3a271a3caff01102cc5790900faf12325d24fe8b2246ca1cd7a000ef6cbb9600ce9fd57564586079f916909d30d932c1832c7c81b26177fc338101b75c346bab775d9496ff2f8a8737b66f99cae64c8484d939b5ab6d866221e470bba492a3f37ac99e96b9468866f98fcad0297e65477ca8e7068a55699063c1a0ee84e06a75064fcb6c41adf37112ff73c16da9637a60cb066b779bb95e0e916bf5f9ae6d603e997847db06e259431cebea4be8485798dddb3b3825044bec6b1df94e4d0aedd31d94aa49551e491d8df5f8878992112df22a042ead4a07083ee0710c91175bd9ffc5987473b62d0d59e91969df181e723c8ecdecfbc0993ff2f3a4809b6452c72ee2b83ed6d7d40b5c04c61f57f04516853a1186d51e9570ea52b12e15abcbe5e78db4c6d9ccccc3e9c3a79153f887578241065eceb8edd2db2ba19370616c2b8b8cec7946281aa2ea0c1bb8f94ddf0a31a455ad81d463fa8e9655d3dc8c373ab0946020a5d3efe0ddba23c13e87a5bd3965f303b85052e2bb6f7bb611ca8fa88a9263b4f99fef854b730ca4d90ddc5d8d03fe1b2608c8be21a75df8143d020f4aa7273572f77f97f1665e39c32c54e966aa54ddc41784eb037fedd2cac6745b3e46a5deb4fe2d8a04ff2a59f2db4dec3c67c2da722a16904139bed32defe18c58aa1ba047f8cb355eb1cb111bf718e7e12ac5fb5441f7822dd7e3f14a1c28ca58dc3cefa9313ab4bd353655289e528b8647a2de3f3bffc568fb25abcd6db62b89626b7ffe732c380982e438343302a242921a9cf88ec701ffba1142eb2b0d13effea739f7b3c8047cd54fca4fb88be6c0ca285e40813cdbdec82b544c73c272df246d1042dc98214584227f6b4abc35281a1bf82e83235091810969c44e877bd3984e79e20be7f9971247b6020433b23593ca93e0c4bb1fdb9e3f6ba1f5599eb6ceabf7706d2a0d65b846752da5a4ded5501850c0cf27ce41690f37437444d1526509761d34782fa9ff584ddcbc879bf3eca391e5480b1b9a46e766e97ef147e368a95789b90ad6f98877de4e5be16eeed567ad49d67b077117dc62b7a0d0411f51ebca0222012720747148f95abe6d62f8f20a1ecaa105ce7c1368dfe6601bafb4adc1e9e575c9682abce9738f085e6a189b4b448511c1f3b0f00550e63314da96daf64e540f939dc35307f26f86a00bab6b471fba595ef010dda01d32cc442b29984a6fb191b2fe9f386ad26d6f94c885def0db9f4a9878b25bfa9c652eaef529676080721536830dd8f20e621737750bbf665855f7a99b2b4537e75e758904481f1109805207be6435b5e8841787f97d74309b1f6ae2f6f42aaf1af535c72b982c13050a44f4731b95f84c040b0819720c904bef96f77ae2889ebd02e5be3d1152c9247fa1fd4882daf5d392ea2a7768f0cba685c6bfd4b5b4d8b494a0ebe357ab67d97262da1e04aa77f083ff4f5fa4072903942027534b33e44e27dc8729321b41326afbec6a9f6f002a15192941259c79cd8cf894f4e6f388029074f560d4c8202839a9cebf169d6245ca63b742de6861fe3ca1811e0f2648da061402f8d62a884f79ed58131a5b053ff054ff9d8fc53e5595d72a164ef426cdea035550254575056bd35c76f6ed59790879fab4922149bd8b3fb0aaf671ee30cffff66b6845d78de1d837dca808bf092637d63d4fbc95c662dfb22802e40bcb5cc175e10f3b5a2507db19af4150da0c404f22c2ac3aaaabfb32fb8127fe38bdd63103a74f17ac73ff19101539a1e2d2bb339e8acc559369a6fa5d4db8090dfe899657b782cf3346bfe06a80b419d35f0f725a4d4870ce343003231d4e233be7a300432c915c6e286896aba2db9b3e832894b4248a82996605cbb81691644bcaa8c9ab1adf6dd185414abcd489007f13f0fe1e79d8199e774c0a8e32751cc48207daae680ba08172b99b031bd3462eb495f38c64707280ee74f6ce8abe3534c0a82ee2b57221e54da1004493e31a3e62290a632473722a74772f6bc2e110588e80a3d27dfa5246957d436abf51838e9e50c0ddecedac6a88453827be294a4fd6442b149dcf4bfa39176b146f16e01ffe99c40c19fe27a0c1ed10a26b42a9b1ba9e4cda48464a35d381f54027986d7bfdb50b557b18152ae0d87649121005afc5526334ce427151667edc5dd6b432cc7d6a0716b624f06d0344b99f586b769ff4625876eae2cb611bcfb6cc8108a25d1d05dcfc566e4133da1d89996920b926cdf5b0f8cc1bca1b3ac61e282419a94125b513745300b73531b88dd3ac0ac231f9e77632ec739d08fdd24868652644871dd144d0fd4cb2ede6828d13efb08258629d8f7cd1b9eac7b929fec716984e9950b2a2fbf49648e959ad61a26858a59bbf8711e7cf9d5965e6aea5cedca7e81e807658a8f211fbd90f8e52f2ea6b794359420dd84de438a9c2916346587818122e31d9184de7be0b3615800b4f7ba7190476bbd5cce32553d5652d0f92379aeaf237e47903299362dae9cb1ba7e9f57eef165c489fd1819f82cc0a2efdb5160549d5322e11b8151ead3d29fde3d11d922c40e17c9cfdbf120cd6cc8574c5abd5db227067501cdf1a8a990ad7d7b3c90891b40e84900f206aa1b25aecfa7831709cfb1c4530c4641994cae26aa832bdf7aa544627a12ada389aafc3b00661b4a9d538896ccc89a2123939bb3275649812eaf659522a7f883935629efad1ae42c1d58dd13521222b243eae0ed6a6c469f630c234394cb8eeb099e1b6ba7b169eb63eaa69acc90c3edd825e2c0e0d20eb99071b07b997564495b87e44e1b0acf91e2b5f62c386a236125c809823b07507a4aefa590857c687212d3635ad8c2fca8c86a01bd8ad11ecf6f86457e0594cafe31e23ad6086bb6d6e18ac3d73024e9a15350f1c66775c3239cf515958dd6bb732d480958d8c5941626a944a61cb52e23481cde1076f2f6b3c3271f914182c03ccb51c75de6fdc6dd2af5479766df171495b0f965ce5eb1600dcbee4cf18bdddb4dbda6f17cafee54dc19a2cfe6e02cbdb8a7131f0c60121d4c67ddeb079f3622ee2e3424b35f6a263c351c7132e5eddab8d9b0e1ea6802b5d512b3cf481eedbd13a049b8c79e67c73f8974bbf666b66779c82e63379123cb8f2104da58aed7465d5f04d83f01d79fd0d30a340e6cdca8d9736f50b2f5edd6e1b3e2b8128b2ab8d1c0c784b5545a93e3132f6ad04e6cbdfd47b1a73da5c4b16a00b68070e5448c8701243fcc91b095dd1f11173627e1784a5901d0983e3ff38f3bd21bd1eac2ec9b475eb25a05a188fd8be7d441c13bc1e473414368e16e57ffbeda3a2724944e022cafadef89e9825c0fa5089894a474228edd52614030bf9bbf8fdad9bdbf70e43494ac352d9e6142f01b0e0b048f1a5428bffba675496327d3d23dbdf09895f2cc275c50259f30e288d4bb10f329173f8632518edf1830b6952988cb81125c8581d1e42de9b9fc04d1fd54b99010ac8b50b53e1e6f199ead63abf2b7522a458708159422ca5f77c20f4ed6eff3975b5494b7cd45c5508f6b111b3d23d1ed1ab7e59d4790624795985a97a8448af65a552de5063ed75c8f6fcd272019dcc4181a52d160021f21106200639e8bbb6eeded1ec56fe77ca2ded960fd3f3e13147f9112869d79bd8c959bece03d1d70811be658ec2082e8dfccd00a8a6e9d0ba3b0713c5b27d5b33a3b06ff0c7945f216511f196ede23c35270c25a7a11c16bbee721d123a90fcd1678ad1cf4e93306c3da13e893b972aba0f765bc12fbeda1471784c23db07a5661b7f336b884d7c3cadf22e9e1c18d5ebf70a6ca4d35ea04d0a478393448a78542189d13d1a57abe3c572d9682723f4ce52fd5fb1ad6506b4051e050474e01a12ba462c98f45c01ae2d8a0ffffecfbccc466db721f40bd9cf5ba73e731ea9f981b8d76f3683ab5be426ed4c64494b8f36a1a215378f6a6e6cda69ae6437833353a6333d2bbe8db7c9120ae1d242bbdc69628e66dd12827d0ed8017064245804149964be61080622825b0efc9dccf378eb931a0c968de8629ce5d287538e1180ac4e0e647cc5b0b926e30f1f61fa835e200cb741cbc107ee8456ec760357142b3346fc99f207ccefe281ef8d955bbd4c7505a1edc778b27a61a06f7de167c37c4202e58d3af383677d30535c4fd75fe33afe796c46f307e641c3ffb2093ebae25a9641e2c92b3c322c34ae8c917f7c3378ac85cf18b92b79ee13b"; + + function setUp() public { verifier = new SLH_DSA_SHA2_128_24_Verifier(); } + + function testPinnedExternalFipsKAT() public view { + assertEq(SIG.length, 3856, "sig length"); + assertTrue(verifier.verify(SEED, ROOT, MSG, SIG), "pinned external-FIPS KAT must verify"); + } + + function testPinnedKATRejectsWrongMessage() public view { + bytes32 wrong = bytes32(uint256(MSG) ^ 1); + (bool ok, bytes memory res) = address(verifier).staticcall( + abi.encodeWithSelector(verifier.verify.selector, SEED, ROOT, wrong, SIG)); + assertTrue(ok && res.length >= 32 && !abi.decode(res, (bool)), "wrong message must not verify"); + } +} diff --git a/test/SphincsC7Test.t.sol b/test/SphincsC7Test.t.sol new file mode 100644 index 0000000..8a1d58a --- /dev/null +++ b/test/SphincsC7Test.t.sol @@ -0,0 +1,38 @@ +// SPDX-License-Identifier: MIT +pragma solidity ^0.8.28; + +import "forge-std/Test.sol"; +import "../src/SPHINCs-C7Asm.sol"; + +contract SphincsC7Test is Test { + SphincsC7Asm verifier; + + function setUp() public { + verifier = new SphincsC7Asm(); + } + + /// @dev End-to-end: a real C7 signature from the Python signer (now on the + /// FIPS 205 uncompressed ADRS + FORS leaf-binding) must verify under + /// the migrated verifier. Proves signer↔verifier byte-agreement. + function testC7VerifyFFI() public { + bytes32 message = 0xdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef; + + string[] memory inputs = new string[](4); + inputs[0] = "python3"; + inputs[1] = "script/signer.py"; + inputs[2] = "c7"; + inputs[3] = "0xdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef"; + + bytes memory result = vm.ffi(inputs); + (bytes32 pkSeed, bytes32 pkRoot, bytes memory sig) = abi.decode(result, (bytes32, bytes32, bytes)); + assertEq(sig.length, 3704, "C7 sig must be 3704 bytes"); + + bool valid = verifier.verify(pkSeed, pkRoot, message, sig); + assertTrue(valid, "C7 signature should be valid"); + + uint256 gasBefore = gasleft(); + verifier.verify(pkSeed, pkRoot, message, sig); + uint256 gasUsed = gasBefore - gasleft(); + emit log_named_uint("C7 verify gas", gasUsed); + } +} diff --git a/test/SphincsFrameAccountC13Test.t.sol b/test/SphincsFrameAccountC13Test.t.sol index 7b7eb75..798764e 100644 --- a/test/SphincsFrameAccountC13Test.t.sol +++ b/test/SphincsFrameAccountC13Test.t.sol @@ -42,16 +42,29 @@ contract SphincsFrameAccountC13Test is Test { } function testFrameVerifyAndApproveRevertsOnBadSignature() public { - bytes32 pkSeed = bytes32(uint256(1)); - bytes32 pkRoot = bytes32(uint256(2)); + // Canonical (top-128-aligned) keys so we exercise the actual bad-SIGNATURE + // path, not the non-canonical-key input guard. + bytes32 pkSeed = bytes32(uint256(1) << 128); + bytes32 pkRoot = bytes32(uint256(2) << 128); SphincsFrameAccount frame = new SphincsFrameAccount(pkSeed, pkRoot, address(verifier), frameOwner); - // 3688 zero bytes — wrong length should already trip the verifier's - // "Invalid sig length" guard. Try the exact length filled with zeros - // (will fail the sum check before any merkle work). + // 3688 zero bytes: correct length, but the FORS+C forced-zero / WOTS+C + // target-sum / root checks all fail. The verifier now RETURNS false for + // these (review C13-evm-f2), so the frame's descriptive require fires. bytes memory zeroSig = new bytes(3688); bytes32 message = bytes32(uint256(0xdead)); - vm.expectRevert(); // verifier reverts on bad sig → outer require fires + vm.expectRevert(bytes("invalid SPHINCS+ signature")); frame.verifyAndApprove(message, zeroSig, 1); } + + function testFrameRevertsOnNonCanonicalKey() public { + // Non-canonical pkSeed (low 128 bits set) now trips the verifier's + // "Invalid public key" guard, surfaced by the frame as "verify call failed". + bytes32 pkSeed = bytes32(uint256(1)); + bytes32 pkRoot = bytes32(uint256(2) << 128); + SphincsFrameAccount frame = new SphincsFrameAccount(pkSeed, pkRoot, address(verifier), frameOwner); + bytes memory zeroSig = new bytes(3688); + vm.expectRevert(bytes("verify call failed")); + frame.verifyAndApprove(bytes32(uint256(0xdead)), zeroSig, 1); + } } diff --git a/verity/SphincsMinusVerifierSpec/C13Concrete.lean b/verity/SphincsMinusVerifierSpec/C13Concrete.lean index 70e27e7..1016d2a 100644 --- a/verity/SphincsMinusVerifierSpec/C13Concrete.lean +++ b/verity/SphincsMinusVerifierSpec/C13Concrete.lean @@ -367,12 +367,10 @@ then: `R`, `seed`, `root` are masked to their high 16 bytes; `message` is a full word. -/ -/-- The H_msg trailing domain-separation word -`0x00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF` -as written by `mstore(0x80, 0xFF…FB...)` — the contract literal has a leading -zero nibble (high nibble 0) followed by 63 `F`'s (i.e. 2^252 - 1). -/ +/-- The H_msg trailing domain-separation word `0xFF…FF` (32 bytes of 0xFF, +i.e. 2^256 - 1) as written by `mstore(0x80, 0xFF…FF)` in the contract. -/ def hMsgPad : Word := - 0x0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF def hMsgC13 (v : Variant) (pk : PublicKey) (R message : Bytes) : HMsg := let digest := @@ -437,6 +435,26 @@ theorem hMsgC13_hyperIndex_div_2048_lt (pk : PublicKey) (R message : Bytes) : have h := hMsgC13_hyperIndex_lt pk R message omega +/-- FIPS 205 field split of the C13 hypertree index: the bottom-subtree index +(`tree` ADRS field). Matches the model's `shr(11, htIdx)`. -/ +def idxTree0C13 (digest : HMsg) : Nat := digest.hyperIndex >>> 11 + +/-- FIPS 205 field split of the C13 hypertree index: the bottom-leaf index +(`keypair` ADRS field). Matches the model's `and(htIdx, 0x7FF)`. -/ +def idxLeaf0C13 (digest : HMsg) : Nat := digest.hyperIndex &&& 0x7FF + +/-- The C13 FORS tree digit is 11-bit (22-bit hypertree index, top half). -/ +theorem idxTree0C13_lt (pk : PublicKey) (R message : Bytes) : + idxTree0C13 (hMsgC13 c13 pk R message) < 2 ^ 11 := by + unfold idxTree0C13 + have h := hMsgC13_hyperIndex_lt pk R message + rw [Nat.shiftRight_eq_div_pow] + omega + +/-- The C13 FORS keypair digit is 11-bit unconditionally (masked). -/ +theorem idxLeaf0C13_lt (digest : HMsg) : idxLeaf0C13 digest < 2 ^ 11 := + lt_of_le_of_lt Nat.and_le_right (by decide) + /-! ### FORS+C reconstruction For each of the K=7 FORS trees: @@ -445,58 +463,123 @@ For each of the K=7 FORS trees: * tree i=6 is forced-zero: `node_6 = th(seed, FORS_TREE adrs (h=0,idx=0), sk_6)`. Then compress: `forsPk = th(seed, FORS_ROOTS adrs, node_0..node_6)`. -FORS leaf ADRS (type=3): `or(shl(96,3), or(shl(64, i), idx))`, with the auth-path -ADRS supplying `shl(32, h+1)` (height) and `parentIdx` (index). layer=tree=0. -/ - -def adrsForsLeaf (i idx : Nat) : Word := (3 <<< 96) ||| (i <<< 64) ||| idx -def adrsForsNode (i h parentIdx : Nat) : Word := - (3 <<< 96) ||| (i <<< 64) ||| ((h + 1) <<< 32) ||| parentIdx -def adrsForsRoots : Word := 4 <<< 96 +FORS leaf ADRS (type=3): `or(forsBase, or(shl(19, i), idx))` where +`forsBase = or(shl(128, idxTree0), or(shl(96, 3), shl(64, idxLeaf0)))`. The +auth-path ADRS supplies `shl(32, h+1)` (height) and +`or(shl(18-h, i), parentIdx)` (tree index folding the k=7 FORS trees into +one 19-bit `word3` per FIPS 205 Alg 17). layer=0 (top of hypertree), +tree=idxTree0, kp=idxLeaf0. -/ + +def adrsForsBase (idxTree0 idxLeaf0 : Nat) : Word := + (idxTree0 <<< 128) ||| (3 <<< 96) ||| (idxLeaf0 <<< 64) + +def adrsForsLeaf (idxTree0 idxLeaf0 i treeIdx : Nat) : Word := + adrsForsBase idxTree0 idxLeaf0 ||| (i <<< 19) ||| treeIdx + +def adrsForsNode (idxTree0 idxLeaf0 i h parentIdx : Nat) : Word := + adrsForsBase idxTree0 idxLeaf0 + ||| ((h + 1) <<< 32) + ||| (i <<< (18 - h)) + ||| parentIdx + +def adrsForsRoots (idxTree0 idxLeaf0 : Nat) : Word := + (idxTree0 <<< 128) ||| (4 <<< 96) ||| (idxLeaf0 <<< 64) + +/-- Central factoring lemma: every FORS leaf address is built from the base. + This replaces the previous 20+ adrsForsLeaf_*_eq + manual bit-mask lemmas. -/ +theorem adrsForsLeaf_eq_of_forsBase + (idxTree0 idxLeaf0 i treeIdx : Nat) : + adrsForsLeaf idxTree0 idxLeaf0 i treeIdx + = adrsForsBase idxTree0 idxLeaf0 ||| (i <<< 19) ||| treeIdx := by + rfl /-- C13 FORS-roots compression address, named with the digest so bridge lemmas can track the FIPS-hardened address dependency at the spec boundary. In the current C13 executable model this is the constant `FORS_ROOTS` word. -/ -def adrsForsRootsC13 (_digest : HMsg) : Word := adrsForsRoots +def adrsForsRootsC13 (digest : HMsg) : Word := + adrsForsRoots (idxTree0C13 digest) (idxLeaf0C13 digest) + +/-- `adrsForsBase` is a bounded 192-bit word (well below 2^256) when +`idxTree0 < 2^64` and `idxLeaf0 < 2^32` (the maximum the FIPS 205 §11.2.2 +32-byte ADRS ever needs: 12-byte tree field + 4-byte kp). This is the +*only* place the bit-disjointness reasoning for the `adrsForsBase` summand +lives; the leaf / node corollaries call it. Returning `< 2^192` (not the +more permissive `< 2^256`) leaves room for the leaf / node OR to chain +`Nat.bitwise_lt_two_pow` without re-introducing the bit-disjointness +reasoning at every call site. -/ +theorem adrsForsBase_lt_of_bounds + {idxTree0 idxLeaf0 : Nat} + (hT : idxTree0 < 2 ^ 64) (hL : idxLeaf0 < 2 ^ 32) : + adrsForsBase idxTree0 idxLeaf0 < 2 ^ 192 := by + unfold adrsForsBase + -- adrsForsBase = (idxTree0 <<< 128) ||| (3 <<< 96) ||| (idxLeaf0 <<< 64). + -- First OR: (idxTree0 <<< 128) ||| (3 <<< 96) < 2^192 (both summands < 2^192). + have hShiftT : (idxTree0 : Nat) <<< 128 < 2 ^ 192 := by + rw [Nat.shiftLeft_eq] + exact lt_of_lt_of_le (Nat.mul_lt_mul_of_pos_right hT (by decide : (0:ℕ) < 2^128)) + (by simpa [Nat.pow_add] using Nat.le_refl _) + have h3 : (3 : Nat) <<< 96 < 2 ^ 192 := by + rw [Nat.shiftLeft_eq]; decide + have h1 : (idxTree0 : Nat) <<< 128 ||| (3 <<< 96) < 2 ^ 192 := + Nat.bitwise_lt_two_pow hShiftT h3 (f := or) + have hShiftL : (idxLeaf0 : Nat) <<< 64 < 2 ^ 96 := by + rw [Nat.shiftLeft_eq] + exact lt_of_lt_of_le (Nat.mul_lt_mul_of_pos_right hL (by decide : (0:ℕ) < 2^64)) + (by simpa [Nat.pow_add] using Nat.le_refl _) + have h2 : (idxLeaf0 : Nat) <<< 64 < 2 ^ 192 := lt_trans hShiftL (by decide : 2^96 < 2^192) + exact Nat.bitwise_lt_two_pow h1 h2 (f := or) /-- The concrete FORS leaf address word is a bounded EVM word for the six normal -FORS roots when the decoded tree index is 19-bit. -/ +FORS roots when the decoded tree index is 19-bit. Bounds on `idxTree0` / +`idxLeaf0` are passed as hypotheses; specialized corollaries (e.g. for the +C13 hypertree-leaf case) live next to `hMsgC13`. -/ theorem adrsForsLeaf_lt_of_normal_idx_lt - {i idx : Nat} (hi : i < 6) (hidx : idx < 2 ^ 19) : - adrsForsLeaf i idx < 2 ^ 256 := by + {idxTree0 idxLeaf0 i idx : Nat} + (hT : idxTree0 < 2 ^ 64) (hL : idxLeaf0 < 2 ^ 32) + (hi : i < 6) (hidx : idx < 2 ^ 19) : + adrsForsLeaf idxTree0 idxLeaf0 i idx < 2 ^ 256 := by unfold adrsForsLeaf - refine Nat.bitwise_lt_two_pow (Nat.bitwise_lt_two_pow ?_ ?_) ?_ - · rw [Nat.shiftLeft_eq] - decide - · rw [Nat.shiftLeft_eq] - calc - i * 2 ^ 64 ≤ 5 * 2 ^ 64 := - Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hi) - _ < 2 ^ 256 := by decide - · exact lt_trans hidx (by decide : 2 ^ 19 < 2 ^ 256) + -- adrsForsLeaf = adrsForsBase ||| (i <<< 19) ||| idx. + have hBase : adrsForsBase idxTree0 idxLeaf0 < 2 ^ 192 := adrsForsBase_lt_of_bounds hT hL + have hShiftI : (i : Nat) <<< 19 < 2 ^ 192 := by + rw [Nat.shiftLeft_eq] + calc i * 2 ^ 19 ≤ 5 * 2 ^ 19 := Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hi) + _ < 2 ^ 192 := by decide + have h1 : adrsForsBase idxTree0 idxLeaf0 ||| (i <<< 19) < 2 ^ 192 := + Nat.bitwise_lt_two_pow hBase hShiftI (f := or) + have hShiftIdx : idx < 2 ^ 192 := lt_trans hidx (by decide : 2^19 < 2^192) + have h2 : (adrsForsBase idxTree0 idxLeaf0 ||| (i <<< 19)) ||| idx < 2 ^ 192 := + Nat.bitwise_lt_two_pow h1 hShiftIdx (f := or) + exact lt_trans h2 (by decide : 2^192 < 2^256) /-- Specialization of `adrsForsLeaf_lt_of_normal_idx_lt` to the normal-root -indices inside concrete C13 `H_msg`. -/ +indices inside concrete C13 `H_msg`. The FIPS digits derived from the C13 +hypertree index are 11-bit, well inside the `2^64`/`2^32` field bounds. -/ theorem adrsForsLeaf_hMsgC13_normal_lt (pk : PublicKey) (R message : Bytes) {j : Nat} (hj : j < 6) : - adrsForsLeaf j (((hMsgC13 c13 pk R message).forsIndex[j]?).getD 0) < 2 ^ 256 := - adrsForsLeaf_lt_of_normal_idx_lt hj - (hMsgC13_forsIndex_getD_lt pk R message (lt_trans hj (by decide : 6 < 7))) + adrsForsLeaf (idxTree0C13 (hMsgC13 c13 pk R message)) + (idxLeaf0C13 (hMsgC13 c13 pk R message)) + j (((hMsgC13 c13 pk R message).forsIndex[j]?).getD 0) < 2 ^ 256 := + adrsForsLeaf_lt_of_normal_idx_lt + (lt_trans (idxTree0C13_lt pk R message) (by decide : (2:Nat) ^ 11 < 2 ^ 64)) + (lt_trans (idxLeaf0C13_lt _) (by decide : (2:Nat) ^ 11 < 2 ^ 32)) + hj (hMsgC13_forsIndex_getD_lt pk R message (lt_trans hj (by decide : 6 < 7))) /-- Climb one FORS auth path (A=19) using fuel-bounded recursion. Mirrors the contract's branchless swap: when `pathIdx` is even, `node` is the left child; when odd, the right child. -/ -def forsClimb (seed i : Word) (fuel : Nat) (h : Nat) (pathIdx : Nat) - (node : Word) (auth : List Bytes) : Word := +def forsClimb (seed i : Word) (idxTree0 idxLeaf0 : Nat) (fuel : Nat) (h : Nat) + (pathIdx : Nat) (node : Word) (auth : List Bytes) : Word := match fuel with | 0 => node | fuel + 1 => let sibling := wordOfHash16 ((auth[h]?).getD ⟨#[]⟩) let parentIdx := pathIdx / 2 - let adrs := adrsForsNode i h parentIdx + let adrs := adrsForsNode idxTree0 idxLeaf0 i h parentIdx let node' := if pathIdx % 2 == 0 then maskN (keccakWords [seed, adrs, node, sibling]) else maskN (keccakWords [seed, adrs, sibling, node]) - forsClimb seed i fuel (h + 1) parentIdx node' auth + forsClimb seed i idxTree0 idxLeaf0 fuel (h + 1) parentIdx node' auth def forsPkFromSigC13 (v : Variant) (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : Option Bytes := @@ -505,11 +588,11 @@ def forsPkFromSigC13 (v : Variant) (pk : PublicKey) (digest : HMsg) let roots := (List.range 6).map (fun i => let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) -- forced-zero tree i = 6 let sk6 := wordOfHash16 ((fors.sk[6]?).getD ⟨#[]⟩) - let root6 := maskN (keccakWords [seed, adrsForsLeaf 6 0, sk6]) + let root6 := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) 6 0, sk6]) let allRoots := roots ++ [root6] let forsPk := maskN (keccakWords (seed :: adrsForsRootsC13 digest :: allRoots)) some (hash16OfWord forsPk) @@ -522,19 +605,19 @@ def forsNormalRootsC13 (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : List (List.range 6).map (fun i => let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) /-- The forced-zero seventh FORS root used by C13. -/ -def forsForcedRootC13 (pk : PublicKey) (fors : ForsSig) : Word := +def forsForcedRootC13 (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : Word := let seed := wordOfHash16 pk.pkSeed let sk6 := wordOfHash16 ((fors.sk[6]?).getD ⟨#[]⟩) - maskN (keccakWords [seed, adrsForsLeaf 6 0, sk6]) + maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) 6 0, sk6]) /-- All seven FORS roots in the exact order consumed by C13's FORS public-key compression. -/ def forsAllRootsC13 (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : List Word := - forsNormalRootsC13 pk digest fors ++ [forsForcedRootC13 pk fors] + forsNormalRootsC13 pk digest fors ++ [forsForcedRootC13 pk digest fors] /-- The masked C13 FORS public-key compression word. -/ def forsPkWordC13 (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : Word := @@ -557,8 +640,8 @@ theorem forsNormalRootsC13_getElem? (let seed := wordOfHash16 pk.pkSeed let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by unfold forsNormalRootsC13 exact getElem?_map_range _ hi @@ -572,8 +655,8 @@ theorem forsNormalRootsC13_getElem (let seed := wordOfHash16 pk.pkSeed let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by unfold forsNormalRootsC13 exact getElem_map_range _ hi @@ -587,8 +670,8 @@ theorem forsAllRootsC13_getElem?_normal (let seed := wordOfHash16 pk.pkSeed let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by unfold forsAllRootsC13 rw [List.getElem?_append_left] · exact forsNormalRootsC13_getElem? pk digest fors hi @@ -598,7 +681,7 @@ theorem forsAllRootsC13_getElem?_normal /-- The seventh C13 FORS root is exactly the forced-zero root. -/ theorem forsAllRootsC13_getElem?_forced (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : - (forsAllRootsC13 pk digest fors)[6]? = some (forsForcedRootC13 pk fors) := by + (forsAllRootsC13 pk digest fors)[6]? = some (forsForcedRootC13 pk digest fors) := by unfold forsAllRootsC13 forsNormalRootsC13 simp @@ -612,8 +695,8 @@ theorem forsAllRootsC13_getElem_normal (let seed := wordOfHash16 pk.pkSeed let treeIdx := (digest.forsIndex[i]?).getD 0 let sk := wordOfHash16 ((fors.sk[i]?).getD ⟨#[]⟩) - let leaf := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk]) - forsClimb seed i 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by + let leaf := maskN (keccakWords [seed, adrsForsLeaf (idxTree0C13 digest) (idxLeaf0C13 digest) i treeIdx, sk]) + forsClimb seed i (idxTree0C13 digest) (idxLeaf0C13 digest) 19 0 treeIdx leaf ((fors.authPath[i]?).getD [])) := by have hidx : i < (forsAllRootsC13 pk digest fors).length := by rw [forsAllRootsC13_length] omega @@ -626,7 +709,7 @@ theorem forsAllRootsC13_getElem_forced (pk : PublicKey) (digest : HMsg) (fors : ForsSig) : (forsAllRootsC13 pk digest fors)[6]'(by rw [forsAllRootsC13_length] - omega) = forsForcedRootC13 pk fors := by + omega) = forsForcedRootC13 pk digest fors := by have hidx : 6 < (forsAllRootsC13 pk digest fors).length := by rw [forsAllRootsC13_length] omega diff --git a/verity/SphincsMinusVerifiers/AXIOMS.md b/verity/SphincsMinusVerifiers/AXIOMS.md index ceabdf1..797e0b2 100644 --- a/verity/SphincsMinusVerifiers/AXIOMS.md +++ b/verity/SphincsMinusVerifiers/AXIOMS.md @@ -75,19 +75,25 @@ The 4 primary residual axioms (all in `Proofs.lean`): seeding layer 4. All downstream C12 layer-4 residuals are already derived as theorems from this single axiom (`C12BridgePrep`). -Supporting single-cell bridge axioms (also `Proofs.lean`, same blocker — framing -equalities between two `SegmentLayer3`-derived states): - -- `c13_beforeWotsPk_memory_zero_eq_lightweight` (cell `0x00`) -- `c13_beforeWotsPk_memory_0x20_eq_lightweight` (cell `0x20`) -- `c13_beforeWotsPk_memory_chain_eq_lightweight` (cells `0x40 + 32*j`) - -Mirror axiom (generic content already proven, kept as axiom only because flipping it -is an uncompilable-here `Proofs.lean` edit — prime first discharge on the big-machine -pass, proof is a one-line `exact`): - -- `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0` - ← `c13Layer0_copyFold43_wotsChainsEnd_cells_of_inputs` (C13WotsPkKeccak.lean). +Discharged 2026-06-11 (now theorems in `Proofs.lean`, no big machine needed): + +- `c13_beforeWotsPk_memory_zero_eq_lightweight` (cell `0x00`) and + `c13_beforeWotsPk_memory_0x20_eq_lightweight` (cell `0x20`): via + `c13_beforeWotsPk_eq_beforeWotsPkFrom` — the historical and lightweight + cutpoints run the *same* suffix statement list from `afterDigit ls`, so the + states are equal and the cell framings are rewrites. +- `c13_beforeWotsPk_memory_chain_eq_lightweight` (cells `0x40 + 32*j`): via the + `beforeWotsPkAfterWotsCopyFrom` factoring (`c13_beforeWotsPkFrom_eq_afterWotsCopy`), + `copyFold43_copied_slot` / `c13_copyLoop_preserves_out_slot`, and the + address-store frame `c13_addressStore_preserves_cell`. Elaboration discipline: + assembled with `congrArg`/`trans` only; the copy fold enters via `rw [← he]` + so its start state is never restated (any defeq between two spellings of a + fold start state whnf-unfolds the fold); `StmtResult.continue.inj` instead of + the `injection` tactic. +- `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0`: via the + verified `c13Layer0_copyFold43_wotsChainsEnd_cells_of_entry` + (`C13WotsPkKeccak.lean`), with the Entry record obtained from the inputs record + at `j = 0` through `ClimbLoop.foldLoop_zero`. ## Current Standalone Lemma Footprints diff --git a/verity/SphincsMinusVerifiers/BindingFrame.lean b/verity/SphincsMinusVerifiers/BindingFrame.lean index 95e919c..0bd751b 100644 --- a/verity/SphincsMinusVerifiers/BindingFrame.lean +++ b/verity/SphincsMinusVerifiers/BindingFrame.lean @@ -19,7 +19,10 @@ -/ import SphincsMinusVerifiers.ClimbLoop -import Compiler.Proofs.Frames +-- `Compiler.Proofs.Frames` is intentionally not imported: all preserves_* +-- lemmas below are proved locally and stay independent of upstream PR #1983 +-- even after its merge. Re-import only if a specific lemma name needs to +-- be shared with another workspace. namespace SphincsMinusVerifiers.BindingFrame diff --git a/verity/SphincsMinusVerifiers/C13BridgePrep.lean b/verity/SphincsMinusVerifiers/C13BridgePrep.lean index 8319f4e..6fb8cae 100644 --- a/verity/SphincsMinusVerifiers/C13BridgePrep.lean +++ b/verity/SphincsMinusVerifiers/C13BridgePrep.lean @@ -119,22 +119,37 @@ theorem runC13BodyObserved_accept_from_fold_ok_current_nodes (C13Concrete.c13PrimitivesConcrete.hMsg c13 { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot) + (hGuard0 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent0 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = + C13Concrete.wordOfHash16 + (SegmentAcceptSpec.c13HypertreeSpecStepAtLayer + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.layers 0 forsPk)) + (hGuard1 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent1 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = C13Concrete.wordOfHash16 specRoot) (hPkRootSize : pkRoot.size = 16) : runC13BodyObserved pkSeed pkRoot message sig = ByteLevel.verifyBytes c13Primitives c13 pkSeed pkRoot message sig := by - -- Both halves discharged without executable layer obligation parameters: - -- guards via digitSum data facts (from hFold + wotsGrinding false); currentNodes via hauth + frozen cd data suppliers (cutpoints + model climb). - let pk := { pkSeed := pkSeed, pkRoot := pkRoot } - let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message - let d := C13Concrete.foldHypertree_c13_ok_two_layer_data pk digest forsPk specRoot sigParsed.layers hFold - have hDigitSum0 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState0 (mkC13State pkSeed pkRoot message sig))).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig0.wots (by simpa using d.hGrinding0) - have hGuard0 := layer0_guard_discharged (CurrentNodeFrame.c13LayerLoopState0 (mkC13State pkSeed pkRoot message sig)) hDigitSum0 - have hCurrent0 := layer0_currentNode_discharged pkSeed pkRoot message sig sigParsed forsPk (CurrentNodeFrame.c13LayerLoopState0 (mkC13State pkSeed pkRoot message sig)) hParse - have hDigitSum1 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState1 (mkC13State pkSeed pkRoot message sig))).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig1.wots (by simpa using d.hGrinding1) - have hGuard1 := layer1_guard_discharged (CurrentNodeFrame.c13LayerLoopState1 (mkC13State pkSeed pkRoot message sig)) hDigitSum1 - have hCurrent1 := layer1_currentNode_discharged pkSeed pkRoot message sig sigParsed specRoot (CurrentNodeFrame.c13LayerLoopState1 (mkC13State pkSeed pkRoot message sig)) hParse exact runC13BodyObserved_accept_from_concrete_layer_current_node_two_step_obligations pkSeed pkRoot message sig sigParsed forsPk specRoot @@ -166,6 +181,34 @@ theorem runC13BodyObserved_accept_from_fold_ok_current_nodes_wordcmp (C13Concrete.c13PrimitivesConcrete.hMsg c13 { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot) + (hGuard0 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent0 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = + C13Concrete.wordOfHash16 + (SegmentAcceptSpec.c13HypertreeSpecStepAtLayer + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.layers 0 forsPk)) + (hGuard1 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent1 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = C13Concrete.wordOfHash16 specRoot) (hWordCmp : decide (C13Concrete.wordOfHash16 specRoot = C13Concrete.wordOfHash16 pkRoot) = rootMatchesPk c13 specRoot pkRoot) : @@ -177,18 +220,6 @@ theorem runC13BodyObserved_accept_from_fold_ok_current_nodes_wordcmp let specStep := SegmentAcceptSpec.c13HypertreeSpecStepAtLayer pk digest sigParsed.layers have hTwo : wordNormalize 2 = 2 := by exact SegmentS2.wordNormalize_of_lt (by decide : 2 < 2 ^ 256) - - -- Both halves discharged without executable layer obligation parameters (wordcmp variant). - let d := C13Concrete.foldHypertree_c13_ok_two_layer_data pk digest forsPk specRoot sigParsed.layers hFold - have hDigitSum0 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState0 st)).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig0.wots (by simpa using d.hGrinding0) - have hGuard0 := layer0_guard_discharged (CurrentNodeFrame.c13LayerLoopState0 st) hDigitSum0 - have hCurrent0 := layer0_currentNode_discharged pkSeed pkRoot message sig sigParsed forsPk (CurrentNodeFrame.c13LayerLoopState0 st) hParse - have hDigitSum1 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState1 st)).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig1.wots (by simpa using d.hGrinding1) - have hGuard1 := layer1_guard_discharged (CurrentNodeFrame.c13LayerLoopState1 st) hDigitSum1 - have hCurrent1 := layer1_currentNode_discharged pkSeed pkRoot message sig sigParsed specRoot (CurrentNodeFrame.c13LayerLoopState1 st) hParse - have hgL : ClimbLoopGuarded.allGuardsPass "layer" SegmentLayer3.stepLayer SegmentLayer3.layerGuard { (afterSeed st) with @@ -216,12 +247,32 @@ theorem runC13BodyObserved_accept_from_fold_ok_current_nodes_wordcmp C13Concrete.wordOfHash16 forsPk := by rw [hForsPkByte] exact (SegmentAcceptSpec.forsPkWordC13_roundtrip pk digest sigParsed.fors).symm + have hTd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hLd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTltd : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message have hForsCompress : CurrentNodeFrame.forsPkCompressWord (afterFors st) = C13Concrete.wordOfHash16 forsPk := by rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_concrete_mkC13State_six_plus_last pkSeed pkRoot message sig digest (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors)] + (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hTd hTltd hLd] · simpa [pk, digest, C13Concrete.forsPkWordC13] using hForsPkWord · intro j hj simpa [pk, digest] using hRoots.1 j hj @@ -521,65 +572,3 @@ theorem runC13BodyObserved_revert_on_forced_zero_false_of_parse #print axioms runC13BodyObserved_revert_on_forced_zero_false_of_parse end SphincsMinusVerifiers.C13BridgePrep - - -theorem layer0_guard_discharged - (st : RuntimeState) - (hDigitSum0 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState0 st)).bindings "digitSum" = 208) : - SegmentLayer3.layerGuard (CurrentNodeFrame.c13LayerLoopState0 st) = true := by - exact SegmentLayer3.layerGuard_of_afterDigit_digitSum_eq (CurrentNodeFrame.c13LayerLoopState0 st) hDigitSum0 - -theorem layer1_guard_discharged - (st : RuntimeState) - (hDigitSum1 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState1 st)).bindings "digitSum" = 208) : - SegmentLayer3.layerGuard (CurrentNodeFrame.c13LayerLoopState1 st) = true := by - exact SegmentLayer3.layerGuard_of_afterDigit_digitSum_eq (CurrentNodeFrame.c13LayerLoopState1 st) hDigitSum1 - - --- Reduction for per-layer currentNode obligations (symmetric to guards). --- stepLayer_currentNode_eq_merkleNode (in SegmentLayer3) + layer merkle climb --- data supplier (auth-path siblings from frozen sig at layer offsets via hauth + --- merkleClimbData_of_frozenCalldata) wires the climbed merkleNode to the spec --- layer root piece from c13HypertreeSpecStepAtLayer or foldHypertree. --- CurrentNodeFrame / beforeMerkle_* / SegmentLayer3MerkleFrame cutpoints exist for this. - -theorem layer0_currentNode_discharged - (pkSeed pkRoot message sig : ByteArray) - (sigParsed : Signature) - (forsPk : ByteArray) - (st : RuntimeState) - (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : -- hClimbData0 wired inside from hauth + frozen cd reads at layer auth offsets - lookupValue (SegmentLayer3.stepLayer (CurrentNodeFrame.c13LayerLoopState0 st)).bindings "currentNode" - = C13Concrete.wordOfHash16 (SegmentAcceptSpec.c13HypertreeSpecStepAtLayer { pkSeed := pkSeed, pkRoot := pkRoot } (C13Concrete.c13PrimitivesConcrete.hMsg c13 { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) sigParsed.layers 0 forsPk) := by - have hEq := SegmentLayer3.stepLayer_currentNode_eq_merkleNode (CurrentNodeFrame.c13LayerLoopState0 st) - -- Full wiring of data supplier (hauth + frozen calldata reads for the specific layer auth-path offsets 1952 + 868*0 + 692 + 16*h): cutpoints (beforeMerkle, LayerFrozenSite, layer_eval_facts_of_c13_frozen_calldata, afterMerkle_model_node_raw_c13, parseSignatureC13_layer_authPath_getElem?, merkleClimbData_of_frozenCalldata) make this mechanical, same as inner climbs in C12. Then tie via stepLayer_merkleNode_eq_wordOfHash16_root_of_xmssClimb_wots_success + c13HypertreeSpecStepAtLayer. - sorry -- the model climb + wots/xmss success from hFold data - -theorem layer1_currentNode_discharged - (pkSeed pkRoot message sig : ByteArray) - (sigParsed : Signature) - (specRoot : ByteArray) - (st : RuntimeState) - (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : -- hClimbData1 wired inside from hauth + frozen cd reads at layer auth offsets (1952 + 868*1 + 692 + 16*h); chains from layer0 - lookupValue (SegmentLayer3.stepLayer (CurrentNodeFrame.c13LayerLoopState1 st)).bindings "currentNode" - = C13Concrete.wordOfHash16 specRoot := by - have hEq := SegmentLayer3.stepLayer_currentNode_eq_merkleNode (CurrentNodeFrame.c13LayerLoopState1 st) - -- Full wiring (identical structure to layer0, using layer 1 offsets and root0 as "forsPk" for the step). - have hL1 : sigParsed.layers[1]? = some (sigParsed.layers[1]'(by simp [C13Concrete.parseSignatureC13_shape hParse]; decide)) := by - simp [C13Concrete.parseSignatureC13_shape hParse] - let lsig1 := (sigParsed.layers[1]? |>.getD default) - let auth1 := lsig1.authPath - let cdAt1 := fun (i : Nat) => C13Concrete.read16 sig (1952 + 868 * 1 + 692 + 16 * i) - have hD1 : ∀ i, i < 11 → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth1 cdAt1 i := by - intro i hi - have hauth := C13Concrete.parseSignatureC13_layer_authPath_getElem? (v := c13) hL1 hi - refine SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleClimbData_of_frozenCalldata pkSeed pkRoot message sig auth1 cdAt1 i (1952 + 868*1 + 692 + 16*i) (by omega) ?_ - rw [hauth] - rfl - have hModel : lookupValue (SegmentLayer3.stepLayer (CurrentNodeFrame.c13LayerLoopState1 st)).bindings "merkleNode" = C13Concrete.xmssClimb (C13Concrete.wordOfHash16 pkSeed) (C13Concrete.adrsXmssTree 1 (by sorry)) 11 0 (by sorry) (by sorry) auth1 := by - apply SegmentAcceptSpec.afterMerkle_model_node_raw_c13 - · intro s a idx hcd hrel; exact (by sorry) - · intro i hi; exact hD1 i hi - · exact (by sorry) - rw [hEq] - exact (by sorry) diff --git a/verity/SphincsMinusVerifiers/ClimbKeccakStep.lean b/verity/SphincsMinusVerifiers/ClimbKeccakStep.lean index 750251c..96104d4 100644 --- a/verity/SphincsMinusVerifiers/ClimbKeccakStep.lean +++ b/verity/SphincsMinusVerifiers/ClimbKeccakStep.lean @@ -229,6 +229,26 @@ theorem evalExpr_add_bounded have hmod : Verity.Core.Uint256.modulus = 2 ^ 256 := rfl rw [hkv, hlv, hmod, Nat.mod_eq_of_lt hsum] +/-- `sub(a, b)` evaluates to `k - l` when `a ↦ k`, `b ↦ l` with both `< 2^256` +and `l ≤ k` (no wrap): the interpreter's `Uint256.sub` reduces mod `2^256`, the +operand mods vanish, and `k - l ≤ k < 2^256` kills the outer mod. Needed for +the FIPS FORS per-level shift amount `sub(18, h)` (`ClimbKit.forsAdrs`). -/ +theorem evalExpr_sub_bounded + (st : RuntimeState) (a b : Expr) (k l : Nat) + (ha : evalExpr [] st a = some k) (hb : evalExpr [] st b = some l) + (hk : k < 2 ^ 256) (hl : l < 2 ^ 256) (hle : l ≤ k) : + evalExpr [] st (.sub a b) = some (k - l) := by + show (do + let lhs : Verity.Core.Uint256 := ← evalExpr [] st a + let rhs : Verity.Core.Uint256 := ← evalExpr [] st b + pure (lhs - rhs).val) = some (k - l) + rw [ha, hb] + show some ((Verity.Core.Uint256.ofNat k - Verity.Core.Uint256.ofNat l).val) + = some (k - l) + have hkv : (Verity.Core.Uint256.ofNat k).val = k := Nat.mod_eq_of_lt hk + have hlv : (Verity.Core.Uint256.ofNat l).val = l := Nat.mod_eq_of_lt hl + rw [Verity.Core.Uint256.sub_eq_of_le (by rw [hkv, hlv]; exact hle), hkv, hlv] + /-! ## 5. The composed ADRS-word resolution. The merkle/FORS climb body assembles the per-step ADRS word as the interpreter @@ -342,6 +362,7 @@ theorem evalExpr_siblingOffset #print axioms evalExpr_shl_bounded #print axioms evalExpr_shr_bounded #print axioms evalExpr_add_bounded +#print axioms evalExpr_sub_bounded #print axioms evalExpr_merkleAdrsWord #print axioms evalExpr_maskedCalldata #print axioms evalExpr_siblingOffset diff --git a/verity/SphincsMinusVerifiers/ClimbKit.lean b/verity/SphincsMinusVerifiers/ClimbKit.lean index bd6c446..20df0cb 100644 --- a/verity/SphincsMinusVerifiers/ClimbKit.lean +++ b/verity/SphincsMinusVerifiers/ClimbKit.lean @@ -42,6 +42,7 @@ private def addE (a b : Expr) : Expr := .add a b private def andE (a b : Expr) : Expr := .bitAnd a b private def orE (a b : Expr) : Expr := .bitOr a b private def xorE (a b : Expr) : Expr := .bitXor a b +private def subE (a b : Expr) : Expr := .sub a b private def shlE (a b : Expr) : Expr := .shl a b private def shrE (a b : Expr) : Expr := .shr a b private def keccak (off size : Nat) : Expr := .keccak256 (u off) (u size) @@ -246,6 +247,162 @@ theorem merkleClimbStep -- empty tail: execStmtList [] _ [] = .continue _, and the `match` reduces rfl +/-! ## 2b. Address-parametric Merkle climb (FIPS FORS support) + +The FIPS 205 C13 FORS node address carries a per-iteration `i <<< (18 - h)` +term that the XMSS tree address does not have, so the two climbs can no +longer share a body parametric only in *variable names*. Instead we make +the body parametric in the whole ADRS word **expression** written to `0x20` +(statement 3). The classic 4-name `merkleClimbBody` above is definitionally +the `xmssAdrs` instantiation (`merkleClimbBody_eq_adrs`), so nothing on the +XMSS side needs re-proving. -/ + +/-- Merkle climb body parametric in the full ADRS word expression. `adrsE` +may freely reference the loop variable `"h"`, the body-local `"parentIdx"`, +and any outer bindings (e.g. `"i"`, `"forsBase"`, a tree-address base var) — +they are plain `localVar` lookups at eval time. -/ +def merkleClimbBodyA (nodeVar idxVar authPtrVar : String) (adrsE : Expr) : List Stmt := [ + .letVar "sibling" + (andE (cdload (addE (v authPtrVar) (shlE (u 4) (v "h")))) (u N_MASK)), + .letVar "parentIdx" (shrE (u 1) (v idxVar)), + mstore 0x20 adrsE, + .letVar "s" (shlE (u 5) (andE (v idxVar) (u 1))), + mstoreE (xorE (u 0x40) (v "s")) (v nodeVar), + mstoreE (xorE (u 0x60) (v "s")) (v "sibling"), + .assignVar nodeVar (andE (keccak 0x00 0x80) (u N_MASK)), + .assignVar idxVar (v "parentIdx") +] + +/-- XMSS / pre-FIPS ADRS word: `base ||| ((h+1) <<< 32) ||| parentIdx`. -/ +def xmssAdrs (adrsBaseVar : String) : Expr := + .bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx")) + +/-- FIPS 205 C13 FORS ADRS word: +`forsBase ||| ((h+1) <<< 32) ||| (i <<< (18-h)) ||| parentIdx` — +character-for-character the `mstore 0x20` operand of the FORS inner climb in +`Model.lean` and the Yul +`or(forsBase, or(shl(32, add(h,1)), or(shl(sub(18,h), i), parentIdx)))`. -/ +def forsAdrs : Expr := + .bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.bitOr (.shl (.sub (.literal 18) (.localVar "h")) (.localVar "i")) + (.localVar "parentIdx"))) + +/-- The classic 4-name body is exactly the XMSS instantiation. -/ +theorem merkleClimbBody_eq_adrs (nodeVar idxVar adrsBaseVar authPtrVar : String) : + merkleClimbBody nodeVar idxVar adrsBaseVar authPtrVar + = merkleClimbBodyA nodeVar idxVar authPtrVar (xmssAdrs adrsBaseVar) := rfl + +/-- Pure state transformer for one address-parametric climb iteration. +Same projection construction as `stepMerkle`. -/ +def stepMerkleA (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) : RuntimeState := + match execStmtList [] st (merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) with + | .continue s' => s' + | _ => st + +/-- The classic 4-name transformer is exactly the XMSS instantiation. -/ +theorem stepMerkle_eq_adrs + (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) : + stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st + = stepMerkleA nodeVar idxVar authPtrVar (xmssAdrs adrsBaseVar) st := rfl + +/-- A deterministic evaluator witness for `adrsE`: a total function giving the +resolved value in every state. Carrying the function (rather than an +existential) keeps the shape lemma's per-statement `rw` steps choice-free, so +the `#print axioms` audit stays at `propext`-level. -/ +structure AdrsEval (adrsE : Expr) where + val : RuntimeState → Nat + eval : ∀ st : RuntimeState, evalExpr [] st adrsE = some (val st) + +/-- The XMSS address word always resolves (every operand is a literal, +local-var lookup, or arithmetic on those — `evalExpr` is total there). -/ +def adrsEval_xmss (adrsBaseVar : String) : AdrsEval (xmssAdrs adrsBaseVar) := + ⟨fun st => (evalExpr [] st (xmssAdrs adrsBaseVar)).getD 0, fun _ => rfl⟩ + +/-- The FIPS FORS address word always resolves (same totality argument; the +extra `.sub`/`.shl` operands are total too). -/ +def adrsEval_fors : AdrsEval forsAdrs := + ⟨fun st => (evalExpr [] st forsAdrs).getD 0, fun _ => rfl⟩ + +set_option maxHeartbeats 2000000 in +/-- **`merkleClimbStepA`** — address-parametric branchless-Merkle-climb shape +lemma. Identical to `merkleClimbStep` except statement 3's operand is the +caller-supplied `adrsE`, discharged by the `AdrsEval` witness instead of +`rfl`. -/ +theorem merkleClimbStepA + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (he : AdrsEval adrsE) + (st : RuntimeState) : + execStmtList [] st (merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) + = .continue (stepMerkleA nodeVar idxVar authPtrVar adrsE st) := by + unfold stepMerkleA + show execStmtList [] st + ([ .letVar "sibling" + (andE (cdload (addE (v authPtrVar) (shlE (u 4) (v "h")))) (u N_MASK)) + , .letVar "parentIdx" (shrE (u 1) (v idxVar)) + , Stmt.mstore (u 0x20) adrsE + , .letVar "s" (shlE (u 5) (andE (v idxVar) (u 1))) + , Stmt.mstore (xorE (u 0x40) (v "s")) (v nodeVar) + , Stmt.mstore (xorE (u 0x60) (v "s")) (v "sibling") + , .assignVar nodeVar (andE (keccak 0x00 0x80) (u N_MASK)) + , .assignVar idxVar (v "parentIdx") ]) + = .continue + (match execStmtList [] st + ([ .letVar "sibling" + (andE (cdload (addE (v authPtrVar) (shlE (u 4) (v "h")))) (u N_MASK)) + , .letVar "parentIdx" (shrE (u 1) (v idxVar)) + , Stmt.mstore (u 0x20) adrsE + , .letVar "s" (shlE (u 5) (andE (v idxVar) (u 1))) + , Stmt.mstore (xorE (u 0x40) (v "s")) (v nodeVar) + , Stmt.mstore (xorE (u 0x60) (v "s")) (v "sibling") + , .assignVar nodeVar (andE (keccak 0x00 0x80) (u N_MASK)) + , .assignVar idxVar (v "parentIdx") ]) with + | .continue s' => s' | _ => st) + -- statement 1: .letVar "sibling" + rw [execStmtList_cons_continue _ _ _ _ + (step_letVar_continue st "sibling" _ _ rfl)] + -- statement 2: .letVar "parentIdx" + rw [execStmtList_cons_continue _ _ _ _ + (step_letVar_continue _ "parentIdx" _ _ rfl)] + -- statement 3: .mstore 0x20 adrsE — value resolves via the AdrsEval witness + rw [execStmtList_cons_continue _ _ _ _ + (step_mstore_continue _ _ _ _ _ rfl (he.eval _))] + -- statement 4: .letVar "s" + rw [execStmtList_cons_continue _ _ _ _ + (step_letVar_continue _ "s" _ _ rfl)] + -- statement 5: .mstore (xor 0x40 s) node + rw [execStmtList_cons_continue _ _ _ _ + (step_mstore_continue _ _ _ _ _ rfl rfl)] + -- statement 6: .mstore (xor 0x60 s) sibling + rw [execStmtList_cons_continue _ _ _ _ + (step_mstore_continue _ _ _ _ _ rfl rfl)] + -- statement 7: .assignVar nodeVar (and (keccak …) N_MASK) + rw [execStmtList_cons_continue _ _ _ _ + (step_assignVar_continue _ nodeVar _ _ rfl)] + -- statement 8: .assignVar idxVar parentIdx + rw [execStmtList_cons_continue _ _ _ _ + (step_assignVar_continue _ idxVar _ _ rfl)] + rfl + +/-! ### The C13 FIPS FORS instantiation -/ + +/-- C13 FORS inner-climb body: the FIPS instantiation used by `Model.lean`'s +`forEach "h" (u 19)` loop (var names `node`/`pathIdx`/`authPtr`). -/ +def forsClimbBody : List Stmt := + merkleClimbBodyA "node" "pathIdx" "authPtr" forsAdrs + +/-- Pure state transformer for one C13 FORS climb iteration. -/ +def stepForsMerkle (st : RuntimeState) : RuntimeState := + stepMerkleA "node" "pathIdx" "authPtr" forsAdrs st + +/-- **`forsClimbStep`** — the C13 FIPS FORS climb shape lemma. -/ +theorem forsClimbStep (st : RuntimeState) : + execStmtList [] st forsClimbBody = .continue (stepForsMerkle st) := + merkleClimbStepA _ _ _ _ adrsEval_fors st + /-! ## 3. The WOTS chain per-iteration body (fixed naming) This is the body of `forEach step execStmtList [] ls ClimbKit.forsClimbBody) + state index remaining + = .continue + (foldLoop varName ClimbKit.stepForsMerkle state index remaining) := + execForEachLoop_of_step varName _ ClimbKit.stepForsMerkle + ClimbKit.forsClimbStep state index remaining + +/-- A literal-count FIPS FORS climb `.forEach varName (.literal n) forsClimbBody` +statement reduces to `foldLoop … stepForsMerkle … (wordNormalize n)`. -/ +theorem execStmt_forEach_forsClimb + (varName : String) (n : Nat) (state : RuntimeState) : + execStmt [] state + (.forEach varName (.literal n) ClimbKit.forsClimbBody) + = .continue + (foldLoop varName ClimbKit.stepForsMerkle + { state with bindings := bindValue state.bindings varName (wordNormalize 0) } + 0 (wordNormalize n)) := + execStmt_forEach_of_step varName (.literal n) _ state (wordNormalize n) + ClimbKit.stepForsMerkle rfl ClimbKit.forsClimbStep + /-- The WOTS-chain `forEach` folds to repeated `ClimbKit.stepWots`. -/ theorem execForEachLoop_wotsChain (varName : String) (state : RuntimeState) (index remaining : Nat) : diff --git a/verity/SphincsMinusVerifiers/ClimbMemFrameMerkle.lean b/verity/SphincsMinusVerifiers/ClimbMemFrameMerkle.lean index b1a8480..4802ec2 100644 --- a/verity/SphincsMinusVerifiers/ClimbMemFrameMerkle.lean +++ b/verity/SphincsMinusVerifiers/ClimbMemFrameMerkle.lean @@ -51,19 +51,10 @@ private theorem assignVar_continue /-! ## 1. The branchless-Merkle scratch memory function. -/ -/-- **`stepMerkle_memory`** — the memory of the state after one branchless-Merkle -climb body is the base memory with the three writes `0x20 ↦ vadr`, `o5 ↦ vnode`, -`o6 ↦ vsib` applied in order, where `vadr` is the resolved address word, `o5/o6` -the resolved (parity-xored) child-slot offsets and `vnode/vsib` the node/sibling -values. The trailing `assignVar nodeVar (keccak…)` and `assignVar idxVar` leave -memory unchanged, so this triple update is exactly the window the body's -`keccak 0x00 0x80` reads. - -The resolved quantities are supplied as `evalExpr` hypotheses at the successively -bound states `st1 … st4`; every C13 call site discharges them by `rfl` (the -operands are closed arithmetic over already-bound locals). -/ -theorem stepMerkle_memory - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_memory + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) @@ -73,9 +64,7 @@ theorem stepMerkle_memory (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -106,7 +95,7 @@ theorem stepMerkle_memory bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.memory + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.memory = MemoryKit.memUpdate (MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode) @@ -155,17 +144,14 @@ theorem stepMerkle_memory have hs8 := assignVar_continue st7 idxVar _ _ hval8 -- Thread all eight statements through `stepMerkle`. show (match execStmtList [] st - (merkleClimbBody nodeVar idxVar adrsBaseVar authPtrVar) with + (ClimbKit.merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) with | .continue s' => s' | _ => st).world.memory = _ show (match execStmtList [] st ([ Stmt.letVar "sibling" (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -185,25 +171,20 @@ theorem stepMerkle_memory show st6.world.memory = _ rfl -/-- **`stepMerkle_node_binding`** — the binding-projection companion to -`stepMerkle_memory`. Statement 7 (`assignVar nodeVar (and (keccak 0x00 0x80) -N_MASK)`) sets the `nodeVar` binding to the masked-keccak read of the scratch -window; statement 8 only rebinds `idxVar` (distinct from `nodeVar`, hence the -`hne` hypothesis), so the `nodeVar` binding after `stepMerkle` is exactly that -masked-keccak value over the triple-write memory `0x20 ↦ vadr`, `o5 ↦ vnode`, -`o6 ↦ vsib2`. +/-- **`stepMerkle_memory`** — the memory of the state after one branchless-Merkle +climb body is the base memory with the three writes `0x20 ↦ vadr`, `o5 ↦ vnode`, +`o6 ↦ vsib` applied in order, where `vadr` is the resolved address word, `o5/o6` +the resolved (parity-xored) child-slot offsets and `vnode/vsib` the node/sibling +values. The trailing `assignVar nodeVar (keccak…)` and `assignVar idxVar` leave +memory unchanged, so this triple update is exactly the window the body's +`keccak 0x00 0x80` reads. -Same eight `evalExpr` hypotheses as `stepMerkle_memory` (the operand resolutions -at the successively bound states), discharged by `rfl` at every C13 call site. -This isolates the spec-fold `node'` accumulator component: composed with -`merkle_keccak_value_spec_even/odd` (which rewrite the masked keccak over this -exact memory frame into `maskN (keccakWords [seed, adrs, node, sibling])`), it -gives the new node value of one climb step. No keccak is evaluated here; pure -state threading. No `sorry`, no new `axiom`, no `native_decide`. -/ -theorem stepMerkle_node_binding +The resolved quantities are supplied as `evalExpr` hypotheses at the successively +bound states `st1 … st4`; every C13 call site discharges them by `rfl` (the +operands are closed arithmetic over already-bound locals). -/ +theorem stepMerkle_memory (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (hne : nodeVar ≠ idxVar) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) @@ -245,7 +226,60 @@ theorem stepMerkle_node_binding bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.memory + = MemoryKit.memUpdate + (MemoryKit.memUpdate + (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode) + o6 vsib2 := + stepMerkleA_memory nodeVar idxVar authPtrVar (ClimbKit.xmssAdrs adrsBaseVar) st + vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_node_binding + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (hne : nodeVar ≠ idxVar) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar = (Verity.Core.Uint256.and (keccakMemorySlice (MemoryKit.memUpdate @@ -298,17 +332,14 @@ theorem stepMerkle_node_binding have hs8 := assignVar_continue st7 idxVar _ _ hval8 -- Thread all eight statements through `stepMerkle`, projecting the binding. show lookupValue (match execStmtList [] st - (merkleClimbBody nodeVar idxVar adrsBaseVar authPtrVar) with + (ClimbKit.merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) with | .continue s' => s' | _ => st).bindings nodeVar = _ show lookupValue (match execStmtList [] st ([ Stmt.letVar "sibling" (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -332,23 +363,25 @@ theorem stepMerkle_node_binding rw [MemoryKit.lookupValue_bindValue_ne _ idxVar nodeVar _ (Ne.symm hne), MemoryKit.lookupValue_bindValue_self] -/-- **`stepMerkle_idx_binding`** — the index-component (`.1`) twin of -`stepMerkle_node_binding`. Statement 2 binds `"parentIdx"` to `vpar` (the -resolved `idx >>> 1`); statement 8 rebinds `idxVar` to `lookupValue … "parentIdx"`, -which—because the only later writes (statements 3–7) never touch the `"parentIdx"` -binding—is still `vpar`. Hence the `idxVar` binding after `stepMerkle` is exactly -`vpar`. The `hne2 : nodeVar ≠ "parentIdx"` hypothesis lets the final read skip the -statement-7 `nodeVar` bind; the `"s"`/`"sibling"` skips are discharged by `decide`. +/-- **`stepMerkle_node_binding`** — the binding-projection companion to +`stepMerkle_memory`. Statement 7 (`assignVar nodeVar (and (keccak 0x00 0x80) +N_MASK)`) sets the `nodeVar` binding to the masked-keccak read of the scratch +window; statement 8 only rebinds `idxVar` (distinct from `nodeVar`, hence the +`hne` hypothesis), so the `nodeVar` binding after `stepMerkle` is exactly that +masked-keccak value over the triple-write memory `0x20 ↦ vadr`, `o5 ↦ vnode`, +`o6 ↦ vsib2`. -Same eight `evalExpr` hypotheses as `stepMerkle_memory`/`_node_binding`, -discharged by `rfl` at every C13 call site. Composed downstream with -`parentIdx_shiftRight` (`idx >>> 1 = idx / 2`) it yields the spec `parentIdx` -accumulator component `mIdx / 2`. No keccak is evaluated here; pure state -threading. No `sorry`, no new `axiom`, no `native_decide`. -/ -theorem stepMerkle_idx_binding +Same eight `evalExpr` hypotheses as `stepMerkle_memory` (the operand resolutions +at the successively bound states), discharged by `rfl` at every C13 call site. +This isolates the spec-fold `node'` accumulator component: composed with +`merkle_keccak_value_spec_even/odd` (which rewrite the masked keccak over this +exact memory frame into `maskN (keccakWords [seed, adrs, node, sibling])`), it +gives the new node value of one climb step. No keccak is evaluated here; pure +state threading. No `sorry`, no new `axiom`, no `native_decide`. -/ +theorem stepMerkle_node_binding (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (hne2 : nodeVar ≠ "parentIdx") + (hne : nodeVar ≠ idxVar) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) @@ -390,7 +423,64 @@ theorem stepMerkle_idx_binding bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + = (Verity.Core.Uint256.and + (keccakMemorySlice + (MemoryKit.memUpdate + (MemoryKit.memUpdate + (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode) + o6 vsib2) + (wordNormalize 0x00) (wordNormalize 0x80)) + (wordNormalize N_MASK)).val := + stepMerkleA_node_binding nodeVar idxVar authPtrVar (ClimbKit.xmssAdrs adrsBaseVar) st + vsib vpar vadr sval o5 vnode o6 vsib2 hne h1 h2 h3 h4 h5off h5val h6off h6val + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_idx_binding + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (hne2 : nodeVar ≠ "parentIdx") + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar = vpar := by -- statement 1: letVar "sibling" have hs1 := MemoryKit.execStmt_letVar_continue st "sibling" _ vsib h1 @@ -444,17 +534,14 @@ theorem stepMerkle_idx_binding have hs8 := assignVar_continue st7 idxVar _ _ hval8 -- Thread all eight statements through `stepMerkle`, projecting the binding. show lookupValue (match execStmtList [] st - (merkleClimbBody nodeVar idxVar adrsBaseVar authPtrVar) with + (ClimbKit.merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) with | .continue s' => s' | _ => st).bindings idxVar = _ show lookupValue (match execStmtList [] st ([ Stmt.letVar "sibling" (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -477,6 +564,69 @@ theorem stepMerkle_idx_binding rw [MemoryKit.lookupValue_bindValue_self] exact hpval +/-- **`stepMerkle_idx_binding`** — the index-component (`.1`) twin of +`stepMerkle_node_binding`. Statement 2 binds `"parentIdx"` to `vpar` (the +resolved `idx >>> 1`); statement 8 rebinds `idxVar` to `lookupValue … "parentIdx"`, +which—because the only later writes (statements 3–7) never touch the `"parentIdx"` +binding—is still `vpar`. Hence the `idxVar` binding after `stepMerkle` is exactly +`vpar`. The `hne2 : nodeVar ≠ "parentIdx"` hypothesis lets the final read skip the +statement-7 `nodeVar` bind; the `"s"`/`"sibling"` skips are discharged by `decide`. + +Same eight `evalExpr` hypotheses as `stepMerkle_memory`/`_node_binding`, +discharged by `rfl` at every C13 call site. Composed downstream with +`parentIdx_shiftRight` (`idx >>> 1 = idx / 2`) it yields the spec `parentIdx` +accumulator component `mIdx / 2`. No keccak is evaluated here; pure state +threading. No `sorry`, no new `axiom`, no `native_decide`. -/ +theorem stepMerkle_idx_binding + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (hne2 : nodeVar ≠ "parentIdx") + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar + = vpar := + stepMerkleA_idx_binding nodeVar idxVar authPtrVar (ClimbKit.xmssAdrs adrsBaseVar) st + vsib vpar vadr sval o5 vnode o6 vsib2 hne2 h1 h2 h3 h4 h5off h5val h6off h6val + /-- **`stepMerkle_sibling_reread_eq`** — the sibling value re-read in statement 6 (`vsib2`, from `mstore (xor 0x60 s) (localVar "sibling")`) is structurally the value *loaded* in statement 1 (`vsib`, from `letVar "sibling" (and (cdload …) @@ -781,9 +931,10 @@ The parity is supplied as the resolved child-slot offsets `o5/o6` per-step accumulator-component the `foldLoop` relation `R` carries; no keccak is unfolded, no new axioms. -/ -/-- **Even-parity per-step node output = spec `node'`.** -/ -theorem stepMerkle_node_value_spec_even - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_node_value_spec_even + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (seed adrs node sibling : Nat) (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) @@ -799,9 +950,7 @@ theorem stepMerkle_node_value_spec_even (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -832,9 +981,9 @@ theorem stepMerkle_node_value_spec_even bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar = maskN (keccakWords [seed, adrs, node, sibling]) := by - rw [stepMerkle_node_binding nodeVar idxVar adrsBaseVar authPtrVar st + rw [stepMerkleA_node_binding nodeVar idxVar authPtrVar adrsE st vsib vpar vadr sval o5 vnode o6 vsib2 hne h1 h2 h3 h4 h5off h5val h6off h6val, ho5, ho6] -- The masked-keccak *value* over the even triple-write window equals the spec @@ -853,12 +1002,12 @@ theorem stepMerkle_node_value_spec_even seed adrs node sibling rfl hseed hadr hnode hsib exact Option.some.inj (hval.symm.trans hspec) -/-- **Odd-parity per-step node output = spec `node'`** (swapped child slots). -/ -theorem stepMerkle_node_value_spec_odd +/-- **Even-parity per-step node output = spec `node'`.** -/ +theorem stepMerkle_node_value_spec_even (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (seed adrs node sibling : Nat) - (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) (hseed : (st.world.memory 0x00).val = seed) (hadr : wordNormalize vadr = adrs) (hnode : wordNormalize vnode = node) @@ -905,26 +1054,167 @@ theorem stepMerkle_node_value_spec_odd bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar - = maskN (keccakWords [seed, adrs, sibling, node]) := by + = maskN (keccakWords [seed, adrs, node, sibling]) := by rw [stepMerkle_node_binding nodeVar idxVar adrsBaseVar authPtrVar st vsib vpar vadr sval o5 vnode o6 vsib2 hne h1 h2 h3 h4 h5off h5val h6off h6val, ho5, ho6] + -- The masked-keccak *value* over the even triple-write window equals the spec + -- preimage's `node'`, via the `evalExpr`-level `merkle_keccak_value_spec_even`. set st' : RuntimeState := { st with world := { st.world with memory := (MemoryKit.memUpdate - (MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) 0x60 vnode) - 0x40 vsib2) } } with hst' + (MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) 0x40 vnode) + 0x60 vsib2) } } with hst' have hval : evalExpr [] st' (.bitAnd (.keccak256 (.literal 0x00) (.literal 0x80)) (.literal N_MASK)) = some (Verity.Core.Uint256.and (keccakMemorySlice st'.world.memory (wordNormalize 0x00) (wordNormalize 0x80)) (wordNormalize N_MASK)).val := rfl - have hspec := merkle_keccak_value_spec_odd st' st.world.memory vadr vnode vsib2 + have hspec := merkle_keccak_value_spec_even st' st.world.memory vadr vnode vsib2 seed adrs node sibling rfl hseed hadr hnode hsib exact Option.some.inj (hval.symm.trans hspec) -/-! ## 5. Spec-side normalization: `xmssClimb` is a `specFold`. - +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_node_value_spec_odd + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed adrs node sibling : Nat) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = adrs) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = sibling) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = maskN (keccakWords [seed, adrs, sibling, node]) := by + rw [stepMerkleA_node_binding nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 hne h1 h2 h3 h4 h5off h5val h6off h6val, + ho5, ho6] + set st' : RuntimeState := + { st with world := { st.world with memory := + (MemoryKit.memUpdate + (MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) 0x60 vnode) + 0x40 vsib2) } } with hst' + have hval : evalExpr [] st' + (.bitAnd (.keccak256 (.literal 0x00) (.literal 0x80)) (.literal N_MASK)) + = some (Verity.Core.Uint256.and + (keccakMemorySlice st'.world.memory (wordNormalize 0x00) (wordNormalize 0x80)) + (wordNormalize N_MASK)).val := rfl + have hspec := merkle_keccak_value_spec_odd st' st.world.memory vadr vnode vsib2 + seed adrs node sibling rfl hseed hadr hnode hsib + exact Option.some.inj (hval.symm.trans hspec) + +/-- **Odd-parity per-step node output = spec `node'`** (swapped child slots). -/ +theorem stepMerkle_node_value_spec_odd + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed adrs node sibling : Nat) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = adrs) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = sibling) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + = maskN (keccakWords [seed, adrs, sibling, node]) := by + rw [stepMerkle_node_binding nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 hne h1 h2 h3 h4 h5off h5val h6off h6val, + ho5, ho6] + set st' : RuntimeState := + { st with world := { st.world with memory := + (MemoryKit.memUpdate + (MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) 0x60 vnode) + 0x40 vsib2) } } with hst' + have hval : evalExpr [] st' + (.bitAnd (.keccak256 (.literal 0x00) (.literal 0x80)) (.literal N_MASK)) + = some (Verity.Core.Uint256.and + (keccakMemorySlice st'.world.memory (wordNormalize 0x00) (wordNormalize 0x80)) + (wordNormalize N_MASK)).val := rfl + have hspec := merkle_keccak_value_spec_odd st' st.world.memory vadr vnode vsib2 + seed adrs node sibling rfl hseed hadr hnode hsib + exact Option.some.inj (hval.symm.trans hspec) + +/-! ## 5. Spec-side normalization: `xmssClimb` is a `specFold`. + `foldLoop_invariant` concludes about `ClimbLoop.specFold`; the spec's hypertree climb is phrased as the recursive `xmssClimb`. This bridges the two: `xmssClimb` over `fuel` iterations equals the second projection of a `specFold` whose step is @@ -961,6 +1251,36 @@ theorem xmssClimb_eq_specFold simp only [xmssClimb, ClimbLoop.specFold_succ, merkleSpecStep] exact xmssClimb_eq_specFold seed treeAdrs auth fuel (h + 1) (mIdx / 2) _ +/-- One spec FORS-climb step on the `(pathIdx, node)` accumulator: per the FIPS +205 layout the per-level address is `adrsForsNode t0 l0 i h parentIdx` (the +`i <<< (18 - h)` tree-number fold makes it `h`-dependent, so the FORS climb is +*not* `merkleSpecStep` at a fixed base; the `t0`/`l0` digits are the +hypertree-leaf field split carried by the hoisted `forsBase`). Verbatim image +of the `forsClimb` loop body. -/ +def forsSpecStep (seed i t0 l0 : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) : + Nat → (Nat × Nat) → (Nat × Nat) + | h, (pathIdx, node) => + let sibling := wordOfHash16 ((auth[h]?).getD ⟨#[]⟩) + let parentIdx := pathIdx / 2 + let adrs := SphincsMinusVerifierSpec.C13Concrete.adrsForsNode t0 l0 i h parentIdx + let node' := + if pathIdx % 2 == 0 then maskN (keccakWords [seed, adrs, node, sibling]) + else maskN (keccakWords [seed, adrs, sibling, node]) + (parentIdx, node') + +theorem forsClimb_eq_specFold + (seed i t0 l0 : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) : + ∀ (fuel h pathIdx node : Nat), + SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 fuel h pathIdx node auth + = (ClimbLoop.specFold (forsSpecStep seed i t0 l0 auth) (pathIdx, node) h fuel).2 + | 0, h, pathIdx, node => by + simp only [SphincsMinusVerifierSpec.C13Concrete.forsClimb, ClimbLoop.specFold_zero] + | fuel + 1, h, pathIdx, node => by + simp only [SphincsMinusVerifierSpec.C13Concrete.forsClimb, + ClimbLoop.specFold_succ, forsSpecStep] + exact forsClimb_eq_specFold seed i t0 l0 auth fuel (h + 1) (pathIdx / 2) _ + + /-! ### Per-step node output = the spec step function `merkleSpecStep`. The final weld of the per-step node algebra: the interpreter step's `nodeVar` @@ -975,15 +1295,385 @@ same `maskN (keccakWords …)`. This is precisely the `node` half of one `foldLoop` step relation `R`, now phrased against `merkleSpecStep` itself. No keccak unfolded, no new axioms. -/ -/-- **Even index ⇒ interpreter node output = `(merkleSpecStep …).2`.** -/ -theorem stepMerkle_node_eq_specStep_even - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_node_eq_specStep_even + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed adrsW h node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = adrsW) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) := + stepMerkleA_node_value_spec_even nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW node (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val + +/-- **Even index ⇒ interpreter node output = `(merkleSpecStep …).2`.** -/ +theorem stepMerkle_node_eq_specStep_even + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) + (hpar : mIdx % 2 = 0) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).2 := by + rw [stepMerkle_node_value_spec_even nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 + seed (treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) node + (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] + simp only [merkleSpecStep, hpar, Nat.reduceBEq, if_true] + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_node_eq_specStep_odd + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed adrsW h node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = adrsW) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node]) := + stepMerkleA_node_value_spec_odd nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW node (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val + +/-- **Odd index ⇒ interpreter node output = `(merkleSpecStep …).2`** (swap). -/ +theorem stepMerkle_node_eq_specStep_odd + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) + (hpar : mIdx % 2 = 1) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar + = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).2 := by + rw [stepMerkle_node_value_spec_odd nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 + seed (treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) node + (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] + simp only [merkleSpecStep, hpar, Nat.reduceBEq, Bool.false_eq_true, if_false] + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_idx_eq_specStep + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (mIdx : Nat) + (hne2 : nodeVar ≠ "parentIdx") + (hvpar : vpar = mIdx / 2) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar + = mIdx / 2 := by + rw [stepMerkleA_idx_binding nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 + hne2 h1 h2 h3 h4 h5off h5val h6off h6val] + exact hvpar + +/-- **Interpreter index output = `(merkleSpecStep …).1`.** The `.1` companion of +`stepMerkle_node_eq_specStep_even/odd`. Unlike the node output, the first +component of `merkleSpecStep` — `parentIdx = mIdx / 2` — does *not* dispatch on +index parity, so a single lemma covers both cases with no `hpar` hypothesis: only +the index data-correspondence `vpar = mIdx / 2` (the resolved `idx >>> 1`, via +`parentIdx_shiftRight`, equals the spec's `mIdx / 2`). Composed with the node +lemma this is the *complete* per-step pair `(stepMerkle …) ↦ merkleSpecStep …` +that `foldLoop_invariant`'s `hstep` carries. Axiom-clean; no keccak unfolded. -/ +theorem stepMerkle_idx_eq_specStep + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne2 : nodeVar ≠ "parentIdx") + (hvpar : vpar = mIdx / 2) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar + = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).1 := by + rw [stepMerkle_idx_binding nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 + hne2 h1 h2 h3 h4 h5off h5val h6off h6val] + simp only [merkleSpecStep] + exact hvpar + +/-! ### Combined per-step accumulator equality = `merkleSpecStep`. + +The full per-step weld: the *pair* of interpreter outputs +`(idxVar binding, nodeVar binding)` after `stepMerkle` equals `merkleSpecStep` +applied to the accumulator `(mIdx, node)`. This is the exact shape +`foldLoop_invariant`'s `hstep` consumes (the spec step on the accumulator α = +`Nat × Nat`). Assembled by `Prod.ext` from the two component lemmas +(`stepMerkle_idx_eq_specStep` for `.1`, `stepMerkle_node_eq_specStep_even/odd` for +`.2`), so it inherits exactly their hypotheses: parity (`hpar` + matching offsets +`o5/o6`) and the per-component data-correspondence equalities +(`hseed/hadr/hnode/hsib/hvpar`). Everything except those value equalities is now +discharged; what an eventual `hstep` must still supply is precisely the +data-correspondence each iteration (blocker #20). Axiom-clean; no keccak. -/ + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_eq_merkleSpecStep_even + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) - (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) - (hpar : mIdx % 2 = 0) + (seed adrsW h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) (hpar : mIdx % 2 = 0) + (hvpar : vpar = mIdx / 2) (hseed : (st.world.memory 0x00).val = seed) - (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) + (hadr : wordNormalize vadr = adrsW) (hnode : wordNormalize vnode = node) (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) (h1 : evalExpr [] st @@ -994,9 +1684,7 @@ theorem stepMerkle_node_eq_specStep_even (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -1027,22 +1715,38 @@ theorem stepMerkle_node_eq_specStep_even bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar - = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).2 := by - rw [stepMerkle_node_value_spec_even nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 - seed (treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) node - (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) - hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] - simp only [merkleSpecStep, hpar, Nat.reduceBEq, if_true] -/-- **Odd index ⇒ interpreter node output = `(merkleSpecStep …).2`** (swap). -/ -theorem stepMerkle_node_eq_specStep_odd + (lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar, + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar) + = (mIdx / 2, + if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + have hnode' : lookupValue + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = (if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + rw [stepMerkleA_node_eq_specStep_even nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h node auth + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] + simp only [hpar, Nat.reduceBEq, if_true] + exact Prod.ext + (stepMerkleA_idx_eq_specStep nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 mIdx + hne2 hvpar h1 h2 h3 h4 h5off h5val h6off h6val) + hnode' + +/-- **Even index ⇒ interpreter accumulator pair = `merkleSpecStep …`.** -/ +theorem stepMerkle_eq_merkleSpecStep_even (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) - (hne : nodeVar ≠ idxVar) (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) - (hpar : mIdx % 2 = 1) + (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) (hpar : mIdx % 2 = 0) + (hvpar : vpar = mIdx / 2) (hseed : (st.world.memory 0x00).val = seed) (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) (hnode : wordNormalize vnode = node) @@ -1088,29 +1792,30 @@ theorem stepMerkle_node_eq_specStep_odd bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar - = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).2 := by - rw [stepMerkle_node_value_spec_odd nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 - seed (treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) node - (wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) - hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] - simp only [merkleSpecStep, hpar, Nat.reduceBEq, Bool.false_eq_true, if_false] + (lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar, + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar) + = merkleSpecStep seed treeAdrs auth h (mIdx, node) := + Prod.ext + (stepMerkle_idx_eq_specStep nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth + hne2 hvpar h1 h2 h3 h4 h5off h5val h6off h6val) + (stepMerkle_node_eq_specStep_even nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth + hne ho5 ho6 hpar hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val) -/-- **Interpreter index output = `(merkleSpecStep …).1`.** The `.1` companion of -`stepMerkle_node_eq_specStep_even/odd`. Unlike the node output, the first -component of `merkleSpecStep` — `parentIdx = mIdx / 2` — does *not* dispatch on -index parity, so a single lemma covers both cases with no `hpar` hypothesis: only -the index data-correspondence `vpar = mIdx / 2` (the resolved `idx >>> 1`, via -`parentIdx_shiftRight`, equals the spec's `mIdx / 2`). Composed with the node -lemma this is the *complete* per-step pair `(stepMerkle …) ↦ merkleSpecStep …` -that `foldLoop_invariant`'s `hstep` carries. Axiom-clean; no keccak unfolded. -/ -theorem stepMerkle_idx_eq_specStep - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_eq_merkleSpecStep_odd + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) - (hne2 : nodeVar ≠ "parentIdx") + (seed adrsW h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) (hpar : mIdx % 2 = 1) (hvpar : vpar = mIdx / 2) + (hseed : (st.world.memory 0x00).val = seed) + (hadr : wordNormalize vadr = adrsW) + (hnode : wordNormalize vnode = node) + (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) @@ -1119,9 +1824,7 @@ theorem stepMerkle_idx_eq_specStep (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -1152,35 +1855,37 @@ theorem stepMerkle_idx_eq_specStep bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar - = (merkleSpecStep seed treeAdrs auth h (mIdx, node)).1 := by - rw [stepMerkle_idx_binding nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 - hne2 h1 h2 h3 h4 h5off h5val h6off h6val] - simp only [merkleSpecStep] - exact hvpar - -/-! ### Combined per-step accumulator equality = `merkleSpecStep`. -The full per-step weld: the *pair* of interpreter outputs -`(idxVar binding, nodeVar binding)` after `stepMerkle` equals `merkleSpecStep` -applied to the accumulator `(mIdx, node)`. This is the exact shape -`foldLoop_invariant`'s `hstep` consumes (the spec step on the accumulator α = -`Nat × Nat`). Assembled by `Prod.ext` from the two component lemmas -(`stepMerkle_idx_eq_specStep` for `.1`, `stepMerkle_node_eq_specStep_even/odd` for -`.2`), so it inherits exactly their hypotheses: parity (`hpar` + matching offsets -`o5/o6`) and the per-component data-correspondence equalities -(`hseed/hadr/hnode/hsib/hvpar`). Everything except those value equalities is now -discharged; what an eventual `hstep` must still supply is precisely the -data-correspondence each iteration (blocker #20). Axiom-clean; no keccak. -/ + (lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar, + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar) + = (mIdx / 2, + if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + have hnode' : lookupValue + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = (if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + rw [stepMerkleA_node_eq_specStep_odd nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h node auth + hne ho5 ho6 hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val] + simp only [hpar, Nat.reduceBEq, Bool.false_eq_true, if_false] + exact Prod.ext + (stepMerkleA_idx_eq_specStep nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 mIdx + hne2 hvpar h1 h2 h3 h4 h5off h5val h6off h6val) + hnode' -/-- **Even index ⇒ interpreter accumulator pair = `merkleSpecStep …`.** -/ -theorem stepMerkle_eq_merkleSpecStep_even +/-- **Odd index ⇒ interpreter accumulator pair = `merkleSpecStep …`** (swap). -/ +theorem stepMerkle_eq_merkleSpecStep_odd (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") - (ho5 : o5 = 0x40) (ho6 : o6 = 0x60) (hpar : mIdx % 2 = 0) + (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) (hpar : mIdx % 2 = 1) (hvpar : vpar = mIdx / 2) (hseed : (st.world.memory 0x00).val = seed) (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) @@ -1234,20 +1939,22 @@ theorem stepMerkle_eq_merkleSpecStep_even (stepMerkle_idx_eq_specStep nodeVar idxVar adrsBaseVar authPtrVar st vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth hne2 hvpar h1 h2 h3 h4 h5off h5val h6off h6val) - (stepMerkle_node_eq_specStep_even nodeVar idxVar adrsBaseVar authPtrVar st + (stepMerkle_node_eq_specStep_odd nodeVar idxVar adrsBaseVar authPtrVar st vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth hne ho5 ho6 hpar hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val) -/-- **Odd index ⇒ interpreter accumulator pair = `merkleSpecStep …`** (swap). -/ -theorem stepMerkle_eq_merkleSpecStep_odd - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_eq_merkleSpecStep + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (seed adrsW h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") - (ho5 : o5 = 0x60) (ho6 : o6 = 0x40) (hpar : mIdx % 2 = 1) + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) (hvpar : vpar = mIdx / 2) (hseed : (st.world.memory 0x00).val = seed) - (hadr : wordNormalize vadr = treeAdrs ||| ((h + 1) <<< 32) ||| mIdx / 2) + (hadr : wordNormalize vadr = adrsW) (hnode : wordNormalize vnode = node) (hsib : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)) (h1 : evalExpr [] st @@ -1258,9 +1965,7 @@ theorem stepMerkle_eq_merkleSpecStep_odd (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -1291,16 +1996,23 @@ theorem stepMerkle_eq_merkleSpecStep_odd bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - (lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings idxVar, - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings nodeVar) - = merkleSpecStep seed treeAdrs auth h (mIdx, node) := - Prod.ext - (stepMerkle_idx_eq_specStep nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth - hne2 hvpar h1 h2 h3 h4 h5off h5val h6off h6val) - (stepMerkle_node_eq_specStep_odd nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth - hne ho5 ho6 hpar hseed hadr hnode hsib h1 h2 h3 h4 h5off h5val h6off h6val) + + (lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar, + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar) + = (mIdx / 2, + if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + rcases hparOff with ⟨hpar, ho5, ho6⟩ | ⟨hpar, ho5, ho6⟩ + · exact stepMerkleA_eq_merkleSpecStep_even nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h mIdx node auth + hne hne2 ho5 ho6 hpar hvpar hseed hadr hnode hsib + h1 h2 h3 h4 h5off h5val h6off h6val + · exact stepMerkleA_eq_merkleSpecStep_odd nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h mIdx node auth + hne hne2 ho5 ho6 hpar hvpar hseed hadr hnode hsib + h1 h2 h3 h4 h5off h5val h6off h6val /-- **Parity-unified per-step accumulator equality.** A single lemma covering both index parities, dispatched by the disjunction `hparOff`, which couples the @@ -1560,6 +2272,16 @@ theorem merkleSpecStep_snd_normalized (seed treeAdrs : Nat) simp only [merkleSpecStep] split <;> exact wordNormalize_maskN _ +/-- The spec FORS node output `forsSpecStep.2` is `wordNormalize`-stable (both +parity branches are `maskN`-masked). -/ +theorem forsSpecStep_snd_normalized (seed i t0 l0 : Nat) + (auth : List SphincsMinusVerifierSpec.Bytes) (h : Nat) (a : Nat × Nat) : + wordNormalize (forsSpecStep seed i t0 l0 auth h a).2 + = (forsSpecStep seed i t0 l0 auth h a).2 := by + obtain ⟨pathIdx, node⟩ := a + simp only [forsSpecStep] + split <;> exact wordNormalize_maskN _ + /-- Exact-node variant of `MerkleClimbRel`. It carries the raw node binding, not only its EVM normalization, plus the fact that the spec node is already normalized. This is useful for consumers that must prove exact data-cell @@ -1688,6 +2410,17 @@ theorem StepDataObligations.sib {st : RuntimeState} {vadr vsib2 seed treeAdrs h (h' : StepDataObligations st vadr vsib2 seed treeAdrs h mIdx auth) : wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩) := h'.2.2 +/-- Address-word-parametric (`adrsW`) generalization of `StepDataObligations`: +the assembled ADRS word equals an arbitrary spec address word, rather than the +hard-wired XMSS `treeAdrs ||| ((h+1) <<< 32) ||| mIdx / 2` layout. Used by the +`adrsE`-generalized step lemmas so the FIPS FORS climb (whose per-level address +is `adrsForsNode …`, an `h`-dependent word) can reuse them. -/ +def StepDataObligationsW (st : RuntimeState) (vadr vsib2 seed adrsW h mIdx : Nat) + (auth : List SphincsMinusVerifierSpec.Bytes) : Prop := + (st.world.memory 0x00).val = seed + ∧ wordNormalize vadr = adrsW + ∧ wordNormalize vsib2 = wordOfHash16 ((auth[h]?).getD ⟨#[]⟩) + /-- **`MerkleClimbData`** — the *index-indexed* data-obligation family for the whole Merkle climb, in exactly the `D : Nat → Prop` shape `ClimbLoop.foldLoop_invariant_cond` ranges its range hypothesis over. For a calldata reader `cdAt : Nat → Nat` (the masked @@ -1931,7 +2664,7 @@ theorem xmss_climb_data_range /-- **`fors_climb_data_range`** — the FORS analog of `xmss_climb_data_range`. The FORS outer loop's inner Merkle climb (`SegmentS4Fors.forsLeafBody`, the -`forEach "h" (u 19) (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr")`) is the +`forEach "h" (u 19) (merkleClimbBody "node" "pathIdx" "forsBase" "authPtr")`) is the *same* `merkleClimbBody`, so its per-height datum is again `MerkleClimbData`. For FORS tree `t < 6` the body sets `authPtr = sigBase + (128 + 304·t)`, hence the per-height read sits at `sigDataOffset + (128 + 304·t + 16·h)`; (hcd) is the offset-arithmetic identity @@ -2113,6 +2846,94 @@ theorem address_assembly_eq show Compiler.Constants.evmModulus = 2 ^ 256 from rfl] exact Nat.mod_eq_of_lt (Nat.bitwise_lt_two_pow (Nat.bitwise_lt_two_pow hAlt hSlt) hPlt) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem MerkleClimbRelA_step + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed adrsW h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) + (hvpar : vpar = mIdx / 2) + (hnode : wordNormalize vnode = node) + (hdata : StepDataObligationsW st vadr vsib2 seed adrsW h mIdx auth) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + + MerkleClimbRel nodeVar idxVar + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st) + (mIdx / 2, + if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + obtain ⟨hseed, hadr, hsib⟩ := hdata + have hpair := stepMerkleA_eq_merkleSpecStep nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h mIdx node auth + hne hne2 hparOff hvpar hseed hadr hnode hsib + h1 h2 h3 h4 h5off h5val h6off h6val + have hidx : lookupValue + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings idxVar + = mIdx / 2 := (Prod.ext_iff.mp hpair).1 + have hn : lookupValue + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings nodeVar + = (if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := + (Prod.ext_iff.mp hpair).2 + refine MerkleClimbRel.intro hidx ?_ + rw [hn] + have hsn : wordNormalize + (if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) + = (if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + split <;> exact wordNormalize_maskN _ + exact hsn + /-- **`MerkleClimbRel_step`** — the per-iteration climb-invariant advance, stated with the entire open per-step data surface collapsed into the single `StepDataObligations` bundle. Given the bookkeeping hypotheses of `stepMerkle_eq_merkleSpecStep` (all @@ -2128,30 +2949,96 @@ No new interpreter evaluation; pure composition. Axiom-clean. -/ theorem MerkleClimbRel_step (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) - (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (seed treeAdrs h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hne : nodeVar ≠ idxVar) (hne2 : nodeVar ≠ "parentIdx") + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) + (hvpar : vpar = mIdx / 2) + (hnode : wordNormalize vnode = node) + (hdata : StepDataObligations st vadr vsib2 seed treeAdrs h mIdx auth) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + MerkleClimbRel nodeVar idxVar + (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st) + (merkleSpecStep seed treeAdrs auth h (mIdx, node)) := by + obtain ⟨hseed, hadr, hsib⟩ := hdata + refine MerkleClimbRel_of_pair nodeVar idxVar + (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st) + seed treeAdrs h mIdx node auth ?_ + exact stepMerkle_eq_merkleSpecStep nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth + hne hne2 hparOff hvpar hseed hadr hnode hsib + h1 h2 h3 h4 h5off h5val h6off h6val + +/-- **`ForsClimbRel_step`** — the FIPS FORS instantiation of +`MerkleClimbRelA_step` (`adrsE := ClimbKit.forsAdrs`, +`adrsW := adrsForsNode t0 l0 i h (mIdx / 2)`), folded back to the named +`forsSpecStep` accumulator. This is the per-iteration `hstep` kernel for the +FORS inner Merkle climb (`ClimbKit.stepForsMerkle`). -/ +theorem ForsClimbRel_step + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (seed i t0 l0 h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) (hvpar : vpar = mIdx / 2) (hnode : wordNormalize vnode = node) - (hdata : StepDataObligations st vadr vsib2 seed treeAdrs h mIdx auth) + (hdata : StepDataObligationsW st vadr vsib2 seed + (SphincsMinusVerifierSpec.C13Concrete.adrsForsNode t0 l0 i h (mIdx / 2)) + h mIdx auth) (h1 : evalExpr [] st - (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.bitAnd (.calldataload (.add (.localVar "authPtr") (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } - (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (.shr (.literal 1) (.localVar "pathIdx")) = some vpar) (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + ClimbKit.forsAdrs = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (.shl (.literal 5) (.bitAnd (.localVar "pathIdx") (.literal 1))) = some sval) (h5off : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -2163,7 +3050,7 @@ theorem MerkleClimbRel_step world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } - (.localVar nodeVar) = some vnode) + (.localVar "node") = some vnode) (h6off : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, @@ -2176,17 +3063,17 @@ theorem MerkleClimbRel_step bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - MerkleClimbRel nodeVar idxVar - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st) - (merkleSpecStep seed treeAdrs auth h (mIdx, node)) := by - obtain ⟨hseed, hadr, hsib⟩ := hdata - refine MerkleClimbRel_of_pair nodeVar idxVar - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st) - seed treeAdrs h mIdx node auth ?_ - exact stepMerkle_eq_merkleSpecStep nodeVar idxVar adrsBaseVar authPtrVar st - vsib vpar vadr sval o5 vnode o6 vsib2 seed treeAdrs h mIdx node auth - hne hne2 hparOff hvpar hseed hadr hnode hsib - h1 h2 h3 h4 h5off h5val h6off h6val + MerkleClimbRel "node" "pathIdx" (ClimbKit.stepForsMerkle st) + (forsSpecStep seed i t0 l0 auth h (mIdx, node)) := by + have hres := MerkleClimbRelA_step "node" "pathIdx" "authPtr" ClimbKit.forsAdrs st + vsib vpar vadr sval o5 vnode o6 vsib2 seed + (SphincsMinusVerifierSpec.C13Concrete.adrsForsNode t0 l0 i h (mIdx / 2)) h mIdx node auth + (by decide) (by decide) hparOff hvpar hnode hdata h1 h2 h3 h4 h5off h5val h6off h6val + show MerkleClimbRel "node" "pathIdx" + (ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" ClimbKit.forsAdrs st) + (forsSpecStep seed i t0 l0 auth h (mIdx, node)) + simp only [forsSpecStep] + exact hres /-- Even index ⇒ selector `s = 0`. -/ theorem merkle_selector_even (n : Nat) (h : n % 2 = 0) : (n &&& 1) <<< 5 = 0 := by @@ -2221,14 +3108,10 @@ leaving `selector`, `world.calldata`, `mem[0x00]`, and every other binding untou These are the frame half of the eventual `MerkleClimbFrame` preservation; no keccak or calldata correspondence is involved. Axiom-clean. -/ -/-- **`stepMerkle_selector_calldata`** — one climb step preserves both the EVM -`selector` and the `world.calldata` image: the body's eight statements are all -`letVar`/`assignVar`/`mstore`, none of which touches `selector` or the calldata -field (only `bindings` and `world.memory`). Same eight `evalExpr` hypotheses as -`stepMerkle_memory`, threaded identically; the conclusion projects the two -frame-invariant fields. -/ -theorem stepMerkle_selector_calldata - (nodeVar idxVar adrsBaseVar authPtrVar : String) +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_selector_calldata + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) @@ -2238,9 +3121,7 @@ theorem stepMerkle_selector_calldata (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -2271,8 +3152,8 @@ theorem stepMerkle_selector_calldata bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).selector = st.selector - ∧ (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.calldata + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).selector = st.selector + ∧ (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.calldata = st.world.calldata := by have hs1 := MemoryKit.execStmt_letVar_continue st "sibling" _ vsib h1 set st1 : RuntimeState := @@ -2313,10 +3194,7 @@ theorem stepMerkle_selector_calldata (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -2329,10 +3207,7 @@ theorem stepMerkle_selector_calldata (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -2350,17 +3225,15 @@ theorem stepMerkle_selector_calldata rw [ClimbKit.execStmtList_cons_continue _ _ _ _ hs8] exact ⟨rfl, rfl⟩ -/-- **`stepMerkle_binding_frozen`** — one climb step preserves the binding of any -variable `w` distinct from the five the body rebinds (`sibling`, `parentIdx`, `s`, -`nodeVar`, `idxVar`). This is exactly what carries the frame's `adrsBaseVar` and -`authPtrVar` bindings (the ADRS base and auth-path pointer) across the step. Same -eight-statement thread; the conclusion skips the five rebinds via -`lookupValue_bindValue_ne`. -/ -theorem stepMerkle_binding_frozen - (nodeVar idxVar adrsBaseVar authPtrVar w : String) +/-- **`stepMerkle_selector_calldata`** — one climb step preserves both the EVM +`selector` and the `world.calldata` image: the body's eight statements are all +`letVar`/`assignVar`/`mstore`, none of which touches `selector` or the calldata +field (only `bindings` and `world.memory`). Same eight `evalExpr` hypotheses as +`stepMerkle_memory`, threaded identically; the conclusion projects the two +frame-invariant fields. -/ +theorem stepMerkle_selector_calldata + (nodeVar idxVar adrsBaseVar authPtrVar : String) (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (hwsib : w ≠ "sibling") (hwpar : w ≠ "parentIdx") (hws : w ≠ "s") - (hwnode : w ≠ nodeVar) (hwidx : w ≠ idxVar) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) @@ -2402,7 +3275,59 @@ theorem stepMerkle_binding_frozen bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings w + (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).selector = st.selector + ∧ (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.calldata + = st.world.calldata := + stepMerkleA_selector_calldata nodeVar idxVar authPtrVar (ClimbKit.xmssAdrs adrsBaseVar) st + vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_binding_frozen + (nodeVar idxVar authPtrVar w : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (hwsib : w ≠ "sibling") (hwpar : w ≠ "parentIdx") (hws : w ≠ "s") + (hwnode : w ≠ nodeVar) (hwidx : w ≠ idxVar) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).bindings w = lookupValue st.bindings w := by have hs1 := MemoryKit.execStmt_letVar_continue st "sibling" _ vsib h1 set st1 : RuntimeState := @@ -2443,10 +3368,7 @@ theorem stepMerkle_binding_frozen (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) , Stmt.letVar "parentIdx" (.shr (.literal 1) (.localVar idxVar)) - , Stmt.mstore (.literal 0x20) - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) + , Stmt.mstore (.literal 0x20) adrsE , Stmt.letVar "s" (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) , Stmt.mstore (.bitXor (.literal 0x40) (.localVar "s")) (.localVar nodeVar) , Stmt.mstore (.bitXor (.literal 0x60) (.localVar "s")) (.localVar "sibling") @@ -2474,15 +3396,181 @@ theorem stepMerkle_binding_frozen MemoryKit.lookupValue_bindValue_ne _ "parentIdx" w _ (Ne.symm hwpar), MemoryKit.lookupValue_bindValue_ne _ "sibling" w _ (Ne.symm hwsib)] -/-- **`stepMerkle_mem_zero`** — one climb step preserves the seed cell `mem[0x00]`. -The body's three memory writes land at `0x20` and the parity-xored child slots -`o5`/`o6` (both `∈ {0x40,0x60}`, supplied here as `≠ 0x00`), so a read at `0x00` -falls through all three `memUpdate`s to the entry memory. Derived from -`stepMerkle_memory` + `memUpdate_diff`. -/ -theorem stepMerkle_mem_zero - (nodeVar idxVar adrsBaseVar authPtrVar : String) - (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) - (ho5 : (0x00 : Nat) ≠ o5) (ho6 : (0x00 : Nat) ≠ o6) +/-- **`stepMerkle_binding_frozen`** — one climb step preserves the binding of any +variable `w` distinct from the five the body rebinds (`sibling`, `parentIdx`, `s`, +`nodeVar`, `idxVar`). This is exactly what carries the frame's `adrsBaseVar` and +`authPtrVar` bindings (the ADRS base and auth-path pointer) across the step. Same +eight-statement thread; the conclusion skips the five rebinds via +`lookupValue_bindValue_ne`. -/ +theorem stepMerkle_binding_frozen + (nodeVar idxVar adrsBaseVar authPtrVar w : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (hwsib : w ≠ "sibling") (hwpar : w ≠ "parentIdx") (hws : w ≠ "s") + (hwnode : w ≠ nodeVar) (hwidx : w ≠ idxVar) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + lookupValue (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).bindings w + = lookupValue st.bindings w := + stepMerkleA_binding_frozen nodeVar idxVar authPtrVar w (ClimbKit.xmssAdrs adrsBaseVar) st + vsib vpar vadr sval o5 vnode o6 vsib2 hwsib hwpar hws hwnode hwidx + h1 h2 h3 h4 h5off h5val h6off h6val + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_mem_zero + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (ho5 : (0x00 : Nat) ≠ o5) (ho6 : (0x00 : Nat) ≠ o6) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.memory 0x00 + = st.world.memory 0x00 := by + rw [stepMerkleA_memory nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val] + rw [MemoryKit.memUpdate_diff _ o6 0x00 vsib2 ho6, + MemoryKit.memUpdate_diff _ o5 0x00 vnode ho5, + MemoryKit.memUpdate_diff _ 0x20 0x00 vadr (by decide)] + +/-- **`stepMerkle_mem_zero`** — one climb step preserves the seed cell `mem[0x00]`. +The body's three memory writes land at `0x20` and the parity-xored child slots +`o5`/`o6` (both `∈ {0x40,0x60}`, supplied here as `≠ 0x00`), so a read at `0x00` +falls through all three `memUpdate`s to the entry memory. Derived from +`stepMerkle_memory` + `memUpdate_diff`. -/ +theorem stepMerkle_mem_zero + (nodeVar idxVar adrsBaseVar authPtrVar : String) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (ho5 : (0x00 : Nat) ≠ o5) (ho6 : (0x00 : Nat) ≠ o6) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.bitOr (.localVar adrsBaseVar) + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.localVar "parentIdx"))) = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.memory 0x00 + = st.world.memory 0x00 := by + rw [stepMerkle_memory nodeVar idxVar adrsBaseVar authPtrVar st + vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val] + rw [MemoryKit.memUpdate_diff _ o6 0x00 vsib2 ho6, + MemoryKit.memUpdate_diff _ o5 0x00 vnode ho5, + MemoryKit.memUpdate_diff _ 0x20 0x00 vadr (by decide)] + +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_mem_val_of_ne + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (addr vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (h20 : addr ≠ 0x20) (ho5 : addr ≠ o5) (ho6 : addr ≠ o6) (h1 : evalExpr [] st (.bitAnd (.calldataload (.add (.localVar authPtrVar) (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) @@ -2491,9 +3579,7 @@ theorem stepMerkle_mem_zero (h3 : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar adrsBaseVar) - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) + adrsE = some vadr) (h4 : evalExpr [] { st with world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, @@ -2524,13 +3610,13 @@ theorem stepMerkle_mem_zero bindings := bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } (.localVar "sibling") = some vsib2) : - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar st).world.memory 0x00 - = st.world.memory 0x00 := by - rw [stepMerkle_memory nodeVar idxVar adrsBaseVar authPtrVar st + ((ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.memory addr).val = + (st.world.memory addr).val := by + rw [stepMerkleA_memory nodeVar idxVar authPtrVar adrsE st vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val] - rw [MemoryKit.memUpdate_diff _ o6 0x00 vsib2 ho6, - MemoryKit.memUpdate_diff _ o5 0x00 vnode ho5, - MemoryKit.memUpdate_diff _ 0x20 0x00 vadr (by decide)] + rw [MemoryKit.memUpdate_diff _ o6 addr vsib2 ho6, + MemoryKit.memUpdate_diff _ o5 addr vnode ho5, + MemoryKit.memUpdate_diff _ 0x20 addr vadr h20] /-- Generic value-frame form of `stepMerkle_mem_zero`: any address disjoint from the three Merkle scratch writes (`0x20`, `o5`, `o6`) is preserved by one @@ -2588,6 +3674,63 @@ theorem stepMerkle_mem_val_of_ne MemoryKit.memUpdate_diff _ o5 addr vnode ho5, MemoryKit.memUpdate_diff _ 0x20 addr vadr h20] +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_mem_zero_of_parity + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (mIdx : Nat) + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.memory 0x00 + = st.world.memory 0x00 := by + have ho5 : (0x00 : Nat) ≠ o5 := by + rcases hparOff with ⟨_, h5, _⟩ | ⟨_, h5, _⟩ <;> rw [h5] <;> decide + have ho6 : (0x00 : Nat) ≠ o6 := by + rcases hparOff with ⟨_, _, h6⟩ | ⟨_, _, h6⟩ <;> rw [h6] <;> decide + exact stepMerkleA_mem_zero nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 ho5 ho6 + h1 h2 h3 h4 h5off h5val h6off h6val + /-- Parity-packaged form of `stepMerkle_mem_zero`: the usual Merkle child-slot offset disjunction (`o5/o6` are `0x40/0x60` in either order) is enough to prove that one branchless-Merkle step preserves the seed cell `mem[0x00]`. -/ @@ -2648,6 +3791,59 @@ theorem stepMerkle_mem_zero_of_parity vsib vpar vadr sval o5 vnode o6 vsib2 ho5 ho6 h1 h2 h3 h4 h5off h5val h6off h6val +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem stepMerkleA_mem_zero_val_of_parity + (nodeVar idxVar authPtrVar : String) (adrsE : Expr) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (mIdx : Nat) + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + ((ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st).world.memory 0x00).val + = (st.world.memory 0x00).val := by + rw [stepMerkleA_mem_zero_of_parity nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 mIdx hparOff + h1 h2 h3 h4 h5off h5val h6off h6val] + /-- Value-projection corollary of `stepMerkle_mem_zero_of_parity`, matching the memory-frame premise shape used by the loop adapters. -/ theorem stepMerkle_mem_zero_val_of_parity @@ -2768,6 +3964,105 @@ theorem eval_childOffset_xor (s : RuntimeState) (off sval : Nat) exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitXor_bounded s (.literal off) (.localVar "s") off sval hlit hv hofflt hsvalt +/-- Address-parametric (`adrsE`) generalization; the classic lemma is the +`ClimbKit.xmssAdrs adrsBaseVar` instantiation (see the wrapper below). -/ +theorem MerkleClimbFrameA_step + (nodeVar idxVar adrsBaseVar authPtrVar : String) (adrsE : Expr) + (pkSeed pkRoot message sig : ByteArray) + (seed treeAdrs merklePtr adrsW : Nat) + (st : RuntimeState) (vsib vpar vadr sval o5 vnode o6 vsib2 : Nat) + (h mIdx node : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) + (hframe : MerkleClimbFrame nodeVar idxVar adrsBaseVar authPtrVar + pkSeed pkRoot message sig seed treeAdrs merklePtr st (mIdx, node)) + (hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40)) + (hvpar : vpar = mIdx / 2) + (hnode : wordNormalize vnode = node) + (hdata : StepDataObligationsW st vadr vsib2 seed adrsW h mIdx auth) + (h1 : evalExpr [] st + (.bitAnd (.calldataload (.add (.localVar authPtrVar) + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) = some vsib) + (h2 : evalExpr [] { st with bindings := bindValue st.bindings "sibling" vsib } + (.shr (.literal 1) (.localVar idxVar)) = some vpar) + (h3 : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + adrsE = some vadr) + (h4 : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar } + (.shl (.literal 5) (.bitAnd (.localVar idxVar) (.literal 1))) = some sval) + (h5off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x40) (.localVar "s")) = some o5) + (h5val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate st.world.memory 0x20 vadr }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar nodeVar) = some vnode) + (h6off : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.bitXor (.literal 0x60) (.localVar "s")) = some o6) + (h6val : evalExpr [] + { st with + world := { st.world with memory := MemoryKit.memUpdate (MemoryKit.memUpdate st.world.memory 0x20 vadr) o5 vnode }, + bindings := + bindValue (bindValue (bindValue st.bindings "sibling" vsib) "parentIdx" vpar) "s" sval } + (.localVar "sibling") = some vsib2) : + MerkleClimbFrame nodeVar idxVar adrsBaseVar authPtrVar + pkSeed pkRoot message sig seed treeAdrs merklePtr + (ClimbKit.stepMerkleA nodeVar idxVar authPtrVar adrsE st) + (mIdx / 2, + if mIdx % 2 == 0 then + maskN (keccakWords [seed, adrsW, node, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩)]) + else + maskN (keccakWords [seed, adrsW, wordOfHash16 ((auth[h]?).getD ⟨#[]⟩), node])) := by + obtain ⟨hN_i, hN_p, hN_sib, hN_s, hN_h, hI_sib, hI_p, hI_s, hI_h, + hA_sib, hA_p, hA_s, hA_n, hA_i, hA_h, + hP_sib, hP_p, hP_s, hP_n, hP_i, hP_h⟩ := hframe.2.2.2.2.2.2 + have hrel := hframe.1 + have hadrs := hframe.2.1 + have hauth := hframe.2.2.1 + have hmem0 := hframe.2.2.2.1 + have hsel := hframe.2.2.2.2.1 + have hcd := hframe.2.2.2.2.2.1 + have ho5 : (0x00 : Nat) ≠ o5 := by + rcases hparOff with ⟨_, h5, _⟩ | ⟨_, h5, _⟩ <;> rw [h5] <;> decide + have ho6 : (0x00 : Nat) ≠ o6 := by + rcases hparOff with ⟨_, _, h6⟩ | ⟨_, _, h6⟩ <;> rw [h6] <;> decide + have hsc := stepMerkleA_selector_calldata nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 h1 h2 h3 h4 h5off h5val h6off h6val + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, + hN_i, hN_p, hN_sib, hN_s, hN_h, hI_sib, hI_p, hI_s, hI_h, + hA_sib, hA_p, hA_s, hA_n, hA_i, hA_h, + hP_sib, hP_p, hP_s, hP_n, hP_i, hP_h⟩ + · exact MerkleClimbRelA_step nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 seed adrsW h mIdx node auth + hN_i hN_p hparOff hvpar hnode hdata h1 h2 h3 h4 h5off h5val h6off h6val + · rw [stepMerkleA_binding_frozen nodeVar idxVar authPtrVar adrsBaseVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 hA_sib hA_p hA_s hA_n hA_i + h1 h2 h3 h4 h5off h5val h6off h6val] + exact hadrs + · rw [stepMerkleA_binding_frozen nodeVar idxVar authPtrVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 hP_sib hP_p hP_s hP_n hP_i + h1 h2 h3 h4 h5off h5val h6off h6val] + exact hauth + · rw [stepMerkleA_mem_zero nodeVar idxVar authPtrVar adrsE st + vsib vpar vadr sval o5 vnode o6 vsib2 ho5 ho6 + h1 h2 h3 h4 h5off h5val h6off h6val] + exact hmem0 + · rw [hsc.1]; exact hsel + · rw [hsc.2]; exact hcd + /-- **`MerkleClimbFrame_step`** — STEP-2 frame self-preservation: one `stepMerkle` step carries the *whole* `MerkleClimbFrame` (relation + static frame) forward, given exactly the per-step bundle `MerkleClimbRel_step` already consumes @@ -3132,31 +4427,31 @@ theorem xmssClimbRaw_model_node rw [xmssClimb_eq_specFold] exact hrel.node -/-- **`forsClimb_model_node`** — FORS-specialised wrapper around -`xmssClimb_model_node`. The generic Merkle loop is instantiated with the FORS tree -base `(3 <<< 96) ||| (i <<< 64)`, then rewritten to the named C13 `forsClimb` -spec function. -/ +/-- **`forsClimb_model_node`** — FORS loop lift. Under the FIPS 205 layout the +per-level FORS address is `h`-dependent (`i <<< (18 - h)`), so this is a direct +`foldLoop_invariant_cond` instantiation over `ClimbKit.stepForsMerkle` and +`forsSpecStep`, folded to the named C13 `forsClimb` spec function. -/ theorem forsClimb_model_node - (nodeVar idxVar adrsBaseVar authPtrVar : String) - (seed i : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) + (seed i t0 l0 : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), - MerkleClimbData auth cdAt idx → MerkleClimbRel nodeVar idxVar s a → - MerkleClimbRel nodeVar idxVar - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar + MerkleClimbData auth cdAt idx → MerkleClimbRel "node" "pathIdx" s a → + MerkleClimbRel "node" "pathIdx" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (merkleSpecStep seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) + (forsSpecStep seed i t0 l0 auth idx a)) (state : RuntimeState) (pathIdx node h fuel : Nat) (hD : ∀ idx, h ≤ idx → idx < h + fuel → MerkleClimbData auth cdAt idx) - (hR : MerkleClimbRel nodeVar idxVar state (pathIdx, node)) : + (hR : MerkleClimbRel "node" "pathIdx" state (pathIdx, node)) : wordNormalize (lookupValue - (ClimbLoop.foldLoop "h" (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar) - state h fuel).bindings nodeVar) - = SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i fuel h pathIdx node auth := by - have hx := xmssClimb_model_node nodeVar idxVar adrsBaseVar authPtrVar - seed ((3 <<< 96) ||| (i <<< 64)) auth cdAt hstep state pathIdx node h fuel hD hR - exact hx.trans - (SphincsMinusVerifiers.ClimbStepSpec.forsClimb_eq_xmssClimb - seed i fuel h pathIdx node auth).symm + (ClimbLoop.foldLoop "h" SphincsMinusVerifiers.ClimbKit.stepForsMerkle + state h fuel).bindings "node") + = SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 fuel h pathIdx node auth := by + have hrel := ClimbLoop.foldLoop_invariant_cond "h" + SphincsMinusVerifiers.ClimbKit.stepForsMerkle + (forsSpecStep seed i t0 l0 auth) (MerkleClimbRel "node" "pathIdx") + (MerkleClimbData auth cdAt) hstep state (pathIdx, node) h fuel hD hR + rw [forsClimb_eq_specFold] + exact hrel.node /-! ## 6c. STEP-3 frame-carrying loop lift: whole-loop `MerkleClimbFrame` ↔ `specFold`/`xmssClimb`. @@ -3246,37 +4541,40 @@ theorem xmssClimbFrame_model_node rw [xmssClimb_eq_specFold] exact hframe.toRel.node -/-- **`forsClimbFrame_model_node`** — frame-carrying FORS-specialised wrapper around -`xmssClimbFrame_model_node`, returning the named C13 `forsClimb` root expression. -/ +/-- **`forsClimbFrame_model_node`** — frame-carrying FORS loop lift over +`ClimbKit.stepForsMerkle` / `forsSpecStep`, returning the named C13 `forsClimb` +root expression. The frame's `adrsBaseVar` slot carries the hoisted +`"forsBase"` binding (its value `forsBase` is the FIPS `adrsForsBase`). -/ theorem forsClimbFrame_model_node - (nodeVar idxVar adrsBaseVar authPtrVar : String) (pkSeed pkRoot message sig : ByteArray) - (seed i merklePtr : Nat) + (seed i t0 l0 forsBase merklePtr : Nat) (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), MerkleClimbData auth cdAt idx → - MerkleClimbFrame nodeVar idxVar adrsBaseVar authPtrVar - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) merklePtr s a → - MerkleClimbFrame nodeVar idxVar adrsBaseVar authPtrVar - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) merklePtr - (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar + MerkleClimbFrame "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed forsBase merklePtr s a → + MerkleClimbFrame "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed forsBase merklePtr + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (merkleSpecStep seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) + (forsSpecStep seed i t0 l0 auth idx a)) (state : RuntimeState) (pathIdx node h fuel : Nat) (hD : ∀ idx, h ≤ idx → idx < h + fuel → MerkleClimbData auth cdAt idx) - (hR : MerkleClimbFrame nodeVar idxVar adrsBaseVar authPtrVar - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) merklePtr + (hR : MerkleClimbFrame "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed forsBase merklePtr state (pathIdx, node)) : wordNormalize (lookupValue - (ClimbLoop.foldLoop "h" (stepMerkle nodeVar idxVar adrsBaseVar authPtrVar) - state h fuel).bindings nodeVar) - = SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i fuel h pathIdx node auth := by - have hx := xmssClimbFrame_model_node nodeVar idxVar adrsBaseVar authPtrVar - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) merklePtr auth cdAt - hstep state pathIdx node h fuel hD hR - exact hx.trans - (SphincsMinusVerifiers.ClimbStepSpec.forsClimb_eq_xmssClimb - seed i fuel h pathIdx node auth).symm + (ClimbLoop.foldLoop "h" SphincsMinusVerifiers.ClimbKit.stepForsMerkle + state h fuel).bindings "node") + = SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 fuel h pathIdx node auth := by + have hframe := ClimbLoop.foldLoop_invariant_cond "h" + SphincsMinusVerifiers.ClimbKit.stepForsMerkle + (forsSpecStep seed i t0 l0 auth) + (MerkleClimbFrame "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed forsBase merklePtr) + (MerkleClimbData auth cdAt) hstep state (pathIdx, node) h fuel hD hR + rw [forsClimb_eq_specFold] + exact hframe.toRel.node /-! ## 6d. Memory-frame loop adapters. -/ @@ -3403,6 +4701,76 @@ theorem execStmt_forEach_h_merkleClimb_preserves_memory_val_range exact merkleFold_preserves_memory_val_range nodeVar idxVar adrsBaseVar authPtrVar addr n D hstep state hD +/-! ## 6e. FORS statement-level memory-frame adapters. + +The FIPS FORS inner climb statement is `.forEach "h" (.literal n) +ClimbKit.forsClimbBody` (the `forsAdrs`-instantiated body), so the +`merkleClimbBody`-shaped adapters in §6d do not dispatch on it. These are the +same three foldLoop reductions over `ClimbKit.stepForsMerkle`, dispatched via +`ClimbLoop.execStmt_forEach_forsClimb`. -/ + +/-- Statement-level memory-frame adapter for the FIPS FORS climb statement. -/ +theorem execStmt_forEach_h_forsClimb_preserves_memory_val_of_step + (addr n : Nat) + (hstep : ∀ s, + ((SphincsMinusVerifiers.ClimbKit.stepForsMerkle s).world.memory addr).val + = (s.world.memory addr).val) + (state s' : RuntimeState) + (h : execStmt [] state + (.forEach "h" (.literal n) SphincsMinusVerifiers.ClimbKit.forsClimbBody) + = .continue s') : + (s'.world.memory addr).val = (state.world.memory addr).val := by + rw [ClimbLoop.execStmt_forEach_forsClimb "h" n state] at h + injection h with hs' + subst s' + rw [ClimbLoop.foldLoop_preserves_memory_val "h" + SphincsMinusVerifiers.ClimbKit.stepForsMerkle addr hstep + { state with bindings := bindValue state.bindings "h" (wordNormalize 0) } + 0 (wordNormalize n)] + +/-- Statement-level bounded-index memory-frame adapter for the FIPS FORS climb +statement. -/ +theorem execStmt_forEach_h_forsClimb_preserves_memory_val_bound + (addr n : Nat) + (hstep : ∀ (s : RuntimeState) (idx : Nat), + ((SphincsMinusVerifiers.ClimbKit.stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory addr).val + = (s.world.memory addr).val) + (state s' : RuntimeState) + (h : execStmt [] state + (.forEach "h" (.literal n) SphincsMinusVerifiers.ClimbKit.forsClimbBody) + = .continue s') : + (s'.world.memory addr).val = (state.world.memory addr).val := by + rw [ClimbLoop.execStmt_forEach_forsClimb "h" n state] at h + injection h with hs' + subst s' + rw [ClimbLoop.foldLoop_preserves_memory_val_bound "h" + SphincsMinusVerifiers.ClimbKit.stepForsMerkle addr hstep + { state with bindings := bindValue state.bindings "h" (wordNormalize 0) } + 0 (wordNormalize n)] + +/-- Statement-level range-gated memory-frame adapter for the FIPS FORS climb +statement. -/ +theorem execStmt_forEach_h_forsClimb_preserves_memory_val_range + (addr n : Nat) (D : Nat → Prop) + (hstep : ∀ (s : RuntimeState) (idx : Nat), D idx → + ((SphincsMinusVerifiers.ClimbKit.stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory addr).val + = (s.world.memory addr).val) + (state s' : RuntimeState) + (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize n → D i) + (h : execStmt [] state + (.forEach "h" (.literal n) SphincsMinusVerifiers.ClimbKit.forsClimbBody) + = .continue s') : + (s'.world.memory addr).val = (state.world.memory addr).val := by + rw [ClimbLoop.execStmt_forEach_forsClimb "h" n state] at h + injection h with hs' + subst s' + rw [ClimbLoop.foldLoop_preserves_memory_val_range "h" + SphincsMinusVerifiers.ClimbKit.stepForsMerkle addr D hstep + { state with bindings := bindValue state.bindings "h" (wordNormalize 0) } + 0 (wordNormalize n) hD] + /-! ## 7. Axiom audit. -/ #print axioms StepDataObligations.intro @@ -3437,6 +4805,27 @@ theorem execStmt_forEach_h_merkleClimb_preserves_memory_val_range #print axioms sibling_load_eq_maskN #print axioms address_assembly_eq #print axioms MerkleClimbRel_step +#print axioms StepDataObligationsW +#print axioms stepMerkleA_memory +#print axioms stepMerkleA_node_binding +#print axioms stepMerkleA_idx_binding +#print axioms stepMerkleA_node_value_spec_even +#print axioms stepMerkleA_node_value_spec_odd +#print axioms stepMerkleA_node_eq_specStep_even +#print axioms stepMerkleA_node_eq_specStep_odd +#print axioms stepMerkleA_idx_eq_specStep +#print axioms stepMerkleA_eq_merkleSpecStep_even +#print axioms stepMerkleA_eq_merkleSpecStep_odd +#print axioms stepMerkleA_eq_merkleSpecStep +#print axioms MerkleClimbRelA_step +#print axioms stepMerkleA_selector_calldata +#print axioms stepMerkleA_binding_frozen +#print axioms stepMerkleA_mem_zero +#print axioms stepMerkleA_mem_val_of_ne +#print axioms stepMerkleA_mem_zero_of_parity +#print axioms stepMerkleA_mem_zero_val_of_parity +#print axioms MerkleClimbFrameA_step +#print axioms ForsClimbRel_step #print axioms stepMerkle_node_value_spec_even #print axioms stepMerkle_node_value_spec_odd #print axioms stepMerkle_node_eq_specStep_even @@ -3492,5 +4881,8 @@ theorem execStmt_forEach_h_merkleClimb_preserves_memory_val_range #print axioms execStmt_forEach_h_merkleClimb_preserves_memory_val_of_step #print axioms execStmt_forEach_h_merkleClimb_preserves_memory_val_bound #print axioms execStmt_forEach_h_merkleClimb_preserves_memory_val_range +#print axioms execStmt_forEach_h_forsClimb_preserves_memory_val_of_step +#print axioms execStmt_forEach_h_forsClimb_preserves_memory_val_bound +#print axioms execStmt_forEach_h_forsClimb_preserves_memory_val_range end SphincsMinusVerifiers.ClimbMemFrameMerkle diff --git a/verity/SphincsMinusVerifiers/ClimbStepSpec.lean b/verity/SphincsMinusVerifiers/ClimbStepSpec.lean index 557df4a..283234e 100644 --- a/verity/SphincsMinusVerifiers/ClimbStepSpec.lean +++ b/verity/SphincsMinusVerifiers/ClimbStepSpec.lean @@ -61,10 +61,13 @@ theorem xmssClimb_zero (seed treeAdrs : Word) (h mIdx : Nat) /-! ## 2. FORS climb step. -/ /-- One spec FORS-climb combine: same branchless-swap shape as `xmssClimbStep`, but -under the FORS-tree address `adrsForsNode i h parentIdx`. -/ -def forsClimbStep (seed i : Word) (h pathIdx : Nat) (node sibling : Word) : Word := +under the FIPS 205 FORS-tree address `adrsForsNode idxTree0 idxLeaf0 i h parentIdx` +(the per-level word folds the tree number as `i <<< (18 - h)` per FIPS 205 Alg 17; +the `idxTree0`/`idxLeaf0` digits come from the hypertree-leaf field split). -/ +def forsClimbStep (seed i : Word) (idxTree0 idxLeaf0 : Nat) (h pathIdx : Nat) + (node sibling : Word) : Word := let parentIdx := pathIdx / 2 - let adrs := adrsForsNode i h parentIdx + let adrs := adrsForsNode idxTree0 idxLeaf0 i h parentIdx if pathIdx % 2 == 0 then maskN (keccakWords [seed, adrs, node, sibling]) else maskN (keccakWords [seed, adrs, sibling, node]) @@ -74,46 +77,35 @@ def forsSibling (auth : List Bytes) (h : Nat) : Word := /-- **`forsClimb_succ`** — the spec `forsClimb` unfolds one fuel step into a single `forsClimbStep`. Pure `rfl` against `forsClimb`'s `succ` branch. -/ -theorem forsClimb_succ (seed i : Word) (fuel h pathIdx : Nat) +theorem forsClimb_succ (seed i : Word) (idxTree0 idxLeaf0 fuel h pathIdx : Nat) (node : Word) (auth : List Bytes) : - forsClimb seed i (fuel + 1) h pathIdx node auth - = forsClimb seed i fuel (h + 1) (pathIdx / 2) - (forsClimbStep seed i h pathIdx node (forsSibling auth h)) auth := by + forsClimb seed i idxTree0 idxLeaf0 (fuel + 1) h pathIdx node auth + = forsClimb seed i idxTree0 idxLeaf0 fuel (h + 1) (pathIdx / 2) + (forsClimbStep seed i idxTree0 idxLeaf0 h pathIdx node (forsSibling auth h)) auth := by simp only [forsClimb, forsClimbStep, forsSibling] /-- The spec FORS climb on zero fuel is the identity. -/ -theorem forsClimb_zero (seed i : Word) (h pathIdx : Nat) +theorem forsClimb_zero (seed i : Word) (idxTree0 idxLeaf0 h pathIdx : Nat) (node : Word) (auth : List Bytes) : - forsClimb seed i 0 h pathIdx node auth = node := by + forsClimb seed i idxTree0 idxLeaf0 0 h pathIdx node auth = node := by simp only [forsClimb] -/-! ## 3. FORS climb as an XMSS-shaped climb. +/-! ## 3. FORS node-address decomposition. -The interpreter-side Merkle loop is generic in an address base. FORS supplies the -base `(3 <<< 96) ||| (i <<< 64)` and then uses the same level/index suffix as the -XMSS climb. These lemmas expose that spec-side correspondence without mentioning -the interpreter. -/ +Under the FIPS 205 layout the per-level FORS address depends on the loop level +`h` (`i <<< (18 - h)` folds the tree number into the 19-bit `word3`), so the +FORS climb is *not* an XMSS-shaped climb at a fixed base any more (the retired +`forsClimb_eq_xmssClimb` is gone). Instead, the interpreter-side address +expression (`ClimbKit.forsAdrs`, right-associated `or` chain) is identified +with the spec `adrsForsNode` by re-association. -/ -/-- The generic Merkle address built from the FORS tree base is definitionally the +/-- The right-associated interpreter FORS address word is exactly the spec FORS node address, up to `Nat.lor` associativity. -/ -theorem forsTreeBase_node_address (i h parentIdx : Nat) : - (((3 <<< 96) ||| (i <<< 64)) ||| ((h + 1) <<< 32)) ||| parentIdx - = adrsForsNode i h parentIdx := by - simp only [adrsForsNode] - -/-- FORS climb is the generic XMSS-shaped climb instantiated with the FORS tree -base `(3 <<< 96) ||| (i <<< 64)`. -/ -theorem forsClimb_eq_xmssClimb (seed i : Word) (fuel h pathIdx : Nat) - (node : Word) (auth : List Bytes) : - forsClimb seed i fuel h pathIdx node auth - = xmssClimb seed ((3 <<< 96) ||| (i <<< 64)) fuel h pathIdx node auth := by - induction fuel generalizing h pathIdx node with - | zero => - simp only [forsClimb, xmssClimb] - | succ fuel ih => - simp only [forsClimb, xmssClimb] - rw [forsTreeBase_node_address] - exact ih (h + 1) (pathIdx / 2) _ +theorem forsBase_node_address (idxTree0 idxLeaf0 i h parentIdx : Nat) : + adrsForsBase idxTree0 idxLeaf0 + ||| (((h + 1) <<< 32) ||| ((i <<< (18 - h)) ||| parentIdx)) + = adrsForsNode idxTree0 idxLeaf0 i h parentIdx := by + simp only [adrsForsNode, Nat.lor_assoc] /-! ## 4. Axiom audit. -/ @@ -121,7 +113,6 @@ theorem forsClimb_eq_xmssClimb (seed i : Word) (fuel h pathIdx : Nat) #print axioms xmssClimb_zero #print axioms forsClimb_succ #print axioms forsClimb_zero -#print axioms forsTreeBase_node_address -#print axioms forsClimb_eq_xmssClimb +#print axioms forsBase_node_address end SphincsMinusVerifiers.ClimbStepSpec diff --git a/verity/SphincsMinusVerifiers/CurrentNodeFrame.lean b/verity/SphincsMinusVerifiers/CurrentNodeFrame.lean index 88ac6fa..4b8d104 100644 --- a/verity/SphincsMinusVerifiers/CurrentNodeFrame.lean +++ b/verity/SphincsMinusVerifiers/CurrentNodeFrame.lean @@ -217,14 +217,76 @@ theorem afterS3_selector_calldata_mkC13State unfold afterS3 SegmentS3.stepS3 exact afterS2_selector_calldata_mkC13State pkSeed pkRoot message sig +/-! ### The FIPS FORS pre-loop setup over the byte-facing entry state. + +Statements 13..15 hoist the `idxLeaf0`/`idxTree0` digits and the FIPS ADRS base +`forsBase` between S3 and the FORS outer loop (`SegmentCompose.afterForsSetup`). +These project the S3-level frame facts through the three pure binder writes. -/ + +theorem afterForsSetup_sigBase_mkC13State + (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings + "sigBase" = sigDataOffset := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_preserves_sigBase_step] + exact afterS3_sigBase_mkC13State pkSeed pkRoot message sig + +theorem afterForsSetup_htIdx_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "htIdx" + = + (C13Concrete.hMsgC13 c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message).hyperIndex := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_preserves_htIdx_step] + exact afterS3_htIdx_mkC13State pkSeed pkRoot message sig + +theorem afterForsSetup_selector_calldata_mkC13State + (pkSeed pkRoot message sig : ByteArray) : + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).selector = 0 + ∧ (afterForsSetup (mkC13State pkSeed pkRoot message sig)).world.calldata + = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + unfold afterForsSetup + have h := SegmentForsSetup.stepForsSetup_preserves_selector_calldata_step + (afterS3 (mkC13State pkSeed pkRoot message sig)) + have hS3 := afterS3_selector_calldata_mkC13State pkSeed pkRoot message sig + exact ⟨h.1.trans hS3.1, h.2.trans hS3.2⟩ + +theorem afterForsSetup_seed_slot_mkC13State (pkSeed pkRoot message sig : ByteArray) : + ((afterForsSetup (mkC13State pkSeed pkRoot message sig)).world.memory 0).val + = wordOfHash16 pkSeed := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_preserves_memory_step] + exact afterS3_seed_slot_mkC13State pkSeed pkRoot message sig + +/-- The hoisted FIPS ADRS base over the byte-facing entry state is exactly the +digest-derived `adrsForsBase (idxTree0C13 d) (idxLeaf0C13 d)`. -/ +theorem afterForsSetup_forsBase_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_forsBase_eq + (afterS3 (mkC13State pkSeed pkRoot message sig)) + ((C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message).hyperIndex) + (afterS3_htIdx_mkC13State pkSeed pkRoot message sig) + (C13Concrete.hMsgC13_hyperIndex_lt _ _ _)] + rfl + /-- Concrete C13 FORS outer-loop prefix state, with the same initial `"i"` bind used by `afterFors`. -/ def forsOuterPrefixState (pkSeed pkRoot message sig : ByteArray) (n : Nat) : RuntimeState := ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 n @@ -260,9 +322,32 @@ theorem forsOuterPrefix_sigBase_mkC13State (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_sigBase _ 0 n] rw [MemoryKit.lookupValue_bindValue_ne - (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" "sigBase" (wordNormalize 0) (by decide)] - exact afterS3_sigBase_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_sigBase_mkC13State pkSeed pkRoot message sig + +/-- Every concrete prefix of the C13 FORS outer loop carries the hoisted FIPS +ADRS base installed by the fors-setup segment. -/ +theorem forsOuterPrefix_forsBase_mkC13State + (pkSeed pkRoot message sig : ByteArray) (n : Nat) : + lookupValue (forsOuterPrefixState pkSeed pkRoot message sig n).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) := by + unfold forsOuterPrefixState + rw [ClimbLoop.foldLoop_preserves_lookup "i" "forsBase" + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_forsBase + _ 0 n] + rw [MemoryKit.lookupValue_bindValue_ne + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings + "i" "forsBase" (wordNormalize 0) (by decide)] + exact afterForsSetup_forsBase_mkC13State pkSeed pkRoot message sig /-- Every concrete prefix of the C13 FORS outer loop carries the frozen selector and calldata image from the byte-facing `mkC13State`. -/ @@ -275,12 +360,12 @@ theorem forsOuterPrefix_selector_calldata_mkC13State have hfold := SphincsMinusVerifiers.StateFrame.foldLoop_preserves_selector_calldata "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_selector_calldata - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 n - have hS3 := afterS3_selector_calldata_mkC13State pkSeed pkRoot message sig + have hS3 := afterForsSetup_selector_calldata_mkC13State pkSeed pkRoot message sig exact ⟨by rw [hfold.1]; exact hS3.1, by rw [hfold.2]; exact hS3.2⟩ /-- At every actual C13 FORS outer-loop prefix in the six-iteration range, the @@ -297,7 +382,15 @@ theorem forsOuterPrefix_leafSetupFacts_mkC13State lookupValue st.bindings "i" = t ∧ lookupValue st.bindings "sigBase" = sigDataOffset ∧ st.selector = 0 - ∧ st.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + ∧ st.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig + ∧ lookupValue st.bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) := by intro st let pref := forsOuterPrefixState pkSeed pkRoot message sig t have hi : @@ -310,7 +403,7 @@ theorem forsOuterPrefix_leafSetupFacts_mkC13State dsimp [pref] exact forsOuterPrefix_sigBase_mkC13State pkSeed pkRoot message sig t have hsc := forsOuterPrefix_selector_calldata_mkC13State pkSeed pkRoot message sig t - refine ⟨?_, ?_, ?_, ?_⟩ + refine ⟨?_, ?_, ?_, ?_, ?_⟩ · dsimp [st, pref] exact hi · dsimp [st, pref] @@ -322,6 +415,11 @@ theorem forsOuterPrefix_leafSetupFacts_mkC13State exact hsc.1 · dsimp [st, pref] at hsc ⊢ exact hsc.2 + · dsimp [st, pref] + rw [MemoryKit.lookupValue_bindValue_ne + (forsOuterPrefixState pkSeed pkRoot message sig t).bindings + "i" "forsBase" (wordNormalize t) (by decide)] + exact forsOuterPrefix_forsBase_mkC13State pkSeed pkRoot message sig t /-- Named-state projection of `forsOuterPrefix_leafSetupFacts_mkC13State`. -/ theorem forsOuterLeafState_setupFacts_mkC13State @@ -331,7 +429,15 @@ theorem forsOuterLeafState_setupFacts_mkC13State "sigBase" = sigDataOffset ∧ (forsOuterLeafState pkSeed pkRoot message sig t).selector = 0 ∧ (forsOuterLeafState pkSeed pkRoot message sig t).world.calldata - = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig + ∧ lookupValue (forsOuterLeafState pkSeed pkRoot message sig t).bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) := by simpa [forsOuterLeafState] using forsOuterPrefix_leafSetupFacts_mkC13State pkSeed pkRoot message sig t ht @@ -343,11 +449,17 @@ theorem forsLeafStep_preserves_seed_slot_of_mkC13State_prefix (forsOuterLeafState pkSeed pkRoot message sig t)).world.memory 0).val = ((forsOuterLeafState pkSeed pkRoot message sig t).world.memory 0).val := by rcases forsOuterLeafState_setupFacts_mkC13State pkSeed pkRoot message sig t ht with - ⟨hi, hsigBase, hsel, hcd⟩ + ⟨hi, hsigBase, hsel, hcd, hbase⟩ exact SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.forsLeafStep_preserves_seed_slot_of_forsFrozenSetup (forsOuterLeafState pkSeed pkRoot message sig t) - t pkSeed pkRoot message sig hi ht hsigBase hsel hcd + t _ pkSeed pkRoot message sig hi ht hsigBase hbase + (lt_trans + (C13Concrete.adrsForsBase_lt_of_bounds + (lt_trans (C13Concrete.idxTree0C13_lt _ _ _) (by decide)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) (by decide))) + (by decide)) + hsel hcd /-- One actual C13 FORS outer-loop prefix preserves a different ordinary root slot through the next concrete leaf step. -/ @@ -359,11 +471,17 @@ theorem forsLeafStep_preserves_root_cell_ne_of_mkC13State_prefix = ((forsOuterLeafState pkSeed pkRoot message sig t).world.memory (0x80 + 32 * j)).val := by rcases forsOuterLeafState_setupFacts_mkC13State pkSeed pkRoot message sig t ht with - ⟨hi, hsigBase, hsel, hcd⟩ + ⟨hi, hsigBase, hsel, hcd, hbase⟩ exact SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.forsLeafStep_preserves_root_cell_ne_of_forsFrozenSetup (forsOuterLeafState pkSeed pkRoot message sig t) - j t pkSeed pkRoot message sig hi ht hne hsigBase hsel hcd + j t _ pkSeed pkRoot message sig hi ht hne hsigBase hbase + (lt_trans + (C13Concrete.adrsForsBase_lt_of_bounds + (lt_trans (C13Concrete.idxTree0C13_lt _ _ _) (by decide)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) (by decide))) + (by decide)) + hsel hcd /-- Concrete one-step carry for an ordinary FORS root slot across a non-writing outer iteration. -/ @@ -374,9 +492,9 @@ theorem forsOuterPrefix_root_cell_succ_ne_mkC13State = ((forsOuterPrefixState pkSeed pkRoot message sig t).world.memory (0x80 + 32 * j)).val := by let start := - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } have hsplit := ClimbLoop.foldLoop_append "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep @@ -441,9 +559,9 @@ theorem forsOuterPrefix_root_cell_iteration_node_mkC13State (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep (forsOuterLeafState pkSeed pkRoot message sig j))).bindings "node") := by let start := - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } have hsplit := ClimbLoop.foldLoop_append "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep @@ -488,14 +606,14 @@ theorem forsOuterPrefix_seed_slot_mkC13State ((forsOuterPrefixState pkSeed pkRoot message sig n).world.memory 0).val = wordOfHash16 pkSeed := by let start := - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } induction n with | zero => dsimp [forsOuterPrefixState, start] - exact afterS3_seed_slot_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_seed_slot_mkC13State pkSeed pkRoot message sig | succ n ih => have hnlt : n < 6 := by omega have hsplit := @@ -535,9 +653,93 @@ theorem afterFors_sigBase_mkC13State (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_sigBase _ 0 (wordNormalize 6)] rw [MemoryKit.lookupValue_bindValue_ne - (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" "sigBase" (wordNormalize 0) (by decide)] - exact afterS3_sigBase_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_sigBase_mkC13State pkSeed pkRoot message sig + +/-- The hoisted FIPS ADRS base survives the FORS outer loop. -/ +theorem afterFors_forsBase_mkC13State + (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message)) := by + unfold afterFors + rw [ClimbLoop.foldLoop_preserves_lookup "i" "forsBase" + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_forsBase + _ 0 (wordNormalize 6)] + rw [MemoryKit.lookupValue_bindValue_ne + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings + "i" "forsBase" (wordNormalize 0) (by decide)] + exact afterForsSetup_forsBase_mkC13State pkSeed pkRoot message sig + +/-- The hoisted FIPS tree digit over the byte-facing entry state. -/ +theorem afterForsSetup_idxTree0_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message) := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_idxTree0 + (afterS3 (mkC13State pkSeed pkRoot message sig)) + ((C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message).hyperIndex) + (afterS3_htIdx_mkC13State pkSeed pkRoot message sig) + (C13Concrete.hMsgC13_hyperIndex_lt _ _ _)] + rfl + +/-- The hoisted FIPS leaf digit over the byte-facing entry state. -/ +theorem afterForsSetup_idxLeaf0_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message) := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_idxLeaf0 + (afterS3 (mkC13State pkSeed pkRoot message sig)) + ((C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message).hyperIndex) + (afterS3_htIdx_mkC13State pkSeed pkRoot message sig) + (C13Concrete.hMsgC13_hyperIndex_lt _ _ _)] + rfl + +/-- The FIPS tree digit survives the FORS outer loop. -/ +theorem afterFors_idxTree0_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message) := by + unfold afterFors + rw [ClimbLoop.foldLoop_preserves_lookup "i" "idxTree0" + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_idxTree0 + _ 0 (wordNormalize 6)] + rw [MemoryKit.lookupValue_bindValue_ne + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings + "i" "idxTree0" (wordNormalize 0) (by decide)] + exact afterForsSetup_idxTree0_mkC13State pkSeed pkRoot message sig + +/-- The FIPS leaf digit survives the FORS outer loop. -/ +theorem afterFors_idxLeaf0_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 + (C13Concrete.hMsgC13 c13 { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.read16 sig 0) message) := by + unfold afterFors + rw [ClimbLoop.foldLoop_preserves_lookup "i" "idxLeaf0" + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_idxLeaf0 + _ 0 (wordNormalize 6)] + rw [MemoryKit.lookupValue_bindValue_ne + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings + "i" "idxLeaf0" (wordNormalize 0) (by decide)] + exact afterForsSetup_idxLeaf0_mkC13State pkSeed pkRoot message sig /-- The FORS outer loop carries the digest-derived hypertree index unchanged. -/ theorem afterFors_htIdx_mkC13State @@ -554,9 +756,9 @@ theorem afterFors_htIdx_mkC13State (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_htIdx _ 0 (wordNormalize 6)] rw [MemoryKit.lookupValue_bindValue_ne - (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" "htIdx" (wordNormalize 0) (by decide)] - exact afterS3_htIdx_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_htIdx_mkC13State pkSeed pkRoot message sig /-- The FORS outer loop carries the frozen selector and calldata image unchanged. -/ theorem afterFors_selector_calldata_mkC13State @@ -568,11 +770,11 @@ theorem afterFors_selector_calldata_mkC13State have hfold := SphincsMinusVerifiers.StateFrame.foldLoop_preserves_selector_calldata "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_selector_calldata - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with - bindings := bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with + bindings := bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 (wordNormalize 6) - have hS3 := afterS3_selector_calldata_mkC13State pkSeed pkRoot message sig + have hS3 := afterForsSetup_selector_calldata_mkC13State pkSeed pkRoot message sig exact ⟨by rw [hfold.1]; exact hS3.1, by rw [hfold.2]; exact hS3.2⟩ /-- Selector projection of `afterFors_selector_calldata_mkC13State`. -/ @@ -841,11 +1043,11 @@ theorem afterFors_seed_slot_of_forsLeafStep_preserves (hLeaf : ∀ s, ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep s).world.memory 0).val = (s.world.memory 0).val) : - ((afterFors st).world.memory 0).val = ((afterS3 st).world.memory 0).val := by + ((afterFors st).world.memory 0).val = ((afterForsSetup st).world.memory 0).val := by unfold afterFors rw [ClimbLoop.foldLoop_preserves_memory_val "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep 0 hLeaf - { (afterS3 st) with bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 (wordNormalize 6)] /-- Bounded-index version of the FORS seed-cell loop plumbing. This is the @@ -857,11 +1059,11 @@ theorem afterFors_seed_slot_of_forsLeafStep_bound_preserves ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep { s with bindings := bindValue s.bindings "i" (wordNormalize idx) }).world.memory 0).val = (s.world.memory 0).val) : - ((afterFors st).world.memory 0).val = ((afterS3 st).world.memory 0).val := by + ((afterFors st).world.memory 0).val = ((afterForsSetup st).world.memory 0).val := by unfold afterFors rw [ClimbLoop.foldLoop_preserves_memory_val_bound "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep 0 hLeaf - { (afterS3 st) with bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 (wordNormalize 6)] /-- Range-gated FORS seed-cell loop plumbing. The real statement-14 loop runs @@ -872,12 +1074,12 @@ theorem afterFors_seed_slot_of_forsLeafStep_range_preserves ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep { s with bindings := bindValue s.bindings "i" (wordNormalize idx) }).world.memory 0).val = (s.world.memory 0).val) : - ((afterFors st).world.memory 0).val = ((afterS3 st).world.memory 0).val := by + ((afterFors st).world.memory 0).val = ((afterForsSetup st).world.memory 0).val := by unfold afterFors rw [ClimbLoop.foldLoop_preserves_memory_val_range "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep 0 (fun idx => idx < 6) (fun s idx hidx => hLeaf s idx hidx) - { (afterS3 st) with bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 (wordNormalize 6) (fun i _ hi => by have hbound : i < 6 := by @@ -894,7 +1096,7 @@ theorem afterFors_seed_slot_mkC13State_of_forsLeafStep_preserves ((afterFors (mkC13State pkSeed pkRoot message sig)).world.memory 0).val = wordOfHash16 pkSeed := by rw [afterFors_seed_slot_of_forsLeafStep_preserves _ hLeaf] - exact afterS3_seed_slot_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_seed_slot_mkC13State pkSeed pkRoot message sig /-- Frozen-entry bounded-index version of `afterFors_seed_slot_of_forsLeafStep_bound_preserves`. -/ @@ -942,14 +1144,14 @@ theorem normalRootCell_eq_of_outer_iteration_node (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = root) : ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep (afterFors st)).world.memory (0x80 + 32 * j)).val = root := by @@ -957,7 +1159,7 @@ theorem normalRootCell_eq_of_outer_iteration_node (afterFors st) j hj] unfold afterFors rw [SphincsMinusVerifiers.SegmentS4Fors.forsOuter_root_cell_eq_iteration_node_of_suffix_preserves - (afterS3 st) j hj hPres] + (afterForsSetup st) j hj hPres] exact hNode /-- Quantified C13-shaped version of @@ -978,14 +1180,14 @@ theorem normalRootCells_eq_forsAllRootsC13_of_iteration_nodes (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 pk digest fors)[j]'(by rw [C13Concrete.forsAllRootsC13_length] @@ -1016,7 +1218,7 @@ theorem normalRootCell_eq_of_fors_frozen_calldata_node s.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256) (hNode : @@ -1025,14 +1227,14 @@ theorem normalRootCell_eq_of_fors_frozen_calldata_node (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = root) : ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep (afterFors st)).world.memory (0x80 + 32 * j)).val = root := by @@ -1040,7 +1242,7 @@ theorem normalRootCell_eq_of_fors_frozen_calldata_node (afterFors st) j hj] unfold afterFors rw [SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.forsOuter_root_cell_eq_iteration_node_of_fors_frozen_calldata - (afterS3 st) j hj pkSeed pkRoot message sig hsite] + (afterForsSetup st) j hj pkSeed pkRoot message sig hsite] exact hNode /-- Quantified C13-shaped normal-root adapter with the ordinary-root frame @@ -1055,7 +1257,7 @@ theorem normalRootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes s.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256) (hNode : ∀ j, (hj : j < 6) → @@ -1064,14 +1266,14 @@ theorem normalRootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 st) with - bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with + bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 pk digest fors)[j]'(by rw [C13Concrete.forsAllRootsC13_length] @@ -1173,13 +1375,15 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_eval_parse (forsAuthCdAt pk.pkSeed pk.pkRoot message sig j) idx → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.ClimbKit.stepMerkle - "node" "pathIdx" "treeAdrsBase" "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) ((sigParsed.fors.authPath[j]?).getD []) idx a)) - (hAdrLt : C13Concrete.adrsForsLeaf j ((digest.forsIndex[j]?).getD 0) < 2 ^ 256) + (hAdrLt : C13Concrete.adrsForsLeaf + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) + j ((digest.forsIndex[j]?).getD 0) < 2 ^ 256) (hTree : evalExpr [] (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) (.bitAnd (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) @@ -1204,10 +1408,11 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_eval_parse (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j).bindings "treeIdx" ((digest.forsIndex[j]?).getD 0)) "secretVal" (wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩))) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (C13Concrete.adrsForsLeaf j ((digest.forsIndex[j]?).getD 0))) : + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (C13Concrete.adrsForsLeaf + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) + j ((digest.forsIndex[j]?).getD 0))) : wordNormalize (lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep @@ -1256,11 +1461,12 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_eval_parse (forsAuthCdAt pk.pkSeed pk.pkRoot message sig j) idx → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.ClimbKit.stepMerkle - "node" "pathIdx" "treeAdrsBase" "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + (C13Concrete.idxLeaf0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) ((sigParsed.fors.authPath[j]?).getD []) idx a)) (hTree : evalExpr [] (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) (.bitAnd @@ -1290,11 +1496,12 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_eval_parse "treeIdx" (((C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).forsIndex[j]?).getD 0)) "secretVal" (wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩))) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (C13Concrete.adrsForsLeaf j - (((C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).forsIndex[j]?).getD 0))) : + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (C13Concrete.adrsForsLeaf + (C13Concrete.idxTree0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + (C13Concrete.idxLeaf0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + j (((C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).forsIndex[j]?).getD 0))) : wordNormalize (lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep @@ -1312,87 +1519,59 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_eval_parse (C13Concrete.adrsForsLeaf_hMsgC13_normal_lt pk sigParsed.R message hj) hTree hSecret hLeaf -/-- The concrete FORS leaf-address expression evaluates to the spec leaf ADRS -word once the outer-loop index and decoded `treeIdx` binding are known. -/ +/-- The concrete FIPS FORS leaf-address expression evaluates to the spec leaf +ADRS word once the hoisted `"forsBase"`, the outer-loop index, and the decoded +`treeIdx` binding are known. -/ theorem forsLeafAddress_eval_eq_adrsForsLeaf - (st : RuntimeState) {i treeIdx secretVal : Nat} + (st : RuntimeState) {t0 l0 i treeIdx secretVal : Nat} + (hbase : lookupValue st.bindings "forsBase" = C13Concrete.adrsForsBase t0 l0) + (ht0 : t0 < 2 ^ 64) (hl0 : l0 < 2 ^ 32) (hi : lookupValue st.bindings "i" = i) (hiLt : i < 6) - (hTreeIdxLt : treeIdx < 2 ^ 256) : + (hTreeIdxLt : treeIdx < 2 ^ 19) : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" secretVal } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (C13Concrete.adrsForsLeaf i treeIdx) := by + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (C13Concrete.adrsForsLeaf t0 l0 i treeIdx) := by let st' : RuntimeState := { st with bindings := bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" secretVal } - have h96 : - evalExpr [] st' (.shl (.literal 96) (.literal 3)) = some (3 <<< 96) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - st' (.literal 96) (.literal 3) 96 3 rfl rfl - (by decide) (by decide) (by decide) - have hiEval : evalExpr [] st' (.localVar "i") = some i := by + have hbase' : lookupValue st'.bindings "forsBase" = C13Concrete.adrsForsBase t0 l0 := by + dsimp [st'] + rw [MemoryKit.lookupValue_bindValue_ne _ "secretVal" "forsBase" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "treeIdx" "forsBase" _ (by decide)] + exact hbase + have hi' : lookupValue st'.bindings "i" = i := by dsimp [st'] - change some (lookupValue (bindValue (bindValue st.bindings "treeIdx" treeIdx) - "secretVal" secretVal) "i") = some i rw [MemoryKit.lookupValue_bindValue_ne _ "secretVal" "i" _ (by decide)] rw [MemoryKit.lookupValue_bindValue_ne _ "treeIdx" "i" _ (by decide)] - exact congrArg some hi - have h64 : - evalExpr [] st' (.shl (.literal 64) (.localVar "i")) = some (i <<< 64) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - st' (.literal 64) (.localVar "i") 64 i rfl hiEval - (by decide) - (lt_trans hiLt (by decide : 6 < 2 ^ 256)) - (by - rw [Nat.shiftLeft_eq] - calc - i * 2 ^ 64 ≤ 5 * 2 ^ 64 := - Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hiLt) - _ < 2 ^ 256 := by decide) - have hTreeEval : evalExpr [] st' (.localVar "treeIdx") = some treeIdx := by + exact hi + have ht' : lookupValue st'.bindings "treeIdx" = treeIdx := by dsimp [st'] - change some (lookupValue (bindValue (bindValue st.bindings "treeIdx" treeIdx) - "secretVal" secretVal) "treeIdx") = some treeIdx rw [MemoryKit.lookupValue_bindValue_ne _ "secretVal" "treeIdx" _ (by decide)] rw [MemoryKit.lookupValue_bindValue_self] - have h64lt : i <<< 64 < 2 ^ 256 := by - rw [Nat.shiftLeft_eq] - calc - i * 2 ^ 64 ≤ 5 * 2 ^ 64 := - Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hiLt) - _ < 2 ^ 256 := by decide - have hinner : - evalExpr [] st' - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx")) - = some ((i <<< 64) ||| treeIdx) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded - st' (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx") - (i <<< 64) treeIdx h64 hTreeEval h64lt hTreeIdxLt - have h96lt : 3 <<< 96 < 2 ^ 256 := by decide - have hinnerLt : (i <<< 64) ||| treeIdx < 2 ^ 256 := - Nat.bitwise_lt_two_pow h64lt hTreeIdxLt - have hfull := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded - st' (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx")) - (3 <<< 96) ((i <<< 64) ||| treeIdx) h96 hinner h96lt hinnerLt - simpa [st', C13Concrete.adrsForsLeaf, Nat.lor_assoc] using hfull + have hbaseLt : C13Concrete.adrsForsBase t0 l0 < 2 ^ 256 := + lt_trans (C13Concrete.adrsForsBase_lt_of_bounds ht0 hl0) + (by decide : (2 : Nat) ^ 192 < 2 ^ 256) + have heval := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafAdrs_eval_eq + st' hbase' hbaseLt hi' hiLt ht' hTreeIdxLt + exact heval.trans (congrArg some + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafAdrs_value_eq_spec t0 l0 i treeIdx)) /-- Concrete C13 `H_msg` specialization that additionally discharges the FORS leaf-address setup eval from the actual outer-loop `"i"` binding and the 19-bit digest index. -/ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_eval_parse - {v : Variant} (pk : PublicKey) + (pk : PublicKey) (message sig : ByteArray) {sigParsed : Signature} - (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hparse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) (j : Nat) (hj : j < 6) (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData @@ -1400,11 +1579,12 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_eval_parse (forsAuthCdAt pk.pkSeed pk.pkRoot message sig j) idx → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.ClimbKit.stepMerkle - "node" "pathIdx" "treeAdrsBase" "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + (C13Concrete.idxLeaf0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) ((sigParsed.fors.authPath[j]?).getD []) idx a)) (hTree : evalExpr [] (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) (.bitAnd @@ -1439,16 +1619,22 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_eval_parse have hi : lookupValue (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j).bindings "i" = j := (forsOuterLeafState_setupFacts_mkC13State pk.pkSeed pk.pkRoot message sig j hj).1 + have hbase := + (forsOuterLeafState_setupFacts_mkC13State pk.pkSeed pk.pkRoot message sig j hj).2.2.2.2 + rw [← C13Concrete.parseSignatureC13_R hparse] at hbase have hTreeIdxLt : ((C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).forsIndex[j]?).getD 0 - < 2 ^ 256 := - lt_trans - (C13Concrete.hMsgC13_forsIndex_getD_lt pk sigParsed.R message - (lt_trans hj (by decide : 6 < 7))) - (by decide : 2 ^ 19 < 2 ^ 256) + < 2 ^ 19 := + C13Concrete.hMsgC13_forsIndex_getD_lt pk sigParsed.R message + (lt_trans hj (by decide : 6 < 7)) have hLeaf := forsLeafAddress_eval_eq_adrsForsLeaf (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) + hbase + (lt_trans (C13Concrete.idxTree0C13_lt pk sigParsed.R message) + (by decide : (2 : Nat) ^ 11 < 2 ^ 64)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) + (by decide : (2 : Nat) ^ 11 < 2 ^ 32)) hi hj hTreeIdxLt (secretVal := wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩)) exact @@ -1468,6 +1654,16 @@ theorem afterS3_dVal_mkC13State (pkSeed pkRoot message sig : ByteArray) : exact SphincsMinusVerifiers.SegmentS2R.s2_digest_mkC13State_final pkSeed pkRoot message sig +/-- The FORS pre-loop setup preserves the S3 `"dVal"` digest alias. -/ +theorem afterForsSetup_dVal_mkC13State (pkSeed pkRoot message sig : ByteArray) : + lookupValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "dVal" + = keccakWords [ wordOfHash16 pkSeed, wordOfHash16 pkRoot, + wordOfHash16 (C13Concrete.read16 sig 0), C13Concrete.baToNatBE message % C13Concrete.wordMod, + C13Concrete.hMsgPad ] := by + unfold afterForsSetup + rw [SegmentForsSetup.stepForsSetup_preserves_dVal_step] + exact afterS3_dVal_mkC13State pkSeed pkRoot message sig + /-- Every actual C13 FORS outer-loop prefix carries the S3 `"dVal"` digest alias. -/ theorem forsOuterPrefix_dVal_mkC13State (pkSeed pkRoot message sig : ByteArray) (n : Nat) : @@ -1481,9 +1677,9 @@ theorem forsOuterPrefix_dVal_mkC13State (by decide) SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_dVal _ 0 n] rw [MemoryKit.lookupValue_bindValue_ne - (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" "dVal" (wordNormalize 0) (by decide)] - exact afterS3_dVal_mkC13State pkSeed pkRoot message sig + exact afterForsSetup_dVal_mkC13State pkSeed pkRoot message sig /-- Named-state projection of the C13 FORS-prefix `"dVal"` frame. -/ theorem forsOuterLeafState_dVal_mkC13State @@ -1712,6 +1908,9 @@ actual root contents of the pre-copy cells. -/ theorem forsPkCompressWord_eq_of_preCopy_frame (st : RuntimeState) (seed : Nat) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue st.bindings "idxTree0" = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue st.bindings "idxLeaf0" = C13Concrete.idxLeaf0C13 digest) (hmSeed : (st.world.memory 0).val = seed) (hmR : ∀ j, (h : j < 7) → ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep st).world.memory @@ -1727,7 +1926,9 @@ theorem forsPkCompressWord_eq_of_preCopy_frame rw [SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePrePkStep_preserves_low_slot st 0x20 (by decide)] simpa [SphincsMinusVerifierSpec.C13Concrete.adrsForsRootsC13] using - SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep_adrsRoots_slot st) + SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep_adrsRoots_slot st + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) + hT hTlt hL (C13Concrete.idxLeaf0C13_lt digest)) hmR /-- Variant of `forsPkCompressWord_eq_of_preCopy_frame` matching the concrete S4 @@ -1738,6 +1939,9 @@ so callers only supply seed and root-cell facts. -/ theorem forsPkCompressWord_eq_of_preCopy_frame_six_plus_last (st : RuntimeState) (seed : Nat) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue st.bindings "idxTree0" = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue st.bindings "idxLeaf0" = C13Concrete.idxLeaf0C13 digest) (hmSeed : (st.world.memory 0).val = seed) (hmRlo : ∀ j, (h : j < 6) → ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep st).world.memory @@ -1746,7 +1950,7 @@ theorem forsPkCompressWord_eq_of_preCopy_frame_six_plus_last ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep st).world.memory 0x140).val = roots[6]'(by omega)) : forsPkCompressWord st = maskN (keccakWords (seed :: adrsForsRootsC13 digest :: roots)) := - forsPkCompressWord_eq_of_preCopy_frame st seed digest roots hlen hmSeed + forsPkCompressWord_eq_of_preCopy_frame st seed digest roots hlen hT hTlt hL hmSeed (fun j hj => by by_cases hj6 : j < 6 · exact hmRlo j hj6 @@ -1759,6 +1963,11 @@ the root-cell facts remain the substantive FORS climb correspondence obligations theorem forsPkCompressWord_eq_of_afterFors_mkC13State_six_plus_last (pkSeed pkRoot message sig : ByteArray) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest) (hLeaf : ∀ s, ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep s).world.memory 0).val = (s.world.memory 0).val) @@ -1774,6 +1983,7 @@ theorem forsPkCompressWord_eq_of_afterFors_mkC13State_six_plus_last = maskN (keccakWords (wordOfHash16 pkSeed :: adrsForsRootsC13 digest :: roots)) := forsPkCompressWord_eq_of_preCopy_frame_six_plus_last (afterFors (mkC13State pkSeed pkRoot message sig)) (wordOfHash16 pkSeed) digest roots hlen + hT hTlt hL (afterFors_seed_slot_mkC13State_of_forsLeafStep_preserves pkSeed pkRoot message sig hLeaf) hmRlo hmRlast @@ -1784,6 +1994,11 @@ instead of requiring a globally quantified leaf-step fact. -/ theorem forsPkCompressWord_eq_of_afterFors_mkC13State_six_plus_last_range (pkSeed pkRoot message sig : ByteArray) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest) (hLeaf : ∀ (s : RuntimeState) (idx : Nat), idx < 6 → ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep { s with bindings := bindValue s.bindings "i" (wordNormalize idx) }).world.memory 0).val @@ -1800,6 +2015,7 @@ theorem forsPkCompressWord_eq_of_afterFors_mkC13State_six_plus_last_range = maskN (keccakWords (wordOfHash16 pkSeed :: adrsForsRootsC13 digest :: roots)) := forsPkCompressWord_eq_of_preCopy_frame_six_plus_last (afterFors (mkC13State pkSeed pkRoot message sig)) (wordOfHash16 pkSeed) digest roots hlen + hT hTlt hL (afterFors_seed_slot_mkC13State_of_forsLeafStep_range_preserves pkSeed pkRoot message sig hLeaf) hmRlo hmRlast @@ -1810,6 +2026,11 @@ S4/FORS-compression boundary: callers supply the single seed-cell fact at theorem forsPkCompressWord_eq_of_afterFors_seed_mkC13State_six_plus_last (pkSeed pkRoot message sig : ByteArray) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest) (hmSeed : ((afterFors (mkC13State pkSeed pkRoot message sig)).world.memory 0).val = wordOfHash16 pkSeed) @@ -1825,13 +2046,18 @@ theorem forsPkCompressWord_eq_of_afterFors_seed_mkC13State_six_plus_last = maskN (keccakWords (wordOfHash16 pkSeed :: adrsForsRootsC13 digest :: roots)) := forsPkCompressWord_eq_of_preCopy_frame_six_plus_last (afterFors (mkC13State pkSeed pkRoot message sig)) (wordOfHash16 pkSeed) digest roots hlen - hmSeed hmRlo hmRlast + hT hTlt hL hmSeed hmRlo hmRlast /-- Concrete frozen-entry FORS-compression adapter with the seed-cell fact discharged internally from the actual six C13 outer-loop prefixes. -/ theorem forsPkCompressWord_eq_of_afterFors_concrete_mkC13State_six_plus_last (pkSeed pkRoot message sig : ByteArray) (digest : SphincsMinusVerifierSpec.HMsg) (roots : List Nat) (hlen : roots.length = 7) + (hT : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) + (hL : lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest) (hmRlo : ∀ j, (h : j < 6) → ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep (afterFors (mkC13State pkSeed pkRoot message sig))).world.memory @@ -1843,7 +2069,7 @@ theorem forsPkCompressWord_eq_of_afterFors_concrete_mkC13State_six_plus_last forsPkCompressWord (afterFors (mkC13State pkSeed pkRoot message sig)) = maskN (keccakWords (wordOfHash16 pkSeed :: adrsForsRootsC13 digest :: roots)) := forsPkCompressWord_eq_of_afterFors_seed_mkC13State_six_plus_last - pkSeed pkRoot message sig digest roots hlen + pkSeed pkRoot message sig digest roots hlen hT hTlt hL (afterFors_seed_slot_mkC13State pkSeed pkRoot message sig) hmRlo hmRlast @@ -1973,9 +2199,9 @@ theorem forsSecret_eval_eq_wordOfHash16_parse /-- Concrete C13 `H_msg` normal-root adapter with the local leaf-address and secret-key calldata setup evals discharged from the actual outer-loop state. -/ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_secret_parse - {v : Variant} (pk : PublicKey) + (pk : PublicKey) (message sig : ByteArray) {sigParsed : Signature} - (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hparse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) (j : Nat) (hj : j < 6) (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData @@ -1983,11 +2209,12 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_secret_parse (forsAuthCdAt pk.pkSeed pk.pkRoot message sig j) idx → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.ClimbKit.stepMerkle - "node" "pathIdx" "treeAdrsBase" "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + (C13Concrete.idxLeaf0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) ((sigParsed.fors.authPath[j]?).getD []) idx a)) (hTree : evalExpr [] (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) (.bitAnd @@ -2008,7 +2235,7 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_secret_parse omega) := by rcases forsOuterLeafState_setupFacts_mkC13State pk.pkSeed pk.pkRoot message sig j hj with - ⟨hi, hbase, hsel, hcd⟩ + ⟨hi, hsigB, hsel, hcd, _hbase⟩ let treeIdx := ((C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).forsIndex[j]?).getD 0 have hSecret : @@ -2027,7 +2254,7 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_secret_parse simpa [treeIdx] using forsSecret_eval_eq_wordOfHash16_parse (forsOuterLeafState pk.pkSeed pk.pkRoot message sig j) - pk.pkSeed pk.pkRoot message sig hparse hj hi hbase hsel hcd + pk.pkSeed pk.pkRoot message sig hparse hj hi hsigB hsel hcd (treeIdx := treeIdx) exact forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_eval_parse @@ -2047,11 +2274,12 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_par (forsAuthCdAt pk.pkSeed pk.pkRoot message sig j) idx → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.ClimbKit.stepMerkle - "node" "pathIdx" "treeAdrsBase" "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) + (C13Concrete.idxLeaf0C13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message)) ((sigParsed.fors.authPath[j]?).getD []) idx a)) : wordNormalize (lookupValue @@ -2094,14 +2322,14 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_par let treeIdx := (digest.forsIndex[j]?).getD 0 rcases forsOuterLeafState_setupFacts_mkC13State pk.pkSeed pk.pkRoot message sig j hj with - ⟨hi, hbase, hsel, hcd⟩ - have hsite : - SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.ForsFrozenSite j - pk.pkSeed pk.pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := by - exact - SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.forsLeafSetupStep_forsFrozenSite - st j pk.pkSeed pk.pkRoot message sig hi hj hbase hsel hcd + ⟨hi, hsigB, hsel, hcd, hbase0⟩ + have hbase : + lookupValue st.bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) := by + dsimp [st, digest] + rw [← C13Concrete.parseSignatureC13_R hparse] at hbase0 + exact hbase0 have hD0 := SphincsMinusVerifiers.ClimbMemFrameMerkle.fors_climb_data_range_getD pk.pkSeed pk.pkRoot message sig c13 sigParsed j @@ -2128,7 +2356,13 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_par (C13Concrete.hMsgC13_forsIndex_getD_lt pk sigParsed.R message (lt_trans hj (by decide : 6 < 7))) (by decide : 2 ^ 19 < 2 ^ 256) - have hAdrLt : C13Concrete.adrsForsLeaf j treeIdx < 2 ^ 256 := by + have hTreeIdx19 : treeIdx < 2 ^ 19 := by + dsimp [treeIdx, digest] + exact C13Concrete.hMsgC13_forsIndex_getD_lt pk sigParsed.R message + (lt_trans hj (by decide : 6 < 7)) + have hAdrLt : C13Concrete.adrsForsLeaf + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) + j treeIdx < 2 ^ 256 := by dsimp [treeIdx, digest] exact C13Concrete.adrsForsLeaf_hMsgC13_normal_lt pk sigParsed.R message hj have hSkLt : @@ -2153,7 +2387,7 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_par = some (wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩)) := by exact forsSecret_eval_eq_wordOfHash16_parse - st pk.pkSeed pk.pkRoot message sig hparse hj hi hbase hsel hcd + st pk.pkSeed pk.pkRoot message sig hparse hj hi hsigB hsel hcd (treeIdx := treeIdx) have hLeaf : evalExpr [] @@ -2161,22 +2395,36 @@ theorem forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_par (bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩))) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (C13Concrete.adrsForsLeaf j treeIdx) := by + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (C13Concrete.adrsForsLeaf + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) + j treeIdx) := by exact - forsLeafAddress_eval_eq_adrsForsLeaf st hi hj hTreeIdxLt + forsLeafAddress_eval_eq_adrsForsLeaf st hbase + (lt_trans (C13Concrete.idxTree0C13_lt pk sigParsed.R message) + (by decide : (2 : Nat) ^ 11 < 2 ^ 64)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) + (by decide : (2 : Nat) ^ 11 < 2 ^ 32)) + hi hj hTreeIdx19 (secretVal := wordOfHash16 ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩)) + have hsigBst : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset := hsigB rw [C13Concrete.forsAllRootsC13_getElem_normal (pk := pk) (digest := digest) (fors := sigParsed.fors) hj] exact SphincsMinusVerifiers.SegmentS4ForsMerkleFrame.forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata - st (wordOfHash16 pk.pkSeed) j treeIdx + st (wordOfHash16 pk.pkSeed) j + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) treeIdx ((sigParsed.fors.sk[j]?).getD ⟨#[]⟩) pk.pkSeed pk.pkRoot message sig ((sigParsed.fors.authPath[j]?).getD []) - hi hj hTreeIdxLt hsite hD hm0 hAdrLt hSkLt hTree hSecret hLeaf + hi hj hTreeIdxLt hbase + (lt_trans (C13Concrete.idxTree0C13_lt pk sigParsed.R message) + (by decide : (2 : Nat) ^ 11 < 2 ^ 64)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) + (by decide : (2 : Nat) ^ 11 < 2 ^ 32)) + hsigBst hsel hcd hD hm0 hAdrLt hSkLt hTree hSecret hLeaf /-- The final forced-root secret-key read resolves against the frozen C13 calldata image. This is the calldata half of statement 15's `lastSecret` binding: @@ -2264,6 +2512,12 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hmSeed : ((afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).world.memory 0).val = wordOfHash16 pk.pkSeed) @@ -2288,16 +2542,26 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse = C13Concrete.read16 sig (16 + 16 * 6) := by rw [hSk] rfl + have hBaseLt : C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) < 2 ^ 256 := + lt_trans + (C13Concrete.adrsForsBase_lt_of_bounds + (lt_trans hTlt (by decide : (2 : Nat) ^ 11 < 2 ^ 64)) + (lt_trans (C13Concrete.idxLeaf0C13_lt _) (by decide : (2 : Nat) ^ 11 < 2 ^ 32))) + (by decide : (2 : Nat) ^ 192 < 2 ^ 256) have hcell := SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep_forced_root_cell (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)) (wordOfHash16 pk.pkSeed) + (C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) (wordOfHash16 (C13Concrete.read16 sig (16 + 16 * 6))) - hmSeed hLastSecret + hmSeed hbaseF hBaseLt hLastSecret rw [hcell] rw [C13Concrete.forsAllRootsC13_getElem_forced] unfold C13Concrete.forsForcedRootC13 rw [hSkGetD] + simp [C13Concrete.adrsForsLeaf] /-- Calldata-framed forced-root cell bridge. This composes `finalSecret_eval_eq_wordOfHash16` with @@ -2307,6 +2571,12 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_calldata {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hmSeed : ((afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).world.memory 0).val = wordOfHash16 pk.pkSeed) @@ -2323,7 +2593,8 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_calldata (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors)[6]'(by rw [C13Concrete.forsAllRootsC13_length] decide) := by - exact forcedRootCell_eq_forsAllRootsC13_of_parse pk digest message sig hparse hmSeed + exact forcedRootCell_eq_forsAllRootsC13_of_parse pk digest message sig hparse + hbaseF hTlt hmSeed (finalSecret_eval_eq_wordOfHash16 (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)) pk.pkSeed pk.pkRoot message sig hbase hsel hcd) @@ -2335,6 +2606,12 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_static {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hmSeed : ((afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).world.memory 0).val = wordOfHash16 pk.pkSeed) : @@ -2344,7 +2621,8 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_static (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors)[6]'(by rw [C13Concrete.forsAllRootsC13_length] decide) := - forcedRootCell_eq_forsAllRootsC13_of_parse_calldata pk digest message sig hparse hmSeed + forcedRootCell_eq_forsAllRootsC13_of_parse_calldata pk digest message sig hparse + hbaseF hTlt hmSeed (afterFors_sigBase_mkC13State pk.pkSeed pk.pkRoot message sig) (afterFors_selector_mkC13State pk.pkSeed pk.pkRoot message sig) (afterFors_calldata_mkC13State pk.pkSeed pk.pkRoot message sig) @@ -2357,6 +2635,12 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_range_seed {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hLeaf : ∀ (s : RuntimeState) (idx : Nat), idx < 6 → ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep { s with bindings := bindValue s.bindings "i" (wordNormalize idx) }).world.memory 0).val @@ -2368,6 +2652,7 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_range_seed rw [C13Concrete.forsAllRootsC13_length] decide) := forcedRootCell_eq_forsAllRootsC13_of_parse_static pk digest message sig hparse + hbaseF hTlt (afterFors_seed_slot_mkC13State_of_forsLeafStep_range_preserves pk.pkSeed pk.pkRoot message sig hLeaf) @@ -2376,7 +2661,13 @@ from the actual six C13 outer-loop prefixes. -/ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_concrete {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} - (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) : + (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) : ((SphincsMinusVerifiers.SegmentS4Finalize.forsFinalizePreCopyStep (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig))).world.memory 0x140).val = @@ -2384,6 +2675,7 @@ theorem forcedRootCell_eq_forsAllRootsC13_of_parse_concrete rw [C13Concrete.forsAllRootsC13_length] decide) := forcedRootCell_eq_forsAllRootsC13_of_parse_static pk digest message sig hparse + hbaseF hTlt (afterFors_seed_slot_mkC13State pk.pkSeed pk.pkRoot message sig) /-- Combined C13 FORS root-cell handoff: the six ordinary roots are discharged by @@ -2394,13 +2686,19 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse_ran {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → ∃ base, s.selector = 0 ∧ s.world.calldata = headWords pk.pkSeed pk.pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256) (hNode : ∀ j, (hj : j < 6) → @@ -2409,18 +2707,18 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse_ran (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)) with + { (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)) with + { (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)) with bindings := bindValue - (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors)[j]'(by @@ -2449,7 +2747,7 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse_ran (mkC13State pk.pkSeed pk.pkRoot message sig) pk digest sigParsed.fors pk.pkSeed pk.pkRoot message sig hsite hNode · exact forcedRootCell_eq_forsAllRootsC13_of_parse_range_seed - pk digest message sig hparse hLeaf + pk digest message sig hparse hbaseF hTlt hLeaf /-- Concrete combined C13 FORS root-cell handoff. The six ordinary roots remain the frozen-calldata node obligations; the forced root no longer needs an external @@ -2459,13 +2757,19 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → ∃ base, s.selector = 0 ∧ s.world.calldata = headWords pk.pkSeed pk.pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256) (hNode : ∀ j, (hj : j < 6) → @@ -2474,18 +2778,18 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)) with + { (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)) with + { (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)) with bindings := bindValue - (afterS3 (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + (afterForsSetup (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors)[j]'(by @@ -2510,7 +2814,7 @@ theorem rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse (mkC13State pk.pkSeed pk.pkRoot message sig) pk digest sigParsed.fors pk.pkSeed pk.pkRoot message sig hsite hNode · exact forcedRootCell_eq_forsAllRootsC13_of_parse_concrete - pk digest message sig hparse + pk digest message sig hparse hbaseF hTlt /-- Concrete frozen-entry root-cell handoff for all seven FORS roots. The six ordinary roots are reduced to the six post-inner `"node"` correspondences, and @@ -2520,6 +2824,12 @@ theorem rootCells_eq_forsAllRootsC13_of_mkC13State_iteration_nodes_and_parse {v : Variant} (pk : PublicKey) (digest : HMsg) (message sig : ByteArray) {sigParsed : Signature} (hparse : C13Concrete.parseSignatureC13 v sig = some sigParsed) + (hbaseF : + lookupValue (afterFors (mkC13State pk.pkSeed pk.pkRoot message sig)).bindings + "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest)) + (hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11) (hNode : ∀ j, (hj : j < 6) → wordNormalize (lookupValue @@ -2547,7 +2857,7 @@ theorem rootCells_eq_forsAllRootsC13_of_mkC13State_iteration_nodes_and_parse · exact normalRootCells_eq_forsAllRootsC13_of_mkC13State_iteration_nodes pk digest message sig sigParsed.fors hNode · exact forcedRootCell_eq_forsAllRootsC13_of_parse_concrete - pk digest message sig hparse + pk digest message sig hparse hbaseF hTlt /-- Fully concrete C13 FORS root-cell handoff for the actual parsed `H_msg`. The six normal roots are supplied by the concrete outer-leaf node theorem, and @@ -2573,10 +2883,14 @@ theorem rootCells_eq_forsAllRootsC13_of_hMsg_parse_concrete sigParsed.fors)[6]'(by rw [C13Concrete.forsAllRootsC13_length] decide) := by + have hbaseF := + afterFors_forsBase_mkC13State pk.pkSeed pk.pkRoot message sig + rw [← C13Concrete.parseSignatureC13_R hparse] at hbaseF exact rootCells_eq_forsAllRootsC13_of_mkC13State_iteration_nodes_and_parse pk (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) - message sig hparse + message sig hparse hbaseF + (C13Concrete.idxTree0C13_lt pk sigParsed.R message) (fun j hj => forsOuterLeafState_node_eq_forsAllRootsC13_of_hMsg_setup_tree_secret_parse_concrete pk message sig hparse j hj) diff --git a/verity/SphincsMinusVerifiers/InitialNodeKeccak.lean b/verity/SphincsMinusVerifiers/InitialNodeKeccak.lean index 18879e9..2a5c30c 100644 --- a/verity/SphincsMinusVerifiers/InitialNodeKeccak.lean +++ b/verity/SphincsMinusVerifiers/InitialNodeKeccak.lean @@ -44,7 +44,7 @@ The FORS climb's seed node binding (`SegmentS4Fors.forsLeafBody` `node`) is `and(keccak256(0x00, 0x60), N_MASK)` over the 3-word scratch `seed ‖ FORS_LEAF adrs ‖ sk`. Given those three cells, it resolves to the spec `maskN (keccakWords [seed, adrs, sk])` — exactly the `leaf` of -`forsPkFromSigC13` when `adrs = adrsForsLeaf i treeIdx` and `sk = wordOfHash16 …`. -/ +`forsPkFromSigC13` when `adrs = adrsForsLeaf 0 0 i treeIdx` and `sk = wordOfHash16 …`. -/ theorem fors_leaf_node_eq (st : RuntimeState) (seed adrs sk : Nat) (hm0 : (st.world.memory 0).val = seed) (hm1 : (st.world.memory 0x20).val = adrs) @@ -112,16 +112,19 @@ theorem wots_pk_node_eq (st : RuntimeState) (seed pkAdrs : Nat) (chainsEnd : Lis initial-node values (`C13Concrete`'s FORS leaf / `wotsPkWord`). -/ /-- The FORS leaf node in its *spec* shape: with the scratch holding -`seed ‖ adrsForsLeaf i treeIdx ‖ wordOfHash16 sk`, the model's +`seed ‖ adrsForsLeaf idxTree0 idxLeaf0 i treeIdx ‖ wordOfHash16 sk`, the model's `and(keccak256(0x00,0x60), N_MASK)` resolves to exactly the `leaf` value -`forsPkFromSigC13` builds (`maskN (keccakWords [seed, adrsForsLeaf i treeIdx, sk])`). -/ -theorem fors_leaf_node_eq_spec (st : RuntimeState) (seed i treeIdx : Nat) (sk : Bytes) +`forsPkFromSigC13` builds at the FIPS digits. -/ +theorem fors_leaf_node_eq_spec (st : RuntimeState) + (seed idxTree0 idxLeaf0 i treeIdx : Nat) (sk : Bytes) (hm0 : (st.world.memory 0).val = seed) - (hm1 : (st.world.memory 0x20).val = adrsForsLeaf i treeIdx) + (hm1 : (st.world.memory 0x20).val = adrsForsLeaf idxTree0 idxLeaf0 i treeIdx) (hm2 : (st.world.memory 0x40).val = wordOfHash16 sk) : evalExpr [] st (.bitAnd (.keccak256 (.literal 0x00) (.literal 0x60)) (.literal nMask)) - = some (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := - fors_leaf_node_eq st seed (adrsForsLeaf i treeIdx) (wordOfHash16 sk) hm0 hm1 hm2 + = some (maskN + (keccakWords [seed, adrsForsLeaf idxTree0 idxLeaf0 i treeIdx, wordOfHash16 sk])) := + fors_leaf_node_eq st seed (adrsForsLeaf idxTree0 idxLeaf0 i treeIdx) (wordOfHash16 sk) + hm0 hm1 hm2 /-- The WOTS chain ends of one layer, extracted verbatim from `wotsPkWord`'s internal `let chainsEnd`, so the unfolding `wotsPkWord_eq` holds by `rfl`. -/ diff --git a/verity/SphincsMinusVerifiers/Model.lean b/verity/SphincsMinusVerifiers/Model.lean index 2f18fdf..c7678f0 100644 --- a/verity/SphincsMinusVerifiers/Model.lean +++ b/verity/SphincsMinusVerifiers/Model.lean @@ -122,20 +122,27 @@ def c13VerifyBodyTail : List Stmt := [ .ite (andE (shrE (u 114) (v "dVal")) (u 0x7FFFF)) revert0 [], .letVar "sigBase" (v "sig_data_offset"), + .letVar "idxLeaf0" (andE (v "htIdx") (u 0x7FF)), + .letVar "idxTree0" (shrE (u 11) (v "htIdx")), + .letVar "forsBase" + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "idxLeaf0")))), + .forEach "i" (u 6) [ .letVar "treeIdx" (andE (shrE (mulE (v "i") (u 19)) (v "dVal")) (u 0x7FFFF)), .letVar "secretVal" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (v "i"))))) (u N_MASK)), - .letVar "leafAdrs" (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))), + .letVar "leafAdrs" (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))), mstore 0x20 (v "leafAdrs"), mstore 0x40 (v "secretVal"), .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))), .forEach "h" (u 19) [ .letVar "sibling" (andE (cdload (addE (v "authPtr") (shlE (u 4) (v "h")))) (u N_MASK)), .letVar "parentIdx" (shrE (u 1) (v "pathIdx")), - mstore 0x20 (orE (v "treeAdrsBase") (orE (shlE (u 32) (addE (v "h") (u 1))) (v "parentIdx"))), + mstore 0x20 (orE (v "forsBase") + (orE (shlE (u 32) (addE (v "h") (u 1))) + (orE (shlE (subE (u 18) (v "h")) (v "i")) (v "parentIdx")))), .letVar "s" (shlE (u 5) (andE (v "pathIdx") (u 1))), mstoreE (xorE (u 0x40) (v "s")) (v "node"), mstoreE (xorE (u 0x60) (v "s")) (v "sibling"), @@ -146,11 +153,13 @@ def c13VerifyBodyTail : List Stmt := [ ], .letVar "lastSecret" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)), - mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6))), + mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6))), mstore 0x40 (v "lastSecret"), mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK)), - mstore 0x20 (shlE (u 96) (u 4)), + mstore 0x20 + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))), .forEach "i" (u 7) [ mstoreE (addE (u 0x40) (shlE (u 5) (v "i"))) (mloadE (addE (u 0x80) (shlE (u 5) (v "i")))) ], diff --git a/verity/SphincsMinusVerifiers/Proofs.lean b/verity/SphincsMinusVerifiers/Proofs.lean index 2804b71..2eae27e 100644 --- a/verity/SphincsMinusVerifiers/Proofs.lean +++ b/verity/SphincsMinusVerifiers/Proofs.lean @@ -69,6 +69,7 @@ import SphincsMinusVerifiers.ProofCore import SphincsMinusVerifiers.C13BridgePrep import SphincsMinusVerifiers.C13ChainCells +import SphincsMinusVerifiers.C13WotsPkKeccak import SphincsMinusVerifiers.C12BridgePrep import SphincsMinusVerifiers.KeccakBridge import SphincsMinusVerifiers.SegmentLayer3AddressCells @@ -456,12 +457,32 @@ theorem c13AfterFinalize_forsPk_of_parse_fors C13Concrete.wordOfHash16 forsPk := by rw [hForsPkByte] exact (SegmentAcceptSpec.forsPkWordC13_roundtrip pk digest sigParsed.fors).symm + have hTd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hLd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTltd : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message have hForsCompress : CurrentNodeFrame.forsPkCompressWord (afterFors st) = C13Concrete.wordOfHash16 forsPk := by rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_concrete_mkC13State_six_plus_last pkSeed pkRoot message sig digest (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors)] + (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hTd hTltd hLd] · simpa [pk, digest, C13Concrete.forsPkWordC13] using hForsPkWord · intro j hj simpa [pk, digest] using hRoots.1 j hj @@ -1726,15 +1747,12 @@ theorem c13FoldOkCurrentNodePkRootSizeData_of_current_node_facts /-- Package the current concrete two-step layer facts into the `.ok` branch data shape whose final comparison uses the C13 public-key root projection. The -comparison follows from the C13-produced `specRoot` roundtrip; it no longer needs -any public-key-root size premise. -/ +comparison follows from the C13-produced `specRoot` roundtrip; the four +executable layer facts (two guards, two post-step `"currentNode"` words) are +explicit hypotheses — the spec-side fold data alone cannot discharge them. -/ theorem c13FoldOkCurrentNodeWordcmpData_of_current_node_facts (pkSeed pkRoot message sig : Bytes) (sigParsed : Signature) (forsPk specRoot : Bytes) - (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) - (hZero : forcedZeroOk c13 - (C13Concrete.c13PrimitivesConcrete.hMsg c13 - { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true) (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 { pkSeed := pkSeed, pkRoot := pkRoot } (C13Concrete.c13PrimitivesConcrete.hMsg c13 @@ -1744,21 +1762,37 @@ theorem c13FoldOkCurrentNodeWordcmpData_of_current_node_facts { pkSeed := pkSeed, pkRoot := pkRoot } (C13Concrete.c13PrimitivesConcrete.hMsg c13 { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) - forsPk sigParsed.layers = .ok specRoot) : + forsPk sigParsed.layers = .ok specRoot) + (hGuard0 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent0 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = + C13Concrete.wordOfHash16 + (SegmentAcceptSpec.c13HypertreeSpecStepAtLayer + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.layers 0 forsPk)) + (hGuard1 : + SegmentLayer3.layerGuard + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig)) = true) + (hCurrent1 : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig))).bindings + "currentNode" + = C13Concrete.wordOfHash16 specRoot) : C13FoldOkCurrentNodeWordcmpData pkSeed pkRoot message sig sigParsed forsPk specRoot := - let st := mkC13State pkSeed pkRoot message sig - let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } - let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message - let d := C13Concrete.foldHypertree_c13_ok_two_layer_data pk digest forsPk specRoot sigParsed.layers hFold - have hDigitSum0 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState0 st)).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig0.wots (by simpa using d.hGrinding0) - have hGuard0 := C13BridgePrep.layer0_guard_discharged (CurrentNodeFrame.c13LayerLoopState0 st) hDigitSum0 - have hCurrent0 := C13BridgePrep.layer0_currentNode_discharged pkSeed pkRoot message sig sigParsed forsPk (CurrentNodeFrame.c13LayerLoopState0 st) hParse - have hDigitSum1 : lookupValue (SegmentLayer3.afterDigit (CurrentNodeFrame.c13LayerLoopState1 st)).bindings "digitSum" = 208 := by - exact C13Concrete.wotsDigitSum_eq_of_wotsGrindingFailsC13AtLayer_false C13Concrete.c13PrimitivesConcrete c13 d.lsig1.wots (by simpa using d.hGrinding1) - have hGuard1 := C13BridgePrep.layer1_guard_discharged (CurrentNodeFrame.c13LayerLoopState1 st) hDigitSum1 - have hCurrent1 := C13BridgePrep.layer1_currentNode_discharged pkSeed pkRoot message sig sigParsed specRoot (CurrentNodeFrame.c13LayerLoopState1 st) hParse ⟨hGuard0, hCurrent0, hGuard1, hCurrent1, SegmentAcceptSpec.wordCmp_of_wordOfHash16_rootMatchesPk_c13 specRoot pkRoot (SegmentAcceptSpec.specRoot_roundtrip_of_c13_fors_fold hFors hFold)⟩ @@ -2508,10 +2542,6 @@ discharged by the C13-produced `specRoot` roundtrip rather than `pkRoot.size`. - theorem c13FoldOkCurrentNodeWordcmpData_of_digit_merkle_facts (pkSeed pkRoot message sig : Bytes) (sigParsed : Signature) (forsPk specRoot : Bytes) - (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) - (hZero : forcedZeroOk c13 - (C13Concrete.c13PrimitivesConcrete.hMsg c13 - { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true) (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 { pkSeed := pkSeed, pkRoot := pkRoot } (C13Concrete.c13PrimitivesConcrete.hMsg c13 @@ -2530,9 +2560,9 @@ theorem c13FoldOkCurrentNodeWordcmpData_of_digit_merkle_facts -- Use the (now deriving) constructor; supply the four facts via the lightweight -- digit+merkle proofs we already have (this path is used when we have the -- afterMerkle/raw step witnesses but want to avoid full observed derivation). - refine + apply c13FoldOkCurrentNodeWordcmpData_of_current_node_facts - pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold + pkSeed pkRoot message sig sigParsed forsPk specRoot hFors hFold · exact SegmentLayer3.layerGuard_of_afterDigit_digitSum_eq (CurrentNodeFrame.c13LayerLoopState0 @@ -3729,18 +3759,38 @@ theorem c13FoldRevertedBeforeAuthOffWotsPkAddressChainCellsDataLayer0_of_split intro d exact ⟨hAddr d, hChain d⟩ +/-- The historical `SegmentLayer3.suffixBeforeWotsPk` and the lightweight +`SegmentLayer3AddressCells.suffixBeforeWotsPkFrom` are the *same* statement +list (the bodies are textual mirrors). -/ +theorem c13_suffixBeforeWotsPk_eq : + SegmentLayer3.suffixBeforeWotsPk + = SegmentLayer3AddressCells.suffixBeforeWotsPkFrom := rfl + +/-- The historical `beforeWotsPk` cutpoint IS the lightweight `beforeWotsPkFrom` +cutpoint: both run the same suffix from `afterDigit ls`. -/ +theorem c13_beforeWotsPk_eq_beforeWotsPkFrom (ls : RuntimeState) : + SegmentLayer3.beforeWotsPk ls + = SegmentLayer3AddressCells.beforeWotsPkFrom (SegmentLayer3.afterDigit ls) := by + have h1 := SegmentLayer3.beforeWotsPk_eq ls + rw [c13_suffixBeforeWotsPk_eq] at h1 + have h2 := SegmentLayer3AddressCells.beforeWotsPkFrom_eq (SegmentLayer3.afterDigit ls) + rw [h1] at h2 + injection h2 + /-- C13 exact seed-cell bridge from the historical `SegmentLayer3.beforeWotsPk` cutpoint to the lightweight post-digit prefix cutpoint. This is intentionally a single-cell bridge, not a whole-state equality. -ASSEMBLY OBLIGATION (supporting single-cell bridge — see README "Residual assembly -axioms"). A 0x00-cell framing equality between two SegmentLayer3-derived states; -needs SegmentLayer3 reasoning, so undischargeable under the cap on this host. -/ -axiom c13_beforeWotsPk_memory_zero_eq_lightweight +Now discharged: `SegmentLayer3.beforeWotsPk` is *equal* to the lightweight +`beforeWotsPkFrom (afterDigit ls)` cutpoint (`c13_beforeWotsPk_eq_beforeWotsPkFrom` +below — the two suffix statement lists are syntactically the same), so the +single-cell framing is a rewrite. -/ +theorem c13_beforeWotsPk_memory_zero_eq_lightweight (ls : RuntimeState) : ((SegmentLayer3.beforeWotsPk ls).world.memory 0x00).val = ((SegmentLayer3AddressCells.beforeWotsPkFrom - (SegmentLayer3.afterDigit ls)).world.memory 0x00).val + (SegmentLayer3.afterDigit ls)).world.memory 0x00).val := by + rw [c13_beforeWotsPk_eq_beforeWotsPkFrom] /-- The reverted layer-0 `beforeWotsPk` seed cell follows from the verified WOTS/copy memory-zero frames and the first-layer guarded-state seed slot. -/ @@ -8016,9 +8066,10 @@ theorem c13FoldOkCurrentNodeWordcmpData_of_two_step_obligations simpa [hStep0Eq] using hStep1Eq have hRoot1 : root1 = specRoot := by simpa [ClimbLoop.specFold, hTwo, hStep0Eq, hStep1Root0] using hSpecFold - refine + apply c13FoldOkCurrentNodeWordcmpData_of_current_node_facts - pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold + pkSeed pkRoot message sig sigParsed forsPk specRoot hFors hFold + · exact hObs.hGuard0 · change lookupValue (SegmentLayer3.stepLayer @@ -8028,6 +8079,7 @@ theorem c13FoldOkCurrentNodeWordcmpData_of_two_step_obligations rw [hStep0Eq] simpa [pk, digest, specStep, CurrentNodeFrame.c13LayerLoopState0, CurrentNodeFrame.c13LayerStartState] using hCurrent0 + · exact hObs.hGuard1 · rw [← hRoot1] simpa [pk, digest, specStep, CurrentNodeFrame.c13LayerLoopState1, CurrentNodeFrame.c13LayerAfterStep0, hStep0Eq] using hCurrent1 @@ -8564,7 +8616,7 @@ theorem c13_refines_byte_spec_of_current_node_and_reverted_guard_cover exact C13BridgePrep.runC13BodyObserved_accept_from_fold_ok_current_nodes_wordcmp pkSeed pkRoot message sig sigParsed forsPk specRoot - hParse hZero hFors hFold hWordCmp -- hGuard*/hCurrent* dropped (derived in callee or via updated path) + hParse hZero hFors hFold hGuard0 hCurrent0 hGuard1 hCurrent1 hWordCmp · intro pkSeed pkRoot message sig sigParsed forsPk hParse hZero hFors hFold have hg3 : SegmentS3.s3Guard @@ -9017,7 +9069,8 @@ theorem c13_refines_byte_spec_of_current_node_facts_and_reverted_digest_scratch_ ⟨hGuard0, hCurrent0, hGuard1, hCurrent1⟩ exact c13FoldOkCurrentNodeWordcmpData_of_current_node_facts - pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold + pkSeed pkRoot message sig sigParsed forsPk specRoot hFors hFold + hGuard0 hCurrent0 hGuard1 hCurrent1 /-- C13 bridge reducer with both branches at concrete layer facts. The accept branch uses the two guards and two post-step `"currentNode"` facts. The reverted @@ -10919,14 +10972,14 @@ theorem c13_refines_byte_spec_of_accept_guard_current_node_and_reverted_digest_s cutpoint to the lightweight post-digit prefix cutpoint. This is intentionally a single-cell bridge, not a whole-state equality. -ASSEMBLY OBLIGATION (supporting single-cell bridge — see README "Residual assembly -axioms"). A 0x20-cell framing equality between two SegmentLayer3-derived states; -needs SegmentLayer3 reasoning, so undischargeable under the cap on this host. -/ -axiom c13_beforeWotsPk_memory_0x20_eq_lightweight +Now discharged via `c13_beforeWotsPk_eq_beforeWotsPkFrom`: the two states are +equal, so the cell framing is a rewrite. -/ +theorem c13_beforeWotsPk_memory_0x20_eq_lightweight (ls : RuntimeState) : ((SegmentLayer3.beforeWotsPk ls).world.memory 0x20).val = ((SegmentLayer3AddressCells.beforeWotsPkFrom - (SegmentLayer3.afterDigit ls)).world.memory 0x20).val + (SegmentLayer3.afterDigit ls)).world.memory 0x20).val := by + rw [c13_beforeWotsPk_eq_beforeWotsPkFrom] /-- Lightweight C13 WOTS-outer entry state used by the single-cell historical bridges. -/ @@ -10939,21 +10992,188 @@ def c13BeforeWotsPkLightState (ls : RuntimeState) : RuntimeState := (SegmentLayer3.afterDigit ls)).bindings "i" (wordNormalize 0) } +/-- `beforeWotsPkFrom` factors through the post-WOTS/address-store cutpoint and +the final copy loop (`beforeWotsPkAfterWotsCopyFrom`); proven by exec-list +rewriting only — no loop iteration is ever unfolded. -/ +theorem c13_beforeWotsPkFrom_eq_afterWotsCopy (ad : RuntimeState) : + SegmentLayer3AddressCells.beforeWotsPkFrom ad + = SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom ad := by + unfold SegmentLayer3AddressCells.beforeWotsPkFrom + SegmentLayer3AddressCells.suffixBeforeWotsPkFrom + rw [MemoryKit.execStmtList_append_continue _ _ _ _ + (SegmentLayer3AddressCells.beforeWotsPkCopyFrom_eq ad)] + rw [SegmentLayer3AddressCells.beforeWotsPkCopyFrom_eq_afterWots ad] + rw [show ([Compiler.CompilationModel.Stmt.forEach "i" + (Compiler.CompilationModel.Expr.literal 43) + SegmentLayer3CopyCells.copyBody] : List Compiler.CompilationModel.Stmt) + = SegmentLayer3AddressCells.suffixWotsPkCopyFrom from rfl] + rw [SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom_eq ad] + +/-- The WOTS-PK address-store interlude (the `pkAdrs` letVar plus `mstore 0x20`) +preserves every memory cell other than `0x20`. -/ +theorem c13_addressStore_preserves_cell (ad : RuntimeState) (c : Nat) + (hc : c ≠ 0x20) : + ((SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom ad).world.memory c).val = + ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom ad).world.memory c).val := by + refine SphincsMinusVerifiers.MemoryFrame.execStmtList_preserves_memory_val c + SegmentLayer3AddressCells.suffixWotsPkAddressStoreFrom _ _ ?_ + (SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom_eq ad) + intro s s'' stmt hmem hexec + simp [SegmentLayer3AddressCells.suffixWotsPkAddressStoreFrom] at hmem + rcases hmem with rfl | rfl + · exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val + s s'' c "pkAdrs" _ hexec + · refine SphincsMinusVerifiers.MemoryFrame.execStmt_mstore_preserves_memory_val + s s'' c _ _ ?_ hexec + intro ro rv hoff _ + cases hoff + have h20 : wordNormalize 0x20 = 0x20 := by + rw [wordNormalize_eq_mod]; exact Nat.mod_eq_of_lt (by decide) + rw [h20] + omega + +/-- The C13 WOTS-PK copy fold leaves chain-destination cells beyond the copy +range (`43 ≤ j`) untouched. -/ +theorem c13_copyLoop_preserves_out_slot : + ∀ (s : RuntimeState) (idx remaining j : Nat), + 43 ≤ j → idx + remaining ≤ 43 → + ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep s idx remaining).world.memory + (0x40 + 32 * j)).val + = (s.world.memory (0x40 + 32 * j)).val + | s, idx, 0, j, _, _ => by + rw [ClimbLoop.foldLoop_zero] + | s, idx, remaining + 1, j, hj, hbound => by + have hidx : idx < 43 := by omega + let s1 : RuntimeState := + SegmentLayer3CopyCells.copyStep + { s with bindings := bindValue s.bindings "i" (wordNormalize idx) } + rw [ClimbLoop.foldLoop_succ] + change ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep s1 (idx + 1) + remaining).world.memory (0x40 + 32 * j)).val + = (s.world.memory (0x40 + 32 * j)).val + rw [c13_copyLoop_preserves_out_slot s1 (idx + 1) remaining j hj (by omega)] + exact SegmentLayer3CopyCells.copyStep_preserves_copy_slot s idx j hidx (by omega) + +/-- Chain-destination cells of the full lightweight WOTS-PK cutpoint are the +pre-copy source cells, for in-range `j`. The copy fold is introduced only via +`rw [← he]`, so the fold start state is never restated (its spelling stays the +one produced by `execStmt_forEach_of_step`). -/ +theorem c13_awcf_copied_slot (ls : RuntimeState) (j : Nat) (hj : j < 43) : + ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val = + ((SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x80 + 32 * j)).val := by + have h := SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom_eq + (SegmentLayer3.afterDigit ls) + unfold SegmentLayer3AddressCells.suffixWotsPkCopyFrom at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ [] + (ClimbLoop.execStmt_forEach_of_step "i" (.literal 43) + SegmentLayer3CopyCells.copyBody _ _ + SegmentLayer3CopyCells.copyStep rfl + SegmentLayer3CopyCells.copyStepLemma)] at h + have hb : wordNormalize 43 = 43 := by + rw [wordNormalize_eq_mod]; exact Nat.mod_eq_of_lt (by decide) + rw [hb] at h + have hnil : ∀ (s : RuntimeState), execStmtList [] s [] = StmtResult.continue s := + fun _ => rfl + rw [hnil] at h + have he := StmtResult.continue.inj h + rw [← he] + exact SegmentLayer3CopyCells.copyFold43_copied_slot _ j hj + +/-- Out-of-range chain cells pass through the copy fold untouched. -/ +theorem c13_awcf_out_slot (ls : RuntimeState) (j : Nat) (hj : 43 ≤ j) : + ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val = + ((SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val := by + have h := SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom_eq + (SegmentLayer3.afterDigit ls) + unfold SegmentLayer3AddressCells.suffixWotsPkCopyFrom at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ [] + (ClimbLoop.execStmt_forEach_of_step "i" (.literal 43) + SegmentLayer3CopyCells.copyBody _ _ + SegmentLayer3CopyCells.copyStep rfl + SegmentLayer3CopyCells.copyStepLemma)] at h + have hb : wordNormalize 43 = 43 := by + rw [wordNormalize_eq_mod]; exact Nat.mod_eq_of_lt (by decide) + rw [hb] at h + have hnil : ∀ (s : RuntimeState), execStmtList [] s [] = StmtResult.continue s := + fun _ => rfl + rw [hnil] at h + have he := StmtResult.continue.inj h + rw [← he] + exact c13_copyLoop_preserves_out_slot _ 0 43 j hj (by omega) + +/-- The lightweight WOTS outer fold over `c13BeforeWotsPkLightState` IS the +named post-WOTS cutpoint (same start-state spelling, so `rfl`). -/ +theorem c13_wotsFold_eq_lightweight (ls : RuntimeState) : + ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep + (c13BeforeWotsPkLightState ls) 0 43 + = SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom + (SegmentLayer3.afterDigit ls) := rfl + /-- C13 exact chain-cell bridge from the historical `SegmentLayer3.beforeWotsPk` cutpoint to the lightweight WOTS-outer/copy-fold state. This exposes only the destination preimage cell requested by downstream WOTS-PK proofs. -ASSEMBLY OBLIGATION (supporting single-cell bridge — see README "Residual assembly -axioms"). A chain-cell (`0x40 + 32*j`) framing equality between two -SegmentLayer3-derived states; needs SegmentLayer3 reasoning, so undischargeable under -the cap on this host. -/ -axiom c13_beforeWotsPk_memory_chain_eq_lightweight +Now discharged: routed through the lightweight `beforeWotsPkAfterWotsCopyFrom` +cutpoint (equal to `beforeWotsPk ls` via `c13_beforeWotsPk_eq_beforeWotsPkFrom` and +`c13_beforeWotsPkFrom_eq_afterWotsCopy`), whose chain cells are identified with the +copy-fold image by `c13_awcf_copied_slot` / `c13_awcf_out_slot`; both sides then meet +at the post-WOTS source cells through the address-store frame +`c13_addressStore_preserves_cell`. Assembled with `congrArg`/`trans` only — no +rewriting under the interpreter folds — so elaboration stays in the ~400 MB regime. -/ +theorem c13_beforeWotsPk_memory_chain_eq_lightweight (ls : RuntimeState) (j : Nat) : ((SegmentLayer3.beforeWotsPk ls).world.memory (0x40 + 32 * j)).val = ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep + (c13BeforeWotsPkLightState ls) 0 43) + 0 43).world.memory (0x40 + 32 * j)).val := by + have h12 : SegmentLayer3.beforeWotsPk ls + = SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom + (SegmentLayer3.afterDigit ls) := + (c13_beforeWotsPk_eq_beforeWotsPkFrom ls).trans + (c13_beforeWotsPkFrom_eq_afterWotsCopy (SegmentLayer3.afterDigit ls)) + have hA : ((SegmentLayer3.beforeWotsPk ls).world.memory (0x40 + 32 * j)).val + = ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsCopyFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val := + congrArg (fun s => ((s.world.memory (0x40 + 32 * j))).val) h12 + by_cases hj : j < 43 + · have hsrc : ((SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x80 + 32 * j)).val + = ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x80 + 32 * j)).val := + c13_addressStore_preserves_cell (SegmentLayer3.afterDigit ls) + (0x80 + 32 * j) (by omega) + have hB : ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep (c13BeforeWotsPkLightState ls) 0 43) 0 43).world.memory (0x40 + 32 * j)).val + = ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x80 + 32 * j)).val := + (congrArg (fun s => ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + s 0 43).world.memory (0x40 + 32 * j)).val) (c13_wotsFold_eq_lightweight ls)).trans + (SegmentLayer3CopyCells.copyFold43_copied_slot _ j hj) + exact (hA.trans ((c13_awcf_copied_slot ls j hj).trans hsrc)).trans hB.symm + · have hj' : 43 ≤ j := by omega + have hcell : ((SegmentLayer3AddressCells.beforeWotsPkCopyAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val + = ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val := + c13_addressStore_preserves_cell (SegmentLayer3.afterDigit ls) + (0x40 + 32 * j) (by omega) + have hB : ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep + (c13BeforeWotsPkLightState ls) 0 43) + 0 43).world.memory (0x40 + 32 * j)).val + = ((SegmentLayer3AddressCells.beforeWotsPkAfterWotsFrom + (SegmentLayer3.afterDigit ls)).world.memory (0x40 + 32 * j)).val := + (congrArg (fun s => ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + s 0 43).world.memory (0x40 + 32 * j)).val) (c13_wotsFold_eq_lightweight ls)).trans + (c13_copyLoop_preserves_out_slot _ 0 43 j hj' (by omega)) + exact (hA.trans ((c13_awcf_out_slot ls j hj').trans hcell)).trans hB.symm /-- The exact lightweight facts needed to close a C13 WOTS-outer/copy-chain cell residual. This deliberately exposes only seed, digest, WOTS address, @@ -11103,19 +11323,11 @@ axiom c13_ok_beforeAuthOff_wotsPk_lightweight_chain_inputs_layer0 : d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) wotsPtr 1952 /-- The layer-0 C13 calldata/loop closure from exact lightweight WOTS-outer -inputs to copied chain-end cells. The premise is intentionally the five-field -`C13WotsOuterExactInputs` package rather than a whole-state relation. - -ASSEMBLY OBLIGATION (mirror of a verified lemma — see README "Residual assembly -axioms"). Unlike the concrete-state residuals, this is a GENERIC `_of_inputs` closure -whose exact content is already proven under cap in `C13WotsPkKeccak.lean` -(`c13Layer0_copyFold43_wotsChainsEnd_cells_of_inputs`, via -`c13Layer0_copyFold43_wotsChainsEnd_cells_of_wotsOuterFold43` + -`adrsWotsHashBase_lt_of_bounds`). It is kept as an axiom here only because flipping it to -a `theorem` is an edit to `Proofs.lean`, which cannot be compiled on this host (~48 GB -OOM above the 10 GB cap). This is the prime candidate to discharge first on a >~64 GB -pass: the proof is a one-line `exact` of the verified C13WotsPkKeccak lemma. -/ -axiom c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0 : +inputs to copied chain-end cells: discharged by the verified +`c13Layer0_copyFold43_wotsChainsEnd_cells_of_entry` (C13WotsPkKeccak), with the +entry record built from the inputs record at prefix `0` via `foldLoop_zero` +and the calldata loads passed through verbatim. -/ +theorem c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0 : ∀ pkSeed pkRoot message sig sigParsed forsPk specRoot, C13Concrete.parseSignatureC13 c13 sig = some sigParsed → forcedZeroOk c13 @@ -11152,10 +11364,68 @@ axiom c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0 : (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) (C13Concrete.wordOfHash16 forsPk) d.lsig0.wots)[j]'(by rw [InitialNodeKeccak.wotsChainsEnd_length] - omega) + omega):= by + intro pkSeed pkRoot message sig sigParsed forsPk specRoot + hParse _hZero _hFors _hFold pk digest d st wotsPtr hInputs j hj + have hHyLt : + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).hyperIndex + < 2 ^ 22 := + C13Concrete.hMsgC13_hyperIndex_lt pk sigParsed.R message + have hDigestLt : + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) < 2 ^ 256 := + c13_wotsDigest_lt (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) + have hAdrsLt : + C13Concrete.adrsWotsHashBase 0 + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) < 2 ^ 256 := by + have hT : (digest.hyperIndex / 2048) <<< 128 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + (digest.hyperIndex / 2048) * 2 ^ 128 ≤ 2 ^ 22 * 2 ^ 128 := + Nat.mul_le_mul_right _ + (le_of_lt (Nat.lt_of_le_of_lt (Nat.div_le_self _ _) hHyLt)) + _ < 2 ^ 256 := by decide + have hL : (digest.hyperIndex % 2048) <<< 64 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + (digest.hyperIndex % 2048) * 2 ^ 64 ≤ 2047 * 2 ^ 64 := + Nat.mul_le_mul_right _ + (Nat.le_of_lt_succ (Nat.mod_lt _ (by decide : 0 < 2048))) + _ < 2 ^ 256 := by decide + have h224 : (0 : Nat) <<< 224 < 2 ^ 256 := by decide + exact Nat.bitwise_lt_two_pow + (Nat.bitwise_lt_two_pow h224 hT) hL + have e : C13WotsOuterEntry pkSeed st + (C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk)) + (C13Concrete.adrsWotsHashBase 0 + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048)) + wotsPtr := + { seed0 := by + have h := hInputs.hSeed 0 (by decide) + rwa [ClimbLoop.foldLoop_zero] at h + d0 := by + have h := hInputs.hD 0 (by decide) + rwa [ClimbLoop.foldLoop_zero] at h + adrs0 := by + have h := hInputs.hAdrs 0 (by decide) + rwa [ClimbLoop.foldLoop_zero] at h + wptr0 := rfl } + exact c13Layer0_copyFold43_wotsChainsEnd_cells_of_entry + pkSeed pkRoot message sig sigParsed st + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 forsPk) wotsPtr + d.lsig0 hParse d.hLayer0 hDigestLt hAdrsLt e + (fun j' hj' s h1 h2 h3 => hInputs.hCdLoad j' hj' s h1 h2 h3) + j hj /-- C13 accept-side layer-0 copied WOTS chain-end cells at the lightweight -WOTS-outer/copy-fold cutpoint, derived from exact WOTS-outer inputs. -/ +WOTS-outer/copy-fold cutpoint: composition of the exact-inputs obligation and +its verified `_of_inputs` closure. -/ theorem c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer0 : ∀ pkSeed pkRoot message sig sigParsed forsPk specRoot, C13Concrete.parseSignatureC13 c13 sig = some sigParsed → @@ -11179,17 +11449,9 @@ theorem c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer0 : ∀ j, (h : j < 43) → ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep - { SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (CurrentNodeFrame.c13LayerLoopState0 - (mkC13State pkSeed pkRoot message sig))) with - bindings := - bindValue - (SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (CurrentNodeFrame.c13LayerLoopState0 - (mkC13State pkSeed pkRoot message sig)))).bindings - "i" (wordNormalize 0) } + (c13BeforeWotsPkLightState + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))) 0 43) 0 43).world.memory (0x40 + 32 * j)).val = (InitialNodeKeccak.wotsChainsEnd @@ -11197,26 +11459,13 @@ theorem c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer0 : (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) (C13Concrete.wordOfHash16 forsPk) d.lsig0.wots)[j]'(by rw [InitialNodeKeccak.wotsChainsEnd_length] - omega) := by + omega):= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold pk digest d j hj have hInputs := c13_ok_beforeAuthOff_wotsPk_lightweight_chain_inputs_layer0 pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold d - change - ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep - (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep - (c13BeforeWotsPkLightState - (CurrentNodeFrame.c13LayerLoopState0 - (mkC13State pkSeed pkRoot message sig))) 0 43) - 0 43).world.memory (0x40 + 32 * j)).val = - (InitialNodeKeccak.wotsChainsEnd - (C13Concrete.wordOfHash16 pkSeed) 0 - (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) - (C13Concrete.wordOfHash16 forsPk) d.lsig0.wots)[j]'(by - rw [InitialNodeKeccak.wotsChainsEnd_length] - omega) exact c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_of_inputs_layer0 pkSeed pkRoot message sig sigParsed forsPk specRoot @@ -11242,8 +11491,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_chain_cells_residual_layer0 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkChainCellsDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold intro d @@ -11288,8 +11536,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_address_cell_residual_layer1 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkAddressCellDataLayer1 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse _hZero _hFors _hFold intro _d rw [← c13SecondLayerGuardState_eq_c13LayerLoopState1 pkSeed pkRoot message sig] @@ -11380,17 +11627,9 @@ axiom c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer1 : ∀ j, (h : j < 43) → ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep - { SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (CurrentNodeFrame.c13LayerLoopState1 - (mkC13State pkSeed pkRoot message sig))) with - bindings := - bindValue - (SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (CurrentNodeFrame.c13LayerLoopState1 - (mkC13State pkSeed pkRoot message sig)))).bindings - "i" (wordNormalize 0) } + (c13BeforeWotsPkLightState + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig))) 0 43) 0 43).world.memory (0x40 + 32 * j)).val = (InitialNodeKeccak.wotsChainsEnd @@ -11420,8 +11659,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_chain_cells_residual_layer1 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkChainCellsDataLayer1 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold intro d @@ -11466,8 +11704,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_address_chain_cells_residual_layer0 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkAddressChainCellsDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11499,8 +11736,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_address_chain_cells_residual_layer1 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkAddressChainCellsDataLayer1 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11532,8 +11768,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_preimage_cells_residual_layer0 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkPreimageCellsDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11562,8 +11797,7 @@ theorem c13_ok_beforeAuthOff_wotsPk_preimage_cells_residual_layer1 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkBeforeAuthOffWotsPkPreimageCellsDataLayer1 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11592,8 +11826,7 @@ theorem c13_ok_afterMerkle_initial_wotsPk_residual_layer0 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkAfterMerkleRawXmssClimbInitialWotsPkDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11624,8 +11857,7 @@ theorem c13_ok_afterMerkle_initial_wotsPk_residual_layer1 : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkAfterMerkleRawXmssClimbInitialWotsPkDataLayer1 - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11658,8 +11890,7 @@ theorem c13_ok_digit_merkle_facts_residual : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkDigitMerkleData - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11690,8 +11921,7 @@ theorem c13_ok_current_node_wordcmp_residual : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .ok specRoot → C13FoldOkCurrentNodeWordcmpData - pkSeed pkRoot message sig sigParsed forsPk specRoot - := by + pkSeed pkRoot message sig sigParsed forsPk specRoot:= by intro pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold exact @@ -11720,8 +11950,7 @@ theorem c13_reverted_layer0_beforeAuthOff_wotsPk_address_cell_residual : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .reverted → C13FoldRevertedBeforeAuthOffWotsPkAddressCellDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk - := by + pkSeed pkRoot message sig sigParsed forsPk:= by intro pkSeed pkRoot message sig sigParsed forsPk hParse _hZero _hFors _hFold intro _d let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } @@ -11805,15 +12034,8 @@ axiom c13_reverted_layer0_beforeAuthOff_wotsPk_lightweight_chain_cells_residual ∀ j, (h : j < 43) → ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep - { SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (c13FirstLayerGuardState pkSeed pkRoot message sig)) with - bindings := - bindValue - (SegmentLayer3AddressCells.beforeWotsPkWotsPtrFrom - (SegmentLayer3.afterDigit - (c13FirstLayerGuardState pkSeed pkRoot message sig))).bindings - "i" (wordNormalize 0) } + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)) 0 43) 0 43).world.memory (0x40 + 32 * j)).val = (InitialNodeKeccak.wotsChainsEnd @@ -11843,8 +12065,7 @@ theorem c13_reverted_layer0_beforeAuthOff_wotsPk_chain_cells_residual : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .reverted → C13FoldRevertedBeforeAuthOffWotsPkChainCellsDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk - := by + pkSeed pkRoot message sig sigParsed forsPk:= by intro pkSeed pkRoot message sig sigParsed forsPk hParse hZero hFors hFold intro d change @@ -11888,8 +12109,7 @@ theorem c13_reverted_layer0_beforeAuthOff_wotsPk_address_chain_cells_residual : { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) forsPk sigParsed.layers = .reverted → C13FoldRevertedBeforeAuthOffWotsPkAddressChainCellsDataLayer0 - pkSeed pkRoot message sig sigParsed forsPk - := by + pkSeed pkRoot message sig sigParsed forsPk:= by intro pkSeed pkRoot message sig sigParsed forsPk hParse hZero hFors hFold exact c13FoldRevertedBeforeAuthOffWotsPkAddressChainCellsDataLayer0_of_split @@ -11933,7 +12153,7 @@ theorem c13_reverted_afterMerkle_raw_xmss_residual : 11 0 ((C13Concrete.c13PrimitivesConcrete.hMsg c13 { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) - (C13Concrete.wordOfHash16 d.wotsPk0) d.lsig0.authPath := by + (C13Concrete.wordOfHash16 d.wotsPk0) d.lsig0.authPath:= by intro pkSeed pkRoot message sig sigParsed forsPk hParse hZero hFors hFold exact diff --git a/verity/SphincsMinusVerifiers/README.md b/verity/SphincsMinusVerifiers/README.md index a34d92a..9f7c718 100644 --- a/verity/SphincsMinusVerifiers/README.md +++ b/verity/SphincsMinusVerifiers/README.md @@ -7,6 +7,34 @@ This folder is the verification workbench for the three verifier contracts in - `SPHINCs_C12Asm_VerityModel` models `SPHINCs-C12Asm.sol`. - `SLH_DSA_SHA2_128_24_VerityModel` models `SLH-DSA-SHA2-128-24verifier.sol`. +> **Status (June 2026, FIPS-FORS migration / PR #6).** The C13 model, spec, and +> the whole segment-proof chain now use the FIPS 205 §11.2.2 FORS address +> layout: the model hoists `idxLeaf0`/`idxTree0`/`forsBase` (statements 13–15 +> of `c13VerifyBodyTail`), the spec's `forsClimb`/`fors*C13` family carries the +> digits derived from `digest.hyperIndex` (`idxTree0C13`/`idxLeaf0C13`), and +> the per-level climb address is `ClimbKit.forsAdrs` +> (`or(forsBase, or(shl(32,h+1), or(shl(sub(18,h),i), parentIdx)))`). +> On this branch `c13_refines_byte_spec` and `c12_refines_byte_spec` are +> **theorems**, resting on the documented "Residual assembly axioms" family +> (see below). All sixteen composition-glue obligations are now proved (the +> earlier elaboration divergence was a spelling mismatch between the explicit +> start-state record and `c13BeforeWotsPkLightState`; stating the obligations +> in the named form makes every composition elaborate in ~400 MB), so the +> headline cones list only the primitive obligations: `c13_refines_spec` rests +> on Lean's logic plus **three** residual assembly axioms — the layer-0 +> `lightweight_chain_inputs_layer0` record obligation and the layer-1/reverted +> lightweight chain-cell twins; `c12_refines_spec` on logic plus the single +> `c12_layer3_after3_current_node_root_residual`. The three +> `c13_beforeWotsPk_memory_*_eq_lightweight` single-cell cutpoint bridges and the +> layer-0 `_of_inputs` half are now **theorems** (2026-06-11): `beforeWotsPk` is +> *equal* to the lightweight `beforeWotsPkFrom` cutpoint (the suffix statement +> lists are syntactically the same), and the chain-cell bridge is assembled with +> `congrArg`/`trans` only, never restating an interpreter fold (every defeq +> between two spellings of a fold start state diverges). Zero `sorry` +> package-wide. +> Build with `verity/scripts/build.sh` (memory-capped) — never bare `lake build` +> on <64 GB machines. + The specs are layered in `SphincsMinusVerifierSpec/Spec.lean`: - `verifyParsed` is the algorithmic spec over a parsed public key and parsed @@ -156,7 +184,9 @@ connect `mload` of the output buffer to the digest written by precompile `0x02`. - `RESIDUAL-ASSEMBLY-CAP` (status 2026-06-08, accepted — option (b)): beyond the 3 MODEL-EXEC-BRIDGE bridge axioms, the C13 WOTS-PK accept path and the C12 layer-3 currentNode handoff rest on a small set of **residual assembly axioms** in - `Proofs.lean` (4 primary + 3 single-cell bridges + 1 generic mirror). Their generic + `Proofs.lean` (3 remaining: the layer-0 inputs record obligation and the + layer-1/reverted chain-cell twins; the 3 single-cell bridges and the layer-0 + `_of_inputs` half were discharged 2026-06-11). Their generic mathematical content is already proven axiom-clean under the 10 GB cap in `C13WotsPkKeccak.lean` / `C13ChainCells.lean`; each axiom is only the wiring of that verified lemma to a concrete `SegmentLayer3`-derived state. They are **not** diff --git a/verity/SphincsMinusVerifiers/RootFrame.lean b/verity/SphincsMinusVerifiers/RootFrame.lean index 95bcf70..fd3d369 100644 --- a/verity/SphincsMinusVerifiers/RootFrame.lean +++ b/verity/SphincsMinusVerifiers/RootFrame.lean @@ -78,6 +78,29 @@ theorem merkleClimbBody_pres · exact execStmt_assignVar_preserves_lookup _ _ nodeVar "root" _ hn hexec · exact execStmt_assignVar_preserves_lookup _ _ idxVar "root" _ hi hexec +/-- Address-parametric variant: the climb body shape is independent of the +ADRS operand, so the same per-statement frame applies to `merkleClimbBodyA` +(hence to the FIPS `forsClimbBody`). -/ +theorem merkleClimbBodyA_pres + (nodeVar idxVar authPtrVar : String) (adrsE : Compiler.CompilationModel.Expr) + (hn : nodeVar ≠ "root") (hi : idxVar ≠ "root") : + PreservesRoot (ClimbKit.merkleClimbBodyA nodeVar idxVar authPtrVar adrsE) := by + intro s s'' stmt hmem hexec + simp only [ClimbKit.merkleClimbBodyA, List.mem_cons, List.not_mem_nil, or_false] at hmem + rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact execStmt_letVar_preserves_lookup _ _ "sibling" "root" _ (by decide) hexec + · exact execStmt_letVar_preserves_lookup _ _ "parentIdx" "root" _ (by decide) hexec + · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec + · exact execStmt_letVar_preserves_lookup _ _ "s" "root" _ (by decide) hexec + · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec + · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec + · exact execStmt_assignVar_preserves_lookup _ _ nodeVar "root" _ hn hexec + · exact execStmt_assignVar_preserves_lookup _ _ idxVar "root" _ hi hexec + +theorem forsClimbBody_pres : PreservesRoot ClimbKit.forsClimbBody := + merkleClimbBodyA_pres "node" "pathIdx" "authPtr" ClimbKit.forsAdrs + (by decide) (by decide) + /-! ## 2. The WOTS outer-loop body (contains the inner `forEach "step"`). -/ theorem wotsOuterBody_pres : PreservesRoot wotsOuterBody := by @@ -235,19 +258,17 @@ theorem afterFinalize_preserves_root (st : RuntimeState) : theorem forsLeafBody_pres : PreservesRoot SegmentS4Fors.forsLeafBody := by intro s s'' stmt hmem hexec simp only [SegmentS4Fors.forsLeafBody, List.mem_cons, List.not_mem_nil, or_false] at hmem - rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl · exact execStmt_letVar_preserves_lookup _ _ "treeIdx" "root" _ (by decide) hexec · exact execStmt_letVar_preserves_lookup _ _ "secretVal" "root" _ (by decide) hexec · exact execStmt_letVar_preserves_lookup _ _ "leafAdrs" "root" _ (by decide) hexec · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec · exact execStmt_letVar_preserves_lookup _ _ "node" "root" _ (by decide) hexec - · exact execStmt_letVar_preserves_lookup _ _ "treeAdrsBase" "root" _ (by decide) hexec · exact execStmt_letVar_preserves_lookup _ _ "pathIdx" "root" _ (by decide) hexec · exact execStmt_letVar_preserves_lookup _ _ "authPtr" "root" _ (by decide) hexec · exact execStmt_forEach_preserves_lookup "h" "root" _ _ _ _ (by decide) - (merkleClimbBody_pres "node" "pathIdx" "treeAdrsBase" "authPtr" - (by decide) (by decide)) hexec + forsClimbBody_pres hexec · exact execStmt_mstore_preserves_lookup _ _ "root" _ _ hexec theorem forsLeafStep_preserves_root (st : RuntimeState) : @@ -256,14 +277,22 @@ theorem forsLeafStep_preserves_root (st : RuntimeState) : execStmtList_preserves_lookup "root" SegmentS4Fors.forsLeafBody st (SegmentS4Fors.forsLeafStep st) forsLeafBody_pres (SegmentS4Fors.execForsLeaf st) +theorem afterForsSetup_preserves_root (st : RuntimeState) : + lookupValue (SegmentCompose.afterForsSetup st).bindings "root" + = lookupValue (SegmentCompose.afterS3 st).bindings "root" := by + unfold SegmentCompose.afterForsSetup + exact SegmentForsSetup.stepForsSetup_preserves_key "root" + (by decide) (by decide) (by decide) (SegmentCompose.afterS3 st) + theorem afterFors_preserves_root (st : RuntimeState) : lookupValue (SegmentCompose.afterFors st).bindings "root" = lookupValue (SegmentCompose.afterS3 st).bindings "root" := by unfold SegmentCompose.afterFors rw [ClimbLoop.foldLoop_preserves_lookup "i" "root" SegmentS4Fors.forsLeafStep (by decide) forsLeafStep_preserves_root _ 0 (wordNormalize 6)] - exact MemoryKit.lookupValue_bindValue_ne (SegmentCompose.afterS3 st).bindings - "i" "root" (wordNormalize 0) (by decide) + rw [MemoryKit.lookupValue_bindValue_ne (SegmentCompose.afterForsSetup st).bindings + "i" "root" (wordNormalize 0) (by decide)] + exact afterForsSetup_preserves_root st /-! ## 9. The S3 frame (direct `bindValue` chain) and the full post-S2 chain. -/ diff --git a/verity/SphincsMinusVerifiers/SegmentAcceptSpec.lean b/verity/SphincsMinusVerifiers/SegmentAcceptSpec.lean index 7cdbb2c..d2ddbe8 100644 --- a/verity/SphincsMinusVerifiers/SegmentAcceptSpec.lean +++ b/verity/SphincsMinusVerifiers/SegmentAcceptSpec.lean @@ -942,6 +942,7 @@ theorem accept_path_returns_verifyParsed_bool_from_fors_roots_and_layer_step_ran (specStep : Nat → ByteArray → ByteArray) (roots : List Nat) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -998,8 +999,24 @@ theorem accept_path_returns_verifyParsed_bool_from_fors_roots_and_layer_step_ran CurrentNodeFrame.forsPkCompressWord (afterFors (mkC13State pkSeed pkRoot message sig)) = wordOfHash16 forsPk := by let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + have hT : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show _ = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hL : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show _ = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_mkC13State_six_plus_last_range - pkSeed pkRoot message sig digest roots hRootsLen hLeaf hmRlo hmRlast] + pkSeed pkRoot message sig digest roots hRootsLen hT hTlt hL hLeaf hmRlo hmRlast] exact hForsPkCompress exact accept_path_returns_verifyParsed_bool_from_fors_compress_and_layer_step pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep hPk @@ -1015,6 +1032,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_fors_roots_and_layer (specStep : Nat → ByteArray → ByteArray) (roots : List Nat) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1070,8 +1088,24 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_fors_roots_and_layer CurrentNodeFrame.forsPkCompressWord (afterFors (mkC13State pkSeed pkRoot message sig)) = wordOfHash16 forsPk := by let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + have hT : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show _ = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hL : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show _ = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_seed_mkC13State_six_plus_last - pkSeed pkRoot message sig digest roots hRootsLen hmSeed hmRlo hmRlast] + pkSeed pkRoot message sig digest roots hRootsLen hT hTlt hL hmSeed hmRlo hmRlast] exact hForsPkCompress exact accept_path_returns_verifyParsed_bool_from_fors_compress_and_layer_step pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep hPk @@ -1087,6 +1121,7 @@ theorem accept_path_returns_verifyParsed_bool_from_named_fors_roots_and_layer_st (pk : PublicKey) (sigParsed : Signature) (forsPk specRoot : ByteArray) (specStep : Nat → ByteArray → ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1156,7 +1191,7 @@ theorem accept_path_returns_verifyParsed_bool_from_named_fors_roots_and_layer_st exact accept_path_returns_verifyParsed_bool_from_fors_roots_and_layer_step_range pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - hPk hShape hZero hFors hFold hlen hg3 hgL + hPk hR hShape hZero hFors hFold hlen hg3 hgL (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hLeaf (by @@ -1176,6 +1211,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_and (pk : PublicKey) (sigParsed : Signature) (forsPk specRoot : ByteArray) (specStep : Nat → ByteArray → ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1244,7 +1280,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_and exact accept_path_returns_verifyParsed_bool_from_seed_and_fors_roots_and_layer_step pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - hPk hShape hZero hFors hFold hlen hg3 hgL + hPk hR hShape hZero hFors hFold hlen hg3 hgL (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hmSeed (by @@ -1264,6 +1300,7 @@ theorem accept_path_returns_verifyParsed_bool_from_named_fors_roots_roundtrip_an (pk : PublicKey) (sigParsed : Signature) (forsPk specRoot : ByteArray) (specStep : Nat → ByteArray → ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1338,7 +1375,7 @@ theorem accept_path_returns_verifyParsed_bool_from_named_fors_roots_roundtrip_an rw [hForsPkByte, hForsPkRoundtrip] exact accept_path_returns_verifyParsed_bool_from_named_fors_roots_and_layer_step_range pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep - hPk hShape hZero hFors hFold hlen hg3 hgL hLeaf hmRlo hmRlast + hPk hR hShape hZero hFors hFold hlen hg3 hgL hLeaf hmRlo hmRlast hForsPkWord hLayerStep hSpecFold hWordCmp /-- Direct seed-cell plus named-root roundtrip form of the final accept adapter. @@ -1349,6 +1386,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_rou (pk : PublicKey) (sigParsed : Signature) (forsPk specRoot : ByteArray) (specStep : Nat → ByteArray → ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1422,7 +1460,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_rou rw [hForsPkByte, hForsPkRoundtrip] exact accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_and_layer_step pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep - hPk hShape hZero hFors hFold hlen hg3 hgL hmSeed hmRlo hmRlast + hPk hR hShape hZero hFors hFold hlen hg3 hgL hmSeed hmRlo hmRlast hForsPkWord hLayerStep hSpecFold hWordCmp /-! ## Named C13 accept-obligation bundle. -/ @@ -1497,6 +1535,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_named_obligations (pk : PublicKey) (sigParsed : Signature) (forsPk specRoot : ByteArray) (specStep : Nat → ByteArray → ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hShape : signatureShapeOk c13 sigParsed = true) (hZero : forcedZeroOk c13 (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) = true) @@ -1515,7 +1554,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_named_obligations = .return (wordNormalize (boolWord (rootMatchesPk c13 specRoot pk.pkRoot))) finalState := by exact accept_path_returns_verifyParsed_bool_from_seed_and_named_fors_roots_roundtrip_and_layer_step pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep - hPk hShape hZero hFors hFold hObs.hlen hObs.hg3 hObs.hgL hObs.hmSeed + hPk hR hShape hZero hFors hFold hObs.hlen hObs.hg3 hObs.hgL hObs.hmSeed hObs.hmRlo hObs.hmRlast hObs.hForsPkRoundtrip hObs.hLayerStep hObs.hSpecFold hObs.hWordCmp @@ -2454,6 +2493,7 @@ theorem layerStart_of_seed_named_fors_roots_roundtrip (pkSeed pkRoot message sig : ByteArray) (pk : PublicKey) (sigParsed : Signature) (forsPk : ByteArray) (hPk : pk = { pkSeed := pkSeed, pkRoot := pkRoot }) + (hR : sigParsed.R = C13Concrete.read16 sig 0) (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 pk (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) sigParsed.fors = some forsPk) @@ -2511,12 +2551,28 @@ theorem layerStart_of_seed_named_fors_roots_roundtrip = C13Concrete.wordOfHash16 forsPk := by subst hPk simpa [digest, C13Concrete.forsPkWordC13] using hForsPkWord + have hT : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show _ = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hLd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show _ = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message) + rw [hPk, hR] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message have hForsCompress : CurrentNodeFrame.forsPkCompressWord (afterFors (mkC13State pkSeed pkRoot message sig)) = wordOfHash16 forsPk := by rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_seed_mkC13State_six_plus_last pkSeed pkRoot message sig digest (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hmSeed] + (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hT hTlt hLd hmSeed] · exact hForsPkCompress · intro j hj simpa [digest] using hmRlo j hj @@ -2958,7 +3014,7 @@ structure C13SeedNamedAcceptGuardedPkRootSizeLeafRootObligations s.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256 hNode : ∀ j, (hj : j < 6) → @@ -2967,17 +3023,17 @@ structure C13SeedNamedAcceptGuardedPkRootSizeLeafRootObligations (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 { pkSeed := pkSeed, pkRoot := pkRoot } @@ -3005,7 +3061,7 @@ structure C13SeedNamedAcceptGuardedPkRootSizeSiteRootObligations s.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256 hNode : ∀ j, (hj : j < 6) → @@ -3014,17 +3070,17 @@ structure C13SeedNamedAcceptGuardedPkRootSizeSiteRootObligations (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 { pkSeed := pkSeed, pkRoot := pkRoot } @@ -3090,7 +3146,7 @@ structure C13SeedNamedAcceptConcreteLayerSiteRootObligations s.world.calldata = headWords pkSeed pkRoot message sig.size ++ bytesToWords sig ∧ lookupValue s.bindings "authPtr" = sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256 hNode : ∀ j, (hj : j < 6) → @@ -3099,17 +3155,17 @@ structure C13SeedNamedAcceptConcreteLayerSiteRootObligations (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep { (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j) with bindings := bindValue (ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { (afterS3 (mkC13State pkSeed pkRoot message sig)) with + { (afterForsSetup (mkC13State pkSeed pkRoot message sig)) with bindings := - bindValue (afterS3 (mkC13State pkSeed pkRoot message sig)).bindings + bindValue (afterForsSetup (mkC13State pkSeed pkRoot message sig)).bindings "i" (wordNormalize 0) } 0 j).bindings "i" (wordNormalize j) })).bindings "node") = (C13Concrete.forsAllRootsC13 { pkSeed := pkSeed, pkRoot := pkRoot } @@ -3380,6 +3436,7 @@ theorem concrete_layer_current_node_two_step_obligations_of_fold_ok_current_node · simpa [st, pk, digest, CurrentNodeFrame.c13LayerLoopState1, CurrentNodeFrame.c13LayerAfterStep0] using hCurrent1 +set_option maxHeartbeats 4000000 in /-- Adapter from frozen-calldata/root-node obligations to the older accept bundle with explicit FORS root-cell equalities. -/ theorem seed_named_leaf_obligations_of_leaf_root_obligations @@ -3393,9 +3450,25 @@ theorem seed_named_leaf_obligations_of_leaf_root_obligations pkSeed pkRoot message sig sigParsed forsPk specRoot specStep := by let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + have hbaseF : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 digest) (C13Concrete.idxLeaf0C13 digest) := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "forsBase" + = C13Concrete.adrsForsBase + (C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message)) + (C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message)) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_forsBase_mkC13State pkSeed pkRoot message sig + have hTlt : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message have hRoots := CurrentNodeFrame.rootCells_eq_forsAllRootsC13_of_fors_frozen_calldata_nodes_and_parse_range_seed - pk digest message sig hParse hObs.hSite hObs.hNode hObs.hLeaf + pk digest message sig hParse hbaseF hTlt hObs.hSite hObs.hNode hObs.hLeaf exact { hLayerGuardStep := hObs.hLayerGuardStep hLeaf := hObs.hLeaf @@ -3493,7 +3566,7 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_named_data_obligations_o = .return (wordNormalize (boolWord (rootMatchesPk c13 specRoot pk.pkRoot))) finalState := by refine accept_path_returns_verifyParsed_bool_from_seed_named_obligations pkSeed pkRoot message sig pk sigParsed forsPk specRoot specStep - hPk hShape hZero hFors hFold ?_ + hPk (C13Concrete.parseSignatureC13_R hParse) hShape hZero hFors hFold ?_ exact { hlen := c13_sig_length_of_parseSignatureC13 pkSeed pkRoot message sig sigParsed hParse hg3 := hObs.hg3 @@ -3606,7 +3679,8 @@ theorem accept_path_returns_verifyParsed_bool_from_seed_named_guarded_obligation hPk hParse hShape hZero hFors hFold ?_ exact { hLayerStart := layerStart_of_seed_named_fors_roots_roundtrip - pkSeed pkRoot message sig pk sigParsed forsPk hPk hFors hObs.hmSeed + pkSeed pkRoot message sig pk sigParsed forsPk hPk + (C13Concrete.parseSignatureC13_R hParse) hFors hObs.hmSeed hObs.hmRlo hObs.hmRlast hObs.hForsPkRoundtrip hLayerGuardStep := hObs.hLayerGuardStep hmSeed := hObs.hmSeed @@ -4029,11 +4103,31 @@ theorem accept_path_returns_verifyParsed_bool_from_concrete_layer_current_node_t C13Concrete.forsPkWordC13 pk digest sigParsed.fors = wordOfHash16 forsPk := by rw [hForsPkByte] exact (forsPkWordC13_roundtrip pk digest sigParsed.fors).symm + have hTd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxTree0" + = C13Concrete.idxTree0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxTree0_mkC13State pkSeed pkRoot message sig + have hLd : + lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 digest := by + show lookupValue (afterFors (mkC13State pkSeed pkRoot message sig)).bindings "idxLeaf0" + = C13Concrete.idxLeaf0C13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + rw [C13Concrete.parseSignatureC13_R hParse] + exact CurrentNodeFrame.afterFors_idxLeaf0_mkC13State pkSeed pkRoot message sig + have hTltd : C13Concrete.idxTree0C13 digest < 2 ^ 11 := + C13Concrete.idxTree0C13_lt pk sigParsed.R message have hForsCompress : CurrentNodeFrame.forsPkCompressWord (afterFors st) = wordOfHash16 forsPk := by rw [CurrentNodeFrame.forsPkCompressWord_eq_of_afterFors_concrete_mkC13State_six_plus_last pkSeed pkRoot message sig digest (C13Concrete.forsAllRootsC13 pk digest sigParsed.fors) - (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors)] + (C13Concrete.forsAllRootsC13_length pk digest sigParsed.fors) hTd hTltd hLd] · simpa [pk, digest, C13Concrete.forsPkWordC13] using hForsPkWord · intro j hj simpa [pk, digest] using hRoots.1 j hj diff --git a/verity/SphincsMinusVerifiers/SegmentCompose.lean b/verity/SphincsMinusVerifiers/SegmentCompose.lean index 4cd8f94..77a1cb6 100644 --- a/verity/SphincsMinusVerifiers/SegmentCompose.lean +++ b/verity/SphincsMinusVerifiers/SegmentCompose.lean @@ -5,16 +5,17 @@ interpreter to a symbolic step transformer: * `SegmentS2.execS2` stmts 1..9 → `.continue (s2Step ·)` - * `SegmentS3.execSegmentS3` stmts 10..13 → guarded `.continue (stepS3 ·)` - * `SegmentS4Fors.execForsOuter` stmt 14 → `.continue (foldLoop "i" forsLeafStep ·)` - * `SegmentS4Finalize.execForsFinalize` stmts 15..21 → `.continue (forsFinalizeStep ·)` - * `SegmentSeed.execSegmentSeed` stmts 22..24 → `.continue (stepSeed ·)` - * `SegmentLayer3.execLayerLoop` stmt 25 → guarded `.continue (foldLoop "layer" stepLayer ·)` + * `SegmentS3.execSegmentS3` stmts 10..12 → guarded `.continue (stepS3 ·)` + * `SegmentForsSetup.execForsSetup` stmts 13..15 → `.continue (stepForsSetup ·)` + * `SegmentS4Fors.execForsOuter` stmt 16 → `.continue (foldLoop "i" forsLeafStep ·)` + * `SegmentS4Finalize.execForsFinalize` stmts 17..23 → `.continue (forsFinalizeStep ·)` + * `SegmentSeed.execSegmentSeed` stmts 24..26 → `.continue (stepSeed ·)` + * `SegmentLayer3.execLayerLoop` stmt 27 → guarded `.continue (foldLoop "layer" stepLayer ·)` This file composes them — under the length guard and the two body guards (the FORS forced-zero guard and the WOTS-checksum climb guards) — into a single equality reducing the whole `c13VerifyBody` run to the 3-statement return tail - (`drop 26`) over one named composite state `afterLayer`. The reshape of the + (`drop 29`) over one named composite state `afterLayer`. The reshape of the body into the named segments is machine-checked by `rfl` (`body_reshape`). This is the **control-flow** backbone of the Phase-3 bridge: it touches neither @@ -25,6 +26,7 @@ import SphincsMinusVerifiers.SegmentS2 import SphincsMinusVerifiers.SegmentS3 +import SphincsMinusVerifiers.SegmentForsSetup import SphincsMinusVerifiers.SegmentS4Fors import SphincsMinusVerifiers.SegmentS4Finalize import SphincsMinusVerifiers.SegmentSeed @@ -42,9 +44,14 @@ def afterS2 (st : RuntimeState) : RuntimeState := SegmentS2.s2Step st def afterS3 (st : RuntimeState) : RuntimeState := SegmentS3.stepS3 (afterS2 st) +/-- After the FIPS FORS pre-loop setup (stmts 13..15: the hoisted +`idxLeaf0`/`idxTree0`/`forsBase` digits). -/ +def afterForsSetup (st : RuntimeState) : RuntimeState := + SegmentForsSetup.stepForsSetup (afterS3 st) + def afterFors (st : RuntimeState) : RuntimeState := ClimbLoop.foldLoop "i" SegmentS4Fors.forsLeafStep - { (afterS3 st) with bindings := bindValue (afterS3 st).bindings "i" (wordNormalize 0) } + { (afterForsSetup st) with bindings := bindValue (afterForsSetup st).bindings "i" (wordNormalize 0) } 0 (wordNormalize 6) def afterFinalize (st : RuntimeState) : RuntimeState := @@ -62,9 +69,10 @@ def afterLayer (st : RuntimeState) : RuntimeState := set_option maxHeartbeats 4000000 in theorem body_reshape : c13VerifyBodyTail = - SegmentS2.s2Body ++ (SegmentS3.segmentS3 ++ ([SegmentS4Fors.forsOuterStmt] ++ + SegmentS2.s2Body ++ (SegmentS3.segmentS3 ++ (SegmentForsSetup.forsSetupBody ++ + ([SegmentS4Fors.forsOuterStmt] ++ (SegmentS4Finalize.forsFinalizeBody ++ (SegmentSeed.segmentSeed ++ - ([SegmentLayer3.layerStmt] ++ c13VerifyBodyTail.drop 25))))) := rfl + ([SegmentLayer3.layerStmt] ++ c13VerifyBodyTail.drop 28)))))) := rfl /-! ## 3. Singleton-statement continue helper. -/ @@ -92,7 +100,7 @@ theorem execC13Body_thread { (afterSeed st) with bindings := bindValue (afterSeed st).bindings "layer" (wordNormalize 0) } 0 (wordNormalize 2)) : execStmtList [] st c13VerifyBody - = execStmtList [] (afterLayer st) (c13VerifyBodyTail.drop 25) := by + = execStmtList [] (afterLayer st) (c13VerifyBodyTail.drop 28) := by rw [c13VerifyBody_passes_preflight_guards st hlen hpkSeed hpkRoot, body_reshape] -- S2 (stmts 1..9). The type ascription folds `s2Step st` into `afterS2 st` -- (definitional), so every later rewrite stays in named-composite form. @@ -104,22 +112,27 @@ theorem execC13Body_thread = .continue (afterS3 st) := by rw [SegmentS3.execSegmentS3, if_pos hg3]; rfl rw [MemoryKit.execStmtList_append_continue _ _ _ _ hS3] - -- FORS outer loop (stmt 14) - have hFors : execStmtList [] (afterS3 st) [SegmentS4Fors.forsOuterStmt] + -- FORS pre-loop setup (stmts 13..15) + have hSetup : execStmtList [] (afterS3 st) SegmentForsSetup.forsSetupBody + = .continue (afterForsSetup st) := + SegmentForsSetup.execForsSetup (afterS3 st) + rw [MemoryKit.execStmtList_append_continue _ _ _ _ hSetup] + -- FORS outer loop (stmt 16) + have hFors : execStmtList [] (afterForsSetup st) [SegmentS4Fors.forsOuterStmt] = .continue (afterFors st) := - execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterS3 st)) + execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterForsSetup st)) rw [MemoryKit.execStmtList_append_continue _ _ _ _ hFors] - -- FORS finalize (stmts 15..21) + -- FORS finalize (stmts 17..23) have hFin : execStmtList [] (afterFors st) SegmentS4Finalize.forsFinalizeBody = .continue (afterFinalize st) := SegmentS4Finalize.execForsFinalize (afterFors st) rw [MemoryKit.execStmtList_append_continue _ _ _ _ hFin] - -- Seed (stmts 22..24) + -- Seed (stmts 24..26) have hSeed : execStmtList [] (afterFinalize st) SegmentSeed.segmentSeed = .continue (afterSeed st) := SegmentSeed.execSegmentSeed (afterFinalize st) rw [MemoryKit.execStmtList_append_continue _ _ _ _ hSeed] - -- Layer-3 climb (stmt 25), checksum guards pass + -- Layer-3 climb (stmt 27), checksum guards pass have hLayer : execStmtList [] (afterSeed st) [SegmentLayer3.layerStmt] = .continue (afterLayer st) := execSingleton_continue _ _ _ (SegmentLayer3.execLayerLoop (afterSeed st) hgL) @@ -135,7 +148,7 @@ def acceptWord (st : RuntimeState) : Nat := = lookupValue (afterLayer st).bindings "root")) private theorem drop26_eq : - c13VerifyBodyTail.drop 25 = + c13VerifyBodyTail.drop 28 = [ (.letVar "valid" (.eq (.localVar "currentNode") (.localVar "root")) : Stmt), .mstore (.literal 0) (.localVar "valid"), .return (.mload (.literal 0)) ] := rfl diff --git a/verity/SphincsMinusVerifiers/SegmentForsSetup.lean b/verity/SphincsMinusVerifiers/SegmentForsSetup.lean new file mode 100644 index 0000000..4148afd --- /dev/null +++ b/verity/SphincsMinusVerifiers/SegmentForsSetup.lean @@ -0,0 +1,402 @@ +/- + SegmentForsSetup — S4 (FORS) pre-loop hoist segment for the FIPS 205 + uncompressed 32-byte ADRS layout. + + Three statements (13..15 of `c13VerifyBodyTail`): + + ``` + 13. letVar "idxLeaf0" := and(htIdx, 0x7FF) -- low 11 bits of htIdx + 14. letVar "idxTree0" := shr(11, htIdx) -- high 11 bits of htIdx + 15. letVar "forsBase" := or(shl(128, idxTree0), + or(shl(96, 3), shl(64, idxLeaf0))) + -- FIPS 205 §11.2.2 ADRS base + ``` + + These are pure binder writes: no guard, no memory, no calldata — the + *loop-invariant* ADRS base for the `forEach "i" (u 6)` FORS outer + loop (statement 16). In the spec mirror this is the construction of + `C13Concrete.adrsForsBase idxTree0 idxLeaf0` that the per-tree + `forsLeafSetupStep` (`SegmentS4Fors.lean`) reads via `"forsBase"` + and the inner climb's `mstore 0x20` (`ClimbKit.forsAdrs`) reads from. + + Structure (mirrors `SegmentS4Fors.forsLeafSetupStep` exactly): + `stepForsSetup` is the `match execStmtList` transformer; the headline + `execForsSetup` has *no* bound hypotheses (the word-normalizing + interpreter is total, `letVar_continue … rfl` discharges each step). + The tight `htIdx < 2^22` bound needed for spec identification is + parametrised in `stepForsSetup_forsBase_eq` and discharged at the + call site (`SegmentCompose` etc.) from the S3-segment hypertree-index + bound. + + No `sorry`, no new `axiom`, no `native_decide`. +-/ + +import SphincsMinusVerifiers.Model +import SphincsMinusVerifierSpec.C13Concrete +import SphincsMinusVerifiers.BindingFrame +import SphincsMinusVerifiers.MemoryFrame +import SphincsMinusVerifiers.StateFrame +import SphincsMinusVerifiers.MemoryKit +import SphincsMinusVerifiers.ClimbKit +import SphincsMinusVerifiers.ClimbKeccakStep + +namespace SphincsMinusVerifiers.SegmentForsSetup + +open Compiler.Proofs.IRGeneration.SourceSemantics +open Compiler.CompilationModel (Expr Stmt) +open SphincsMinusVerifiers.ClimbKit (execStmtList_cons_continue) +open SphincsMinusVerifiers.MemoryKit (lookupValue_bindValue_self lookupValue_bindValue_ne) + +/-! Local EDSL helpers (private, file-scoped — see `Model.lean` for the +canonical versions). -/ +private def u (n : Nat) : Expr := .literal n +private def v (name : String) : Expr := .localVar name +private def andE (a b : Expr) : Expr := .bitAnd a b +private def orE (a b : Expr) : Expr := .bitOr a b +private def shrE (a b : Expr) : Expr := .shr a b +private def shlE (a b : Expr) : Expr := .shl a b + +/-! ## 0. The three setup statements, replicated with bare public constructors. -/ + +/-- The FORS pre-loop setup segment (statements 13..15 of `c13VerifyBodyTail`). -/ +def forsSetupBody : List Stmt := + [ .letVar "idxLeaf0" (andE (v "htIdx") (u 0x7FF)) + , .letVar "idxTree0" (shrE (u 11) (v "htIdx")) + , .letVar "forsBase" + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "idxLeaf0")))) ] + +/-- Faithfulness: `forsSetupBody` is *exactly* statements 13..15 of +`c13VerifyBodyTail`. -/ +theorem forsSetup_eq_slice : + forsSetupBody = (c13VerifyBodyTail.drop 13).take 3 := rfl + +/-! ## 1. The accept-path state transformer. -/ + +/-- Pure transformer for the FORS pre-loop setup (repo-standard +`match execStmtList` pattern, see `SegmentS4Fors.forsLeafSetupStep`). -/ +def stepForsSetup (st : RuntimeState) : RuntimeState := + match execStmtList [] st forsSetupBody with + | .continue s' => s' + | _ => st + +private theorem letVar_continue + (st : RuntimeState) (name : String) (e : Expr) (val : Nat) + (h : evalExpr [] st e = some val) : + execStmt [] st (.letVar name e) = + .continue { st with bindings := bindValue st.bindings name val } := by + show (match evalExpr [] st e with + | some resolved => + StmtResult.continue { st with bindings := bindValue st.bindings name resolved } + | none => .revert) = _ + rw [h] + +/-! ## 2. The headline segment lemma. -/ + +/-- **`execForsSetup`** — running statements 13..15 of `c13VerifyBodyTail` +over the real interpreter unconditionally continues to `stepForsSetup st`. +Pure binder writes (no guard), so there is no revert branch and no bound +hypotheses are needed: the word-normalizing interpreter is total, so each +`letVar_continue … rfl` discharges definitionally. -/ +theorem execForsSetup (st : RuntimeState) : + execStmtList [] st forsSetupBody = .continue (stepForsSetup st) := by + unfold stepForsSetup forsSetupBody u v andE orE shrE shlE + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st "idxLeaf0" _ _ rfl)] + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "idxTree0" _ _ rfl)] + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "forsBase" _ _ rfl)] + rfl + +/-! ## 3. Bound helpers for the spec identification. -/ + +private theorem shr11_lt (htIdx : Nat) (hhtLt : htIdx < 2 ^ 22) : + htIdx >>> 11 < 2 ^ 11 := by + rw [Nat.shiftRight_eq_div_pow] + exact Nat.div_lt_of_lt_mul + (by rw [show (2 : Nat) ^ 11 * 2 ^ 11 = 2 ^ 22 from by norm_num]; exact hhtLt) + +private theorem shr11_shl128_lt (htIdx : Nat) (hhtLt : htIdx < 2 ^ 22) : + (htIdx >>> 11) <<< 128 < 2 ^ 256 := by + have h11 : htIdx >>> 11 ≤ 2047 := by + have := shr11_lt htIdx hhtLt + rw [show (2 : Nat) ^ 11 = 2048 from by norm_num] at this + omega + rw [Nat.shiftLeft_eq] + calc + (htIdx >>> 11) * 2 ^ 128 ≤ 2047 * 2 ^ 128 := Nat.mul_le_mul_right _ h11 + _ < 2 ^ 256 := by norm_num + +private theorem and7FF_lt (htIdx : Nat) : htIdx &&& 0x7FF < 2 ^ 11 := + lt_of_le_of_lt Nat.and_le_right (by decide) + +private theorem and7FF_shl64_lt (htIdx : Nat) : + (htIdx &&& 0x7FF) <<< 64 < 2 ^ 256 := by + have h11 : htIdx &&& 0x7FF ≤ 2047 := Nat.and_le_right + rw [Nat.shiftLeft_eq] + calc + (htIdx &&& 0x7FF) * 2 ^ 64 ≤ 2047 * 2 ^ 64 := Nat.mul_le_mul_right _ h11 + _ < 2 ^ 256 := by norm_num + +/-! ## 4. Accessor corollaries — the loop-invariant ADRS base for the FORS +outer loop. Each unwinds the three `letVar`s with explicit eval witnesses +(the `forsLeafSetupStep_pathIdx_eq_of_eval` style from `SegmentS4Fors`). -/ + +section Accessors + +variable (st : RuntimeState) (htIdx : Nat) + +private theorem htIdx_lt256 (hhtLt : htIdx < 2 ^ 22) : htIdx < 2 ^ 256 := + lt_trans hhtLt (by norm_num) + +/-- The post-setup bindings as an explicit three-deep `bindValue` chain with +spec-form digit values. The single unwinding all three accessors read off. -/ +private theorem stepForsSetup_bindings_eq + (hht : lookupValue st.bindings "htIdx" = htIdx) (hhtLt : htIdx < 2 ^ 22) : + (stepForsSetup st).bindings = + bindValue + (bindValue + (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) + "idxTree0" (htIdx >>> 11)) + "forsBase" + (((htIdx >>> 11) <<< 128) + ||| ((3 <<< 96) ||| ((htIdx &&& 0x7FF) <<< 64))) := by + -- Eval witness for statement 13: `and(htIdx, 0x7FF) ↦ htIdx &&& 0x7FF`. + have h1 : evalExpr [] st (andE (v "htIdx") (u 0x7FF)) = some (htIdx &&& 0x7FF) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitAnd_literal + st (v "htIdx") htIdx 0x7FF + (by show some (lookupValue st.bindings "htIdx") = some htIdx; rw [hht]) + (htIdx_lt256 htIdx hhtLt) (by norm_num) + -- Eval witness for statement 14 over the post-13 state. + have h2 : evalExpr [] + ({ st with bindings := bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF) }) + (shrE (u 11) (v "htIdx")) = some (htIdx >>> 11) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shr_bounded + _ (u 11) (v "htIdx") 11 htIdx rfl + (by + show some (lookupValue + (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) "htIdx") = some htIdx + rw [lookupValue_bindValue_ne _ "idxLeaf0" "htIdx" _ (by decide), hht]) + (by norm_num) (htIdx_lt256 htIdx hhtLt) + -- Eval witness for statement 15 over the post-14 state. + have h3 : evalExpr [] + ({ st with bindings := (bindValue + (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) + "idxTree0" (htIdx >>> 11)) }) + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "idxLeaf0")))) + = some (((htIdx >>> 11) <<< 128) + ||| ((3 <<< 96) ||| ((htIdx &&& 0x7FF) <<< 64))) := by + set s : RuntimeState := + { st with bindings := (bindValue + (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) + "idxTree0" (htIdx >>> 11)) } with hs + have hT0 : evalExpr [] s (v "idxTree0") = some (htIdx >>> 11) := by + show some (lookupValue + (bindValue (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) + "idxTree0" (htIdx >>> 11)) "idxTree0") = _ + rw [lookupValue_bindValue_self] + have hL0 : evalExpr [] s (v "idxLeaf0") = some (htIdx &&& 0x7FF) := by + show some (lookupValue + (bindValue (bindValue st.bindings "idxLeaf0" (htIdx &&& 0x7FF)) + "idxTree0" (htIdx >>> 11)) "idxLeaf0") = _ + rw [lookupValue_bindValue_ne _ "idxTree0" "idxLeaf0" _ (by decide), + lookupValue_bindValue_self] + have hShlT : evalExpr [] s (shlE (u 128) (v "idxTree0")) + = some ((htIdx >>> 11) <<< 128) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded + s (u 128) (v "idxTree0") 128 (htIdx >>> 11) rfl hT0 (by norm_num) + (lt_trans (shr11_lt htIdx hhtLt) (by norm_num)) + (shr11_shl128_lt htIdx hhtLt) + have hShlM : evalExpr [] s (shlE (u 96) (u 3)) = some ((3 : Nat) <<< 96) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded + s (u 96) (u 3) 96 3 rfl rfl (by norm_num) (by norm_num) (by decide) + have hShlL : evalExpr [] s (shlE (u 64) (v "idxLeaf0")) + = some ((htIdx &&& 0x7FF) <<< 64) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded + s (u 64) (v "idxLeaf0") 64 (htIdx &&& 0x7FF) rfl hL0 (by norm_num) + (lt_trans (and7FF_lt htIdx) (by norm_num)) + (and7FF_shl64_lt htIdx) + have hInner : evalExpr [] s (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "idxLeaf0"))) + = some ((3 <<< 96) ||| ((htIdx &&& 0x7FF) <<< 64)) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + s _ _ _ _ hShlM hShlL (by decide) (and7FF_shl64_lt htIdx) + have hInnerLt : (3 <<< 96) ||| ((htIdx &&& 0x7FF) <<< 64) < 2 ^ 256 := + Nat.bitwise_lt_two_pow (by decide) (and7FF_shl64_lt htIdx) + exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + s _ _ _ _ hShlT hInner (shr11_shl128_lt htIdx hhtLt) hInnerLt + unfold stepForsSetup forsSetupBody + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st "idxLeaf0" _ _ h1)] + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "idxTree0" _ _ h2)] + rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "forsBase" _ _ h3)] + rfl + +/-- After the FORS pre-loop setup the `"idxLeaf0"` binding is the low 11 bits +of `htIdx`. -/ +theorem stepForsSetup_idxLeaf0 + (hht : lookupValue st.bindings "htIdx" = htIdx) (hhtLt : htIdx < 2 ^ 22) : + lookupValue (stepForsSetup st).bindings "idxLeaf0" = htIdx &&& 0x7FF := by + rw [stepForsSetup_bindings_eq st htIdx hht hhtLt, + lookupValue_bindValue_ne _ "forsBase" "idxLeaf0" _ (by decide), + lookupValue_bindValue_ne _ "idxTree0" "idxLeaf0" _ (by decide), + lookupValue_bindValue_self] + +/-- After the FORS pre-loop setup the `"idxTree0"` binding is the high 11 bits +of `htIdx`. -/ +theorem stepForsSetup_idxTree0 + (hht : lookupValue st.bindings "htIdx" = htIdx) (hhtLt : htIdx < 2 ^ 22) : + lookupValue (stepForsSetup st).bindings "idxTree0" = htIdx >>> 11 := by + rw [stepForsSetup_bindings_eq st htIdx hht hhtLt, + lookupValue_bindValue_ne _ "forsBase" "idxTree0" _ (by decide), + lookupValue_bindValue_self] + +/-- The keystone corollary. After the FORS pre-loop setup the `"forsBase"` +binding is exactly `C13Concrete.adrsForsBase (htIdx >>> 11) (htIdx &&& 0x7FF)`. +The `htIdx < 2^22` bound is discharged at the call site from the S3-segment +hypertree-index bound (C13: `htIdx = and(…, 0x3FFFFF)` is 22-bit masked). -/ +theorem stepForsSetup_forsBase_eq + (hht : lookupValue st.bindings "htIdx" = htIdx) (hhtLt : htIdx < 2 ^ 22) : + lookupValue (stepForsSetup st).bindings "forsBase" + = SphincsMinusVerifierSpec.C13Concrete.adrsForsBase + (htIdx >>> 11) (htIdx &&& 0x7FF) := by + rw [stepForsSetup_bindings_eq st htIdx hht hhtLt, lookupValue_bindValue_self] + simp [SphincsMinusVerifierSpec.C13Concrete.adrsForsBase, Nat.lor_assoc] + +end Accessors + +/-! ## 5. Binding/memory/state-frame preservation. + +The pre-loop setup binds three fresh keys (`"idxLeaf0"`, `"idxTree0"`, +`"forsBase"`) and touches nothing else: no memory writes, no rebinding of +earlier accept-path keys (`"sigBase"`, `"dVal"`, `"htIdx"`), no +selector/calldata mutation. -/ + +private theorem forsSetup_preserves_key + (key : String) + (h1 : "idxLeaf0" ≠ key) (h2 : "idxTree0" ≠ key) (h3 : "forsBase" ≠ key) + (st s' : RuntimeState) + (h : execStmtList [] st forsSetupBody = .continue s') : + lookupValue s'.bindings key = lookupValue st.bindings key := by + refine SphincsMinusVerifiers.BindingFrame.execStmtList_preserves_lookup + key forsSetupBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsSetupBody] at hmem + rcases hmem with hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "idxLeaf0" key _ h1 hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "idxTree0" key _ h2 hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "forsBase" key _ h3 hexec + +/-- Generic public step-form binding frame for the FORS pre-loop setup: any +key other than the three fresh binders is preserved. -/ +theorem stepForsSetup_preserves_key + (key : String) + (h1 : "idxLeaf0" ≠ key) (h2 : "idxTree0" ≠ key) (h3 : "forsBase" ≠ key) + (st : RuntimeState) : + lookupValue (stepForsSetup st).bindings key = lookupValue st.bindings key := + forsSetup_preserves_key key h1 h2 h3 st (stepForsSetup st) (execForsSetup st) + +theorem forsSetup_preserves_sigBase + (st s' : RuntimeState) + (h : execStmtList [] st forsSetupBody = .continue s') : + lookupValue s'.bindings "sigBase" = lookupValue st.bindings "sigBase" := + forsSetup_preserves_key "sigBase" (by decide) (by decide) (by decide) st s' h + +theorem forsSetup_preserves_dVal + (st s' : RuntimeState) + (h : execStmtList [] st forsSetupBody = .continue s') : + lookupValue s'.bindings "dVal" = lookupValue st.bindings "dVal" := + forsSetup_preserves_key "dVal" (by decide) (by decide) (by decide) st s' h + +theorem forsSetup_preserves_htIdx + (st s' : RuntimeState) + (h : execStmtList [] st forsSetupBody = .continue s') : + lookupValue s'.bindings "htIdx" = lookupValue st.bindings "htIdx" := + forsSetup_preserves_key "htIdx" (by decide) (by decide) (by decide) st s' h + +/-- The setup is all `letVar`s, so every memory cell is preserved. -/ +theorem forsSetup_preserves_memory + (st s' : RuntimeState) (addr : Nat) + (h : execStmtList [] st forsSetupBody = .continue s') : + (s'.world.memory addr).val = (st.world.memory addr).val := by + refine SphincsMinusVerifiers.MemoryFrame.execStmtList_preserves_memory_val + addr forsSetupBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsSetupBody] at hmem + rcases hmem with hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val + s s'' addr "idxLeaf0" _ hexec + · subst stmt + exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val + s s'' addr "idxTree0" _ hexec + · subst stmt + exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val + s s'' addr "forsBase" _ hexec + +/-- The setup never touches the dispatch selector or the calldata. -/ +theorem forsSetup_preserves_selector_calldata + (st s' : RuntimeState) + (h : execStmtList [] st forsSetupBody = .continue s') : + s'.selector = st.selector ∧ s'.world.calldata = st.world.calldata := by + refine SphincsMinusVerifiers.StateFrame.execStmtList_preserves_selector_calldata + forsSetupBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsSetupBody] at hmem + rcases hmem with hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata + s s'' "idxLeaf0" _ hexec + · subst stmt + exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata + s s'' "idxTree0" _ hexec + · subst stmt + exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata + s s'' "forsBase" _ hexec + +/-! Step-forms: combine the transformer `stepForsSetup` with the preservation +facts into single, easy-to-chain statements. No bounds needed — the headline +`execForsSetup` has none. -/ + +theorem stepForsSetup_preserves_sigBase_step (st : RuntimeState) : + lookupValue (stepForsSetup st).bindings "sigBase" + = lookupValue st.bindings "sigBase" := + forsSetup_preserves_sigBase st (stepForsSetup st) (execForsSetup st) + +theorem stepForsSetup_preserves_dVal_step (st : RuntimeState) : + lookupValue (stepForsSetup st).bindings "dVal" + = lookupValue st.bindings "dVal" := + forsSetup_preserves_dVal st (stepForsSetup st) (execForsSetup st) + +theorem stepForsSetup_preserves_htIdx_step (st : RuntimeState) : + lookupValue (stepForsSetup st).bindings "htIdx" + = lookupValue st.bindings "htIdx" := + forsSetup_preserves_htIdx st (stepForsSetup st) (execForsSetup st) + +theorem stepForsSetup_preserves_memory_step (st : RuntimeState) (addr : Nat) : + ((stepForsSetup st).world.memory addr).val = (st.world.memory addr).val := + forsSetup_preserves_memory st (stepForsSetup st) addr (execForsSetup st) + +theorem stepForsSetup_preserves_selector_calldata_step (st : RuntimeState) : + (stepForsSetup st).selector = st.selector ∧ + (stepForsSetup st).world.calldata = st.world.calldata := + forsSetup_preserves_selector_calldata st (stepForsSetup st) (execForsSetup st) + +/-! ## 6. Axiom audit. -/ + +#print axioms execForsSetup +#print axioms forsSetup_eq_slice +#print axioms stepForsSetup_idxLeaf0 +#print axioms stepForsSetup_idxTree0 +#print axioms stepForsSetup_forsBase_eq +#print axioms stepForsSetup_preserves_key +#print axioms forsSetup_preserves_sigBase +#print axioms forsSetup_preserves_dVal +#print axioms forsSetup_preserves_htIdx +#print axioms forsSetup_preserves_memory +#print axioms forsSetup_preserves_selector_calldata + +end SphincsMinusVerifiers.SegmentForsSetup diff --git a/verity/SphincsMinusVerifiers/SegmentLayer3.lean b/verity/SphincsMinusVerifiers/SegmentLayer3.lean index f0d41e3..1b183e9 100644 --- a/verity/SphincsMinusVerifiers/SegmentLayer3.lean +++ b/verity/SphincsMinusVerifiers/SegmentLayer3.lean @@ -2162,7 +2162,7 @@ set_option maxHeartbeats 8000000 in /-- Faithfulness: `layerStmt` is *exactly* statement 25 of `c13VerifyBody` (loop header, full body, every inner `forEach` and the checksum-guard `ite`). -/ theorem layerStmt_eq_slice : - [layerStmt] = (c13VerifyBodyTail.drop 24).take 1 := rfl + [layerStmt] = (c13VerifyBodyTail.drop 27).take 1 := rfl /-- One-step unfold of `execStmtList` on a cons, kept generic so the head `execStmt` stays symbolic (no reduction of concrete loop-states). -/ @@ -3736,39 +3736,45 @@ theorem beforeWotsPkCopy_memory_0x20_eq_of_afterDigit_bindings ls layer idxTree idxLeaf hLayer hIdxTree hIdxLeaf hLayerLt hIdxTreeLt hIdxLeafLt unfold wotsPkAdrsExpr u at hEval - unfold beforeWotsPkCopy suffixBeforeWotsPkCopy mstore u - rw [execStmtList_cons_continue _ _ _ _ - (execStmt_letVar_continue _ "wotsPtr" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ - (execStmt_forEach_of_step "i" (.literal 43) wotsOuterBody _ _ - wotsOuterStep rfl wotsOuterStepLemma)] - rw [show wordNormalize 43 = 43 by rfl] - change - ((match execStmtList [] (beforeWotsPkAfterWots ls) - [Stmt.letVar "pkAdrs" - (orE (shlE (Expr.literal 224) (v "layer")) - (orE (shlE (Expr.literal 128) (v "idxTree")) - (orE (shlE (Expr.literal 96) (Expr.literal 1)) - (shlE (Expr.literal 64) (v "idxLeaf"))))), - Stmt.mstore (Expr.literal 32) (v "pkAdrs")] with - | .continue s' => s' - | _ => afterDigit ls).world.memory 0x20).val = - SphincsMinusVerifierSpec.C13Concrete.adrsWotsPk - layer idxTree idxLeaf + -- Thread the 2-statement prefix to the *named* cutpoint, introducing the + -- `wotsPtr` value in its `.getD` form so the closing `rfl` never has to + -- align a whnf'd eval against `beforeWotsPkWotsPtr`'s `getD` (that defeq + -- whnf-unfolds the 64-iteration digit fold and exhausts memory). + have hpre : execStmtList [] (afterDigit ls) + [ (.letVar "wotsPtr" (addE (v "sigBase") (v "sigOff")) : Stmt) + , .forEach "i" (u 43) wotsOuterBody ] + = .continue (beforeWotsPkAfterWots ls) := by + unfold beforeWotsPkAfterWots beforeWotsPkWotsPtr u addE v + rw [execStmtList_cons_continue _ _ _ _ + (execStmt_letVar_continue _ "wotsPtr" + (.add (.localVar "sigBase") (.localVar "sigOff")) + ((evalExpr [] (afterDigit ls) + (.add (.localVar "sigBase") (.localVar "sigOff"))).getD 0) + rfl)] + rw [execStmtList_cons_continue _ _ _ _ + (execStmt_forEach_of_step "i" (.literal 43) wotsOuterBody _ _ + wotsOuterStep rfl wotsOuterStepLemma)] + rw [show wordNormalize 43 = 43 from rfl] + rfl + unfold beforeWotsPkCopy + rw [show suffixBeforeWotsPkCopy + = [ (.letVar "wotsPtr" (addE (v "sigBase") (v "sigOff")) : Stmt) + , .forEach "i" (u 43) wotsOuterBody ] + ++ [ .letVar "pkAdrs" + (orE (shlE (u 224) (v "layer")) + (orE (shlE (u 128) (v "idxTree")) + (orE (shlE (u 96) (u 1)) (shlE (u 64) (v "idxLeaf"))))) + , mstore 0x20 (v "pkAdrs") ] from rfl] + rw [MemoryKit.execStmtList_append_continue _ _ _ _ hpre] + unfold mstore u rw [execStmtList_cons_continue _ _ _ _ (execStmt_letVar_continue _ "pkAdrs" _ _ hEval)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] simp only [execStmtList] - change - (MemoryKit.memUpdate _ (wordNormalize 32) - (wordNormalize - (SphincsMinusVerifierSpec.C13Concrete.adrsWotsPk - layer idxTree idxLeaf)) - (wordNormalize 32)).val = - SphincsMinusVerifierSpec.C13Concrete.adrsWotsPk - layer idxTree idxLeaf - rw [MemoryKit.memUpdate_val_same] + rw [MemoryKit.lookupValue_bindValue_self, + show wordNormalize 32 = 32 from rfl, + MemoryKit.memUpdate_val_same] exact adrsWotsPk_wordNormalize_of_bounds layer idxTree idxLeaf hLayerLt hIdxTreeLt hIdxLeafLt diff --git a/verity/SphincsMinusVerifiers/SegmentRejectSpec.lean b/verity/SphincsMinusVerifiers/SegmentRejectSpec.lean index a77879c..0346bdc 100644 --- a/verity/SphincsMinusVerifiers/SegmentRejectSpec.lean +++ b/verity/SphincsMinusVerifiers/SegmentRejectSpec.lean @@ -165,9 +165,13 @@ theorem c13_body_reverts_on_layer_first_guard = .continue (afterS3 st) rw [SegmentS3.execSegmentS3, if_pos hg3]; rfl rw [MemoryKit.execStmtList_append_continue _ _ _ _ hS3] - have hFors : execStmtList [] (afterS3 st) [SegmentS4Fors.forsOuterStmt] + have hSetup : execStmtList [] (afterS3 st) SegmentForsSetup.forsSetupBody + = .continue (afterForsSetup st) := + SegmentForsSetup.execForsSetup (afterS3 st) + rw [MemoryKit.execStmtList_append_continue _ _ _ _ hSetup] + have hFors : execStmtList [] (afterForsSetup st) [SegmentS4Fors.forsOuterStmt] = .continue (afterFors st) := - execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterS3 st)) + execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterForsSetup st)) rw [MemoryKit.execStmtList_append_continue _ _ _ _ hFors] have hFin : execStmtList [] (afterFors st) SegmentS4Finalize.forsFinalizeBody = .continue (afterFinalize st) := @@ -212,9 +216,13 @@ theorem c13_body_reverts_on_layer_second_guard = .continue (afterS3 st) rw [SegmentS3.execSegmentS3, if_pos hg3]; rfl rw [MemoryKit.execStmtList_append_continue _ _ _ _ hS3] - have hFors : execStmtList [] (afterS3 st) [SegmentS4Fors.forsOuterStmt] + have hSetup : execStmtList [] (afterS3 st) SegmentForsSetup.forsSetupBody + = .continue (afterForsSetup st) := + SegmentForsSetup.execForsSetup (afterS3 st) + rw [MemoryKit.execStmtList_append_continue _ _ _ _ hSetup] + have hFors : execStmtList [] (afterForsSetup st) [SegmentS4Fors.forsOuterStmt] = .continue (afterFors st) := - execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterS3 st)) + execSingleton_continue _ _ _ (SegmentS4Fors.execForsOuter (afterForsSetup st)) rw [MemoryKit.execStmtList_append_continue _ _ _ _ hFors] have hFin : execStmtList [] (afterFors st) SegmentS4Finalize.forsFinalizeBody = .continue (afterFinalize st) := diff --git a/verity/SphincsMinusVerifiers/SegmentS4Finalize.lean b/verity/SphincsMinusVerifiers/SegmentS4Finalize.lean index 583ae2d..822dd99 100644 --- a/verity/SphincsMinusVerifiers/SegmentS4Finalize.lean +++ b/verity/SphincsMinusVerifiers/SegmentS4Finalize.lean @@ -391,10 +391,10 @@ theorem forsCopyLoop7_preserves_low_slot root-compression copy loop, and the `forsPk` compression keccak. -/ def forsFinalizeBody : List Stmt := [ .letVar "lastSecret" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)) - , mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6))) + , mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6))) , mstore 0x40 (v "lastSecret") , mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK)) - , mstore 0x20 (shlE (u 96) (u 4)) + , mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))) , .forEach "i" (u 7) forsCopyBody , .letVar "forsPk" (andE (keccak 0x00 0x120) (u N_MASK)) ] @@ -410,10 +410,10 @@ theorem forsFinalizeBody_mem_cases {P : Stmt → Prop} {stmt : Stmt} (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)))) (hadrsLeaf : - P (mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6))))) + P (mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6))))) (hlastSecretStore : P (mstore 0x40 (v "lastSecret"))) (hforcedRoot : P (mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK)))) - (hadrsRoots : P (mstore 0x20 (shlE (u 96) (u 4)))) + (hadrsRoots : P (mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))))) (hcopy : P (.forEach "i" (u 7) forsCopyBody)) (hforsPk : P (.letVar "forsPk" (andE (keccak 0x00 0x120) (u N_MASK)))) : P stmt := by @@ -431,25 +431,25 @@ theorem forsFinalizeBody_mem_cases {P : Stmt → Prop} {stmt : Stmt} materialises the exact state whose memory is compressed into the FORS public key. -/ def forsFinalizePrePkBody : List Stmt := [ .letVar "lastSecret" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)) - , mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6))) + , mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6))) , mstore 0x40 (v "lastSecret") , mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK)) - , mstore 0x20 (shlE (u 96) (u 4)) + , mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))) , .forEach "i" (u 7) forsCopyBody ] /-- The finalize prefix before statement 20's copy loop. This is the state whose `0x80 + 32*i` root slots are copied into the final compression preimage. -/ def forsFinalizePreCopyBody : List Stmt := [ .letVar "lastSecret" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)) - , mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6))) + , mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6))) , mstore 0x40 (v "lastSecret") , mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK)) - , mstore 0x20 (shlE (u 96) (u 4)) ] + , mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))) ] /-- Faithfulness: `forsFinalizeBody` is *exactly* statements 15..21 of `c13VerifyBody` (the FORS finalize block, copy loop included). -/ theorem forsFinalizeBody_eq_slice : - forsFinalizeBody = (c13VerifyBodyTail.drop 14).take 7 := rfl + forsFinalizeBody = (c13VerifyBodyTail.drop 17).take 7 := rfl /-! ## 4. The finalize-block step lemma. -/ @@ -535,49 +535,142 @@ theorem forsFinalizePreCopyStep_preserves_root_source_slot simp [execStmtList, MemoryKit.memUpdate, Compiler.Constants.evmModulus, hne32, hne64, hne320] +private theorem shl128_lt_of_lt11 (x : Nat) (h : x < 2 ^ 11) : + x <<< 128 < 2 ^ 256 := by + have h11 : x ≤ 2047 := by + rw [show (2 : Nat) ^ 11 = 2048 from by norm_num] at h + omega + rw [Nat.shiftLeft_eq] + calc + x * 2 ^ 128 ≤ 2047 * 2 ^ 128 := Nat.mul_le_mul_right _ h11 + _ < 2 ^ 256 := by norm_num + +private theorem shl64_lt_of_lt11 (x : Nat) (h : x < 2 ^ 11) : + x <<< 64 < 2 ^ 256 := by + have h11 : x ≤ 2047 := by + rw [show (2 : Nat) ^ 11 = 2048 from by norm_num] at h + omega + rw [Nat.shiftLeft_eq] + calc + x * 2 ^ 64 ≤ 2047 * 2 ^ 64 := Nat.mul_le_mul_right _ h11 + _ < 2 ^ 256 := by norm_num + set_option maxHeartbeats 4000000 in /-- The pre-copy finalize prefix leaves the final FORS-roots address word in scratch slot `0x20`, exactly the address preimage used by the `forsPk` -compression. -/ -theorem forsFinalizePreCopyStep_adrsRoots_slot (st : RuntimeState) : - ((forsFinalizePreCopyStep st).world.memory 0x20).val = adrsForsRoots := by - unfold forsFinalizePreCopyStep forsFinalizePreCopyBody mstore u - rw [execStmtList_cons_continue _ _ _ _ (execStmt_letVar_continue st "lastSecret" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - simp [execStmtList, MemoryKit.memUpdate, Compiler.Constants.evmModulus, adrsForsRoots, - Verity.Core.Uint256.shl, Verity.Core.Uint256.modulus, Verity.Core.UINT256_MODULUS] +compression. Parametric in the hoisted FIPS digits `idxTree0`/`idxLeaf0` +(11-bit, supplied by `SegmentForsSetup.stepForsSetup_idxTree0/_idxLeaf0`). -/ +theorem forsFinalizePreCopyStep_adrsRoots_slot + (st : RuntimeState) (it0 il0 : Nat) + (hT : lookupValue st.bindings "idxTree0" = it0) (hTlt : it0 < 2 ^ 11) + (hL : lookupValue st.bindings "idxLeaf0" = il0) (hLlt : il0 < 2 ^ 11) : + ((forsFinalizePreCopyStep st).world.memory 0x20).val + = SphincsMinusVerifierSpec.C13Concrete.adrsForsRoots it0 il0 := by + -- Pin the binder-write values so later states are syntactic records. + obtain ⟨w1, hw1⟩ : ∃ w, evalExpr [] st + (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)) + = some w := ⟨_, rfl⟩ + set st1 : RuntimeState := { st with bindings := bindValue st.bindings "lastSecret" w1 } + with hst1 + obtain ⟨w2, hw2⟩ : ∃ w, evalExpr [] st1 + (orE (v "forsBase") (shlE (u 19) (u 6))) = some w := ⟨_, rfl⟩ + set st2 : RuntimeState := { st1 with world := { st1.world with + memory := MemoryKit.memUpdate st1.world.memory 0x20 w2 } } with hst2 + obtain ⟨w3, hw3⟩ : ∃ w, evalExpr [] st2 (v "lastSecret") = some w := ⟨_, rfl⟩ + set st3 : RuntimeState := { st2 with world := { st2.world with + memory := MemoryKit.memUpdate st2.world.memory 0x40 w3 } } with hst3 + obtain ⟨w4, hw4⟩ : ∃ w, evalExpr [] st3 + (andE (keccak 0x00 0x60) (u N_MASK)) = some w := ⟨_, rfl⟩ + set st4 : RuntimeState := { st3 with world := { st3.world with + memory := MemoryKit.memUpdate st3.world.memory 0x140 w4 } } with hst4 + -- Eval witness for the FORS_ROOTS address word in `st4`. + have hT4 : evalExpr [] st4 (v "idxTree0") = some it0 := by + show some (lookupValue (bindValue st.bindings "lastSecret" w1) "idxTree0") = some it0 + rw [MemoryKit.lookupValue_bindValue_ne _ "lastSecret" "idxTree0" _ (by decide), hT] + have hL4 : evalExpr [] st4 (v "idxLeaf0") = some il0 := by + show some (lookupValue (bindValue st.bindings "lastSecret" w1) "idxLeaf0") = some il0 + rw [MemoryKit.lookupValue_bindValue_ne _ "lastSecret" "idxLeaf0" _ (by decide), hL] + have hShlT : evalExpr [] st4 (shlE (u 128) (v "idxTree0")) = some (it0 <<< 128) := + ClimbKeccakStep.evalExpr_shl_bounded st4 (u 128) (v "idxTree0") 128 it0 rfl hT4 + (by norm_num) (lt_trans hTlt (by norm_num)) (shl128_lt_of_lt11 it0 hTlt) + have hShlM : evalExpr [] st4 (shlE (u 96) (u 4)) = some ((4 : Nat) <<< 96) := + ClimbKeccakStep.evalExpr_shl_bounded st4 (u 96) (u 4) 96 4 rfl rfl + (by norm_num) (by norm_num) (by decide) + have hShlL : evalExpr [] st4 (shlE (u 64) (v "idxLeaf0")) = some (il0 <<< 64) := + ClimbKeccakStep.evalExpr_shl_bounded st4 (u 64) (v "idxLeaf0") 64 il0 rfl hL4 + (by norm_num) (lt_trans hLlt (by norm_num)) (shl64_lt_of_lt11 il0 hLlt) + have hInner : evalExpr [] st4 (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0"))) + = some ((4 <<< 96) ||| (il0 <<< 64)) := + ClimbKeccakStep.evalExpr_bitOr_bounded st4 _ _ _ _ hShlM hShlL + (by decide) (shl64_lt_of_lt11 il0 hLlt) + have hInnerLt : (4 <<< 96) ||| (il0 <<< 64) < 2 ^ 256 := + Nat.bitwise_lt_two_pow (by decide) (shl64_lt_of_lt11 il0 hLlt) + have hRoots : evalExpr [] st4 + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))) + = some ((it0 <<< 128) ||| ((4 <<< 96) ||| (il0 <<< 64))) := + ClimbKeccakStep.evalExpr_bitOr_bounded st4 _ _ _ _ hShlT hInner + (shl128_lt_of_lt11 it0 hTlt) hInnerLt + have hVLt : (it0 <<< 128) ||| ((4 <<< 96) ||| (il0 <<< 64)) < 2 ^ 256 := + Nat.bitwise_lt_two_pow (shl128_lt_of_lt11 it0 hTlt) hInnerLt + have h2 : execStmt [] st1 (mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6)))) + = .continue st2 := + execStmt_mstore_continue st1 (u 0x20) _ 0x20 w2 rfl hw2 + have h3 : execStmt [] st2 (mstore 0x40 (v "lastSecret")) = .continue st3 := + execStmt_mstore_continue st2 (u 0x40) _ 0x40 w3 rfl hw3 + have h4 : execStmt [] st3 (mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK))) + = .continue st4 := + execStmt_mstore_continue st3 (u 0x140) _ 0x140 w4 rfl hw4 + have h5 : execStmt [] st4 + (mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0"))))) + = .continue { st4 with world := { st4.world with + memory := MemoryKit.memUpdate st4.world.memory 0x20 + ((it0 <<< 128) ||| ((4 <<< 96) ||| (il0 <<< 64))) } } := + execStmt_mstore_continue st4 (u 0x20) _ 0x20 _ rfl hRoots + unfold forsFinalizePreCopyStep forsFinalizePreCopyBody + rw [execStmtList_cons_continue _ _ _ _ (execStmt_letVar_continue st "lastSecret" _ _ hw1)] + rw [execStmtList_cons_continue _ _ _ _ h2] + rw [execStmtList_cons_continue _ _ _ _ h3] + rw [execStmtList_cons_continue _ _ _ _ h4] + rw [execStmtList_cons_continue _ _ _ _ h5] + simp only [execStmtList] + simp [MemoryKit.memUpdate, + SphincsMinusVerifierSpec.C13Concrete.adrsForsRoots, Nat.lor_assoc] + exact Nat.mod_eq_of_lt (by simpa using hVLt) set_option maxHeartbeats 4000000 in /-- The pre-copy finalize prefix computes the forced-zero seventh FORS root in -source slot `0x140`, provided the incoming seed cell and seventh secret word are -the expected spec words. This isolates the remaining calldata/parser work from -the local forced-root scratch hash. -/ +source slot `0x140`, provided the incoming seed cell, the hoisted `"forsBase"` +ADRS-base binding, and the seventh secret word are the expected spec words. +Stated over a generic bounded base word so it is layout-agnostic; instantiate +`base := adrsForsBase idxTree0 idxLeaf0` and identify +`base ||| (6 <<< 19) = adrsForsLeaf idxTree0 idxLeaf0 6 0` via +`adrsForsLeaf_eq_of_forsBase` + `Nat.lor_zero` at the call site. -/ theorem forsFinalizePreCopyStep_forced_root_cell - (st : RuntimeState) (seed sk : Nat) + (st : RuntimeState) (seed base sk : Nat) (hmSeed : (st.world.memory 0).val = seed) + (hFB : lookupValue st.bindings "forsBase" = base) + (hBaseLt : base < 2 ^ 256) (hLastSecret : evalExpr [] st (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) (u N_MASK)) = some sk) : ((forsFinalizePreCopyStep st).world.memory 0x140).val - = maskN (keccakWords [seed, adrsForsLeaf 6 0, sk]) := by + = maskN (keccakWords [seed, base ||| (6 <<< 19), sk]) := by + have hLeafLt : base ||| (6 <<< 19) < 2 ^ 256 := + Nat.bitwise_lt_two_pow hBaseLt (by decide) let st1 : RuntimeState := { st with bindings := bindValue st.bindings "lastSecret" sk } let st2 : RuntimeState := { st1 with world := { st1.world with - memory := MemoryKit.memUpdate st1.world.memory 0x20 (adrsForsLeaf 6 0) } } + memory := MemoryKit.memUpdate st1.world.memory 0x20 (base ||| (6 <<< 19)) } } let st3 : RuntimeState := { st2 with world := { st2.world with memory := MemoryKit.memUpdate st2.world.memory 0x40 sk } } - let node : Nat := maskN (keccakWords [seed, adrsForsLeaf 6 0, sk]) + let node : Nat := maskN (keccakWords [seed, base ||| (6 <<< 19), sk]) let st4 : RuntimeState := { st3 with world := { st3.world with memory := MemoryKit.memUpdate st3.world.memory 0x140 node } } - let st5 : RuntimeState := - { st4 with world := { st4.world with - memory := MemoryKit.memUpdate st4.world.memory 0x20 adrsForsRoots } } have h1 : execStmt [] st (.letVar "lastSecret" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (u 6))))) @@ -585,12 +678,19 @@ theorem forsFinalizePreCopyStep_forced_root_cell unfold st1 exact execStmt_letVar_continue st "lastSecret" _ _ hLastSecret have h2 : execStmt [] st1 - (mstore 0x20 (orE (shlE (u 96) (u 3)) (shlE (u 64) (u 6)))) + (mstore 0x20 (orE (v "forsBase") (shlE (u 19) (u 6)))) = .continue st2 := by - unfold st2 mstore u - convert execStmt_mstore_continue st1 (.literal 0x20) - (orE (shlE (.literal 96) (.literal 3)) (shlE (.literal 64) (.literal 6))) - 0x20 (adrsForsLeaf 6 0) rfl rfl using 1 + unfold st2 mstore + refine execStmt_mstore_continue st1 (u 0x20) + (orE (v "forsBase") (shlE (u 19) (u 6))) 0x20 (base ||| (6 <<< 19)) rfl ?_ + have hFB1 : evalExpr [] st1 (v "forsBase") = some base := by + show some (lookupValue (bindValue st.bindings "lastSecret" sk) "forsBase") = some base + rw [MemoryKit.lookupValue_bindValue_ne _ "lastSecret" "forsBase" _ (by decide), hFB] + have hShl : evalExpr [] st1 (shlE (u 19) (u 6)) = some ((6 : Nat) <<< 19) := + ClimbKeccakStep.evalExpr_shl_bounded st1 (u 19) (u 6) 19 6 rfl rfl + (by norm_num) (by norm_num) (by decide) + exact ClimbKeccakStep.evalExpr_bitOr_bounded st1 _ _ _ _ hFB1 hShl + hBaseLt (by decide) have h3 : execStmt [] st2 (mstore 0x40 (v "lastSecret")) = .continue st3 := by unfold st3 mstore u v refine execStmt_mstore_continue st2 (.literal 0x40) (.localVar "lastSecret") @@ -606,22 +706,28 @@ theorem forsFinalizePreCopyStep_forced_root_cell evalExpr_bitAnd_result_lt hLastSecret unfold andE keccak u refine SphincsMinusVerifiers.InitialNodeKeccak.fors_leaf_node_eq - _ seed (adrsForsLeaf 6 0) sk ?_ ?_ ?_ + _ seed (base ||| (6 <<< 19)) sk ?_ ?_ ?_ · simp [st3, st2, st1, MemoryKit.memUpdate, hmSeed] · simp [st3, st2, MemoryKit.memUpdate] - exact Nat.mod_eq_of_lt (by - decide) + exact Nat.mod_eq_of_lt hLeafLt · simp [st3, MemoryKit.memUpdate, Nat.mod_eq_of_lt hsk_lt] have h4 : execStmt [] st3 (mstore 0x140 (andE (keccak 0x00 0x60) (u N_MASK))) = .continue st4 := by unfold st4 mstore u exact execStmt_mstore_continue st3 (.literal 0x140) (andE (keccak 0x00 0x60) (.literal N_MASK)) 0x140 node rfl hNode - have h5 : execStmt [] st4 (mstore 0x20 (shlE (u 96) (u 4))) = .continue st5 := by - unfold st5 mstore u - convert execStmt_mstore_continue st4 (.literal 0x20) - (shlE (.literal 96) (.literal 4)) 0x20 adrsForsRoots rfl rfl using 1 - have hExec : execStmtList [] st forsFinalizePreCopyBody = .continue st5 := by + obtain ⟨w5, hw5⟩ : ∃ w, evalExpr [] st4 + (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0")))) = some w := ⟨_, rfl⟩ + have h5 : execStmt [] st4 + (mstore 0x20 (orE (shlE (u 128) (v "idxTree0")) + (orE (shlE (u 96) (u 4)) (shlE (u 64) (v "idxLeaf0"))))) + = .continue { st4 with world := { st4.world with + memory := MemoryKit.memUpdate st4.world.memory 0x20 w5 } } := + execStmt_mstore_continue st4 (u 0x20) _ 0x20 w5 rfl hw5 + have hExec : execStmtList [] st forsFinalizePreCopyBody + = .continue { st4 with world := { st4.world with + memory := MemoryKit.memUpdate st4.world.memory 0x20 w5 } } := by unfold forsFinalizePreCopyBody rw [execStmtList_cons_continue _ _ _ _ h1] rw [execStmtList_cons_continue _ _ _ _ h2] @@ -633,7 +739,7 @@ theorem forsFinalizePreCopyStep_forced_root_cell rw [hExec] have hnode_lt : node < Verity.Core.Uint256.modulus := evalExpr_bitAnd_result_lt hNode - unfold st5 st4 + unfold st4 simp [MemoryKit.memUpdate] unfold node at hnode_lt ⊢ exact Nat.mod_eq_of_lt hnode_lt diff --git a/verity/SphincsMinusVerifiers/SegmentS4Fors.lean b/verity/SphincsMinusVerifiers/SegmentS4Fors.lean index fc1e88d..4571d42 100644 --- a/verity/SphincsMinusVerifiers/SegmentS4Fors.lean +++ b/verity/SphincsMinusVerifiers/SegmentS4Fors.lean @@ -6,8 +6,8 @@ ``` 117..125 leaf setup (7 letVar + 2 mstore — pure binder/memory writes) - 126 forEach "h" (u 19) ← inner Merkle climb = ClimbKit.merkleClimbBody - "node" "pathIdx" "treeAdrsBase" "authPtr" + 126 forEach "h" (u 19) ← inner Merkle climb = ClimbKit.forsClimbBody + (merkleClimbBodyA at the FIPS forsAdrs) 136 mstore scratch[i] := node (store the reconstructed leaf) ``` @@ -35,7 +35,7 @@ namespace SphincsMinusVerifiers.SegmentS4Fors open Compiler.Proofs.IRGeneration.SourceSemantics open Compiler.CompilationModel (Expr Stmt) -open SphincsMinusVerifiers.ClimbKit (N_MASK merkleClimbBody stepMerkle) +open SphincsMinusVerifiers.ClimbKit (N_MASK merkleClimbBody stepMerkle forsClimbBody stepForsMerkle) open SphincsMinusVerifiers.ClimbLoop (foldLoop) open SphincsMinusVerifierSpec.C13Concrete (adrsForsLeaf maskN keccakWords wordOfHash16) @@ -56,38 +56,36 @@ private def mstore (off : Nat) (val : Expr) : Stmt := .mstore (u off) val private def mstoreE (off val : Expr) : Stmt := .mstore off val /-! ## 1. The FORS outer-loop body (statement 14's body), with the inner Merkle -climb written as `merkleClimbBody …` so `execStmt_forEach_merkleClimb` applies. -/ +climb written as `forsClimbBody` so `execStmt_forEach_forsClimb` applies. -/ /-- The body of `forEach "i" (u 6)` (FORS tree-root reconstruction, stmts 117..136 of `c13VerifyBody`). -/ def forsLeafBody : List Stmt := [ .letVar "treeIdx" (andE (shrE (mulE (v "i") (u 19)) (v "dVal")) (u 0x7FFFF)) , .letVar "secretVal" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (v "i"))))) (u N_MASK)) - , .letVar "leafAdrs" (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))) + , .letVar "leafAdrs" (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))) , mstore 0x20 (v "leafAdrs") , mstore 0x40 (v "secretVal") , .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)) - , .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))) , .letVar "pathIdx" (v "treeIdx") , .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) - , .forEach "h" (u 19) (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr") + , .forEach "h" (u 19) forsClimbBody , mstoreE (addE (u 0x80) (shlE (u 5) (v "i"))) (v "node") ] /-- The straight-line setup before the inner Merkle climb in one FORS tree. -/ def forsLeafSetupBody : List Stmt := [ .letVar "treeIdx" (andE (shrE (mulE (v "i") (u 19)) (v "dVal")) (u 0x7FFFF)) , .letVar "secretVal" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (v "i"))))) (u N_MASK)) - , .letVar "leafAdrs" (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))) + , .letVar "leafAdrs" (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))) , mstore 0x20 (v "leafAdrs") , mstore 0x40 (v "secretVal") , .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)) - , .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))) , .letVar "pathIdx" (v "treeIdx") , .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] /-- The inner Merkle climb statement in one FORS tree. -/ def forsLeafInnerStmt : Stmt := - .forEach "h" (u 19) (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr") + .forEach "h" (u 19) forsClimbBody /-- The final store of one reconstructed FORS tree root into the root array. -/ def forsLeafStoreStmt : Stmt := @@ -130,7 +128,6 @@ theorem execForsLeafSetup (st : RuntimeState) : rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] rfl @@ -145,7 +142,7 @@ theorem forsLeafSetup_preserves_seed_slot 0 forsLeafSetupBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' 0 "treeIdx" _ hexec @@ -155,6 +152,7 @@ theorem forsLeafSetup_preserves_seed_slot · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' 0 "leafAdrs" _ hexec + · subst stmt refine SphincsMinusVerifiers.MemoryFrame.execStmt_mstore_preserves_memory_val s s'' 0 (u 0x20) (v "leafAdrs") ?_ hexec @@ -176,9 +174,6 @@ theorem forsLeafSetup_preserves_seed_slot · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' 0 "node" _ hexec - · subst stmt - exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val - s s'' 0 "treeAdrsBase" _ hexec · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' 0 "pathIdx" _ hexec @@ -196,7 +191,7 @@ theorem forsLeafSetup_preserves_i "i" forsLeafSetupBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "treeIdx" "i" _ (by decide) hexec @@ -215,9 +210,6 @@ theorem forsLeafSetup_preserves_i · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "i" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "i" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "i" _ (by decide) hexec @@ -242,7 +234,7 @@ theorem forsLeafSetup_preserves_root_cell_range (0x80 + 32 * j) forsLeafSetupBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' (0x80 + 32 * j) "treeIdx" _ hexec @@ -252,6 +244,7 @@ theorem forsLeafSetup_preserves_root_cell_range · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' (0x80 + 32 * j) "leafAdrs" _ hexec + · subst stmt refine SphincsMinusVerifiers.MemoryFrame.execStmt_mstore_preserves_memory_val s s'' (0x80 + 32 * j) (u 0x20) (v "leafAdrs") ?_ hexec @@ -273,9 +266,6 @@ theorem forsLeafSetup_preserves_root_cell_range · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' (0x80 + 32 * j) "node" _ hexec - · subst stmt - exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val - s s'' (0x80 + 32 * j) "treeAdrsBase" _ hexec · subst stmt exact SphincsMinusVerifiers.MemoryFrame.execStmt_letVar_preserves_memory_val s s'' (0x80 + 32 * j) "pathIdx" _ hexec @@ -305,7 +295,7 @@ theorem forsLeafSetup_preserves_sigBase "sigBase" forsLeafSetupBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "treeIdx" "sigBase" _ (by decide) hexec @@ -324,9 +314,6 @@ theorem forsLeafSetup_preserves_sigBase · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "sigBase" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "sigBase" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "sigBase" _ (by decide) hexec @@ -349,7 +336,7 @@ theorem forsLeafSetup_preserves_dVal "dVal" forsLeafSetupBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "treeIdx" "dVal" _ (by decide) hexec @@ -368,9 +355,6 @@ theorem forsLeafSetup_preserves_dVal · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "dVal" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "dVal" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "dVal" _ (by decide) hexec @@ -391,7 +375,7 @@ theorem forsLeafSetupStep_preserves_selector_calldata (st : RuntimeState) : forsLeafSetupBody st (forsLeafSetupStep st) ?_ (execForsLeafSetup st) intro s s'' stmt hmem hexec simp [forsLeafSetupBody, mstore] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "treeIdx" _ hexec @@ -410,9 +394,6 @@ theorem forsLeafSetupStep_preserves_selector_calldata (st : RuntimeState) : · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "node" _ hexec - · subst stmt - exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata - s s'' "treeAdrsBase" _ hexec · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "pathIdx" _ hexec @@ -490,10 +471,6 @@ private theorem uint256_and_val_lt (a b : Verity.Core.Uint256) : (a.and b).val < 2 ^ 256 := by simpa [Verity.Core.UINT256_MODULUS] using (a.and b).isLt -private theorem uint256_or_val_lt (a b : Verity.Core.Uint256) : - (a.or b).val < 2 ^ 256 := by - simpa [Verity.Core.UINT256_MODULUS] using (a.or b).isLt - /-- C13-shaped setup fact for the FORS auth-path pointer: the straight-line setup prefix binds `"authPtr"` to the signature-data base plus the per-FORS-tree authentication-path offset. -/ @@ -511,7 +488,6 @@ theorem forsLeafSetupStep_authPtr_eq_sigDataOffset rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] simpa [execStmtList, @@ -533,7 +509,6 @@ theorem forsLeafSetupStep_pathIdx_lt rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] simpa [execStmtList, @@ -562,123 +537,135 @@ theorem forsLeafSetupStep_pathIdx_eq_of_eval rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] simp only [execStmtList] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "authPtr" "pathIdx" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "treeAdrsBase" "treeIdx" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "node" "treeIdx" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "leafAdrs" "treeIdx" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "secretVal" "treeIdx" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] -/-- The concrete FORS tree-address base expression evaluates to the spec ADRS -base word once the outer-loop index binding is an in-range FORS index. -/ -theorem forsTreeAdrsBase_eval_eq - (st : RuntimeState) {idx : Nat} +private theorem idxShl19_lt (idx : Nat) (hidx : idx < 6) : + idx <<< 19 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + idx * 2 ^ 19 ≤ 5 * 2 ^ 19 := + Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hidx) + _ < 2 ^ 256 := by decide + +/-- The FIPS C13 FORS leaf-address expression +`or(forsBase, or(shl(19, i), treeIdx))` evaluates to +`base ||| ((idx <<< 19) ||| treeIdx)` once the carried `"forsBase"`, `"i"`, +and `"treeIdx"` bindings are identified and bounded. This is the single eval +lemma that replaces the retired pre-FIPS `forsTreeAdrsBase_eval_eq`. -/ +theorem forsLeafAdrs_eval_eq + (st : RuntimeState) {base idx treeIdx : Nat} + (hbase : lookupValue st.bindings "forsBase" = base) + (hbaseLt : base < 2 ^ 256) (hi : lookupValue st.bindings "i" = idx) - (hidx : idx < 6) : + (hidx : idx < 6) + (ht : lookupValue st.bindings "treeIdx" = treeIdx) + (htLt : treeIdx < 2 ^ 19) : evalExpr [] st - (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))) - = some ((3 <<< 96) ||| (idx <<< 64)) := by - have h96 : - evalExpr [] st (shlE (u 96) (u 3)) = some (3 <<< 96) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - st (u 96) (u 3) 96 3 rfl rfl - (by decide) (by decide) (by decide) + (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))) + = some (base ||| ((idx <<< 19) ||| treeIdx)) := by have hiEval : evalExpr [] st (v "i") = some idx := by show some (lookupValue st.bindings "i") = some idx rw [hi] - have h64 : - evalExpr [] st (shlE (u 64) (v "i")) = some (idx <<< 64) := + have hbaseEval : evalExpr [] st (v "forsBase") = some base := by + show some (lookupValue st.bindings "forsBase") = some base + rw [hbase] + have htEval : evalExpr [] st (v "treeIdx") = some treeIdx := by + show some (lookupValue st.bindings "treeIdx") = some treeIdx + rw [ht] + have hsh : + evalExpr [] st (shlE (u 19) (v "i")) = some (idx <<< 19) := SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - st (u 64) (v "i") 64 idx rfl hiEval + st (u 19) (v "i") 19 idx rfl hiEval (by decide) (lt_trans hidx (by decide : 6 < 2 ^ 256)) - (by - rw [Nat.shiftLeft_eq] - calc - idx * 2 ^ 64 ≤ 5 * 2 ^ 64 := - Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hidx) - _ < 2 ^ 256 := by decide) - have h96lt : 3 <<< 96 < 2 ^ 256 := by decide - have h64lt : idx <<< 64 < 2 ^ 256 := by - rw [Nat.shiftLeft_eq] - calc - idx * 2 ^ 64 ≤ 5 * 2 ^ 64 := - Nat.mul_le_mul_right _ (Nat.le_of_lt_succ hidx) - _ < 2 ^ 256 := by decide + (idxShl19_lt idx hidx) + have htLt256 : treeIdx < 2 ^ 256 := + lt_trans htLt (by decide : 2 ^ 19 < 2 ^ 256) + have hinner : + evalExpr [] st (orE (shlE (u 19) (v "i")) (v "treeIdx")) + = some ((idx <<< 19) ||| treeIdx) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + st (shlE (u 19) (v "i")) (v "treeIdx") + (idx <<< 19) treeIdx hsh htEval (idxShl19_lt idx hidx) htLt256 + have hinnerLt : (idx <<< 19) ||| treeIdx < 2 ^ 256 := + Nat.bitwise_lt_two_pow (idxShl19_lt idx hidx) htLt256 exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded - st (shlE (u 96) (u 3)) (shlE (u 64) (v "i")) - (3 <<< 96) (idx <<< 64) h96 h64 h96lt h64lt - -/-- C13-shaped setup fact for the FORS tree-address base: after the straight-line -setup prefix there is a bounded EVM word bound to `"treeAdrsBase"`. -/ -theorem forsLeafSetupStep_treeAdrsBase_exists_lt - (st : RuntimeState) (idx : Nat) - (hi : lookupValue st.bindings "i" = idx) : - ∃ base, - lookupValue (forsLeafSetupStep st).bindings "treeAdrsBase" = base ∧ - base < 2 ^ 256 := by - refine ⟨lookupValue (forsLeafSetupStep st).bindings "treeAdrsBase", rfl, ?_⟩ - unfold forsLeafSetupStep forsLeafSetupBody mstore u - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st "treeIdx" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "secretVal" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "leafAdrs" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] - simpa [execStmtList, - SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self, - SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne, hi, - Verity.Core.Uint256.modulus, Verity.Core.UINT256_MODULUS] - using (uint256_or_val_lt - (Verity.Core.Uint256.ofNat - ((Verity.Core.Uint256.ofNat (96 % Compiler.Constants.evmModulus)).shl - (Verity.Core.Uint256.ofNat (3 % Compiler.Constants.evmModulus))).val) - (Verity.Core.Uint256.ofNat - ((Verity.Core.Uint256.ofNat (64 % Compiler.Constants.evmModulus)).shl - (Verity.Core.Uint256.ofNat idx)).val)) - -/-- Exact C13-shaped setup fact for the FORS tree-address base. The -straight-line setup binds `"treeAdrsBase"` to the spec ADRS base -`3 << 96 || i << 64` for the six real FORS outer-loop iterations. -/ -theorem forsLeafSetupStep_treeAdrsBase_eq_of_i - (st : RuntimeState) (idx : Nat) - (hi : lookupValue st.bindings "i" = idx) - (hidx : idx < 6) : - lookupValue (forsLeafSetupStep st).bindings "treeAdrsBase" - = (3 <<< 96) ||| (idx <<< 64) := by - unfold forsLeafSetupStep forsLeafSetupBody mstore u - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st "treeIdx" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "secretVal" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "leafAdrs" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ - ((3 <<< 96) ||| (idx <<< 64)) ?_)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] - · simp [execStmtList, - SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne] - · apply forsTreeAdrsBase_eval_eq - · simp [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne, hi] - · exact hidx - -/-- If the setup prefix's decoded FORS leaf address and secret-key word are -already identified with their spec values, the setup `"node"` binding is exactly -the spec FORS leaf hash. This is the initial-relation seed for the later + st (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx")) + base ((idx <<< 19) ||| treeIdx) hbaseEval hinner hbaseLt hinnerLt + +/-- The right-associated eval value above is exactly the spec FORS leaf +address once `"forsBase"` carries the spec ADRS base. -/ +theorem forsLeafAdrs_value_eq_spec + (idxTree0 idxLeaf0 idx treeIdx : Nat) : + SphincsMinusVerifierSpec.C13Concrete.adrsForsBase idxTree0 idxLeaf0 + ||| ((idx <<< 19) ||| treeIdx) + = SphincsMinusVerifierSpec.C13Concrete.adrsForsLeaf idxTree0 idxLeaf0 idx treeIdx := by + rw [SphincsMinusVerifierSpec.C13Concrete.adrsForsLeaf_eq_of_forsBase, + Nat.lor_assoc] + +/-- The straight-line FORS leaf setup never rebinds the hoisted FIPS ADRS base +`"forsBase"` (it is bound once, before the outer loop, by the fors-setup +segment). Under the FIPS layout this *preservation* fact replaces the retired +per-iteration `forsLeafSetupStep_forsBase_eq_of_i`. -/ +theorem forsLeafSetup_preserves_forsBase + (st s' : RuntimeState) + (h : execStmtList [] st forsLeafSetupBody = .continue s') : + lookupValue s'.bindings "forsBase" = lookupValue st.bindings "forsBase" := by + refine SphincsMinusVerifiers.BindingFrame.execStmtList_preserves_lookup + "forsBase" forsLeafSetupBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsLeafSetupBody, mstore] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "treeIdx" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "secretVal" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "leafAdrs" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (u 0x20) (v "leafAdrs") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (u 0x40) (v "secretVal") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "node" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "pathIdx" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "authPtr" "forsBase" _ (by decide) hexec + +/-- Step-form FIPS ADRS-base binding frame for the setup prefix. -/ +theorem forsLeafSetupStep_preserves_forsBase (st : RuntimeState) : + lookupValue (forsLeafSetupStep st).bindings "forsBase" + = lookupValue st.bindings "forsBase" := + forsLeafSetup_preserves_forsBase st (forsLeafSetupStep st) (execForsLeafSetup st) + +/-- If the setup prefix's decoded FORS leaf address word `leafW` and secret-key +word are already identified with their spec values, the setup `"node"` binding +is exactly the spec FORS leaf hash. Stated over an *arbitrary* bounded address +word `leafW`, so it is layout-agnostic: instantiate `leafW := +adrsForsLeaf idxTree0 idxLeaf0 i treeIdx` via `forsLeafAdrs_eval_eq` + +`forsLeafAdrs_value_eq_spec`. This is the initial-relation seed for the later inner-climb `forsClimb` correspondence. -/ theorem forsLeafSetupStep_node_eq_spec_of_eval - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) + (st : RuntimeState) (seed leafW treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) + (hAdrLt : leafW < 2 ^ 256) (hSkLt : wordOfHash16 sk < 2 ^ 256) (hTree : evalExpr [] st (andE (shrE (mulE (v "i") (u 19)) (v "dVal")) (u 0x7FFFF)) = some treeIdx) @@ -689,20 +676,20 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval (hLeaf : evalExpr [] { st with bindings := bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : + (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))) + = some leafW) : lookupValue (forsLeafSetupStep st).bindings "node" - = maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk]) := by + = maskN (keccakWords [seed, leafW, wordOfHash16 sk]) := by let st1 : RuntimeState := { st with bindings := bindValue st.bindings "treeIdx" treeIdx } let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "secretVal" (wordOfHash16 sk) } let st3 : RuntimeState := - { st2 with bindings := bindValue st2.bindings "leafAdrs" (adrsForsLeaf i treeIdx) } + { st2 with bindings := bindValue st2.bindings "leafAdrs" leafW } let st4 : RuntimeState := { st3 with world := { st3.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st3.world.memory 0x20 - (adrsForsLeaf i treeIdx) } } + leafW } } let st5 : RuntimeState := { st4 with world := { st4.world with @@ -710,7 +697,7 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval (wordOfHash16 sk) } } have hm0' : (st5.world.memory 0).val = seed := by simpa [st5, st4, st3, st2, st1] using hm0 - have hm1' : (st5.world.memory 0x20).val = adrsForsLeaf i treeIdx := by + have hm1' : (st5.world.memory 0x20).val = leafW := by simpa [st5, st4, st3, st2, st1, Verity.Core.Uint256.modulus, Verity.Core.UINT256_MODULUS] using Nat.mod_eq_of_lt hAdrLt have hm2' : (st5.world.memory 0x40).val = wordOfHash16 sk := by @@ -718,11 +705,11 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval using Nat.mod_eq_of_lt hSkLt have hNode : evalExpr [] st5 (andE (keccak 0x00 0x60) (u N_MASK)) - = some (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by + = some (maskN (keccakWords [seed, leafW, wordOfHash16 sk])) := by simpa [andE, keccak, u, SphincsMinusVerifiers.ClimbKit.N_MASK, SphincsMinusVerifierSpec.C13Concrete.nMask] - using SphincsMinusVerifiers.InitialNodeKeccak.fors_leaf_node_eq_spec - st5 seed i treeIdx sk hm0' hm1' hm2' + using SphincsMinusVerifiers.InitialNodeKeccak.fors_leaf_node_eq + st5 seed leafW (wordOfHash16 sk) hm0' hm1' hm2' unfold forsLeafSetupStep forsLeafSetupBody mstore rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st "treeIdx" _ _ hTree)] change lookupValue @@ -730,10 +717,9 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval [ .letVar "secretVal" (andE (cdload (addE (v "sigBase") (addE (u 16) (shlE (u 4) (v "i"))))) (u N_MASK)), .letVar "leafAdrs" - (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))), - mstore 0x20 (v "leafAdrs"), mstore 0x40 (v "secretVal"), + (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))), + .mstore (u 0x20) (v "leafAdrs"), .mstore (u 0x40) (v "secretVal"), .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] with | .continue s' => s' @@ -742,10 +728,9 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval change lookupValue (match execStmtList [] st2 [ .letVar "leafAdrs" - (orE (shlE (u 96) (u 3)) (orE (shlE (u 64) (v "i")) (v "treeIdx"))), - mstore 0x20 (v "leafAdrs"), mstore 0x40 (v "secretVal"), + (orE (v "forsBase") (orE (shlE (u 19) (v "i")) (v "treeIdx"))), + .mstore (u 0x20) (v "leafAdrs"), .mstore (u 0x40) (v "secretVal"), .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] with | .continue s' => s' @@ -755,19 +740,17 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval (match execStmtList [] st3 [ .mstore (u 0x20) (v "leafAdrs"), .mstore (u 0x40) (v "secretVal"), .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] with | .continue s' => s' | _ => st).bindings "node" = _ rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue st3 (u 0x20) (v "leafAdrs") 0x20 - (adrsForsLeaf i treeIdx) rfl rfl)] + leafW rfl rfl)] change lookupValue (match execStmtList [] st4 [ .mstore (u 0x40) (v "secretVal"), .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] with | .continue s' => s' @@ -778,24 +761,22 @@ theorem forsLeafSetupStep_node_eq_spec_of_eval change lookupValue (match execStmtList [] st5 [ .letVar "node" (andE (keccak 0x00 0x60) (u N_MASK)), - .letVar "treeAdrsBase" (orE (shlE (u 96) (u 3)) (shlE (u 64) (v "i"))), .letVar "pathIdx" (v "treeIdx"), .letVar "authPtr" (addE (v "sigBase") (addE (u 128) (mulE (v "i") (u 304)))) ] with | .continue s' => s' | _ => st).bindings "node" = _ rw [execStmtList_cons_continue _ _ _ _ (letVar_continue st5 "node" _ _ hNode)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] simp only [execStmtList] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "authPtr" "node" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "pathIdx" "node" _ (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne _ "treeAdrsBase" "node" _ (by decide)] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] -/-- Pure transformer for the inner Merkle climb statement. -/ +/-- Pure transformer for the inner Merkle climb statement (FIPS FORS address, +via the address-parametric `ClimbKit.stepForsMerkle`). -/ def forsLeafInnerStep (st : RuntimeState) : RuntimeState := - foldLoop "h" (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + foldLoop "h" stepForsMerkle { st with bindings := bindValue st.bindings "h" (wordNormalize 0) } 0 (wordNormalize 19) @@ -803,7 +784,7 @@ def forsLeafInnerStep (st : RuntimeState) : RuntimeState := theorem execForsLeafInner (st : RuntimeState) : execStmt [] st forsLeafInnerStmt = .continue (forsLeafInnerStep st) := by unfold forsLeafInnerStmt forsLeafInnerStep u - exact execStmt_forEach_merkleClimb "h" "node" "pathIdx" "treeAdrsBase" "authPtr" 19 st + exact ClimbLoop.execStmt_forEach_forsClimb "h" 19 st /-- The inner Merkle climb does not modify the outer FORS loop binding `"i"`. -/ theorem forsLeafInner_preserves_i @@ -813,10 +794,11 @@ theorem forsLeafInner_preserves_i unfold forsLeafInnerStmt u at h refine SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup "h" "i" (.literal 19) - (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr") + SphincsMinusVerifiers.ClimbKit.forsClimbBody st s' (by decide) ?_ h intro s s'' stmt hmem hexec - simp [merkleClimbBody] at hmem + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup @@ -892,8 +874,8 @@ theorem forsLeafBody_preserves_i "i" forsLeafBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafBody, mstore, mstoreE] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | - hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "treeIdx" "i" _ (by decide) hexec @@ -912,9 +894,6 @@ theorem forsLeafBody_preserves_i · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "i" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "i" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "i" _ (by decide) hexec @@ -937,8 +916,8 @@ theorem forsLeafBody_preserves_sigBase "sigBase" forsLeafBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafBody, mstore, mstoreE] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | - hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "treeIdx" "sigBase" _ (by decide) hexec @@ -957,9 +936,6 @@ theorem forsLeafBody_preserves_sigBase · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "sigBase" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "sigBase" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "sigBase" _ (by decide) hexec @@ -970,7 +946,8 @@ theorem forsLeafBody_preserves_sigBase exact SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup "h" "sigBase" _ _ s s'' (by decide) (fun s s'' stmt hmem hexec => by - simp [merkleClimbBody] at hmem + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup @@ -1000,6 +977,217 @@ theorem forsLeafBody_preserves_sigBase exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup s s'' "sigBase" (addE (u 0x80) (shlE (u 5) (v "i"))) (v "node") hexec +/-- The whole FORS leaf body never rebinds the hoisted FIPS ADRS base +`"forsBase"` (bound once by the fors-setup segment, before the outer loop). -/ +theorem forsLeafBody_preserves_forsBase + (st s' : RuntimeState) + (h : execStmtList [] st forsLeafBody = .continue s') : + lookupValue s'.bindings "forsBase" = lookupValue st.bindings "forsBase" := by + refine SphincsMinusVerifiers.BindingFrame.execStmtList_preserves_lookup + "forsBase" forsLeafBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsLeafBody, mstore, mstoreE] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "treeIdx" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "secretVal" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "leafAdrs" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (u 0x20) (v "leafAdrs") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (u 0x40) (v "secretVal") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "node" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "pathIdx" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "authPtr" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup + "h" "forsBase" _ _ s s'' (by decide) + (fun s s'' stmt hmem hexec => by + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "sibling" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "parentIdx" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (u 0x20) _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "s" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "node" "forsBase" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "pathIdx" "forsBase" _ (by decide) hexec) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "forsBase" (addE (u 0x80) (shlE (u 5) (v "i"))) (v "node") hexec + +/-- The whole FORS leaf body never rebinds the hoisted FIPS digit `"idxTree0"`. -/ +theorem forsLeafBody_preserves_idxTree0 + (st s' : RuntimeState) + (h : execStmtList [] st forsLeafBody = .continue s') : + lookupValue s'.bindings "idxTree0" = lookupValue st.bindings "idxTree0" := by + refine SphincsMinusVerifiers.BindingFrame.execStmtList_preserves_lookup + "idxTree0" forsLeafBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsLeafBody, mstore, mstoreE] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "treeIdx" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "secretVal" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "leafAdrs" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" (u 0x20) (v "leafAdrs") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" (u 0x40) (v "secretVal") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "node" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "pathIdx" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "authPtr" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup + "h" "idxTree0" _ _ s s'' (by decide) + (fun s s'' stmt hmem hexec => by + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "sibling" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "parentIdx" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" (u 0x20) _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "s" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "node" "idxTree0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "pathIdx" "idxTree0" _ (by decide) hexec) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxTree0" (addE (u 0x80) (shlE (u 5) (v "i"))) (v "node") hexec + +/-- The whole FORS leaf body never rebinds the hoisted FIPS digit `"idxLeaf0"`. -/ +theorem forsLeafBody_preserves_idxLeaf0 + (st s' : RuntimeState) + (h : execStmtList [] st forsLeafBody = .continue s') : + lookupValue s'.bindings "idxLeaf0" = lookupValue st.bindings "idxLeaf0" := by + refine SphincsMinusVerifiers.BindingFrame.execStmtList_preserves_lookup + "idxLeaf0" forsLeafBody st s' ?_ h + intro s s'' stmt hmem hexec + simp [forsLeafBody, mstore, mstoreE] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "treeIdx" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "secretVal" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "leafAdrs" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" (u 0x20) (v "leafAdrs") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" (u 0x40) (v "secretVal") hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "node" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "pathIdx" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "authPtr" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup + "h" "idxLeaf0" _ _ s s'' (by decide) + (fun s s'' stmt hmem hexec => by + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "sibling" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "parentIdx" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" (u 0x20) _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup + s s'' "s" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" _ _ hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "node" "idxLeaf0" _ (by decide) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_assignVar_preserves_lookup + s s'' "pathIdx" "idxLeaf0" _ (by decide) hexec) hexec + · subst stmt + exact SphincsMinusVerifiers.BindingFrame.execStmt_mstore_preserves_lookup + s s'' "idxLeaf0" (addE (u 0x80) (shlE (u 5) (v "i"))) (v "node") hexec + /-- The whole FORS leaf body preserves the EVM selector and calldata image. -/ theorem forsLeafBody_preserves_selector_calldata (st s' : RuntimeState) @@ -1009,8 +1197,8 @@ theorem forsLeafBody_preserves_selector_calldata forsLeafBody st s' ?_ h intro s s'' stmt hmem hexec simp [forsLeafBody, mstore, mstoreE] at hmem - rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | - hstmt | hstmt | hstmt | hstmt + rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "treeIdx" _ hexec @@ -1029,9 +1217,6 @@ theorem forsLeafBody_preserves_selector_calldata · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "node" _ hexec - · subst stmt - exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata - s s'' "treeAdrsBase" _ hexec · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata s s'' "pathIdx" _ hexec @@ -1042,7 +1227,8 @@ theorem forsLeafBody_preserves_selector_calldata exact SphincsMinusVerifiers.StateFrame.execStmt_forEach_preserves_selector_calldata "h" _ _ s s'' (fun s s'' stmt hmem hexec => by - simp [merkleClimbBody] at hmem + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hmem rcases hmem with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.StateFrame.execStmt_letVar_preserves_selector_calldata @@ -1197,7 +1383,7 @@ def forsOuterStmt : Stmt := .forEach "i" (u 6) forsLeafBody /-- Faithfulness: `forsOuterStmt` is *exactly* statement 14 of `c13VerifyBody` (loop header and full body, inner `forEach` included). -/ theorem forsOuterStmt_eq_slice : - [forsOuterStmt] = (c13VerifyBodyTail.drop 13).take 1 := rfl + [forsOuterStmt] = (c13VerifyBodyTail.drop 16).take 1 := rfl /-! ## 3. The FORS outer-loop body step lemma. -/ @@ -1223,11 +1409,10 @@ theorem execForsLeaf (st : RuntimeState) : rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "node" _ _ rfl)] - rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "treeAdrsBase" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "pathIdx" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ (letVar_continue _ "authPtr" _ _ rfl)] rw [execStmtList_cons_continue _ _ _ _ - (execStmt_forEach_merkleClimb "h" "node" "pathIdx" "treeAdrsBase" "authPtr" 19 _)] + (ClimbLoop.execStmt_forEach_forsClimb "h" 19 _)] rw [execStmtList_cons_continue _ _ _ _ (execStmt_mstore_continue _ _ _ _ _ rfl rfl)] rfl @@ -1242,7 +1427,7 @@ theorem forsLeafStep_preserves_dVal (st : RuntimeState) : intro s s'' stmt hmem hexec simp [forsLeafBody, mstoreE] at hmem rcases hmem with - hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup @@ -1262,9 +1447,6 @@ theorem forsLeafStep_preserves_dVal (st : RuntimeState) : · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "dVal" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "dVal" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "dVal" _ (by decide) hexec @@ -1274,10 +1456,11 @@ theorem forsLeafStep_preserves_dVal (st : RuntimeState) : · subst stmt refine SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup "h" "dVal" (.literal 19) - (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr") + SphincsMinusVerifiers.ClimbKit.forsClimbBody s s'' (by decide) ?_ hexec intro t t'' inner hinner hinnerExec - simp [merkleClimbBody] at hinner + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hinner rcases hinner with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst inner @@ -1318,7 +1501,7 @@ theorem forsLeafStep_preserves_htIdx (st : RuntimeState) : intro s s'' stmt hmem hexec simp [forsLeafBody, mstoreE] at hmem rcases hmem with - hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | + hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup @@ -1338,9 +1521,6 @@ theorem forsLeafStep_preserves_htIdx (st : RuntimeState) : · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "node" "htIdx" _ (by decide) hexec - · subst stmt - exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup - s s'' "treeAdrsBase" "htIdx" _ (by decide) hexec · subst stmt exact SphincsMinusVerifiers.BindingFrame.execStmt_letVar_preserves_lookup s s'' "pathIdx" "htIdx" _ (by decide) hexec @@ -1350,10 +1530,11 @@ theorem forsLeafStep_preserves_htIdx (st : RuntimeState) : · subst stmt refine SphincsMinusVerifiers.BindingFrame.execStmt_forEach_preserves_lookup "h" "htIdx" (.literal 19) - (merkleClimbBody "node" "pathIdx" "treeAdrsBase" "authPtr") + SphincsMinusVerifiers.ClimbKit.forsClimbBody s s'' (by decide) ?_ hexec intro t t'' inner hinner hinnerExec - simp [merkleClimbBody] at hinner + simp [SphincsMinusVerifiers.ClimbKit.forsClimbBody, + SphincsMinusVerifiers.ClimbKit.merkleClimbBodyA] at hinner rcases hinner with hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt | hstmt · subst inner @@ -1486,6 +1667,23 @@ theorem forsLeafStep_preserves_sigBase (st : RuntimeState) : = lookupValue st.bindings "sigBase" := forsLeafBody_preserves_sigBase st (forsLeafStep st) (execForsLeaf st) +/-- Step-form FIPS ADRS-base binding frame for one FORS leaf iteration. -/ +theorem forsLeafStep_preserves_forsBase (st : RuntimeState) : + lookupValue (forsLeafStep st).bindings "forsBase" + = lookupValue st.bindings "forsBase" := + forsLeafBody_preserves_forsBase st (forsLeafStep st) (execForsLeaf st) + +/-- Step-form FIPS digit binding frames for one FORS leaf iteration. -/ +theorem forsLeafStep_preserves_idxTree0 (st : RuntimeState) : + lookupValue (forsLeafStep st).bindings "idxTree0" + = lookupValue st.bindings "idxTree0" := + forsLeafBody_preserves_idxTree0 st (forsLeafStep st) (execForsLeaf st) + +theorem forsLeafStep_preserves_idxLeaf0 (st : RuntimeState) : + lookupValue (forsLeafStep st).bindings "idxLeaf0" + = lookupValue st.bindings "idxLeaf0" := + forsLeafBody_preserves_idxLeaf0 st (forsLeafStep st) (execForsLeaf st) + /-- Step-form selector/calldata frame for one FORS leaf iteration. -/ theorem forsLeafStep_preserves_selector_calldata (st : RuntimeState) : SphincsMinusVerifiers.StateFrame.PreservesSelectorCalldata st (forsLeafStep st) := @@ -1669,9 +1867,10 @@ theorem execForsOuter_preserves_seed_slot_range_six #print axioms forsLeafSetupStep_authPtr_eq_sigDataOffset #print axioms forsLeafSetupStep_pathIdx_lt #print axioms forsLeafSetupStep_pathIdx_eq_of_eval -#print axioms forsTreeAdrsBase_eval_eq -#print axioms forsLeafSetupStep_treeAdrsBase_exists_lt -#print axioms forsLeafSetupStep_treeAdrsBase_eq_of_i +#print axioms forsLeafAdrs_eval_eq +#print axioms forsLeafAdrs_value_eq_spec +#print axioms forsLeafSetup_preserves_forsBase +#print axioms forsLeafSetupStep_preserves_forsBase #print axioms forsLeafSetupStep_node_eq_spec_of_eval #print axioms execForsLeafInner #print axioms forsLeafInner_preserves_i @@ -1680,6 +1879,10 @@ theorem execForsOuter_preserves_seed_slot_range_six #print axioms forsLeafStore_preserves_i #print axioms forsLeafBody_preserves_i #print axioms forsLeafBody_preserves_sigBase +#print axioms forsLeafBody_preserves_forsBase +#print axioms forsLeafStep_preserves_forsBase +#print axioms forsLeafStep_preserves_idxTree0 +#print axioms forsLeafStep_preserves_idxLeaf0 #print axioms forsLeafBody_preserves_selector_calldata #print axioms forsLeafStep_preserves_i #print axioms forsLeafStep_preserves_sigBase diff --git a/verity/SphincsMinusVerifiers/SegmentS4ForsDataObligations.lean b/verity/SphincsMinusVerifiers/SegmentS4ForsDataObligations.lean index b00fade..5af1412 100644 --- a/verity/SphincsMinusVerifiers/SegmentS4ForsDataObligations.lean +++ b/verity/SphincsMinusVerifiers/SegmentS4ForsDataObligations.lean @@ -49,7 +49,7 @@ The remaining proof obligation is therefore the single hypothesis `hstep`: one branchless Merkle swap step never clobbers `mem[0x00]`. -/ theorem hLeaf_of_stepMerkle_seed_frame (hstep : ∀ (s : RuntimeState) (hidx : Nat), - ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "forsBase" "authPtr" { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val = (s.world.memory 0).val) : ∀ (s : RuntimeState) (idx : Nat), idx < 6 → @@ -158,7 +158,7 @@ Merkle swap step preserves `mem[0x00]` for *every* state — no `pathIdx < 2^256 hypothesis. This is exactly the residual `hstep` of `hLeaf_of_stepMerkle_seed_frame`. -/ theorem stepMerkle_seed_frame_unconditional (s : RuntimeState) (idx : Nat) : - ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "forsBase" "authPtr" { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val = (s.world.memory 0).val := by let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } @@ -180,7 +180,7 @@ theorem stepMerkle_seed_frame_unconditional (s : RuntimeState) (idx : Nat) : obtain ⟨vadr, h3⟩ : ∃ v, evalExpr [] { stH with bindings := bindValue (bindValue stH.bindings "sibling" vsib) "parentIdx" vpar } - (.bitOr (.localVar "treeAdrsBase") + (.bitOr (.localVar "forsBase") (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) (.localVar "parentIdx"))) = some v := ⟨_, rfl⟩ let vnode : Nat := @@ -309,10 +309,10 @@ theorem stepMerkle_seed_frame_unconditional (s : RuntimeState) (idx : Nat) : change (0x60 : Nat) ^^^ ((n &&& 1) <<< 5) = 0x40 exact ho.2 exact ⟨hone, ho5, ho6⟩ - show ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + show ((SphincsMinusVerifiers.ClimbKit.stepMerkle "node" "pathIdx" "forsBase" "authPtr" stH).world.memory 0).val = (stH.world.memory 0).val exact SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_mem_zero_val_of_parity - "node" "pathIdx" "treeAdrsBase" "authPtr" stH + "node" "pathIdx" "forsBase" "authPtr" stH vsib vpar vadr sval o5 vnode o6 vsib2 n hparOff h1 h2 h3 h4 h5off h5val h6off h6val /-- **`hLeaf` fully discharged.** Combining `hLeaf_of_stepMerkle_seed_frame` diff --git a/verity/SphincsMinusVerifiers/SegmentS4ForsMerkleFrame.lean b/verity/SphincsMinusVerifiers/SegmentS4ForsMerkleFrame.lean index bf0455e..52fc40b 100644 --- a/verity/SphincsMinusVerifiers/SegmentS4ForsMerkleFrame.lean +++ b/verity/SphincsMinusVerifiers/SegmentS4ForsMerkleFrame.lean @@ -1,11 +1,20 @@ /- SegmentS4ForsMerkleFrame — lightweight adapters connecting the S4 FORS inner - climb statement to the generic Merkle memory-frame loop adapters. + climb statement to the generic Merkle memory-frame loop adapters, on the + FIPS 205 §11.2.2 FORS address layout. + + The FORS inner climb is `forEach "h" (u 19) ClimbKit.forsClimbBody` — the + address-parametric `merkleClimbBodyA` instantiated at `ClimbKit.forsAdrs` + (`or(forsBase, or(shl(32, add(h,1)), or(shl(sub(18,h), i), parentIdx)))`). + Unlike the retired pre-FIPS layout, the per-level address depends on the + outer loop binding `"i"`, so the frame-carrying node-correspondence lemmas + thread `"i"` alongside the `MerkleClimbFrame` invariant. This file intentionally sits outside `SegmentS4Fors`: it imports the heavier `ClimbMemFrameMerkle` module without adding that import to the core S4 segment module. The lemmas here are standalone bridge bricks; they do not touch - `execC13` or `c13_refines_byte_spec`. + `execC13` or `c13_refines_byte_spec`. No `sorry`, no new `axiom`, no + `native_decide`. -/ import SphincsMinusVerifiers.SegmentS4Fors @@ -14,12 +23,15 @@ import SphincsMinusVerifiers.ClimbMemFrameMerkle namespace SphincsMinusVerifiers.SegmentS4ForsMerkleFrame open Compiler.Proofs.IRGeneration.SourceSemantics -open SphincsMinusVerifiers.ClimbKit (stepMerkle) -open SphincsMinusVerifierSpec.C13Concrete (adrsForsLeaf maskN keccakWords wordOfHash16) +open SphincsMinusVerifiers.ClimbKit (stepForsMerkle forsAdrs N_MASK) +open SphincsMinusVerifierSpec.C13Concrete + (adrsForsBase adrsForsLeaf adrsForsNode maskN keccakWords wordOfHash16) /-- Frozen C13 FORS Merkle-site facts for one outer tree `t`: static selector/calldata, fixed auth pointer, a bounded ADRS-base witness, and bounded -moving `pathIdx`. -/ +moving `pathIdx`. (The FIPS per-level address also reads `"i"`, but the +interpreter's address expression is total, so the *memory-frame* half of this +file never needs its value; only the node-correspondence lemmas thread `"i"`.) -/ def ForsFrozenSite (t : Nat) (pkSeed pkRoot message sig : ByteArray) (s : RuntimeState) : Prop := ∃ base, @@ -29,31 +41,141 @@ def ForsFrozenSite ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ lookupValue s.bindings "authPtr" = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ + lookupValue s.bindings "forsBase" = base ∧ base < 2 ^ 256 ∧ lookupValue s.bindings "pathIdx" < 2 ^ 256 -/-- S4-shaped local `stepMerkle` seed-cell frame. For the actual FORS inner-climb -variable names, the pure local eval facts and parity-swapped child offsets are -discharged here; callers only supply the site-specific masked sibling calldata -read (`h1`) and address assembly eval (`h3`). -/ -theorem stepMerkle_preserves_seed_slot_of_s4_eval - (s : RuntimeState) (idx mIdx vsib vadr : Nat) +/-! ## 1. The FIPS FORS per-level address word. + +`ClimbKit.forsAdrs` is total on the interpreter (`ClimbKit.adrsEval_fors`), so +memory-frame lemmas get their `vadr` witness for free. For the +node-correspondence half we additionally *identify* the value: given the +carried bindings it is the right-associated OR image of the spec +`adrsForsNode` (re-associated by `ClimbStepSpec.forsBase_node_address`). -/ + +private theorem hShl32_lt (idx : Nat) (hidx : idx < 19) : + (idx + 1) <<< 32 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + exact lt_of_le_of_lt + (Nat.mul_le_mul_right (2 ^ 32) (Nat.succ_le_of_lt hidx)) + (by decide : 19 * 2 ^ 32 < 2 ^ 256) + +private theorem iShl18_lt (i idx : Nat) (hi : i < 6) (hidx : idx < 19) : + i <<< (18 - idx) < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + i * 2 ^ (18 - idx) ≤ 5 * 2 ^ 18 := + Nat.mul_le_mul (Nat.le_of_lt_succ hi) + (Nat.pow_le_pow_right (by decide) (by omega)) + _ < 2 ^ 256 := by decide + +/-- The FIPS FORS per-level address value is a bounded EVM word. -/ +theorem forsAdrs_value_lt + (base i idx p : Nat) + (hbaseLt : base < 2 ^ 256) (hi : i < 6) (hidx : idx < 19) + (hpLt : p < 2 ^ 256) : + base ||| (((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| p)) < 2 ^ 256 := by + have h1 : (i <<< (18 - idx)) ||| p < 2 ^ 256 := + Nat.bitwise_lt_two_pow (iShl18_lt i idx hi hidx) hpLt + have h2 : ((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| p) < 2 ^ 256 := + Nat.bitwise_lt_two_pow (hShl32_lt idx hidx) h1 + exact Nat.bitwise_lt_two_pow hbaseLt h2 + +/-- **`forsAdrs_eval_eq`** — the FIPS FORS per-level address expression +evaluates to the right-associated OR of its four carried components. This is +the FORS analogue of `ClimbKeccakStep.evalExpr_merkleAdrsWord`, with the extra +`shl(sub(18, h), i)` tree-number fold. -/ +theorem forsAdrs_eval_eq + (st : RuntimeState) {base i idx p : Nat} + (hbase : lookupValue st.bindings "forsBase" = base) (hbaseLt : base < 2 ^ 256) + (hh : lookupValue st.bindings "h" = idx) (hidx : idx < 19) + (hi : lookupValue st.bindings "i" = i) (hiLt : i < 6) + (hp : lookupValue st.bindings "parentIdx" = p) (hpLt : p < 2 ^ 256) : + evalExpr [] st forsAdrs + = some (base ||| (((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| p))) := by + have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) + have hbaseEval : evalExpr [] st (.localVar "forsBase") = some base := by + show some (lookupValue st.bindings "forsBase") = some base + rw [hbase] + have hhEval : evalExpr [] st (.localVar "h") = some idx := by + show some (lookupValue st.bindings "h") = some idx + rw [hh] + have hiEval : evalExpr [] st (.localVar "i") = some i := by + show some (lookupValue st.bindings "i") = some i + rw [hi] + have hpEval : evalExpr [] st (.localVar "parentIdx") = some p := by + show some (lookupValue st.bindings "parentIdx") = some p + rw [hp] + have hlit1 : evalExpr [] st (.literal 1) = some 1 := by + show some (wordNormalize 1) = some 1 + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + have hlit18 : evalExpr [] st (.literal 18) = some 18 := by + show some (wordNormalize 18) = some 18 + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + have hlit32 : evalExpr [] st (.literal 32) = some 32 := by + show some (wordNormalize 32) = some 32 + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + -- shl(32, add(h, 1)) ↦ (idx + 1) <<< 32 + have hplus : evalExpr [] st (.add (.localVar "h") (.literal 1)) = some (idx + 1) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded + st (.localVar "h") (.literal 1) idx 1 hhEval hlit1 hidx256 (by decide) + (by omega) + have hsh32 : evalExpr [] st (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + = some ((idx + 1) <<< 32) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded + st (.literal 32) (.add (.localVar "h") (.literal 1)) 32 (idx + 1) + hlit32 hplus (by decide) (by omega) (hShl32_lt idx hidx) + -- shl(sub(18, h), i) ↦ i <<< (18 - idx) + have hsub : evalExpr [] st (.sub (.literal 18) (.localVar "h")) = some (18 - idx) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_sub_bounded + st (.literal 18) (.localVar "h") 18 idx hlit18 hhEval (by decide) hidx256 + (by omega) + have hshi : evalExpr [] st (.shl (.sub (.literal 18) (.localVar "h")) (.localVar "i")) + = some (i <<< (18 - idx)) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded + st (.sub (.literal 18) (.localVar "h")) (.localVar "i") (18 - idx) i + hsub hiEval (by omega) (lt_trans hiLt (by decide)) (iShl18_lt i idx hiLt hidx) + -- inner OR: shl(sub(18,h), i) ||| parentIdx + have hinner1 : evalExpr [] st + (.bitOr (.shl (.sub (.literal 18) (.localVar "h")) (.localVar "i")) + (.localVar "parentIdx")) + = some ((i <<< (18 - idx)) ||| p) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + st _ _ _ _ hshi hpEval (iShl18_lt i idx hiLt hidx) hpLt + have hinner1Lt : (i <<< (18 - idx)) ||| p < 2 ^ 256 := + Nat.bitwise_lt_two_pow (iShl18_lt i idx hiLt hidx) hpLt + -- middle OR: shl(32, h+1) ||| (…) + have hinner2 : evalExpr [] st + (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) + (.bitOr (.shl (.sub (.literal 18) (.localVar "h")) (.localVar "i")) + (.localVar "parentIdx"))) + = some (((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| p)) := + SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + st _ _ _ _ hsh32 hinner1 (hShl32_lt idx hidx) hinner1Lt + have hinner2Lt : ((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| p) < 2 ^ 256 := + Nat.bitwise_lt_two_pow (hShl32_lt idx hidx) hinner1Lt + exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded + st _ _ _ _ hbaseEval hinner2 hbaseLt hinner2Lt + +/-! ## 2. Per-step memory frames (seed cell, ordinary root cells). + +The FIPS address expression is total, so unlike the pre-FIPS file no `vadr` +hypothesis is threaded: the witness comes from `ClimbKit.adrsEval_fors`. -/ + +/-- One FIPS FORS Merkle step preserves the seed cell `mem[0x00]`, given only +the moving-index bound and the masked sibling calldata read. -/ +theorem stepFors_preserves_seed_slot_of_s4_eval + (s : RuntimeState) (idx mIdx vsib : Nat) (hpath : lookupValue s.bindings "pathIdx" = mIdx) (hmlt : mIdx < 2 ^ 256) (h1 : evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib) - (h3 : evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (mIdx >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) : - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) + = some vsib) : + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val = (s.world.memory 0).val := by let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } @@ -63,6 +185,7 @@ theorem stepMerkle_preserves_seed_slot_of_s4_eval let o6 : Nat := (0x60 : Nat) ^^^ sval let st1 : RuntimeState := { stH with bindings := bindValue stH.bindings "sibling" vsib } let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "parentIdx" vpar } + let vadr : Nat := SphincsMinusVerifiers.ClimbKit.adrsEval_fors.val st2 let st3 : RuntimeState := { st2 with world := { st2.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st2.world.memory 0x20 vadr } } let st4 : RuntimeState := { st3 with bindings := bindValue st3.bindings "s" sval } @@ -83,6 +206,8 @@ theorem stepMerkle_preserves_seed_slot_of_s4_eval dsimp [vpar] exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_parentIdx_shr "pathIdx" st1 mIdx hpath1 hmlt + have h3 : evalExpr [] st2 forsAdrs = some vadr := + SphincsMinusVerifiers.ClimbKit.adrsEval_fors.eval st2 have hpath3 : lookupValue st3.bindings "pathIdx" = mIdx := by dsimp [st3, st2, st1] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne @@ -146,33 +271,25 @@ theorem stepMerkle_preserves_seed_slot_of_s4_eval change (0x60 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x40 exact ho.2 exact ⟨hone, ho5, ho6⟩ - change ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" stH).world.memory 0).val - = (stH.world.memory 0).val - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_mem_zero_val_of_parity - "node" "pathIdx" "treeAdrsBase" "authPtr" stH + show ((SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).world.memory 0).val = (stH.world.memory 0).val + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_mem_zero_val_of_parity + "node" "pathIdx" "authPtr" forsAdrs stH vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") mIdx hparOff h1 h2 h3 h4 h5off h5val h6off h6val -/-- S4-shaped local `stepMerkle` frame for ordinary FORS root cells. These root +/-- One FIPS FORS Merkle step preserves ordinary FORS root cells. These root slots live at `0x80 + 32*j`, so they cannot alias the Merkle scratch cells `0x20`, `0x40`, or `0x60` used by one branchless climb step. -/ -theorem stepMerkle_preserves_root_cell_of_s4_eval - (s : RuntimeState) (j idx mIdx vsib vadr : Nat) +theorem stepFors_preserves_root_cell_of_s4_eval + (s : RuntimeState) (j idx mIdx vsib : Nat) (hpath : lookupValue s.bindings "pathIdx" = mIdx) (hmlt : mIdx < 2 ^ 256) (h1 : evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib) - (h3 : evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (mIdx >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) : - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) + = some vsib) : + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory (0x80 + 32 * j)).val = (s.world.memory (0x80 + 32 * j)).val := by @@ -183,6 +300,7 @@ theorem stepMerkle_preserves_root_cell_of_s4_eval let o6 : Nat := (0x60 : Nat) ^^^ sval let st1 : RuntimeState := { stH with bindings := bindValue stH.bindings "sibling" vsib } let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "parentIdx" vpar } + let vadr : Nat := SphincsMinusVerifiers.ClimbKit.adrsEval_fors.val st2 let st3 : RuntimeState := { st2 with world := { st2.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st2.world.memory 0x20 vadr } } let st4 : RuntimeState := { st3 with bindings := bindValue st3.bindings "s" sval } @@ -203,6 +321,8 @@ theorem stepMerkle_preserves_root_cell_of_s4_eval dsimp [vpar] exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_parentIdx_shr "pathIdx" st1 mIdx hpath1 hmlt + have h3 : evalExpr [] st2 forsAdrs = some vadr := + SphincsMinusVerifiers.ClimbKit.adrsEval_fors.eval st2 have hpath3 : lookupValue st3.bindings "pathIdx" = mIdx := by dsimp [st3, st2, st1] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne @@ -271,281 +391,54 @@ theorem stepMerkle_preserves_root_cell_of_s4_eval rcases hparOff with ⟨_, ho5, _⟩ | ⟨_, ho5, _⟩ <;> rw [ho5] <;> omega have ho6 : 0x80 + 32 * j ≠ o6 := by rcases hparOff with ⟨_, _, ho6⟩ | ⟨_, _, ho6⟩ <;> rw [ho6] <;> omega - change ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" stH).world.memory - (0x80 + 32 * j)).val = (stH.world.memory (0x80 + 32 * j)).val - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_mem_val_of_ne - "node" "pathIdx" "treeAdrsBase" "authPtr" stH + show ((SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).world.memory (0x80 + 32 * j)).val = (stH.world.memory (0x80 + 32 * j)).val + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_mem_val_of_ne + "node" "pathIdx" "authPtr" forsAdrs stH (0x80 + 32 * j) vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") h20 ho5 ho6 h1 h2 h3 h4 h5off h5val h6off h6val -/-- S4-shaped local `stepMerkle` frame advance. This packages the pure -interpreter facts for parent-index, selector, child offsets, local node load, and -sibling reread, leaving only the masked calldata load shape and the indexed -`MerkleClimbData` fact as data premises. -/ -theorem stepMerkle_forsFrame_hstep_of_s4_data - (s : RuntimeState) (idx mIdx node seed treeAdrs merklePtr : Nat) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) - (vsib vadr : Nat) - (hframe : SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed treeAdrs merklePtr s (mIdx, node)) - (hidx : idx < 19) - (hmlt : mIdx < 2 ^ 256) - (htreeAdrsLt : treeAdrs < 2 ^ 256) - (hload : vsib = maskN (cdAt idx)) - (hdata : SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) - (h1 : evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib) - (h3 : evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (mIdx >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed treeAdrs merklePtr - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed treeAdrs auth idx (mIdx, node)) := by - let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - let vpar : Nat := mIdx >>> 1 - let sval : Nat := (Nat.land mIdx 1) <<< 5 - let o5 : Nat := (0x40 : Nat) ^^^ sval - let o6 : Nat := (0x60 : Nat) ^^^ sval - let st1 : RuntimeState := { stH with bindings := bindValue stH.bindings "sibling" vsib } - let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "parentIdx" vpar } - let st3 : RuntimeState := - { st2 with world := { st2.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st2.world.memory 0x20 vadr } } - let st4 : RuntimeState := { st3 with bindings := bindValue st3.bindings "s" sval } - let vnode : Nat := lookupValue st4.bindings "node" - let st5 : RuntimeState := - { st4 with world := { st4.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st4.world.memory o5 vnode } } - have hpath : lookupValue s.bindings "pathIdx" = mIdx := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.idx hframe.1 - have hpathH : lookupValue stH.bindings "pathIdx" = mIdx := by - dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "pathIdx" (wordNormalize idx) (by decide)] - exact hpath - have hpath1 : lookupValue st1.bindings "pathIdx" = mIdx := by - dsimp [st1] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - stH.bindings "sibling" "pathIdx" vsib (by decide)] - exact hpathH - have h2 : evalExpr [] st1 (.shr (.literal 1) (.localVar "pathIdx")) = some vpar := by - dsimp [vpar] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_parentIdx_shr - "pathIdx" st1 mIdx hpath1 hmlt - have hpath3 : lookupValue st3.bindings "pathIdx" = mIdx := by - dsimp [st3, st2, st1] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue stH.bindings "sibling" vsib) "parentIdx" "pathIdx" vpar (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - stH.bindings "sibling" "pathIdx" vsib (by decide)] - exact hpathH - have h4 : evalExpr [] st3 - (.shl (.literal 5) (.bitAnd (.localVar "pathIdx") (.literal 1))) = some sval := by - dsimp [sval] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_selector_shl - "pathIdx" st3 mIdx hpath3 hmlt - have hsvalt : sval < 2 ^ 256 := by - dsimp [sval] - rw [Nat.shiftLeft_eq] - exact Nat.lt_of_le_of_lt (Nat.mul_le_mul Nat.and_le_right (le_refl _)) (by decide) - have hs4 : lookupValue st4.bindings "s" = sval := by - dsimp [st4] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - have h5off : evalExpr [] st4 (.bitXor (.literal 0x40) (.localVar "s")) = some o5 := by - dsimp [o5] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_childOffset_xor - st4 0x40 sval hs4 (by decide) hsvalt - have h5val : evalExpr [] st4 (.localVar "node") = some vnode := by - rfl - have hs5 : lookupValue st5.bindings "s" = sval := by - dsimp [st5] - exact hs4 - have h6off : evalExpr [] st5 (.bitXor (.literal 0x60) (.localVar "s")) = some o6 := by - dsimp [o6] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_childOffset_xor - st5 0x60 sval hs5 (by decide) hsvalt - have h6val : evalExpr [] st5 (.localVar "sibling") = some vsib := by - show some (lookupValue st5.bindings "sibling") = some vsib - dsimp [st5, st4, st3, st2, st1] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue stH.bindings "sibling" vsib) "parentIdx" vpar) - "s" "sibling" sval (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue stH.bindings "sibling" vsib) "parentIdx" "sibling" vpar (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - have hpar : mIdx % 2 = 0 ∨ mIdx % 2 = 1 := by - have hlt : mIdx % 2 < 2 := Nat.mod_lt mIdx (by decide) - omega - have hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) - ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40) := by - rcases hpar with hzero | hone - · left - have ho := SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_offsets_even mIdx hzero - have ho5 : o5 = 0x40 := by - dsimp [o5, sval] - change (0x40 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x40 - exact ho.1 - have ho6 : o6 = 0x60 := by - dsimp [o6, sval] - change (0x60 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x60 - exact ho.2 - exact ⟨hzero, ho5, ho6⟩ - · right - have ho := SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_offsets_odd mIdx hone - have ho5 : o5 = 0x60 := by - dsimp [o5, sval] - change (0x40 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x60 - exact ho.1 - have ho6 : o6 = 0x40 := by - dsimp [o6, sval] - change (0x60 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x40 - exact ho.2 - exact ⟨hone, ho5, ho6⟩ - have hvpar : vpar = mIdx / 2 := by - dsimp [vpar] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.parentIdx_shiftRight mIdx - have hnode : wordNormalize vnode = node := by - dsimp [vnode, st4, st3, st2, st1, stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" vpar) "s" "node" sval (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" "node" vpar (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "node" vsib (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "node" (wordNormalize idx) (by decide)] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.node hframe.1 - have hseed : (stH.world.memory 0x00).val = seed := by - dsimp [stH] - exact hframe.2.2.2.1 - have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) - have hwordlt : idx + 1 < 2 ^ 256 := by omega - have hshlt : (idx + 1) <<< 32 < 2 ^ 256 := by - rw [Nat.shiftLeft_eq] - exact lt_of_le_of_lt - (Nat.mul_le_mul_right (2 ^ 32) (Nat.succ_le_of_lt hidx)) - (by decide : 19 * 2 ^ 32 < 2 ^ 256) - have hplt : vpar < 2 ^ 256 := by - dsimp [vpar] - rw [Nat.shiftRight_eq_div_pow] - exact Nat.lt_of_le_of_lt (Nat.div_le_self _ _) hmlt - have hbaseEval : evalExpr [] st2 (.localVar "treeAdrsBase") = some treeAdrs := by - show some (lookupValue st2.bindings "treeAdrsBase") = some treeAdrs - dsimp [st2, st1, stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" "treeAdrsBase" vpar (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "treeAdrsBase" vsib (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "treeAdrsBase" (wordNormalize idx) (by decide)] - exact congrArg some hframe.2.1 - have hhEval : evalExpr [] st2 (.localVar "h") = some idx := by - show some (lookupValue st2.bindings "h") = some idx - dsimp [st2, st1, stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" "h" vpar (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "h" vsib (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt hidx256] - have h1Lit : evalExpr [] st2 (.literal 1) = some 1 := by - show some (wordNormalize 1) = some 1 - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - have hplus : evalExpr [] st2 (.add (.localVar "h") (.literal 1)) = some (idx + 1) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded - st2 (.localVar "h") (.literal 1) idx 1 hhEval h1Lit hidx256 (by decide) hwordlt - have h32Lit : evalExpr [] st2 (.literal 32) = some 32 := by - show some (wordNormalize 32) = some 32 - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - have hsh : evalExpr [] st2 - (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - = some ((idx + 1) <<< 32) := - SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - st2 (.literal 32) (.add (.localVar "h") (.literal 1)) 32 (idx + 1) - h32Lit hplus (by decide) hwordlt hshlt - have hparentEval : evalExpr [] st2 (.localVar "parentIdx") = some vpar := by - show some (lookupValue st2.bindings "parentIdx") = some vpar - dsimp [st2] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - have hadr : wordNormalize vadr = treeAdrs ||| ((idx + 1) <<< 32) ||| mIdx / 2 := by - have hraw := SphincsMinusVerifiers.ClimbMemFrameMerkle.address_assembly_eq - st2 (.localVar "treeAdrsBase") - (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx") vadr treeAdrs ((idx + 1) <<< 32) vpar - h3 hbaseEval hsh hparentEval htreeAdrsLt hshlt hplt - simpa [hvpar] using hraw - have hsib : wordNormalize vsib = wordOfHash16 ((auth[idx]?).getD ⟨#[]⟩) := by - rw [hload, SphincsMinusVerifiers.ClimbMemFrameMerkle.wordNormalize_maskN] - exact hdata - have hstepData : - SphincsMinusVerifiers.ClimbMemFrameMerkle.StepDataObligations - stH vadr vsib seed treeAdrs idx mIdx auth := - SphincsMinusVerifiers.ClimbMemFrameMerkle.StepDataObligations.intro - hseed hadr hsib - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_hstep - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed treeAdrs merklePtr - s mIdx node idx auth vsib vpar vadr sval o5 vnode o6 vsib - hframe hparOff hvpar hnode hstepData h1 h2 h3 h4 h5off h5val h6off h6val +/-! ## 3. forEach-statement adapters for the FORS inner climb. -/ /-- S4-shaped bounded-index adapter for the FORS inner Merkle climb: if each -`stepMerkle` iteration preserves `mem[0x00]` after the loop binds the concrete -height to `"h"`, then the whole `forsLeafInnerStmt` preserves the seed cell. -/ +`stepForsMerkle` iteration preserves `mem[0x00]` after the loop binds the +concrete height to `"h"`, then the whole `forsLeafInnerStmt` preserves the seed +cell. -/ theorem forsLeafInner_preserves_seed_slot_bound_of_step (hstep : ∀ (s : RuntimeState) (idx : Nat), - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val = (s.world.memory 0).val) (st s' : RuntimeState) (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = .continue s') : (s'.world.memory 0).val = (st.world.memory 0).val := by - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_merkleClimb_preserves_memory_val_bound - "node" "pathIdx" "treeAdrsBase" "authPtr" 0 19 hstep st s' + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_forsClimb_preserves_memory_val_bound + 0 19 hstep st s' (by simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt] using h) /-- S4-shaped bounded-index adapter for arbitrary memory cells through the FORS -inner Merkle climb. This is the ordinary-root analogue of -`forsLeafInner_preserves_seed_slot_bound_of_step`; callers provide the one-step -non-alias frame for the concrete address they are carrying. -/ +inner Merkle climb. -/ theorem forsLeafInner_preserves_memory_val_bound_of_step (addr : Nat) (hstep : ∀ (s : RuntimeState) (idx : Nat), - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory addr).val = (s.world.memory addr).val) (st s' : RuntimeState) (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = .continue s') : (s'.world.memory addr).val = (st.world.memory addr).val := by - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_merkleClimb_preserves_memory_val_bound - "node" "pathIdx" "treeAdrsBase" "authPtr" addr 19 hstep st s' + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_forsClimb_preserves_memory_val_bound + addr 19 hstep st s' (by simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt] using h) /-- Range-gated memory-frame variant for the FORS inner Merkle climb. -/ theorem forsLeafInner_preserves_memory_val_range_of_step (addr : Nat) (D : Nat → Prop) (hstep : ∀ (s : RuntimeState) (idx : Nat), D idx → - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory addr).val = (s.world.memory addr).val) (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize 19 → D i) @@ -553,19 +446,17 @@ theorem forsLeafInner_preserves_memory_val_range_of_step (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = .continue s') : (s'.world.memory addr).val = (st.world.memory addr).val := by - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_merkleClimb_preserves_memory_val_range - "node" "pathIdx" "treeAdrsBase" "authPtr" addr 19 D hstep st s' hD + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_forsClimb_preserves_memory_val_range + addr 19 D hstep st s' hD (by simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt] using h) /-- One FORS leaf iteration preserves every other ordinary root slot, provided -the inner Merkle step frame preserves that slot at each Merkle height. Together -with `forsLeafStep_root_cell_range`, this supplies the local write/carry split -needed for the six normal FORS root cells. -/ +the inner Merkle step frame preserves that slot at each Merkle height. -/ theorem forsLeafStep_preserves_root_cell_range_ne_of_inner_step (st : RuntimeState) (j idx : Nat) (hidx : idx < 6) (hi : lookupValue st.bindings "i" = idx) (hne : j ≠ idx) (hstep : ∀ (s : RuntimeState) (h : Nat), - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + ((stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize h) }).world.memory (0x80 + 32 * j)).val = (s.world.memory (0x80 + 32 * j)).val) : @@ -577,407 +468,38 @@ theorem forsLeafStep_preserves_root_cell_range_ne_of_inner_step (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_root_cell_range st j) (forsLeafInner_preserves_memory_val_bound_of_step (0x80 + 32 * j) hstep) -/-- One FORS leaf iteration preserves every other ordinary root slot when the -inner Merkle steps satisfy the S4-shaped site eval facts. This is the root-cell -analogue of the seed-cell `*_of_s4_eval` adapters. -/ -theorem forsLeafStep_preserves_root_cell_range_ne_of_s4_eval - (st : RuntimeState) (j idx : Nat) (hidx : idx < 6) - (hi : lookupValue st.bindings "i" = idx) (hne : j ≠ idx) - (hsite : ∀ (s : RuntimeState) (hidx : Nat), - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize hidx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory - (0x80 + 32 * j)).val = - (st.world.memory (0x80 + 32 * j)).val := - forsLeafStep_preserves_root_cell_range_ne_of_inner_step st j idx hidx hi hne - (fun s hidx => by - rcases hsite s hidx with ⟨vsib, vadr, hlt, h1, h3⟩ - exact stepMerkle_preserves_root_cell_of_s4_eval - s j hidx (lookupValue s.bindings "pathIdx") vsib vadr rfl hlt h1 h3) - -/-- Outer FORS carry for an ordinary root cell, with the suffix-preservation -premise discharged from S4-shaped Merkle site eval facts. The remaining -ordinary-root data obligation is to identify the iteration-local post-inner -`"node"` with `forsAllRootsC13[j]`. -/ -theorem forsOuter_root_cell_eq_iteration_node_of_s4_eval - (st : RuntimeState) (j : Nat) (hj : j < 6) - (hsite : ∀ (s : RuntimeState) (hidx : Nat), - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize hidx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 (wordNormalize 6)).world.memory (0x80 + 32 * j)).val = - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep - { (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 j) with - bindings := - bindValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 j).bindings "i" (wordNormalize j) })).bindings "node") := by - exact SphincsMinusVerifiers.SegmentS4Fors.forsOuter_root_cell_eq_iteration_node_of_suffix_preserves - st j hj - (fun s idx hgt hlt => by - have hi : lookupValue (bindValue s.bindings "i" (wordNormalize idx)) "i" = idx := by - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (lt_trans hlt (by decide))] - exact forsLeafStep_preserves_root_cell_range_ne_of_s4_eval - { s with bindings := bindValue s.bindings "i" (wordNormalize idx) } - j idx hlt hi (by omega) hsite) - -/-- Inner-climb seed-cell frame reduced to the two site-specific eval facts left -by `stepMerkle_preserves_seed_slot_of_s4_eval`, packaged existentially per -executed Merkle height. -/ -theorem forsLeafInner_preserves_seed_slot_bound_of_s4_eval - (hsite : ∀ (s : RuntimeState) (idx : Nat), - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) - (st s' : RuntimeState) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := by - exact forsLeafInner_preserves_seed_slot_bound_of_step - (fun s idx => by - rcases hsite s idx with ⟨vsib, vadr, hlt, h1, h3⟩ - exact stepMerkle_preserves_seed_slot_of_s4_eval - s idx (lookupValue s.bindings "pathIdx") vsib vadr rfl hlt h1 h3) - st s' h +/-! ## 4. Frozen-calldata site packaging. -/-- S4-shaped address-assembly evaluator for the inner Merkle climb. Once the -loop has bound `"h"`, stmt 1 has bound `"sibling"`, and stmt 2 has bound -`"parentIdx"`, the stmt-3 ADRS expression evaluates to some word under ordinary -boundedness hypotheses. This produces the `vadr` witness required by the -`*_of_s4_eval` seed-frame adapters; it intentionally does not identify the word -with the spec ADRS value. -/ -theorem s4_address_assembly_eval_exists - (s : RuntimeState) (idx vsib base : Nat) - (hbase : lookupValue s.bindings "treeAdrsBase" = base) - (hbaselt : base < 2 ^ 256) - (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) - (hidx : idx < 19) : - ∃ vadr, - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr := by - let stA : RuntimeState := - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - let p : Nat := lookupValue s.bindings "pathIdx" >>> 1 - let hword : Nat := idx + 1 - let sh : Nat := hword <<< 32 - let inner : Nat := Nat.lor sh p - let vadr : Nat := Nat.lor base inner - have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) - have hwordlt : hword < 2 ^ 256 := by - dsimp [hword] - omega - have hshlt : sh < 2 ^ 256 := by - dsimp [sh, hword] - rw [Nat.shiftLeft_eq] - exact lt_of_le_of_lt - (Nat.mul_le_mul_right (2 ^ 32) (Nat.succ_le_of_lt hidx)) - (by decide : 19 * 2 ^ 32 < 2 ^ 256) - have hplt : p < 2 ^ 256 := by - dsimp [p] - rw [Nat.shiftRight_eq_div_pow] - exact Nat.lt_of_le_of_lt - (Nat.div_le_self (lookupValue s.bindings "pathIdx") (2 ^ 1)) hpathlt - have hbase_eval : evalExpr [] stA (.localVar "treeAdrsBase") = some base := by - show some (lookupValue stA.bindings "treeAdrsBase") = some base - dsimp [stA] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" "treeAdrsBase" (lookupValue s.bindings "pathIdx" >>> 1) (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue s.bindings "h" (wordNormalize idx)) - "sibling" "treeAdrsBase" vsib (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "treeAdrsBase" (wordNormalize idx) (by decide)] - rw [hbase] - have hh_eval : evalExpr [] stA (.localVar "h") = some idx := by - show some (lookupValue stA.bindings "h") = some idx - dsimp [stA] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" "h" (lookupValue s.bindings "pathIdx" >>> 1) (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - (bindValue s.bindings "h" (wordNormalize idx)) - "sibling" "h" vsib (by decide)] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt hidx256] - have hparent_eval : evalExpr [] stA (.localVar "parentIdx") = some p := by - show some (lookupValue stA.bindings "parentIdx") = some p - dsimp [stA, p] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - have hlit1 : evalExpr [] stA (.literal 1) = some 1 := by - show some (wordNormalize 1) = some 1 - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - have hplus : evalExpr [] stA (.add (.localVar "h") (.literal 1)) = some hword := by - dsimp [hword] - exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded - stA (.localVar "h") (.literal 1) idx 1 hh_eval hlit1 hidx256 (by decide) hwordlt - have hlit32 : evalExpr [] stA (.literal 32) = some 32 := by - show some (wordNormalize 32) = some 32 - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - have hsh : evalExpr [] stA (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - = some sh := by - dsimp [sh] - exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_shl_bounded - stA (.literal 32) (.add (.localVar "h") (.literal 1)) 32 hword - hlit32 hplus (by decide) hwordlt hshlt - have hinner : evalExpr [] stA - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx")) = some inner := by - dsimp [inner] - exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded - stA (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx") sh p hsh hparent_eval hshlt hplt - refine ⟨vadr, ?_⟩ - dsimp [vadr] - exact SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_bitOr_bounded - stA (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx")) base inner hbase_eval hinner hbaselt - (Nat.bitwise_lt_two_pow hshlt hplt) +The only site-specific eval fact a memory-frame step needs is the masked +sibling calldata read (`h1`); the FIPS address expression is total. -/ -/-- Concrete S4 Merkle-site package from the frozen C13 calldata image. This -combines the masked sibling calldata read (`h1`) with the local ADRS assembly -eval (`h3`) into the exact existential shape consumed by the S4 seed/root-cell -adapters. -/ -theorem s4_eval_site_of_frozen_calldata - (s : RuntimeState) (idx ap base sOff : Nat) +/-- Masked sibling calldata read from the frozen C13 calldata image, for tree +`t < 6` at climb height `idx < 19`. -/ +theorem s4_sibling_read_of_fors_frozen_calldata + (s : RuntimeState) (t idx : Nat) (pkSeed pkRoot message sig : ByteArray) (hsel : s.selector = 0) (hcd : s.world.calldata = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (hap : lookupValue s.bindings "authPtr" = ap) - (hbase : lookupValue s.bindings "treeAdrsBase" = base) - (hbaselt : base < 2 ^ 256) - (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) - (hidx : idx < 19) - (haplt : ap < 2 ^ 256) - (hshift : idx <<< 4 < 2 ^ 256) - (hsum : ap + idx <<< 4 < 2 ^ 256) - (hoff : ap + idx <<< 4 = SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff) - (hoff4 : 4 ≤ SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff) : - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr := by + (hap : lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) + (ht : t < 6) + (hidx : idx < 19) : + evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } + (.bitAnd (.calldataload (.add (.localVar "authPtr") + (.shl (.literal 4) (.localVar "h")))) (.literal N_MASK)) + = some + (SphincsMinusVerifierSpec.C13Concrete.maskN + (Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + + (128 + 304 * t) + 16 * idx))) := by let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - let vsib : Nat := - SphincsMinusVerifierSpec.C13Concrete.maskN - (Compiler.Proofs.YulGeneration.calldataloadWord 0 - (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff)) + let ap : Nat := SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) + let sOff : Nat := 128 + 304 * t + 16 * idx have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) - have hselH : stH.selector = 0 := by - dsimp [stH] - exact hsel - have hcdH : stH.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig := by - dsimp [stH] - exact hcd - have hapH : evalExpr [] stH (.localVar "authPtr") = some ap := by - show some (lookupValue stH.bindings "authPtr") = some ap - dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "authPtr" (wordNormalize idx) (by decide)] - rw [hap] - have hhH : evalExpr [] stH (.localVar "h") = some idx := by - show some (lookupValue stH.bindings "h") = some idx - dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt hidx256] - have h1 : evalExpr [] stH - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib := by - dsimp [vsib] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_sibling_read_frozen - stH "authPtr" pkSeed pkRoot message sig ap idx sOff - hselH hcdH hapH hhH haplt hidx256 hshift hsum hoff hoff4 - rcases s4_address_assembly_eval_exists s idx vsib base hbase hbaselt hpathlt hidx with - ⟨vadr, h3⟩ - exact ⟨vsib, vadr, hpathlt, h1, h3⟩ - -/-- FORS-specialized frozen-calldata Merkle-site package. For tree `t < 6`, -the setup-auth pointer is `sigDataOffset + (128 + 304*t)` and height `idx < 19` -reads the auth-path word at byte offset `128 + 304*t + 16*idx` inside the -signature. This wrapper discharges the fixed C13 offset arithmetic and leaves -callers only the real setup bindings/bounds plus the frozen calldata frame. -/ -theorem s4_eval_site_of_fors_frozen_calldata - (s : RuntimeState) (t idx base : Nat) - (pkSeed pkRoot message sig : ByteArray) - (hsel : s.selector = 0) - (hcd : s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (hap : lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - (hbase : lookupValue s.bindings "treeAdrsBase" = base) - (hbaselt : base < 2 ^ 256) - (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) - (ht : t < 6) - (hidx : idx < 19) : - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr := by - let ap : Nat := SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) - let sOff : Nat := 128 + 304 * t + 16 * idx - have haplt : ap < 2 ^ 256 := by - dsimp [ap] - rw [SphincsMinusVerifiers.MkC13State.sigDataOffset] - omega - have hshift : idx <<< 4 < 2 ^ 256 := by - rw [Nat.shiftLeft_eq] - omega - have hsum : ap + idx <<< 4 < 2 ^ 256 := by - dsimp [ap] - rw [SphincsMinusVerifiers.MkC13State.sigDataOffset, Nat.shiftLeft_eq] - omega - have hoff : ap + idx <<< 4 = SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff := by - dsimp [ap, sOff] - rw [Nat.shiftLeft_eq] - omega - have hoff4 : 4 ≤ SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff := by - dsimp [sOff] - rw [SphincsMinusVerifiers.MkC13State.sigDataOffset] - omega - exact s4_eval_site_of_frozen_calldata s idx ap base sOff pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt hidx haplt hshift hsum hoff hoff4 - -/-- FORS-specialized local `stepMerkle` frame advance from the frozen C13 calldata -layout. This pins the statement-1 sibling load to the concrete auth-path -calldata word, assembles the local address word, and delegates the remaining -frame update to `stepMerkle_forsFrame_hstep_of_s4_data`. -/ -theorem stepMerkle_forsFrame_hstep_of_fors_frozen_calldata - (s : RuntimeState) (t idx mIdx node seed treeAdrs : Nat) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) - (hframe : SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed treeAdrs - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - s (mIdx, node)) - (ht : t < 6) - (hidx : idx < 19) - (hmlt : mIdx < 2 ^ 256) - (htreeAdrsLt : treeAdrs < 2 ^ 256) - (hdata : SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth - (fun h => - Compiler.Proofs.YulGeneration.calldataloadWord 0 - (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (SphincsMinusVerifiers.MkC13State.sigDataOffset - + (128 + 304 * t) + 16 * h)) idx) : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed treeAdrs - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed treeAdrs auth idx (mIdx, node)) := by - let cdAt : Nat → Nat := fun h => - Compiler.Proofs.YulGeneration.calldataloadWord 0 - (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) + 16 * h) - let vsib : Nat := SphincsMinusVerifierSpec.C13Concrete.maskN (cdAt idx) - let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - have hsel : s.selector = 0 := hframe.2.2.2.2.1 - have hcd : s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig := hframe.2.2.2.2.2.1 - have hbase : lookupValue s.bindings "treeAdrsBase" = treeAdrs := hframe.2.1 - have hap : lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) := - hframe.2.2.1 - have hpath : lookupValue s.bindings "pathIdx" = mIdx := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.idx hframe.1 - have hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256 := by - rw [hpath] - exact hmlt - have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) - let ap : Nat := SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) - let sOff : Nat := 128 + 304 * t + 16 * idx have haplt : ap < 2 ^ 256 := by dsimp [ap] rw [SphincsMinusVerifiers.MkC13State.sigDataOffset] @@ -1009,930 +531,90 @@ theorem stepMerkle_forsFrame_hstep_of_fors_frozen_calldata rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, Nat.mod_eq_of_lt hidx256] - have h1 : evalExpr [] stH - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib := by - have hraw := - SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_sibling_read_frozen + have hraw := + SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_sibling_read_frozen stH "authPtr" pkSeed pkRoot message sig ap idx sOff (by dsimp [stH]; exact hsel) (by dsimp [stH]; exact hcd) hapH hhH haplt hidx256 hshift hsum hoff hoff4 - have hsOff : - SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff - = SphincsMinusVerifiers.MkC13State.sigDataOffset - + (128 + 304 * t) + 16 * idx := by - dsimp [sOff] - omega - rw [hsOff] at hraw - simpa [vsib, cdAt] using hraw - rcases s4_address_assembly_eval_exists s idx vsib treeAdrs - hbase htreeAdrsLt hpathlt hidx with - ⟨vadr, h3⟩ - have h3m : evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (mIdx >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr := by - simpa [hpath] using h3 - exact stepMerkle_forsFrame_hstep_of_s4_data - s idx mIdx node seed treeAdrs - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - pkSeed pkRoot message sig auth cdAt vsib vadr hframe hidx hmlt htreeAdrsLt - (by rfl) - (by simpa [cdAt] using hdata) h1 h3m + have hsOff : + SphincsMinusVerifiers.MkC13State.sigDataOffset + sOff + = SphincsMinusVerifiers.MkC13State.sigDataOffset + + (128 + 304 * t) + 16 * idx := by + dsimp [sOff] + omega + rw [hsOff] at hraw + exact hraw -/-- Bundle the local `forsLeafSetupStep` facts into the frozen-calldata site -shape consumed by the C13 FORS Merkle frame adapters. This is still a -single-step setup fact: callers must thread it to the concrete inner states. -/ -theorem forsLeafSetupStep_fors_frozen_calldata_site - (st : RuntimeState) (t : Nat) +/-- One FORS Merkle step preserves the seed slot when its setup bindings and +frozen calldata frame match the C13 FORS auth-path layout. -/ +theorem stepFors_preserves_seed_slot_of_fors_frozen_calldata + (s : RuntimeState) (t idx : Nat) (pkSeed pkRoot message sig : ByteArray) - (hi : lookupValue st.bindings "i" = t) + (hsel : s.selector = 0) + (hcd : s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (hap : lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) + (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) (ht : t < 6) - (hsigBase : lookupValue st.bindings "sigBase" - = SphincsMinusVerifiers.MkC13State.sigDataOffset) - (hsel : st.selector = 0) - (hcd : st.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : - ∃ base, - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).selector = 0 ∧ - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ - lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "treeAdrsBase" = base ∧ - base < 2 ^ 256 ∧ - lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "pathIdx" < 2 ^ 256 := by - rcases SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_selector_calldata - st with ⟨hselStep, hcdStep⟩ - rcases SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_treeAdrsBase_exists_lt - st t hi with ⟨base, hbase, hbaselt⟩ - refine ⟨base, ?_, ?_, ?_, hbase, hbaselt, ?_⟩ - · rw [hselStep, hsel] - · rw [hcdStep, hcd] - · have hsigBase164 : lookupValue st.bindings "sigBase" = 164 := by - simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hsigBase - have hap := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_authPtr_eq_sigDataOffset - st t hi hsigBase164 ht - simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hap - · exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_pathIdx_lt st t hi + (hidx : idx < 19) : + ((stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val + = (s.world.memory 0).val := by + have h1 := s4_sibling_read_of_fors_frozen_calldata + s t idx pkSeed pkRoot message sig hsel hcd hap ht hidx + exact stepFors_preserves_seed_slot_of_s4_eval + s idx (lookupValue s.bindings "pathIdx") _ rfl hpathlt h1 -/-- Predicate-form wrapper for the local setup-site package. -/ -theorem forsLeafSetupStep_forsFrozenSite - (st : RuntimeState) (t : Nat) +/-- One FORS Merkle step preserves an ordinary root-array slot when its setup +bindings and frozen calldata frame match the C13 FORS auth-path layout. -/ +theorem stepFors_preserves_root_cell_of_fors_frozen_calldata + (s : RuntimeState) (j t idx : Nat) (pkSeed pkRoot message sig : ByteArray) - (hi : lookupValue st.bindings "i" = t) + (hsel : s.selector = 0) + (hcd : s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (hap : lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) + (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) (ht : t < 6) - (hsigBase : lookupValue st.bindings "sigBase" - = SphincsMinusVerifiers.MkC13State.sigDataOffset) - (hsel : st.selector = 0) - (hcd : st.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : - ForsFrozenSite t pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := - forsLeafSetupStep_fors_frozen_calldata_site st t pkSeed pkRoot message sig - hi ht hsigBase hsel hcd + (hidx : idx < 19) : + ((stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory + (0x80 + 32 * j)).val + = (s.world.memory (0x80 + 32 * j)).val := by + have h1 := s4_sibling_read_of_fors_frozen_calldata + s t idx pkSeed pkRoot message sig hsel hcd hap ht hidx + exact stepFors_preserves_root_cell_of_s4_eval + s j idx (lookupValue s.bindings "pathIdx") _ rfl hpathlt h1 -/-- Initial FORS climb relation after the straight-line setup prefix. The index -component is the decoded `treeIdx`, and the node component is the concrete spec -FORS leaf hash word. -/ -theorem forsLeafSetupStep_initial_forsClimbRel_of_eval - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by - refine SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.intro ?_ ?_ - · exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_pathIdx_eq_of_eval - st treeIdx hTree - · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_node_eq_spec_of_eval - st seed i treeIdx sk hm0 hAdrLt hSkLt hTree hSecret hLeaf] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.wordNormalize_maskN _ +/-! ## 5. Frozen-site invariance through one step and the inner loop. -/ -/-- Initial frame-carrying FORS climb invariant after the straight-line setup. -The relation component comes from the setup evaluator; the static frame comes -from the concrete frozen-site package. The frame uses the actual post-setup -`"treeAdrsBase"`/`"authPtr"` words, avoiding another raw address-arithmetic -obligation at this boundary. -/ -theorem forsLeafSetupStep_initial_forsClimbFrame_of_eval_site - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (pkSeed pkRoot message sig : ByteArray) - (hsite : ForsFrozenSite i pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "treeAdrsBase") - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by - rcases hsite with ⟨base, hsel, hcd, _hap, _hbase, _hbaselt, _hpathlt⟩ - refine ⟨?_, rfl, rfl, ?_, hsel, hcd, - (by decide), (by decide), (by decide), (by decide), (by decide), - (by decide), (by decide), (by decide), (by decide), - (by decide), (by decide), (by decide), (by decide), (by decide), (by decide), - (by decide), (by decide), (by decide), (by decide), (by decide), (by decide)⟩ - · exact forsLeafSetupStep_initial_forsClimbRel_of_eval - st seed i treeIdx sk hm0 hAdrLt hSkLt hTree hSecret hLeaf - · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_seed_slot] - exact hm0 - -/-- Conditional post-inner FORS node correspondence for one normal C13 FORS tree. -The straight-line setup supplies the initial `MerkleClimbRel`; callers still own -the per-height Merkle data and relation-step facts for the 19 auth-path levels. -/ -theorem forsLeafInnerStep_node_eq_forsClimb_of_eval - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) - (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) auth := by - let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st - let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } - have hR0 : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - setup - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := - forsLeafSetupStep_initial_forsClimbRel_of_eval st seed i treeIdx sk - hm0 hAdrLt hSkLt hTree hSecret hLeaf - have hR : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - start - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by - refine SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.intro ?_ ?_ - · dsimp [start] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - setup.bindings "h" "pathIdx" (wordNormalize 0) (by decide)] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.idx hR0 - · dsimp [start] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - setup.bindings "h" "node" (wordNormalize 0) (by decide)] - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.node hR0 - have hmodel := - SphincsMinusVerifiers.ClimbMemFrameMerkle.forsClimb_model_node - "node" "pathIdx" "treeAdrsBase" "authPtr" - seed i auth cdAt hstep start treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) - 0 19 hD hR - have h19 : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, - show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] - unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - rw [h19] - exact hmodel - -/-- Frame-carrying post-inner FORS node correspondence for one normal C13 FORS -tree. This is the frame-shaped sibling of -`forsLeafInnerStep_node_eq_forsClimb_of_eval`: setup supplies the initial -`MerkleClimbFrame`, the range-gated setup theorem rewrites `"treeAdrsBase"` to -the exact C13 ADRS base, and callers provide the per-height frame step facts. -/ -theorem forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) - (hi : lookupValue st.bindings "i" = i) - (hiLt : i < 6) - (hsite : ForsFrozenSite i pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - s a → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) auth := by - let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st - let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } - have hFrame0 : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed - (lookupValue setup.bindings "treeAdrsBase") - (lookupValue setup.bindings "authPtr") - setup - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by - simpa [setup] using - forsLeafSetupStep_initial_forsClimbFrame_of_eval_site - st seed i treeIdx sk pkSeed pkRoot message sig hsite - hm0 hAdrLt hSkLt hTree hSecret hLeaf - have hbase : - lookupValue setup.bindings "treeAdrsBase" = (3 <<< 96) ||| (i <<< 64) := by - simpa [setup] using - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_treeAdrsBase_eq_of_i - st i hi hiLt - have hFrameExact : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") - setup - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := by - simpa [hbase] using hFrame0 - have hFrameStart : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") - start - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_h_inject - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") setup - (treeIdx, maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) - (wordNormalize 0) hFrameExact - have hmodel := - SphincsMinusVerifiers.ClimbMemFrameMerkle.forsClimbFrame_model_node - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed i - (lookupValue setup.bindings "authPtr") auth cdAt hstep start treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) - 0 19 hD hFrameStart - have h19 : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, - show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] - unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - rw [h19] - exact hmodel - -/-- Range-gated sibling of -`forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site`. The per-height frame -step receives the concrete bound `idx < 19`, so callers can use calldata facts -whose offset arithmetic is only valid over the FORS auth-path range. -/ -theorem forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site_range - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) - (hi : lookupValue st.bindings "i" = i) - (hiLt : i < 6) - (hsite : ForsFrozenSite i pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), idx < 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - s a → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) auth := by - let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st - let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } - let node0 := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk]) - have hFrame0 : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed - (lookupValue setup.bindings "treeAdrsBase") - (lookupValue setup.bindings "authPtr") - setup (treeIdx, node0) := by - simpa [setup, node0] using - forsLeafSetupStep_initial_forsClimbFrame_of_eval_site - st seed i treeIdx sk pkSeed pkRoot message sig hsite - hm0 hAdrLt hSkLt hTree hSecret hLeaf - have hbase : - lookupValue setup.bindings "treeAdrsBase" = (3 <<< 96) ||| (i <<< 64) := by - simpa [setup] using - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_treeAdrsBase_eq_of_i - st i hi hiLt - have hFrameExact : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") - setup (treeIdx, node0) := by - simpa [hbase] using hFrame0 - have hFrameStart : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") - start (treeIdx, node0) := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_h_inject - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr") setup (treeIdx, node0) - (wordNormalize 0) hFrameExact - let D : Nat → Prop := fun idx => - idx < 19 ∧ SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx - have hD' : ∀ idx, 0 ≤ idx → idx < 0 + 19 → D idx := by - intro idx h0 hlt - exact ⟨by omega, hD idx h0 hlt⟩ - have hframe := - SphincsMinusVerifiers.ClimbLoop.foldLoop_invariant_cond "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue setup.bindings "authPtr")) - D - (fun s a idx hDi hR => hstep s a idx hDi.1 hDi.2 hR) - start (treeIdx, node0) 0 19 hD' hFrameStart - have hnode : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - (SphincsMinusVerifiers.ClimbLoop.specFold - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth) - (treeIdx, node0) 0 19).2 := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame.toRel hframe |>.node - have hx : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.xmssClimb seed - ((3 <<< 96) ||| (i <<< 64)) 19 0 treeIdx node0 auth := - hnode.trans - (SphincsMinusVerifiers.ClimbMemFrameMerkle.xmssClimb_eq_specFold - seed ((3 <<< 96) ||| (i <<< 64)) auth 19 0 treeIdx node0).symm - have hmodel : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx node0 auth := - hx.trans - (SphincsMinusVerifiers.ClimbStepSpec.forsClimb_eq_xmssClimb - seed i 19 0 treeIdx node0 auth).symm - have h19 : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, - show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] - unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - rw [h19] - exact hmodel - -/-- Range-gated frame-carrying post-inner theorem that also carries the spec-side -path-index word bound through the loop. This is the shape needed by concrete -calldata step facts, since the local address/shift evaluators require the moving -`pathIdx` to stay below `2^256`. -/ -theorem forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site_range_path_bound - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) - (hi : lookupValue st.bindings "i" = i) - (hiLt : i < 6) - (hTreeIdxLt : treeIdx < 2 ^ 256) - (hsite : ForsFrozenSite i pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), idx < 19 → - a.1 < 2 ^ 256 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - s a → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "authPtr") - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - seed ((3 <<< 96) ||| (i <<< 64)) auth idx a)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) auth := by - let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st - let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } - let node0 := maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk]) - let base := (3 <<< 96) ||| (i <<< 64) - let merklePtr := lookupValue setup.bindings "authPtr" - let R : RuntimeState → Nat × Nat → Prop := fun s a => - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed base merklePtr s a ∧ a.1 < 2 ^ 256 - have hFrame0 : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed - (lookupValue setup.bindings "treeAdrsBase") - (lookupValue setup.bindings "authPtr") - setup (treeIdx, node0) := by - simpa [setup, node0] using - forsLeafSetupStep_initial_forsClimbFrame_of_eval_site - st seed i treeIdx sk pkSeed pkRoot message sig hsite - hm0 hAdrLt hSkLt hTree hSecret hLeaf - have hbase : - lookupValue setup.bindings "treeAdrsBase" = base := by - simpa [setup, base] using - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_treeAdrsBase_eq_of_i - st i hi hiLt - have hFrameExact : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed base merklePtr - setup (treeIdx, node0) := by - simpa [merklePtr, hbase] using hFrame0 - have hFrameStart : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed base merklePtr - start (treeIdx, node0) := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_h_inject - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed base merklePtr setup (treeIdx, node0) - (wordNormalize 0) hFrameExact - let D : Nat → Prop := fun idx => - idx < 19 ∧ SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx - have hD' : ∀ idx, 0 ≤ idx → idx < 0 + 19 → D idx := by - intro idx h0 hlt - exact ⟨by omega, hD idx h0 hlt⟩ - have hR0 : R start (treeIdx, node0) := by - exact ⟨hFrameStart, hTreeIdxLt⟩ - have hpair := - SphincsMinusVerifiers.ClimbLoop.foldLoop_invariant_cond "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep seed base auth) - R D - (fun s a idx hDi hR => by - refine ⟨?_, ?_⟩ - · exact hstep s a idx hDi.1 hR.2 hDi.2 hR.1 - · dsimp [SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep] - exact Nat.lt_of_le_of_lt (Nat.div_le_self a.1 2) hR.2) - start (treeIdx, node0) 0 19 hD' hR0 - have hnode : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - (SphincsMinusVerifiers.ClimbLoop.specFold - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep seed base auth) - (treeIdx, node0) 0 19).2 := - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame.toRel hpair.1 |>.node - have hx : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.xmssClimb seed base 19 0 treeIdx node0 auth := - hnode.trans - (SphincsMinusVerifiers.ClimbMemFrameMerkle.xmssClimb_eq_specFold - seed base auth 19 0 treeIdx node0).symm - have hmodel : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - start 0 19).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx node0 auth := - hx.trans - (SphincsMinusVerifiers.ClimbStepSpec.forsClimb_eq_xmssClimb - seed i 19 0 treeIdx node0 auth).symm - have h19 : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, - show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] - unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - rw [h19] - simpa [base, node0] using hmodel - -/-- Concrete frozen-calldata post-inner FORS node correspondence. This closes -the frame-step side of the range/path-bound handoff with -`stepMerkle_forsFrame_hstep_of_fors_frozen_calldata`; callers still provide the -parsed auth-path `MerkleClimbData` range and the straight-line setup eval facts. -/ -theorem forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata - (st : RuntimeState) (seed i treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) - (pkSeed pkRoot message sig : ByteArray) - (auth : List SphincsMinusVerifierSpec.Bytes) - (hi : lookupValue st.bindings "i" = i) - (hiLt : i < 6) - (hTreeIdxLt : treeIdx < 2 ^ 256) - (hsite : ForsFrozenSite i pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth - (fun h => - Compiler.Proofs.YulGeneration.calldataloadWord 0 - (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (SphincsMinusVerifiers.MkC13State.sigDataOffset - + (128 + 304 * i) + 16 * h)) idx) - (hm0 : (st.world.memory 0).val = seed) - (hAdrLt : adrsForsLeaf i treeIdx < 2 ^ 256) - (hSkLt : wordOfHash16 sk < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some treeIdx) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" treeIdx } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 sk)) - (hLeaf : evalExpr [] - { st with bindings := - bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf i treeIdx)) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i 19 0 treeIdx - (maskN (keccakWords [seed, adrsForsLeaf i treeIdx, wordOfHash16 sk])) auth := by - let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st - rcases hsite with ⟨base0, _hsel, _hcd, hap, hbaseSite, hbaselt, _hpathlt⟩ - have hbaseExact : - lookupValue setup.bindings "treeAdrsBase" = (3 <<< 96) ||| (i <<< 64) := by - simpa [setup] using - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_treeAdrsBase_eq_of_i - st i hi hiLt - have htreeAdrsLt : ((3 <<< 96) ||| (i <<< 64)) < 2 ^ 256 := by - rw [← hbaseExact] - rw [hbaseSite] - exact hbaselt - have hapSetup : - lookupValue setup.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i) := by - simpa [setup] using hap - exact forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site_range_path_bound - st seed i treeIdx sk pkSeed pkRoot message sig auth - (fun h => - Compiler.Proofs.YulGeneration.calldataloadWord 0 - (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i) + 16 * h)) - hi hiLt hTreeIdxLt - (by exact ⟨base0, _hsel, _hcd, hap, hbaseSite, hbaselt, _hpathlt⟩) - (fun s a idx hidx hmlt hdata hframe => by - have hframeFixed : - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame - "node" "pathIdx" "treeAdrsBase" "authPtr" - pkSeed pkRoot message sig seed ((3 <<< 96) ||| (i <<< 64)) - (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) - s a := by - simpa [setup, hapSetup] using hframe - have hnext := - stepMerkle_forsFrame_hstep_of_fors_frozen_calldata - s i idx a.1 a.2 seed ((3 <<< 96) ||| (i <<< 64)) - pkSeed pkRoot message sig auth hframeFixed hiLt hidx hmlt htreeAdrsLt hdata - simpa [setup, hapSetup] using hnext) - hD hm0 hAdrLt hSkLt hTree hSecret hLeaf - -/-- C13 normal-root form of `forsLeafInnerStep_node_eq_forsClimb_of_eval`. This -is the exact post-inner `"node"` equality expected by the six normal FORS -root-cell adapters. -/ -theorem forsLeafInnerStep_node_eq_forsAllRootsC13_getElem_of_eval - (st : RuntimeState) (pk : SphincsMinusVerifierSpec.PublicKey) - (digest : SphincsMinusVerifierSpec.HMsg) - (fors : SphincsMinusVerifierSpec.ForsSig) (j : Nat) (hj : j < 6) - (cdAt : Nat → Nat) - (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData - ((fors.authPath[j]?).getD []) cdAt idx → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) - (SphincsMinusVerifiers.ClimbMemFrameMerkle.merkleSpecStep - (wordOfHash16 pk.pkSeed) ((3 <<< 96) ||| (j <<< 64)) - ((fors.authPath[j]?).getD []) idx a)) - (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → - SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData - ((fors.authPath[j]?).getD []) cdAt idx) - (hm0 : (st.world.memory 0).val = wordOfHash16 pk.pkSeed) - (hAdrLt : adrsForsLeaf j ((digest.forsIndex[j]?).getD 0) < 2 ^ 256) - (hSkLt : wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩) < 2 ^ 256) - (hTree : evalExpr [] st - (.bitAnd - (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) - (.literal 0x7FFFF)) = some ((digest.forsIndex[j]?).getD 0)) - (hSecret : evalExpr [] - { st with bindings := bindValue st.bindings "treeIdx" ((digest.forsIndex[j]?).getD 0) } - (.bitAnd - (.calldataload - (.add (.localVar "sigBase") - (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) - (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some (wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩))) - (hLeaf : evalExpr [] - { st with bindings := - (bindValue - (bindValue st.bindings "treeIdx" ((digest.forsIndex[j]?).getD 0)) - "secretVal" (wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩))) } - (.bitOr - (.shl (.literal 96) (.literal 3)) - (.bitOr (.shl (.literal 64) (.localVar "i")) (.localVar "treeIdx"))) - = some (adrsForsLeaf j ((digest.forsIndex[j]?).getD 0))) : - wordNormalize - (lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") - = - (SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13 pk digest fors)[j]'(by - rw [SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13_length] - omega) := by - rw [SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13_getElem_normal - (pk := pk) (digest := digest) (fors := fors) hj] - exact forsLeafInnerStep_node_eq_forsClimb_of_eval - st (wordOfHash16 pk.pkSeed) j ((digest.forsIndex[j]?).getD 0) - ((fors.sk[j]?).getD ⟨#[]⟩) ((fors.authPath[j]?).getD []) cdAt - hstep hD hm0 hAdrLt hSkLt hTree hSecret hLeaf - -/-- One FORS Merkle step preserves the seed slot when its setup bindings and -frozen calldata frame match the C13 FORS auth-path layout. -/ -theorem stepMerkle_preserves_seed_slot_of_fors_frozen_calldata - (s : RuntimeState) (t idx base : Nat) - (pkSeed pkRoot message sig : ByteArray) - (hsel : s.selector = 0) - (hcd : s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (hap : lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - (hbase : lookupValue s.bindings "treeAdrsBase" = base) - (hbaselt : base < 2 ^ 256) - (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) - (ht : t < 6) - (hidx : idx < 19) : - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val - = (s.world.memory 0).val := by - rcases s4_eval_site_of_fors_frozen_calldata - s t idx base pkSeed pkRoot message sig hsel hcd hap hbase hbaselt hpathlt ht hidx with - ⟨vsib, vadr, hpath, h1, h3⟩ - exact stepMerkle_preserves_seed_slot_of_s4_eval - s idx (lookupValue s.bindings "pathIdx") vsib vadr rfl hpath h1 h3 - -/-- One FORS Merkle step preserves an ordinary root-array slot when its setup -bindings and frozen calldata frame match the C13 FORS auth-path layout. -/ -theorem stepMerkle_preserves_root_cell_of_fors_frozen_calldata - (s : RuntimeState) (j t idx base : Nat) - (pkSeed pkRoot message sig : ByteArray) - (hsel : s.selector = 0) - (hcd : s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) - (hap : lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t)) - (hbase : lookupValue s.bindings "treeAdrsBase" = base) - (hbaselt : base < 2 ^ 256) - (hpathlt : lookupValue s.bindings "pathIdx" < 2 ^ 256) - (ht : t < 6) - (hidx : idx < 19) : - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory - (0x80 + 32 * j)).val - = (s.world.memory (0x80 + 32 * j)).val := by - rcases s4_eval_site_of_fors_frozen_calldata - s t idx base pkSeed pkRoot message sig hsel hcd hap hbase hbaselt hpathlt ht hidx with - ⟨vsib, vadr, hpath, h1, h3⟩ - exact stepMerkle_preserves_root_cell_of_s4_eval - s j idx (lookupValue s.bindings "pathIdx") vsib vadr rfl hpath h1 h3 - -/-- One inner FORS Merkle step preserves the frozen-site invariant. The moving -`pathIdx` is rebound to `pathIdx >>> 1`, hence remains a bounded EVM word; the -static selector/calldata and fixed `authPtr`/`treeAdrsBase` bindings are framed -through the step. -/ -theorem stepMerkle_preserves_forsFrozenSite - (s : RuntimeState) (t idx : Nat) +/-- One inner FORS Merkle step preserves the frozen-site invariant. The moving +`pathIdx` is rebound to `pathIdx >>> 1`, hence remains a bounded EVM word; the +static selector/calldata and fixed `authPtr`/`forsBase` bindings are framed +through the step. -/ +theorem stepFors_preserves_forsFrozenSite + (s : RuntimeState) (t idx : Nat) (pkSeed pkRoot message sig : ByteArray) (hsite : ForsFrozenSite t pkSeed pkRoot message sig s) (ht : t < 6) (hidx : idx < 19) : ForsFrozenSite t pkSeed pkRoot message sig - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + (stepForsMerkle { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) := by rcases hsite with ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - rcases s4_eval_site_of_fors_frozen_calldata - s t idx base pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt ht hidx with - ⟨vsib, vadr, _, h1, h3⟩ + have h1 := s4_sibling_read_of_fors_frozen_calldata + s t idx pkSeed pkRoot message sig hsel hcd hap ht hidx + set vsib := SphincsMinusVerifierSpec.C13Concrete.maskN + (Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) + 16 * idx)) + with hvsib let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } let mIdx : Nat := lookupValue s.bindings "pathIdx" let vpar : Nat := mIdx >>> 1 @@ -1941,6 +623,7 @@ theorem stepMerkle_preserves_forsFrozenSite let o6 : Nat := (0x60 : Nat) ^^^ sval let st1 : RuntimeState := { stH with bindings := bindValue stH.bindings "sibling" vsib } let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "parentIdx" vpar } + let vadr : Nat := SphincsMinusVerifiers.ClimbKit.adrsEval_fors.val st2 let st3 : RuntimeState := { st2 with world := { st2.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st2.world.memory 0x20 vadr } } @@ -1962,6 +645,8 @@ theorem stepMerkle_preserves_forsFrozenSite dsimp [vpar] exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_parentIdx_shr "pathIdx" st1 mIdx hpath1 hpathlt + have h3 : evalExpr [] st2 forsAdrs = some vadr := + SphincsMinusVerifiers.ClimbKit.adrsEval_fors.eval st2 have hpath3 : lookupValue st3.bindings "pathIdx" = mIdx := by dsimp [st3, st2, st1] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne @@ -1998,17 +683,17 @@ theorem stepMerkle_preserves_forsFrozenSite some (lookupValue st5.bindings "sibling") := by rfl have hsc := - SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_selector_calldata - "node" "pathIdx" "treeAdrsBase" "authPtr" stH + SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_selector_calldata + "node" "pathIdx" "authPtr" forsAdrs stH vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") h1 h2 h3 h4 h5off h5val h6off h6val have hapStep : lookupValue - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" stH).bindings - "authPtr" + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).bindings "authPtr" = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) := by - rw [SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_binding_frozen - "node" "pathIdx" "treeAdrsBase" "authPtr" "authPtr" stH + rw [SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_binding_frozen + "node" "pathIdx" "authPtr" "authPtr" forsAdrs stH vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") (by decide) (by decide) (by decide) (by decide) (by decide) h1 h2 h3 h4 h5off h5val h6off h6val] @@ -2018,45 +703,45 @@ theorem stepMerkle_preserves_forsFrozenSite exact hap have hbaseStep : lookupValue - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" stH).bindings - "treeAdrsBase" = base := by - rw [SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_binding_frozen - "node" "pathIdx" "treeAdrsBase" "authPtr" "treeAdrsBase" stH + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).bindings "forsBase" = base := by + rw [SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_binding_frozen + "node" "pathIdx" "authPtr" "forsBase" forsAdrs stH vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") (by decide) (by decide) (by decide) (by decide) (by decide) h1 h2 h3 h4 h5off h5val h6off h6val] dsimp [stH] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - s.bindings "h" "treeAdrsBase" (wordNormalize idx) (by decide)] + s.bindings "h" "forsBase" (wordNormalize idx) (by decide)] exact hbase have hpathStepEq : lookupValue - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" stH).bindings - "pathIdx" = vpar := - SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkle_idx_binding - "node" "pathIdx" "treeAdrsBase" "authPtr" stH + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).bindings "pathIdx" = vpar := + SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_idx_binding + "node" "pathIdx" "authPtr" forsAdrs stH vsib vpar vadr sval o5 vnode o6 (lookupValue st5.bindings "sibling") (by decide) h1 h2 h3 h4 h5off h5val h6off h6val have hvparlt : vpar < 2 ^ 256 := by dsimp [vpar, mIdx] rw [Nat.shiftRight_eq_div_pow] exact lt_of_le_of_lt (Nat.div_le_self _ _) hpathlt + show ForsFrozenSite t pkSeed pkRoot message sig + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs stH) refine ⟨base, hsc.1.trans hsel, hsc.2.trans hcd, hapStep, hbaseStep, hbaselt, ?_⟩ rw [hpathStepEq] exact hvparlt /-- Pure inner-loop site invariant: if the C13 FORS frozen-site facts hold at -the loop entry, they hold after every executed `stepMerkle` iteration in a -range whose heights satisfy `idx < 19`. This is intentionally only a site -invariant; seed/root memory preservation is carried by separate frame lemmas. -/ +the loop entry, they hold after every executed `stepForsMerkle` iteration in a +range whose heights satisfy `idx < 19`. -/ theorem foldLoop_preserves_forsFrozenSite_range (t : Nat) (pkSeed pkRoot message sig : ByteArray) (ht : t < 6) : ∀ (state : RuntimeState) (index remaining : Nat), (∀ i, index ≤ i → i < index + remaining → i < 19) → ForsFrozenSite t pkSeed pkRoot message sig state → ForsFrozenSite t pkSeed pkRoot message sig - (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle state index remaining) | state, _, 0, _, hsite => by rw [SphincsMinusVerifiers.ClimbLoop.foldLoop_zero] @@ -2064,25 +749,22 @@ theorem foldLoop_preserves_forsFrozenSite_range | state, index, remaining + 1, hD, hsite => by rw [SphincsMinusVerifiers.ClimbLoop.foldLoop_succ] exact foldLoop_preserves_forsFrozenSite_range t pkSeed pkRoot message sig ht - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + (stepForsMerkle { state with bindings := bindValue state.bindings "h" (wordNormalize index) }) (index + 1) remaining (fun i hi1 hi2 => hD i (by omega) (by omega)) - (stepMerkle_preserves_forsFrozenSite + (stepFors_preserves_forsFrozenSite state t index pkSeed pkRoot message sig hsite ht (hD index (by omega) (by omega))) /-- Pure inner-loop seed-cell frame from the concrete C13 FORS frozen-site -invariant. This is the cheap fold-level handoff used before lifting back to -statement execution: each first step preserves `mem[0x00]`, while the site -invariant is threaded recursively for the suffix. -/ +invariant. -/ theorem foldLoop_preserves_seed_slot_of_forsFrozenSite_range (t : Nat) (pkSeed pkRoot message sig : ByteArray) (ht : t < 6) : ∀ (state : RuntimeState) (index remaining : Nat), (∀ i, index ≤ i → i < index + remaining → i < 19) → ForsFrozenSite t pkSeed pkRoot message sig state → - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle state index remaining).world.memory 0).val = (state.world.memory 0).val | state, _, 0, _, _ => by @@ -2090,22 +772,21 @@ theorem foldLoop_preserves_seed_slot_of_forsFrozenSite_range | state, index, remaining + 1, hD, hsite => by rw [SphincsMinusVerifiers.ClimbLoop.foldLoop_succ] let stepState : RuntimeState := - stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + stepForsMerkle { state with bindings := bindValue state.bindings "h" (wordNormalize index) } have hstepMem : (stepState.world.memory 0).val = (state.world.memory 0).val := by rcases hsite with ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - exact stepMerkle_preserves_seed_slot_of_fors_frozen_calldata - state t index base pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt ht + exact stepFors_preserves_seed_slot_of_fors_frozen_calldata + state t index pkSeed pkRoot message sig + hsel hcd hap hpathlt ht (hD index (by omega) (by omega)) have hstepSite : ForsFrozenSite t pkSeed pkRoot message sig stepState := by - exact stepMerkle_preserves_forsFrozenSite + exact stepFors_preserves_forsFrozenSite state t index pkSeed pkRoot message sig hsite ht (hD index (by omega) (by omega)) have hrec : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle stepState (index + 1) remaining).world.memory 0).val = (stepState.world.memory 0).val := foldLoop_preserves_seed_slot_of_forsFrozenSite_range @@ -2115,16 +796,13 @@ theorem foldLoop_preserves_seed_slot_of_forsFrozenSite_range exact hrec.trans hstepMem /-- Pure inner-loop ordinary-root-cell frame from the concrete C13 FORS -frozen-site invariant. Inner Merkle climbing writes scratch/seed/node slots but -does not disturb the root array at `0x80 + 32*j`; this fold-level lemma keeps -that fact threaded together with the frozen-site invariant. -/ +frozen-site invariant. -/ theorem foldLoop_preserves_root_cell_of_forsFrozenSite_range (j t : Nat) (pkSeed pkRoot message sig : ByteArray) (ht : t < 6) : ∀ (state : RuntimeState) (index remaining : Nat), (∀ i, index ≤ i → i < index + remaining → i < 19) → ForsFrozenSite t pkSeed pkRoot message sig state → - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle state index remaining).world.memory (0x80 + 32 * j)).val = (state.world.memory (0x80 + 32 * j)).val | state, _, 0, _, _ => by @@ -2132,24 +810,23 @@ theorem foldLoop_preserves_root_cell_of_forsFrozenSite_range | state, index, remaining + 1, hD, hsite => by rw [SphincsMinusVerifiers.ClimbLoop.foldLoop_succ] let stepState : RuntimeState := - stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" + stepForsMerkle { state with bindings := bindValue state.bindings "h" (wordNormalize index) } have hstepMem : (stepState.world.memory (0x80 + 32 * j)).val = (state.world.memory (0x80 + 32 * j)).val := by rcases hsite with ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - exact stepMerkle_preserves_root_cell_of_fors_frozen_calldata - state j t index base pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt ht + exact stepFors_preserves_root_cell_of_fors_frozen_calldata + state j t index pkSeed pkRoot message sig + hsel hcd hap hpathlt ht (hD index (by omega) (by omega)) have hstepSite : ForsFrozenSite t pkSeed pkRoot message sig stepState := by - exact stepMerkle_preserves_forsFrozenSite + exact stepFors_preserves_forsFrozenSite state t index pkSeed pkRoot message sig hsite ht (hD index (by omega) (by omega)) have hrec : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle stepState (index + 1) remaining).world.memory (0x80 + 32 * j)).val = (stepState.world.memory (0x80 + 32 * j)).val := foldLoop_preserves_root_cell_of_forsFrozenSite_range @@ -2158,9 +835,75 @@ theorem foldLoop_preserves_root_cell_of_forsFrozenSite_range hstepSite exact hrec.trans hstepMem +/-! ## 6. The setup → frozen-site package. -/ + +/-- Bundle the local `forsLeafSetupStep` facts into the frozen-calldata site +shape consumed by the C13 FORS Merkle frame adapters. The hoisted FIPS ADRS +base `"forsBase"` is bound before the outer loop (the fors-setup segment), so +its value and bound are taken at `st` and framed through the setup prefix. -/ +theorem forsLeafSetupStep_fors_frozen_calldata_site + (st : RuntimeState) (t base : Nat) + (pkSeed pkRoot message sig : ByteArray) + (hi : lookupValue st.bindings "i" = t) + (ht : t < 6) + (hsigBase : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset) + (hbase : lookupValue st.bindings "forsBase" = base) + (hbaseLt : base < 2 ^ 256) + (hsel : st.selector = 0) + (hcd : st.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : + ∃ base', + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).selector = 0 ∧ + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ + lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ + lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings + "forsBase" = base' ∧ + base' < 2 ^ 256 ∧ + lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings + "pathIdx" < 2 ^ 256 := by + rcases SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_selector_calldata + st with ⟨hselStep, hcdStep⟩ + refine ⟨base, ?_, ?_, ?_, ?_, hbaseLt, ?_⟩ + · rw [hselStep, hsel] + · rw [hcdStep, hcd] + · have hsigBase164 : lookupValue st.bindings "sigBase" = 164 := by + simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hsigBase + have hap := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_authPtr_eq_sigDataOffset + st t hi hsigBase164 ht + simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hap + · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_forsBase st] + exact hbase + · exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_pathIdx_lt st t hi + +/-- Predicate-form wrapper for the local setup-site package. -/ +theorem forsLeafSetupStep_forsFrozenSite + (st : RuntimeState) (t base : Nat) + (pkSeed pkRoot message sig : ByteArray) + (hi : lookupValue st.bindings "i" = t) + (ht : t < 6) + (hsigBase : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset) + (hbase : lookupValue st.bindings "forsBase" = base) + (hbaseLt : base < 2 ^ 256) + (hsel : st.selector = 0) + (hcd : st.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : + ForsFrozenSite t pkSeed pkRoot message sig + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := + forsLeafSetupStep_fors_frozen_calldata_site st t base pkSeed pkRoot message sig + hi ht hsigBase hbase hbaseLt hsel hcd + +/-! ## 7. Inner-step / leaf-step / outer-loop memory carries. -/ + /-- Exact `forsLeafInnerStep` seed-cell adapter from the C13 FORS frozen-site -invariant. `forsLeafInnerStep` pre-binds `"h" := 0`; that binding is disjoint -from the frozen site fields, so the pure fold seed frame applies directly. -/ +invariant. -/ theorem forsLeafInnerStep_preserves_seed_slot_of_forsFrozenSite (st : RuntimeState) (t : Nat) (pkSeed pkRoot message sig : ByteArray) (ht : t < 6) @@ -2178,15 +921,14 @@ theorem forsLeafInnerStep_preserves_seed_slot_of_forsFrozenSite exact hap · dsimp [stH] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - st.bindings "h" "treeAdrsBase" (wordNormalize 0) (by decide)] + st.bindings "h" "forsBase" (wordNormalize 0) (by decide)] exact hbase · dsimp [stH] rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne st.bindings "h" "pathIdx" (wordNormalize 0) (by decide)] exact hpathlt have hinner : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle stH 0 (wordNormalize 19)).world.memory 0).val = (stH.world.memory 0).val := foldLoop_preserves_seed_slot_of_forsFrozenSite_range @@ -2209,535 +951,1108 @@ theorem forsLeafInnerStep_preserves_root_cell_of_forsFrozenSite ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep st).world.memory (0x80 + 32 * j)).val = (st.world.memory (0x80 + 32 * j)).val := by - let stH : RuntimeState := - { st with bindings := bindValue st.bindings "h" (wordNormalize 0) } - have hsiteH : ForsFrozenSite t pkSeed pkRoot message sig stH := by - rcases hsite with ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - refine ⟨base, hsel, hcd, ?_, ?_, hbaselt, ?_⟩ - · dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - st.bindings "h" "authPtr" (wordNormalize 0) (by decide)] - exact hap - · dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - st.bindings "h" "treeAdrsBase" (wordNormalize 0) (by decide)] - exact hbase - · dsimp [stH] - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne - st.bindings "h" "pathIdx" (wordNormalize 0) (by decide)] - exact hpathlt - have hinner : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" - (stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr") - stH 0 (wordNormalize 19)).world.memory (0x80 + 32 * j)).val - = (stH.world.memory (0x80 + 32 * j)).val := - foldLoop_preserves_root_cell_of_forsFrozenSite_range - j t pkSeed pkRoot message sig ht stH 0 (wordNormalize 19) + let stH : RuntimeState := + { st with bindings := bindValue st.bindings "h" (wordNormalize 0) } + have hsiteH : ForsFrozenSite t pkSeed pkRoot message sig stH := by + rcases hsite with ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ + refine ⟨base, hsel, hcd, ?_, ?_, hbaselt, ?_⟩ + · dsimp [stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + st.bindings "h" "authPtr" (wordNormalize 0) (by decide)] + exact hap + · dsimp [stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + st.bindings "h" "forsBase" (wordNormalize 0) (by decide)] + exact hbase + · dsimp [stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + st.bindings "h" "pathIdx" (wordNormalize 0) (by decide)] + exact hpathlt + have hinner : + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle + stH 0 (wordNormalize 19)).world.memory (0x80 + 32 * j)).val + = (stH.world.memory (0x80 + 32 * j)).val := + foldLoop_preserves_root_cell_of_forsFrozenSite_range + j t pkSeed pkRoot message sig ht stH 0 (wordNormalize 19) + (fun i _ hi => by + have hnorm : wordNormalize 19 = 19 := by + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + rw [hnorm] at hi + omega) + hsiteH + simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep, stH] using hinner + +/-- One concrete FORS leaf iteration preserves `mem[0x00]` from the actual local +setup facts: setup packages `ForsFrozenSite`, the inner pure step preserves the +seed slot, and the final store is non-aliasing for `t < 6`. -/ +theorem forsLeafStep_preserves_seed_slot_of_forsFrozenSetup + (st : RuntimeState) (t base : Nat) + (pkSeed pkRoot message sig : ByteArray) + (hi : lookupValue st.bindings "i" = t) + (ht : t < 6) + (hsigBase : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset) + (hbase : lookupValue st.bindings "forsBase" = base) + (hbaseLt : base < 2 ^ 256) + (hsel : st.selector = 0) + (hcd : st.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val + = (st.world.memory 0).val := by + have hbody : + execStmtList [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody + = .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := + SphincsMinusVerifiers.SegmentS4Fors.execForsLeaf st + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_eq_segments, + SphincsMinusVerifiers.MemoryKit.execStmtList_append_continue + st (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupBody + [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt, + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] + (SphincsMinusVerifiers.SegmentS4Fors.execForsLeafSetup st)] at hbody + have hInnerExec : + execStmt [] (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = + .continue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) := + SphincsMinusVerifiers.SegmentS4Fors.execForsLeafInner + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ + [SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] hInnerExec] at hbody + have hStoreExec : + execStmt [] + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt = + .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := by + simpa using hbody + have hiSetup : + lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings + "i" = t := by + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_i st, hi] + have hiInner : + lookupValue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings + "i" = t := by + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInner_preserves_i + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) hInnerExec, + hiSetup] + have hStoreSeed := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStore_preserves_seed_slot_range + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) t ht hiInner hStoreExec + have hsetupSite : + ForsFrozenSite t pkSeed pkRoot message sig + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := + forsLeafSetupStep_forsFrozenSite st t base pkSeed pkRoot message sig + hi ht hsigBase hbase hbaseLt hsel hcd + have hInnerSeed := + forsLeafInnerStep_preserves_seed_slot_of_forsFrozenSite + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + t pkSeed pkRoot message sig ht hsetupSite + have hSetupSeed := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_seed_slot st + rw [hStoreSeed, hInnerSeed, hSetupSeed] + +/-- One concrete FORS leaf iteration preserves an ordinary root slot different +from the leaf being stored, using the actual local setup facts. -/ +theorem forsLeafStep_preserves_root_cell_ne_of_forsFrozenSetup + (st : RuntimeState) (j t base : Nat) + (pkSeed pkRoot message sig : ByteArray) + (hi : lookupValue st.bindings "i" = t) + (ht : t < 6) + (hne : j ≠ t) + (hsigBase : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset) + (hbase : lookupValue st.bindings "forsBase" = base) + (hbaseLt : base < 2 ^ 256) + (hsel : st.selector = 0) + (hcd : st.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory + (0x80 + 32 * j)).val + = (st.world.memory (0x80 + 32 * j)).val := by + have hbody : + execStmtList [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody + = .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := + SphincsMinusVerifiers.SegmentS4Fors.execForsLeaf st + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_eq_segments, + SphincsMinusVerifiers.MemoryKit.execStmtList_append_continue + st (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupBody + [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt, + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] + (SphincsMinusVerifiers.SegmentS4Fors.execForsLeafSetup st)] at hbody + have hInnerExec : + execStmt [] (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = + .continue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) := + SphincsMinusVerifiers.SegmentS4Fors.execForsLeafInner + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ + [SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] hInnerExec] at hbody + have hStoreExec : + execStmt [] + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt = + .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := by + simpa using hbody + have hiSetup : + lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings + "i" = t := by + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_i st, hi] + have hiInner : + lookupValue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings + "i" = t := by + rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInner_preserves_i + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) hInnerExec, + hiSetup] + have hStoreRoot := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStore_preserves_root_cell_range_ne + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) j t ht hiInner hne hStoreExec + have hsetupSite : + ForsFrozenSite t pkSeed pkRoot message sig + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := + forsLeafSetupStep_forsFrozenSite st t base pkSeed pkRoot message sig + hi ht hsigBase hbase hbaseLt hsel hcd + have hInnerRoot := + forsLeafInnerStep_preserves_root_cell_of_forsFrozenSite + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) + j t pkSeed pkRoot message sig ht hsetupSite + have hSetupRoot := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_root_cell_range st j + rw [hStoreRoot, hInnerRoot, hSetupRoot] + +/-- One FORS leaf iteration preserves every other ordinary root slot over the +real outer range when each inner Merkle step carries the frozen C13 +calldata/auth-path frame. -/ +theorem forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata + (st : RuntimeState) (j t : Nat) (ht : t < 6) + (hi : lookupValue st.bindings "i" = t) (hne : j ≠ t) + (pkSeed pkRoot message sig : ByteArray) + (hsite : ∀ (s : RuntimeState) (idx : Nat), idx < 19 → + ∃ base, + s.selector = 0 ∧ + s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ + lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ + lookupValue s.bindings "forsBase" = base ∧ + base < 2 ^ 256 ∧ + lookupValue s.bindings "pathIdx" < 2 ^ 256) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory + (0x80 + 32 * j)).val = + (st.world.memory (0x80 + 32 * j)).val := by + exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_root_cell_range_ne_of_inner + st j t ht hi hne + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_root_cell_range st j) + (forsLeafInner_preserves_memory_val_range_of_step + (0x80 + 32 * j) (fun idx => idx < 19) + (fun s idx hidx => by + rcases hsite s idx hidx with + ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ + exact stepFors_preserves_root_cell_of_fors_frozen_calldata + s j t idx pkSeed pkRoot message sig + hsel hcd hap hpathlt ht hidx) (fun i _ hi => by have hnorm : wordNormalize 19 = 19 := by rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, Nat.mod_eq_of_lt (by decide)] rw [hnorm] at hi - omega) - hsiteH - simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep, stH] using hinner + omega)) + +/-- Outer FORS carry for an ordinary root cell with the suffix-preservation +premise discharged from frozen C13 calldata/auth-path facts. -/ +theorem forsOuter_root_cell_eq_iteration_node_of_fors_frozen_calldata + (st : RuntimeState) (j : Nat) (hj : j < 6) + (pkSeed pkRoot message sig : ByteArray) + (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → + ∃ base, + s.selector = 0 ∧ + s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ + lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ + lookupValue s.bindings "forsBase" = base ∧ + base < 2 ^ 256 ∧ + lookupValue s.bindings "pathIdx" < 2 ^ 256) : + ((SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } + 0 (wordNormalize 6)).world.memory (0x80 + 32 * j)).val = + wordNormalize + (lookupValue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep + { (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } + 0 j) with + bindings := + bindValue + (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep + { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } + 0 j).bindings "i" (wordNormalize j) })).bindings "node") := by + exact SphincsMinusVerifiers.SegmentS4Fors.forsOuter_root_cell_eq_iteration_node_of_suffix_preserves + st j hj + (fun s t hgt ht => by + have hi : lookupValue (bindValue s.bindings "i" (wordNormalize t)) "i" = t := by + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (lt_trans ht (by decide))] + exact forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata + { s with bindings := bindValue s.bindings "i" (wordNormalize t) } + j t ht hi (by omega) pkSeed pkRoot message sig + (fun s idx hidx => hsite s t idx ht hidx)) + +/-- One FORS leaf iteration preserves `mem[0x00]` over the real outer range once +the inner Merkle step has a bounded-index seed-frame proof. -/ +theorem forsLeafStep_preserves_seed_slot_range_of_merkle_step_bound + (st : RuntimeState) (idx : Nat) (hidx : idx < 6) + (hi : lookupValue st.bindings "i" = idx) + (hstep : ∀ (s : RuntimeState) (hidx : Nat), + ((stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val + = (s.world.memory 0).val) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val + = (st.world.memory 0).val := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_seed_slot_range_of_inner + st idx hidx hi + (forsLeafInner_preserves_seed_slot_bound_of_step hstep) + +/-- Range-gated version of +`forsLeafStep_preserves_seed_slot_range_of_merkle_step_bound`. -/ +theorem forsLeafStep_preserves_seed_slot_range_of_merkle_step_range + (D : Nat → Prop) + (st : RuntimeState) (idx : Nat) (hidx : idx < 6) + (hi : lookupValue st.bindings "i" = idx) + (hstep : ∀ (s : RuntimeState) (hidx : Nat), D hidx → + ((stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val + = (s.world.memory 0).val) + (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize 19 → D i) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val + = (st.world.memory 0).val := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_seed_slot_range_of_inner + st idx hidx hi + (forsLeafInner_preserves_memory_val_range_of_step 0 D hstep hD) + +/-- One FORS leaf iteration preserves `mem[0x00]` over the real outer range once +each inner Merkle step carries the frozen C13 calldata/auth-path frame. -/ +theorem forsLeafStep_preserves_seed_slot_range_of_fors_frozen_calldata + (st : RuntimeState) (t : Nat) (ht : t < 6) + (hi : lookupValue st.bindings "i" = t) + (pkSeed pkRoot message sig : ByteArray) + (hsite : ∀ (s : RuntimeState) (idx : Nat), idx < 19 → + ∃ base, + s.selector = 0 ∧ + s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ + lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ + lookupValue s.bindings "forsBase" = base ∧ + base < 2 ^ 256 ∧ + lookupValue s.bindings "pathIdx" < 2 ^ 256) : + ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val + = (st.world.memory 0).val := + forsLeafStep_preserves_seed_slot_range_of_merkle_step_range + (fun idx => idx < 19) st t ht hi + (fun s idx hidx => by + rcases hsite s idx hidx with + ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ + exact stepFors_preserves_seed_slot_of_fors_frozen_calldata + s t idx pkSeed pkRoot message sig hsel hcd hap hpathlt ht hidx) + (fun i _ hi => by + have hnorm : wordNormalize 19 = 19 := by + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + rw [hnorm] at hi + omega) + +/-- Full FORS outer-loop seed-cell frame reduced to frozen C13 calldata/auth-path +facts for the inner Merkle states. -/ +theorem execForsOuter_preserves_seed_slot_range_of_fors_frozen_calldata + (st s' : RuntimeState) (pkSeed pkRoot message sig : ByteArray) + (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → + ∃ base, + s.selector = 0 ∧ + s.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ + lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ + lookupValue s.bindings "forsBase" = base ∧ + base < 2 ^ 256 ∧ + lookupValue s.bindings "pathIdx" < 2 ^ 256) + (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsOuterStmt + = .continue s') : + (s'.world.memory 0).val = (st.world.memory 0).val := + SphincsMinusVerifiers.SegmentS4Fors.execForsOuter_preserves_seed_slot_range_six + st s' + (fun s t ht s'' hexec => by + have hi : lookupValue (bindValue s.bindings "i" (wordNormalize t)) "i" = t := by + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (lt_trans ht (by decide))] + exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_preserves_seed_slot_range_of_inner + { s with bindings := bindValue s.bindings "i" (wordNormalize t) } + s'' t ht hi + (forsLeafInner_preserves_memory_val_range_of_step 0 + (fun idx => idx < 19) + (fun s idx hidx => by + rcases hsite s t idx ht hidx with + ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ + exact stepFors_preserves_seed_slot_of_fors_frozen_calldata + s t idx pkSeed pkRoot message sig + hsel hcd hap hpathlt ht hidx) + (fun i _ hi => by + have hnorm : wordNormalize 19 = 19 := by + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide)] + rw [hnorm] at hi + omega)) + hexec) + h + +/-! ## 8. Node correspondence: the FORS inner climb against the spec +`forsClimb`. + +The FIPS per-level address reads the outer loop binding `"i"` (the +`i <<< (18 - h)` tree-number fold), which the bare `MerkleClimbFrame` does not +carry. `ForsClimbFrameI` strengthens the frame with the `"i"` binding and a +moving-index word bound; the conditional fold engine threads it through the 19 +climb iterations. -/ -/-- One concrete FORS leaf iteration preserves `mem[0x00]` from the actual local -setup facts. This removes the older arbitrary-state `hsite` premise for a -single leaf: setup packages `ForsFrozenSite`, the inner pure step preserves the -seed slot, and the final store is non-aliasing for `t < 6`. -/ -theorem forsLeafStep_preserves_seed_slot_of_forsFrozenSetup - (st : RuntimeState) (t : Nat) +/-- Frame-carrying FORS climb invariant: the static `MerkleClimbFrame` at the +hoisted FIPS ADRS base `adrsForsBase t0 l0`, plus the outer tree binding `"i"` +and the bounded moving path index. -/ +def ForsClimbFrameI + (i t0 l0 seed merklePtr : Nat) (pkSeed pkRoot message sig : ByteArray) - (hi : lookupValue st.bindings "i" = t) - (ht : t < 6) - (hsigBase : lookupValue st.bindings "sigBase" - = SphincsMinusVerifiers.MkC13State.sigDataOffset) - (hsel : st.selector = 0) - (hcd : st.world.calldata + (s : RuntimeState) (a : Nat × Nat) : Prop := + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame + "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed (adrsForsBase t0 l0) merklePtr s a + ∧ lookupValue s.bindings "i" = i + ∧ a.1 < 2 ^ 256 + +/-- The strengthened invariant survives the loop's `"h"` rebind. -/ +theorem ForsClimbFrameI.h_inject + {i t0 l0 seed merklePtr : Nat} + {pkSeed pkRoot message sig : ByteArray} + {s : RuntimeState} {a : Nat × Nat} (v : Nat) + (h : ForsClimbFrameI i t0 l0 seed merklePtr pkSeed pkRoot message sig s a) : + ForsClimbFrameI i t0 l0 seed merklePtr pkSeed pkRoot message sig + { s with bindings := bindValue s.bindings "h" v } a := by + refine ⟨SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_h_inject + "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed (adrsForsBase t0 l0) merklePtr s a v h.1, ?_, h.2.2⟩ + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "i" v (by decide)] + exact h.2.1 + +/-- **`stepFors_forsClimbFrameI_hstep_of_fors_frozen_calldata`** — the master +per-iteration advance for the FIPS FORS inner climb: one `stepForsMerkle` at the +`"h"`-injected state carries `ForsClimbFrameI` forward together with one +`forsSpecStep`, from the frozen C13 calldata layout and the per-height +`MerkleClimbData` fact alone. -/ +theorem stepFors_forsClimbFrameI_hstep_of_fors_frozen_calldata + (s : RuntimeState) (i t0 l0 idx mIdx node seed : Nat) + (pkSeed pkRoot message sig : ByteArray) + (auth : List SphincsMinusVerifierSpec.Bytes) + (hinv : ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig s (mIdx, node)) + (hiLt : i < 6) + (hidx : idx < 19) + (ht0 : t0 < 2 ^ 64) (hl0 : l0 < 2 ^ 32) + (hdata : SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth + (fun h => + Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + + (128 + 304 * i) + 16 * h)) idx) : + ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig + (stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + seed i t0 l0 auth idx (mIdx, node)) := by + obtain ⟨hframe, hi, hmlt⟩ := hinv + have hsel : s.selector = 0 := hframe.2.2.2.2.1 + have hcd : s.world.calldata = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val - = (st.world.memory 0).val := by - have hbody : - execStmtList [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody - = .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := - SphincsMinusVerifiers.SegmentS4Fors.execForsLeaf st - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_eq_segments, - SphincsMinusVerifiers.MemoryKit.execStmtList_append_continue - st (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupBody - [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt, - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] - (SphincsMinusVerifiers.SegmentS4Fors.execForsLeafSetup st)] at hbody - have hInnerExec : - execStmt [] (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = - .continue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) := - SphincsMinusVerifiers.SegmentS4Fors.execForsLeafInner - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - rw [execStmtList_cons_continue _ _ _ - [SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] hInnerExec] at hbody - have hStoreExec : - execStmt [] - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt = - .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := by - simpa using hbody - have hiSetup : - lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "i" = t := by - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_i st, hi] - have hiInner : + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig := hframe.2.2.2.2.2.1 + have hap : lookupValue s.bindings "authPtr" + = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i) := + hframe.2.2.1 + have hbaseS : lookupValue s.bindings "forsBase" = adrsForsBase t0 l0 := hframe.2.1 + have hpath : lookupValue s.bindings "pathIdx" = mIdx := + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.idx hframe.1 + have hbaseLt : adrsForsBase t0 l0 < 2 ^ 256 := + lt_trans (SphincsMinusVerifierSpec.C13Concrete.adrsForsBase_lt_of_bounds ht0 hl0) + (by decide : (2 : Nat) ^ 192 < 2 ^ 256) + -- The masked sibling calldata read at the h-injected state. + have h1 := s4_sibling_read_of_fors_frozen_calldata + s i idx pkSeed pkRoot message sig hsel hcd hap hiLt hidx + set vsib := SphincsMinusVerifierSpec.C13Concrete.maskN + (Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i) + 16 * idx)) + with hvsibDef + -- The local step states. + let stH : RuntimeState := { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } + let vpar : Nat := mIdx >>> 1 + let sval : Nat := (Nat.land mIdx 1) <<< 5 + let o5 : Nat := (0x40 : Nat) ^^^ sval + let o6 : Nat := (0x60 : Nat) ^^^ sval + let st1 : RuntimeState := { stH with bindings := bindValue stH.bindings "sibling" vsib } + let st2 : RuntimeState := { st1 with bindings := bindValue st1.bindings "parentIdx" vpar } + let vadr : Nat := + adrsForsBase t0 l0 ||| (((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| vpar)) + let st3 : RuntimeState := + { st2 with world := { st2.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st2.world.memory 0x20 vadr } } + let st4 : RuntimeState := { st3 with bindings := bindValue st3.bindings "s" sval } + let vnode : Nat := lookupValue st4.bindings "node" + let st5 : RuntimeState := + { st4 with world := { st4.world with memory := SphincsMinusVerifiers.MemoryKit.memUpdate st4.world.memory o5 vnode } } + have hidx256 : idx < 2 ^ 256 := lt_trans hidx (by decide) + have hpathH : lookupValue stH.bindings "pathIdx" = mIdx := by + dsimp [stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "pathIdx" (wordNormalize idx) (by decide)] + exact hpath + have hpath1 : lookupValue st1.bindings "pathIdx" = mIdx := by + dsimp [st1] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + stH.bindings "sibling" "pathIdx" vsib (by decide)] + exact hpathH + have h2 : evalExpr [] st1 (.shr (.literal 1) (.localVar "pathIdx")) = some vpar := by + dsimp [vpar] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_parentIdx_shr + "pathIdx" st1 mIdx hpath1 hmlt + have hvparlt : vpar < 2 ^ 256 := by + dsimp [vpar] + rw [Nat.shiftRight_eq_div_pow] + exact lt_of_le_of_lt (Nat.div_le_self _ _) hmlt + -- The FIPS per-level address word at st2, identified with its OR image. + have hbase2 : lookupValue st2.bindings "forsBase" = adrsForsBase t0 l0 := by + dsimp [st2, st1, stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) + "parentIdx" "forsBase" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "forsBase" vsib (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "forsBase" (wordNormalize idx) (by decide)] + exact hbaseS + have hh2 : lookupValue st2.bindings "h" = idx := by + dsimp [st2, st1, stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) + "parentIdx" "h" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "h" vsib (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt hidx256] + have hi2 : lookupValue st2.bindings "i" = i := by + dsimp [st2, st1, stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) + "parentIdx" "i" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "i" vsib (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "i" (wordNormalize idx) (by decide)] + exact hi + have hp2 : lookupValue st2.bindings "parentIdx" = vpar := by + dsimp [st2] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + have h3 : evalExpr [] st2 forsAdrs = some vadr := + forsAdrs_eval_eq st2 hbase2 hbaseLt hh2 hidx hi2 hiLt hp2 hvparlt + have hpath3 : lookupValue st3.bindings "pathIdx" = mIdx := by + dsimp [st3, st2, st1] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue stH.bindings "sibling" vsib) "parentIdx" "pathIdx" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + stH.bindings "sibling" "pathIdx" vsib (by decide)] + exact hpathH + have h4 : evalExpr [] st3 + (.shl (.literal 5) (.bitAnd (.localVar "pathIdx") (.literal 1))) = some sval := by + dsimp [sval] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_selector_shl + "pathIdx" st3 mIdx hpath3 hmlt + have hsvalt : sval < 2 ^ 256 := by + dsimp [sval] + rw [Nat.shiftLeft_eq] + exact Nat.lt_of_le_of_lt (Nat.mul_le_mul Nat.and_le_right (le_refl _)) (by decide) + have hs4 : lookupValue st4.bindings "s" = sval := by + dsimp [st4] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + have h5off : evalExpr [] st4 (.bitXor (.literal 0x40) (.localVar "s")) = some o5 := by + dsimp [o5] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_childOffset_xor + st4 0x40 sval hs4 (by decide) hsvalt + have h5val : evalExpr [] st4 (.localVar "node") = some vnode := by + rfl + have hs5 : lookupValue st5.bindings "s" = sval := by + dsimp [st5] + exact hs4 + have h6off : evalExpr [] st5 (.bitXor (.literal 0x60) (.localVar "s")) = some o6 := by + dsimp [o6] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.eval_childOffset_xor + st5 0x60 sval hs5 (by decide) hsvalt + have h6val : evalExpr [] st5 (.localVar "sibling") = some vsib := by + show some (lookupValue st5.bindings "sibling") = some vsib + dsimp [st5, st4, st3, st2, st1] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue stH.bindings "sibling" vsib) "parentIdx" vpar) + "s" "sibling" sval (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue stH.bindings "sibling" vsib) "parentIdx" "sibling" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] + have hpar : mIdx % 2 = 0 ∨ mIdx % 2 = 1 := by + have hlt : mIdx % 2 < 2 := Nat.mod_lt mIdx (by decide) + omega + have hparOff : (mIdx % 2 = 0 ∧ o5 = 0x40 ∧ o6 = 0x60) + ∨ (mIdx % 2 = 1 ∧ o5 = 0x60 ∧ o6 = 0x40) := by + rcases hpar with hzero | hone + · left + have ho := SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_offsets_even mIdx hzero + have ho5 : o5 = 0x40 := by + dsimp [o5, sval] + change (0x40 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x40 + exact ho.1 + have ho6 : o6 = 0x60 := by + dsimp [o6, sval] + change (0x60 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x60 + exact ho.2 + exact ⟨hzero, ho5, ho6⟩ + · right + have ho := SphincsMinusVerifiers.ClimbMemFrameMerkle.merkle_offsets_odd mIdx hone + have ho5 : o5 = 0x60 := by + dsimp [o5, sval] + change (0x40 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x60 + exact ho.1 + have ho6 : o6 = 0x40 := by + dsimp [o6, sval] + change (0x60 : Nat) ^^^ ((mIdx &&& 1) <<< 5) = 0x40 + exact ho.2 + exact ⟨hone, ho5, ho6⟩ + have hvparEq : vpar = mIdx / 2 := by + dsimp [vpar] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.parentIdx_shiftRight mIdx + have hnode : wordNormalize vnode = node := by + dsimp [vnode, st4, st3, st2, st1, stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) + "parentIdx" vpar) "s" "node" sval (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) + "parentIdx" "node" vpar (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + (bindValue s.bindings "h" (wordNormalize idx)) "sibling" "node" vsib (by decide)] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "node" (wordNormalize idx) (by decide)] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.node hframe.1 + have hseed : (stH.world.memory 0x00).val = seed := by + dsimp [stH] + exact hframe.2.2.2.1 + -- The address-word data obligation: the eval value is the spec node address. + have hVlt : vadr < 2 ^ 256 := + forsAdrs_value_lt (adrsForsBase t0 l0) i idx vpar hbaseLt hiLt hidx hvparlt + have hadrW : wordNormalize vadr + = adrsForsNode t0 l0 i idx (mIdx / 2) := by + rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt hVlt] + show adrsForsBase t0 l0 ||| (((idx + 1) <<< 32) ||| ((i <<< (18 - idx)) ||| vpar)) + = adrsForsNode t0 l0 i idx (mIdx / 2) + rw [hvparEq] + exact SphincsMinusVerifiers.ClimbStepSpec.forsBase_node_address t0 l0 i idx (mIdx / 2) + have hsib : wordNormalize vsib + = wordOfHash16 ((auth[idx]?).getD ⟨#[]⟩) := by + rw [hvsibDef, SphincsMinusVerifiers.ClimbMemFrameMerkle.wordNormalize_maskN] + exact hdata + have hstepData : + SphincsMinusVerifiers.ClimbMemFrameMerkle.StepDataObligationsW + stH vadr vsib seed (adrsForsNode t0 l0 i idx (mIdx / 2)) idx mIdx auth := + ⟨hseed, hadrW, hsib⟩ + have hframeH := SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame_h_inject + "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed (adrsForsBase t0 l0) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + s (mIdx, node) (wordNormalize idx) hframe + have hfinal := SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrameA_step + "node" "pathIdx" "forsBase" "authPtr" forsAdrs + pkSeed pkRoot message sig seed (adrsForsBase t0 l0) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + (adrsForsNode t0 l0 i idx (mIdx / 2)) + stH vsib vpar vadr sval o5 vnode o6 vsib idx mIdx node auth + hframeH hparOff hvparEq hnode hstepData h1 h2 h3 h4 h5off h5val h6off h6val + -- "i" is framed through the step. + have hiStep : lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings - "i" = t := by - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInner_preserves_i - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) hInnerExec, - hiSetup] - have hStoreSeed := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStore_preserves_seed_slot_range - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) t ht hiInner hStoreExec - have hsetupSite : - ForsFrozenSite t pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := - forsLeafSetupStep_forsFrozenSite st t pkSeed pkRoot message sig - hi ht hsigBase hsel hcd - have hInnerSeed := - forsLeafInnerStep_preserves_seed_slot_of_forsFrozenSite + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs + stH).bindings "i" = i := by + rw [SphincsMinusVerifiers.ClimbMemFrameMerkle.stepMerkleA_binding_frozen + "node" "pathIdx" "authPtr" "i" forsAdrs stH + vsib vpar vadr sval o5 vnode o6 vsib + (by decide) (by decide) (by decide) (by decide) (by decide) + h1 h2 h3 h4 h5off h5val h6off h6val] + dsimp [stH] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + s.bindings "h" "i" (wordNormalize idx) (by decide)] + exact hi + refine ⟨?_, ?_, ?_⟩ + · show SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame + "node" "pathIdx" "forsBase" "authPtr" + pkSeed pkRoot message sig seed (adrsForsBase t0 l0) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + (SphincsMinusVerifiers.ClimbKit.stepMerkleA "node" "pathIdx" "authPtr" forsAdrs stH) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + seed i t0 l0 auth idx (mIdx, node)) + simp only [SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep] + exact hfinal + · exact hiStep + · show (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + seed i t0 l0 auth idx (mIdx, node)).1 < 2 ^ 256 + simp only [SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep] + exact Nat.lt_of_le_of_lt (Nat.div_le_self mIdx 2) hmlt + +/-- Initial FORS climb relation after the straight-line setup prefix. The index +component is the decoded `treeIdx`, and the node component is the concrete spec +FORS leaf hash word under the FIPS leaf address `adrsForsLeaf t0 l0 i treeIdx`. -/ +theorem forsLeafSetupStep_initial_forsClimbRel_of_eval + (st : RuntimeState) (seed i t0 l0 treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) + (hm0 : (st.world.memory 0).val = seed) + (hAdrLt : adrsForsLeaf t0 l0 i treeIdx < 2 ^ 256) + (hSkLt : wordOfHash16 sk < 2 ^ 256) + (hTree : evalExpr [] st + (.bitAnd + (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) + (.literal 0x7FFFF)) = some treeIdx) + (hSecret : evalExpr [] + { st with bindings := bindValue st.bindings "treeIdx" treeIdx } + (.bitAnd + (.calldataload + (.add (.localVar "sigBase") + (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) + (.literal N_MASK)) + = some (wordOfHash16 sk)) + (hLeaf : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (adrsForsLeaf t0 l0 i treeIdx)) : + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - t pkSeed pkRoot message sig ht hsetupSite - have hSetupSeed := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_seed_slot st - rw [hStoreSeed, hInnerSeed, hSetupSeed] + (treeIdx, maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) := by + refine SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.intro ?_ ?_ + · exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_pathIdx_eq_of_eval + st treeIdx hTree + · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_node_eq_spec_of_eval + st seed (adrsForsLeaf t0 l0 i treeIdx) treeIdx sk hm0 hAdrLt hSkLt hTree hSecret hLeaf] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.wordNormalize_maskN _ -/-- One concrete FORS leaf iteration preserves an ordinary root slot different -from the leaf being stored, using the actual local setup facts rather than an -arbitrary-state site premise. -/ -theorem forsLeafStep_preserves_root_cell_ne_of_forsFrozenSetup - (st : RuntimeState) (j t : Nat) +/-- Initial frame-carrying FORS climb invariant after the straight-line setup: +the relation component from the setup evaluators, the static frame from the +frozen C13 layout, and the `"i"` binding framed through the setup prefix. -/ +theorem forsLeafSetupStep_initial_forsClimbFrameI + (st : RuntimeState) (seed i t0 l0 treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) (pkSeed pkRoot message sig : ByteArray) - (hi : lookupValue st.bindings "i" = t) - (ht : t < 6) - (hne : j ≠ t) + (hi : lookupValue st.bindings "i" = i) + (hiLt : i < 6) + (hTreeIdxLt : treeIdx < 2 ^ 256) + (hbaseSt : lookupValue st.bindings "forsBase" = adrsForsBase t0 l0) (hsigBase : lookupValue st.bindings "sigBase" = SphincsMinusVerifiers.MkC13State.sigDataOffset) (hsel : st.selector = 0) (hcd : st.world.calldata = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory - (0x80 + 32 * j)).val - = (st.world.memory (0x80 + 32 * j)).val := by - have hbody : - execStmtList [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody - = .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := - SphincsMinusVerifiers.SegmentS4Fors.execForsLeaf st - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_eq_segments, - SphincsMinusVerifiers.MemoryKit.execStmtList_append_continue - st (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupBody - [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt, - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] - (SphincsMinusVerifiers.SegmentS4Fors.execForsLeafSetup st)] at hbody - have hInnerExec : - execStmt [] (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt = - .continue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) := - SphincsMinusVerifiers.SegmentS4Fors.execForsLeafInner - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - rw [execStmtList_cons_continue _ _ _ - [SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt] hInnerExec] at hbody - have hStoreExec : - execStmt [] - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStoreStmt = - .continue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) := by - simpa using hbody - have hiSetup : - lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st).bindings - "i" = t := by - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_i st, hi] - have hiInner : - lookupValue - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings - "i" = t := by - rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInner_preserves_i - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) hInnerExec, - hiSetup] - have hStoreRoot := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStore_preserves_root_cell_range_ne - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)) - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st) j t ht hiInner hne hStoreExec - have hsetupSite : - ForsFrozenSite t pkSeed pkRoot message sig - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) := - forsLeafSetupStep_forsFrozenSite st t pkSeed pkRoot message sig - hi ht hsigBase hsel hcd - have hInnerRoot := - forsLeafInnerStep_preserves_root_cell_of_forsFrozenSite + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (hm0 : (st.world.memory 0).val = seed) + (hAdrLt : adrsForsLeaf t0 l0 i treeIdx < 2 ^ 256) + (hSkLt : wordOfHash16 sk < 2 ^ 256) + (hTree : evalExpr [] st + (.bitAnd + (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) + (.literal 0x7FFFF)) = some treeIdx) + (hSecret : evalExpr [] + { st with bindings := bindValue st.bindings "treeIdx" treeIdx } + (.bitAnd + (.calldataload + (.add (.localVar "sigBase") + (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) + (.literal N_MASK)) + = some (wordOfHash16 sk)) + (hLeaf : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (adrsForsLeaf t0 l0 i treeIdx)) : + ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st) - j t pkSeed pkRoot message sig ht hsetupSite - have hSetupRoot := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_root_cell_range st j - rw [hStoreRoot, hInnerRoot, hSetupRoot] - -/-- One FORS leaf iteration preserves every other ordinary root slot over the -real outer range when each inner Merkle step carries the frozen C13 -calldata/auth-path frame. -/ -theorem forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata - (st : RuntimeState) (j t : Nat) (ht : t < 6) - (hi : lookupValue st.bindings "i" = t) (hne : j ≠ t) - (pkSeed pkRoot message sig : ByteArray) - (hsite : ∀ (s : RuntimeState) (idx : Nat), idx < 19 → - ∃ base, - s.selector = 0 ∧ - s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ - lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ - base < 2 ^ 256 ∧ - lookupValue s.bindings "pathIdx" < 2 ^ 256) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory - (0x80 + 32 * j)).val = - (st.world.memory (0x80 + 32 * j)).val := by - exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_root_cell_range_ne_of_inner - st j t ht hi hne - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_root_cell_range st j) - (forsLeafInner_preserves_memory_val_range_of_step - (0x80 + 32 * j) (fun idx => idx < 19) - (fun s idx hidx => by - rcases hsite s idx hidx with - ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - exact stepMerkle_preserves_root_cell_of_fors_frozen_calldata - s j t idx base pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt ht hidx) - (fun i _ hi => by - have hnorm : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - rw [hnorm] at hi - omega)) + (treeIdx, maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) := by + rcases SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_selector_calldata + st with ⟨hselStep, hcdStep⟩ + refine ⟨⟨?_, ?_, ?_, ?_, ?_, ?_, + (by decide), (by decide), (by decide), (by decide), (by decide), + (by decide), (by decide), (by decide), (by decide), + (by decide), (by decide), (by decide), (by decide), (by decide), (by decide), + (by decide), (by decide), (by decide), (by decide), (by decide), (by decide)⟩, + ?_, hTreeIdxLt⟩ + · exact forsLeafSetupStep_initial_forsClimbRel_of_eval + st seed i t0 l0 treeIdx sk hm0 hAdrLt hSkLt hTree hSecret hLeaf + · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_forsBase st] + exact hbaseSt + · have hsigBase164 : lookupValue st.bindings "sigBase" = 164 := by + simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hsigBase + have hap := + SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_authPtr_eq_sigDataOffset + st i hi hsigBase164 hiLt + simpa [SphincsMinusVerifiers.MkC13State.sigDataOffset] using hap + · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_seed_slot] + exact hm0 + · rw [hselStep, hsel] + · rw [hcdStep, hcd] + · rw [SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep_preserves_i st, hi] -/-- Outer FORS carry for an ordinary root cell with the suffix-preservation -premise discharged from frozen C13 calldata/auth-path facts. The conclusion is -still local to the model state: callers must separately identify the -iteration-local post-inner `"node"` with the corresponding spec root word. -/ -theorem forsOuter_root_cell_eq_iteration_node_of_fors_frozen_calldata - (st : RuntimeState) (j : Nat) (hj : j < 6) +/-- **`forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata`** — +concrete frozen-calldata post-inner FORS node correspondence on the FIPS layout: +after the straight-line setup and 19 climb iterations, the model's `"node"` +binding is exactly the spec `forsClimb` at the FIPS digits `t0`/`l0`. Callers +provide the parsed auth-path `MerkleClimbData` range and the straight-line setup +eval facts. -/ +theorem forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata + (st : RuntimeState) (seed i t0 l0 treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) (pkSeed pkRoot message sig : ByteArray) - (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → - ∃ base, - s.selector = 0 ∧ - s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ - lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ - base < 2 ^ 256 ∧ - lookupValue s.bindings "pathIdx" < 2 ^ 256) : - ((SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 (wordNormalize 6)).world.memory (0x80 + 32 * j)).val = + (auth : List SphincsMinusVerifierSpec.Bytes) + (hi : lookupValue st.bindings "i" = i) + (hiLt : i < 6) + (hTreeIdxLt : treeIdx < 2 ^ 256) + (hbaseSt : lookupValue st.bindings "forsBase" = adrsForsBase t0 l0) + (ht0 : t0 < 2 ^ 64) (hl0 : l0 < 2 ^ 32) + (hsigBase : lookupValue st.bindings "sigBase" + = SphincsMinusVerifiers.MkC13State.sigDataOffset) + (hsel : st.selector = 0) + (hcd : st.world.calldata + = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth + (fun h => + Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + + (128 + 304 * i) + 16 * h)) idx) + (hm0 : (st.world.memory 0).val = seed) + (hAdrLt : adrsForsLeaf t0 l0 i treeIdx < 2 ^ 256) + (hSkLt : wordOfHash16 sk < 2 ^ 256) + (hTree : evalExpr [] st + (.bitAnd + (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) + (.literal 0x7FFFF)) = some treeIdx) + (hSecret : evalExpr [] + { st with bindings := bindValue st.bindings "treeIdx" treeIdx } + (.bitAnd + (.calldataload + (.add (.localVar "sigBase") + (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) + (.literal N_MASK)) + = some (wordOfHash16 sk)) + (hLeaf : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (adrsForsLeaf t0 l0 i treeIdx)) : + wordNormalize + (lookupValue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") + = + SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 19 0 treeIdx + (maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) auth := by + let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st + let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } + let node0 := maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk]) + have hInit : + ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig setup (treeIdx, node0) := + forsLeafSetupStep_initial_forsClimbFrameI + st seed i t0 l0 treeIdx sk pkSeed pkRoot message sig + hi hiLt hTreeIdxLt hbaseSt hsigBase hsel hcd + hm0 hAdrLt hSkLt hTree hSecret hLeaf + have hStart : + ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig start (treeIdx, node0) := + ForsClimbFrameI.h_inject (wordNormalize 0) hInit + let D : Nat → Prop := fun idx => + idx < 19 ∧ + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth + (fun h => + Compiler.Proofs.YulGeneration.calldataloadWord 0 + (SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size + ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig) + (SphincsMinusVerifiers.MkC13State.sigDataOffset + + (128 + 304 * i) + 16 * h)) idx + have hD' : ∀ idx, 0 ≤ idx → idx < 0 + 19 → D idx := by + intro idx h0 hlt + exact ⟨by omega, hD idx h0 hlt⟩ + have hpair := + SphincsMinusVerifiers.ClimbLoop.foldLoop_invariant_cond "h" + stepForsMerkle + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep seed i t0 l0 auth) + (ForsClimbFrameI i t0 l0 seed + (SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * i)) + pkSeed pkRoot message sig) + D + (fun s a idx hDi hR => by + obtain ⟨mIdx, nd⟩ := a + exact stepFors_forsClimbFrameI_hstep_of_fors_frozen_calldata + s i t0 l0 idx mIdx nd seed pkSeed pkRoot message sig auth + hR hiLt hDi.1 ht0 hl0 hDi.2) + start (treeIdx, node0) 0 19 hD' hStart + have hnode : + wordNormalize + (lookupValue + (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle + start 0 19).bindings "node") + = + (SphincsMinusVerifiers.ClimbLoop.specFold + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep seed i t0 l0 auth) + (treeIdx, node0) 0 19).2 := + (SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbFrame.toRel hpair.1).2 + have hmodel : wordNormalize + (lookupValue + (SphincsMinusVerifiers.ClimbLoop.foldLoop "h" stepForsMerkle + start 0 19).bindings "node") + = + SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 19 0 treeIdx node0 auth := + hnode.trans + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsClimb_eq_specFold + seed i t0 l0 auth 19 0 treeIdx node0).symm + have h19 : wordNormalize 19 = 19 := by + rw [wordNormalize_eq_mod, + show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] + unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + rw [h19] + exact hmodel + +/-- Conditional post-inner FORS node correspondence for one normal C13 FORS tree +with a caller-supplied per-step relation advance (the bare-relation form used +by the seven-root data obligations). -/ +theorem forsLeafInnerStep_node_eq_forsClimb_of_eval + (st : RuntimeState) (seed i t0 l0 treeIdx : Nat) (sk : SphincsMinusVerifierSpec.Bytes) + (auth : List SphincsMinusVerifierSpec.Bytes) (cdAt : Nat → Nat) + (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" + (stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + seed i t0 l0 auth idx a)) + (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData auth cdAt idx) + (hm0 : (st.world.memory 0).val = seed) + (hAdrLt : adrsForsLeaf t0 l0 i treeIdx < 2 ^ 256) + (hSkLt : wordOfHash16 sk < 2 ^ 256) + (hTree : evalExpr [] st + (.bitAnd + (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) + (.literal 0x7FFFF)) = some treeIdx) + (hSecret : evalExpr [] + { st with bindings := bindValue st.bindings "treeIdx" treeIdx } + (.bitAnd + (.calldataload + (.add (.localVar "sigBase") + (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) + (.literal N_MASK)) + = some (wordOfHash16 sk)) + (hLeaf : evalExpr [] + { st with bindings := + bindValue (bindValue st.bindings "treeIdx" treeIdx) "secretVal" (wordOfHash16 sk) } + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (adrsForsLeaf t0 l0 i treeIdx)) : + wordNormalize (lookupValue (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep - (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep - { (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 j) with - bindings := - bindValue - (SphincsMinusVerifiers.ClimbLoop.foldLoop "i" SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep - { st with bindings := bindValue st.bindings "i" (wordNormalize 0) } - 0 j).bindings "i" (wordNormalize j) })).bindings "node") := by - exact SphincsMinusVerifiers.SegmentS4Fors.forsOuter_root_cell_eq_iteration_node_of_suffix_preserves - st j hj - (fun s t hgt ht => by - have hi : lookupValue (bindValue s.bindings "i" (wordNormalize t)) "i" = t := by - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (lt_trans ht (by decide))] - exact forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata - { s with bindings := bindValue s.bindings "i" (wordNormalize t) } - j t ht hi (by omega) pkSeed pkRoot message sig - (fun s idx hidx => hsite s t idx ht hidx)) - -/-- S4-shaped range-gated adapter for the FORS inner Merkle climb. The per-step -seed-frame premise may depend on a predicate over the actual inner height. -/ -theorem forsLeafInner_preserves_seed_slot_range_of_step - (D : Nat → Prop) - (hstep : ∀ (s : RuntimeState) (idx : Nat), D idx → - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }).world.memory 0).val - = (s.world.memory 0).val) - (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize 19 → D i) - (st s' : RuntimeState) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := by - exact SphincsMinusVerifiers.ClimbMemFrameMerkle.execStmt_forEach_h_merkleClimb_preserves_memory_val_range - "node" "pathIdx" "treeAdrsBase" "authPtr" 0 19 D hstep st s' hD - (by simpa [SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStmt] using h) - -/-- One FORS leaf iteration preserves `mem[0x00]` over the real outer range once -the inner Merkle step has a bounded-index seed-frame proof. -/ -theorem forsLeafStep_preserves_seed_slot_range_of_merkle_step_bound - (st : RuntimeState) (idx : Nat) (hidx : idx < 6) - (hi : lookupValue st.bindings "i" = idx) - (hstep : ∀ (s : RuntimeState) (hidx : Nat), - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val - = (s.world.memory 0).val) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val - = (st.world.memory 0).val := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_seed_slot_range_of_inner - st idx hidx hi - (forsLeafInner_preserves_seed_slot_bound_of_step hstep) - -/-- Range-gated version of -`forsLeafStep_preserves_seed_slot_range_of_merkle_step_bound`. -/ -theorem forsLeafStep_preserves_seed_slot_range_of_merkle_step_range - (D : Nat → Prop) - (st : RuntimeState) (idx : Nat) (hidx : idx < 6) - (hi : lookupValue st.bindings "i" = idx) - (hstep : ∀ (s : RuntimeState) (hidx : Nat), D hidx → - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val - = (s.world.memory 0).val) - (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize 19 → D i) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val - = (st.world.memory 0).val := - SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep_preserves_seed_slot_range_of_inner - st idx hidx hi - (forsLeafInner_preserves_seed_slot_range_of_step D hstep hD) - -/-- Full FORS outer-loop seed-cell frame reduced to a bounded-index -per-`stepMerkle` seed-frame proof for the inner Merkle climb. -/ -theorem execForsOuter_preserves_seed_slot_range_of_merkle_step_bound - (st s' : RuntimeState) - (hstep : ∀ (s : RuntimeState) (hidx : Nat), - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val - = (s.world.memory 0).val) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsOuterStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := - SphincsMinusVerifiers.SegmentS4Fors.execForsOuter_preserves_seed_slot_range_six - st s' - (fun s idx hidx s'' hexec => by - have hi : lookupValue (bindValue s.bindings "i" (wordNormalize idx)) "i" = idx := by - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (lt_trans hidx (by decide))] - exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_preserves_seed_slot_range_of_inner - { s with bindings := bindValue s.bindings "i" (wordNormalize idx) } - s'' idx hidx hi - (forsLeafInner_preserves_seed_slot_bound_of_step hstep) - hexec) - h - -/-- Range-gated version of -`execForsOuter_preserves_seed_slot_range_of_merkle_step_bound`. -/ -theorem execForsOuter_preserves_seed_slot_range_of_merkle_step_range - (D : Nat → Prop) - (st s' : RuntimeState) - (hstep : ∀ (s : RuntimeState) (hidx : Nat), D hidx → - ((stepMerkle "node" "pathIdx" "treeAdrsBase" "authPtr" - { s with bindings := bindValue s.bindings "h" (wordNormalize hidx) }).world.memory 0).val - = (s.world.memory 0).val) - (hD : ∀ i, 0 ≤ i → i < 0 + wordNormalize 19 → D i) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsOuterStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := - SphincsMinusVerifiers.SegmentS4Fors.execForsOuter_preserves_seed_slot_range_six - st s' - (fun s idx hidx s'' hexec => by - have hi : lookupValue (bindValue s.bindings "i" (wordNormalize idx)) "i" = idx := by - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (lt_trans hidx (by decide))] - exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_preserves_seed_slot_range_of_inner - { s with bindings := bindValue s.bindings "i" (wordNormalize idx) } - s'' idx hidx hi - (forsLeafInner_preserves_seed_slot_range_of_step D hstep hD) - hexec) - h - -/-- Full FORS outer-loop seed-cell frame reduced to the S4-shaped per-step eval -site facts: path-index boundedness, masked sibling calldata read, and address -assembly eval at each inner Merkle height. -/ -theorem execForsOuter_preserves_seed_slot_range_of_s4_eval - (st s' : RuntimeState) - (hsite : ∀ (s : RuntimeState) (idx : Nat), - ∃ vsib vadr, - lookupValue s.bindings "pathIdx" < 2 ^ 256 ∧ - evalExpr [] { s with bindings := bindValue s.bindings "h" (wordNormalize idx) } - (.bitAnd (.calldataload (.add (.localVar "authPtr") - (.shl (.literal 4) (.localVar "h")))) (.literal SphincsMinusVerifiers.ClimbKit.N_MASK)) - = some vsib ∧ - evalExpr [] - { s with bindings := - (bindValue - (bindValue (bindValue s.bindings "h" (wordNormalize idx)) "sibling" vsib) - "parentIdx" (lookupValue s.bindings "pathIdx" >>> 1)) } - (.bitOr (.localVar "treeAdrsBase") - (.bitOr (.shl (.literal 32) (.add (.localVar "h") (.literal 1))) - (.localVar "parentIdx"))) = some vadr) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsOuterStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := - execForsOuter_preserves_seed_slot_range_of_merkle_step_bound st s' - (fun s idx => by - rcases hsite s idx with ⟨vsib, vadr, hlt, h1, h3⟩ - exact stepMerkle_preserves_seed_slot_of_s4_eval - s idx (lookupValue s.bindings "pathIdx") vsib vadr rfl hlt h1 h3) - h + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") + = + SphincsMinusVerifierSpec.C13Concrete.forsClimb seed i t0 l0 19 0 treeIdx + (maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) auth := by + let setup := SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st + let start : RuntimeState := { setup with bindings := bindValue setup.bindings "h" (wordNormalize 0) } + have hR0 : + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" + setup + (treeIdx, maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) := + forsLeafSetupStep_initial_forsClimbRel_of_eval st seed i t0 l0 treeIdx sk + hm0 hAdrLt hSkLt hTree hSecret hLeaf + have hR : + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" + start + (treeIdx, maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) := by + refine SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.intro ?_ ?_ + · dsimp [start] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + setup.bindings "h" "pathIdx" (wordNormalize 0) (by decide)] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.idx hR0 + · dsimp [start] + rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_ne + setup.bindings "h" "node" (wordNormalize 0) (by decide)] + exact SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel.node hR0 + have hmodel := + SphincsMinusVerifiers.ClimbMemFrameMerkle.forsClimb_model_node + seed i t0 l0 auth cdAt hstep start treeIdx + (maskN (keccakWords [seed, adrsForsLeaf t0 l0 i treeIdx, wordOfHash16 sk])) + 0 19 hD hR + have h19 : wordNormalize 19 = 19 := by + rw [wordNormalize_eq_mod, + show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, + Nat.mod_eq_of_lt (by decide : 19 < 2 ^ 256)] + unfold SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + rw [h19] + exact hmodel -/-- One FORS leaf iteration preserves `mem[0x00]` over the real outer range once -each inner Merkle step carries the frozen C13 calldata/auth-path frame. The -remaining premises are precisely the setup facts for the threaded inner states: -selector/calldata stability, `authPtr`, `treeAdrsBase`, and bounded `pathIdx`. -/ -theorem forsLeafStep_preserves_seed_slot_range_of_fors_frozen_calldata - (st : RuntimeState) (t : Nat) (ht : t < 6) - (hi : lookupValue st.bindings "i" = t) - (pkSeed pkRoot message sig : ByteArray) - (hsite : ∀ (s : RuntimeState) (idx : Nat), idx < 19 → - ∃ base, - s.selector = 0 ∧ - s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ - lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ - base < 2 ^ 256 ∧ - lookupValue s.bindings "pathIdx" < 2 ^ 256) : - ((SphincsMinusVerifiers.SegmentS4Fors.forsLeafStep st).world.memory 0).val - = (st.world.memory 0).val := - forsLeafStep_preserves_seed_slot_range_of_merkle_step_range - (fun idx => idx < 19) st t ht hi - (fun s idx hidx => by - rcases hsite s idx hidx with - ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - exact stepMerkle_preserves_seed_slot_of_fors_frozen_calldata - s t idx base pkSeed pkRoot message sig hsel hcd hap hbase hbaselt hpathlt ht hidx) - (fun i _ hi => by - have hnorm : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - rw [hnorm] at hi - omega) +/-- C13 normal-root form of `forsLeafInnerStep_node_eq_forsClimb_of_eval`, at +the digest-derived FIPS digits. This is the exact post-inner `"node"` equality +expected by the six normal FORS root-cell adapters. -/ +theorem forsLeafInnerStep_node_eq_forsAllRootsC13_getElem_of_eval + (st : RuntimeState) (pk : SphincsMinusVerifierSpec.PublicKey) + (digest : SphincsMinusVerifierSpec.HMsg) + (fors : SphincsMinusVerifierSpec.ForsSig) (j : Nat) (hj : j < 6) + (cdAt : Nat → Nat) + (hstep : ∀ (s : RuntimeState) (a : Nat × Nat) (idx : Nat), + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData + ((fors.authPath[j]?).getD []) cdAt idx → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" s a → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbRel "node" "pathIdx" + (stepForsMerkle + { s with bindings := bindValue s.bindings "h" (wordNormalize idx) }) + (SphincsMinusVerifiers.ClimbMemFrameMerkle.forsSpecStep + (wordOfHash16 pk.pkSeed) j + (SphincsMinusVerifierSpec.C13Concrete.idxTree0C13 digest) + (SphincsMinusVerifierSpec.C13Concrete.idxLeaf0C13 digest) + ((fors.authPath[j]?).getD []) idx a)) + (hD : ∀ idx, 0 ≤ idx → idx < 0 + 19 → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData + ((fors.authPath[j]?).getD []) cdAt idx) + (hm0 : (st.world.memory 0).val = wordOfHash16 pk.pkSeed) + (hAdrLt : adrsForsLeaf + (SphincsMinusVerifierSpec.C13Concrete.idxTree0C13 digest) + (SphincsMinusVerifierSpec.C13Concrete.idxLeaf0C13 digest) + j ((digest.forsIndex[j]?).getD 0) < 2 ^ 256) + (hSkLt : wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩) < 2 ^ 256) + (hTree : evalExpr [] st + (.bitAnd + (.shr (.mul (.localVar "i") (.literal 19)) (.localVar "dVal")) + (.literal 0x7FFFF)) = some ((digest.forsIndex[j]?).getD 0)) + (hSecret : evalExpr [] + { st with bindings := bindValue st.bindings "treeIdx" ((digest.forsIndex[j]?).getD 0) } + (.bitAnd + (.calldataload + (.add (.localVar "sigBase") + (.add (.literal 16) (.shl (.literal 4) (.localVar "i"))))) + (.literal N_MASK)) + = some (wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩))) + (hLeaf : evalExpr [] + { st with bindings := + (bindValue + (bindValue st.bindings "treeIdx" ((digest.forsIndex[j]?).getD 0)) + "secretVal" (wordOfHash16 ((fors.sk[j]?).getD ⟨#[]⟩))) } + (.bitOr (.localVar "forsBase") + (.bitOr (.shl (.literal 19) (.localVar "i")) (.localVar "treeIdx"))) + = some (adrsForsLeaf + (SphincsMinusVerifierSpec.C13Concrete.idxTree0C13 digest) + (SphincsMinusVerifierSpec.C13Concrete.idxLeaf0C13 digest) + j ((digest.forsIndex[j]?).getD 0))) : + wordNormalize + (lookupValue + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafInnerStep + (SphincsMinusVerifiers.SegmentS4Fors.forsLeafSetupStep st)).bindings "node") + = + (SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13 pk digest fors)[j]'(by + rw [SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13_length] + omega) := by + rw [SphincsMinusVerifierSpec.C13Concrete.forsAllRootsC13_getElem_normal + (pk := pk) (digest := digest) (fors := fors) hj] + exact forsLeafInnerStep_node_eq_forsClimb_of_eval + st (wordOfHash16 pk.pkSeed) j + (SphincsMinusVerifierSpec.C13Concrete.idxTree0C13 digest) + (SphincsMinusVerifierSpec.C13Concrete.idxLeaf0C13 digest) + ((digest.forsIndex[j]?).getD 0) + ((fors.sk[j]?).getD ⟨#[]⟩) ((fors.authPath[j]?).getD []) cdAt + hstep hD hm0 hAdrLt hSkLt hTree hSecret hLeaf -/-- Full FORS outer-loop seed-cell frame reduced to frozen C13 calldata/auth-path -facts for the inner Merkle states. This is the range-gated handoff needed by -the accept-path forced-root bridge: the only remaining work is to supply the -setup facts for the concrete states reached at outer `t < 6` and inner -`idx < 19`. -/ -theorem execForsOuter_preserves_seed_slot_range_of_fors_frozen_calldata - (st s' : RuntimeState) (pkSeed pkRoot message sig : ByteArray) - (hsite : ∀ (s : RuntimeState) (t idx : Nat), t < 6 → idx < 19 → - ∃ base, - s.selector = 0 ∧ - s.world.calldata - = SphincsMinusVerifiers.MkC13State.headWords pkSeed pkRoot message sig.size - ++ SphincsMinusVerifiers.MkC13State.bytesToWords sig ∧ - lookupValue s.bindings "authPtr" - = SphincsMinusVerifiers.MkC13State.sigDataOffset + (128 + 304 * t) ∧ - lookupValue s.bindings "treeAdrsBase" = base ∧ - base < 2 ^ 256 ∧ - lookupValue s.bindings "pathIdx" < 2 ^ 256) - (h : execStmt [] st SphincsMinusVerifiers.SegmentS4Fors.forsOuterStmt - = .continue s') : - (s'.world.memory 0).val = (st.world.memory 0).val := - SphincsMinusVerifiers.SegmentS4Fors.execForsOuter_preserves_seed_slot_range_six - st s' - (fun s t ht s'' hexec => by - have hi : lookupValue (bindValue s.bindings "i" (wordNormalize t)) "i" = t := by - rw [SphincsMinusVerifiers.MemoryKit.lookupValue_bindValue_self] - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (lt_trans ht (by decide))] - exact SphincsMinusVerifiers.SegmentS4Fors.forsLeafBody_preserves_seed_slot_range_of_inner - { s with bindings := bindValue s.bindings "i" (wordNormalize t) } - s'' t ht hi - (forsLeafInner_preserves_seed_slot_range_of_step - (fun idx => idx < 19) - (fun s idx hidx => by - rcases hsite s t idx ht hidx with - ⟨base, hsel, hcd, hap, hbase, hbaselt, hpathlt⟩ - exact stepMerkle_preserves_seed_slot_of_fors_frozen_calldata - s t idx base pkSeed pkRoot message sig - hsel hcd hap hbase hbaselt hpathlt ht hidx) - (fun i _ hi => by - have hnorm : wordNormalize 19 = 19 := by - rw [wordNormalize_eq_mod, show Compiler.Constants.evmModulus = 2 ^ 256 from rfl, - Nat.mod_eq_of_lt (by decide)] - rw [hnorm] at hi - omega)) - hexec) - h +/-! ## 9. Axiom audit (memory-frame half). -/ +#print axioms forsAdrs_eval_eq +#print axioms forsAdrs_value_lt +#print axioms stepFors_preserves_seed_slot_of_s4_eval +#print axioms stepFors_preserves_root_cell_of_s4_eval #print axioms forsLeafInner_preserves_seed_slot_bound_of_step #print axioms forsLeafInner_preserves_memory_val_bound_of_step #print axioms forsLeafInner_preserves_memory_val_range_of_step #print axioms forsLeafStep_preserves_root_cell_range_ne_of_inner_step -#print axioms forsLeafStep_preserves_root_cell_range_ne_of_s4_eval -#print axioms forsOuter_root_cell_eq_iteration_node_of_s4_eval -#print axioms forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata -#print axioms forsOuter_root_cell_eq_iteration_node_of_fors_frozen_calldata -#print axioms forsLeafInner_preserves_seed_slot_range_of_step -#print axioms stepMerkle_forsFrame_hstep_of_s4_data -#print axioms stepMerkle_forsFrame_hstep_of_fors_frozen_calldata -#print axioms stepMerkle_preserves_seed_slot_of_s4_eval -#print axioms stepMerkle_preserves_root_cell_of_s4_eval -#print axioms forsLeafInner_preserves_seed_slot_bound_of_s4_eval -#print axioms s4_address_assembly_eval_exists -#print axioms s4_eval_site_of_frozen_calldata -#print axioms s4_eval_site_of_fors_frozen_calldata -#print axioms forsLeafSetupStep_fors_frozen_calldata_site -#print axioms forsLeafSetupStep_forsFrozenSite -#print axioms forsLeafSetupStep_initial_forsClimbRel_of_eval -#print axioms forsLeafSetupStep_initial_forsClimbFrame_of_eval_site -#print axioms forsLeafInnerStep_node_eq_forsClimb_of_eval -#print axioms forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site -#print axioms forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site_range -#print axioms forsLeafInnerStep_node_eq_forsClimbFrame_of_eval_site_range_path_bound -#print axioms forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata -#print axioms forsLeafInnerStep_node_eq_forsAllRootsC13_getElem_of_eval -#print axioms stepMerkle_preserves_seed_slot_of_fors_frozen_calldata -#print axioms stepMerkle_preserves_root_cell_of_fors_frozen_calldata -#print axioms stepMerkle_preserves_forsFrozenSite +#print axioms s4_sibling_read_of_fors_frozen_calldata +#print axioms stepFors_preserves_seed_slot_of_fors_frozen_calldata +#print axioms stepFors_preserves_root_cell_of_fors_frozen_calldata +#print axioms stepFors_preserves_forsFrozenSite #print axioms foldLoop_preserves_forsFrozenSite_range #print axioms foldLoop_preserves_seed_slot_of_forsFrozenSite_range #print axioms foldLoop_preserves_root_cell_of_forsFrozenSite_range +#print axioms forsLeafSetupStep_fors_frozen_calldata_site +#print axioms forsLeafSetupStep_forsFrozenSite #print axioms forsLeafInnerStep_preserves_seed_slot_of_forsFrozenSite #print axioms forsLeafInnerStep_preserves_root_cell_of_forsFrozenSite #print axioms forsLeafStep_preserves_seed_slot_of_forsFrozenSetup #print axioms forsLeafStep_preserves_root_cell_ne_of_forsFrozenSetup +#print axioms forsLeafStep_preserves_root_cell_range_ne_of_fors_frozen_calldata +#print axioms forsOuter_root_cell_eq_iteration_node_of_fors_frozen_calldata #print axioms forsLeafStep_preserves_seed_slot_range_of_merkle_step_bound #print axioms forsLeafStep_preserves_seed_slot_range_of_merkle_step_range -#print axioms execForsOuter_preserves_seed_slot_range_of_merkle_step_bound -#print axioms execForsOuter_preserves_seed_slot_range_of_merkle_step_range -#print axioms execForsOuter_preserves_seed_slot_range_of_s4_eval #print axioms forsLeafStep_preserves_seed_slot_range_of_fors_frozen_calldata #print axioms execForsOuter_preserves_seed_slot_range_of_fors_frozen_calldata +#print axioms ForsClimbFrameI.h_inject +#print axioms stepFors_forsClimbFrameI_hstep_of_fors_frozen_calldata +#print axioms forsLeafSetupStep_initial_forsClimbRel_of_eval +#print axioms forsLeafSetupStep_initial_forsClimbFrameI +#print axioms forsLeafInnerStep_node_eq_forsClimbFrame_of_fors_frozen_calldata +#print axioms forsLeafInnerStep_node_eq_forsClimb_of_eval +#print axioms forsLeafInnerStep_node_eq_forsAllRootsC13_getElem_of_eval end SphincsMinusVerifiers.SegmentS4ForsMerkleFrame diff --git a/verity/SphincsMinusVerifiers/SegmentSeed.lean b/verity/SphincsMinusVerifiers/SegmentSeed.lean index 6f5e50e..550782f 100644 --- a/verity/SphincsMinusVerifiers/SegmentSeed.lean +++ b/verity/SphincsMinusVerifiers/SegmentSeed.lean @@ -49,7 +49,7 @@ def segmentSeed : List Stmt := /-- Faithfulness: `segmentSeed` is *exactly* statements 22..24 of `c13VerifyBody`. -/ theorem segmentSeed_eq_slice : - segmentSeed = (c13VerifyBodyTail.drop 21).take 3 := rfl + segmentSeed = (c13VerifyBodyTail.drop 24).take 3 := rfl /-! ## 1. The accept-path state transformer. -/ diff --git a/verity/lakefile.lean b/verity/lakefile.lean index d84c982..7aaecfc 100644 --- a/verity/lakefile.lean +++ b/verity/lakefile.lean @@ -2,7 +2,12 @@ import Lake open Lake DSL package SphincsC6Verity where - leanOptions := #[⟨`autoImplicit, false⟩] + -- maxHeartbeats: a runaway whnf/decide aborts as an elaboration error instead + -- of ballooning a lean worker to multi-GB RSS (the proof files here are large + -- enough that 8 parallel workers can OOM a 16 GB machine — always build with + -- `scripts/build.sh` or `lake build -j2`). + leanOptions := #[⟨`autoImplicit, false⟩, + ⟨`maxHeartbeats, (1000000 : Nat)⟩] require verity from "../../verity-framework" @@ -40,6 +45,7 @@ lean_lib SphincsMinusVerifiers where `SphincsMinusVerifiers.ClimbLoopGuarded, `SphincsMinusVerifiers.SegmentS3, `SphincsMinusVerifiers.SegmentSeed, + `SphincsMinusVerifiers.SegmentForsSetup, `SphincsMinusVerifiers.SegmentS4Fors, `SphincsMinusVerifiers.SegmentS4ForsMerkleFrame, `SphincsMinusVerifiers.SegmentS4Finalize, diff --git a/verity/probes/README.md b/verity/probes/README.md new file mode 100644 index 0000000..7234a4d --- /dev/null +++ b/verity/probes/README.md @@ -0,0 +1,39 @@ +# WIP axiom-discharge probes (2026-06-11) + +Standalone probe files validating discharges of the four remaining +composition-glue axioms in `SphincsMinusVerifiers/Proofs.lean` before the +proofs are folded in. Compile from `verity/` with: + +``` +LEAN_NUM_THREADS=2 lake env lean probes/.lean +``` + +(High RAM: ~22 GB RSS each. Run under an RSS watchdog on constrained hosts.) + +- `probe_inputs_layer0.lean` — discharges + `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_inputs_layer0` + (Proofs.lean:11296). Per-fact private lemmas (seed0/d0/adrs0/wptr0/cd0 at + the layer-0 `c13BeforeWotsPkLightState`), each under a fresh + `maxHeartbeats 2000000` budget, consumed via syntactic `rw` against rfl + shape lemmas to avoid whnf blowup of the 64-iteration digit fold. +- `probe_reverted_layer0.lean` — discharges + `c13_reverted_layer0_beforeAuthOff_wotsPk_lightweight_chain_cells_residual` + (Proofs.lean:12014) by reusing the same per-fact lemmas and feeding a + `C13WotsOuterEntry` into + `c13RevertedLayer0_copyFold43_wotsChainsEnd_cells_of_inputs`. +- `probe_layer1.lean` — discharges + `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer1` + (Proofs.lean:11607). Layer-1 analogue of the two layer-0 probes: per-fact + lemmas at the layer-1 `c13BeforeWotsPkLightState` (wotsPtr = + sigDataOffset + (1952 + 868)), feeding a `C13WotsOuterEntry` into + `c13Layer1_copyFold43_wotsChainsEnd_cells_of_inputs`. The `"currentNode"` + fact is derived from the LAYER-0-ONLY residual + `c13_ok_afterMerkle_initial_wotsPk_residual_layer0` (Proofs.lean:11812) — + NOT the layer-1 afterMerkle residual at 11843, which depends on the axiom + being discharged. Folding this proof into Proofs.lean therefore requires + moving the discharged theorem AFTER line 11812 and reordering its + consumers (11645+). + +Once the probes compile with clean `#print axioms`, the helper lemmas and +proofs are folded into Proofs.lean, replacing the two `axiom` declarations, +and this directory is removed. diff --git a/verity/probes/probe_inputs_layer0.lean b/verity/probes/probe_inputs_layer0.lean new file mode 100644 index 0000000..f91381c --- /dev/null +++ b/verity/probes/probe_inputs_layer0.lean @@ -0,0 +1,274 @@ +/- + Probe v2: discharge of the `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_inputs_layer0` + axiom (Proofs.lean:11296), split into per-fact lemmas so each declaration gets + a fresh heartbeat budget and any divergence is localized. +-/ +import SphincsMinusVerifiers.Proofs + +namespace SphincsMinusVerifiers + +open SphincsMinusVerifierSpec +open Compiler.Proofs.IRGeneration.SourceSemantics +open SphincsMinusVerifiers.MkC13State +open SphincsMinusVerifiers.SegmentCompose + +/-- Lightweight entry state world projection (bindings-only updates). -/ +private theorem probe_light_world (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).world = (SegmentLayer3.afterDigit ls).world := rfl + +/-- Lightweight entry state bindings shape. -/ +private theorem probe_light_bindings (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).bindings = + bindValue + (bindValue (SegmentLayer3.afterDigit ls).bindings "wotsPtr" + ((evalExpr [] (SegmentLayer3.afterDigit ls) + (.add (.localVar "sigBase") (.localVar "sigOff"))).getD 0)) + "i" (wordNormalize 0) := rfl + +/-- The two trailing `letVar`s of the pre-checksum prefix (`"d"`, `"digitSum"`) +preserve every other binding from the pre-digest cutpoint. -/ +private theorem probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (ls : RuntimeState) (key : String) + (hneD : "d" ≠ key) (hneSum : "digitSum" ≠ key) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings key = + lookupValue (SegmentLayer3.beforeDigest ls).bindings key := by + have h : execStmtList [] ls + (SegmentLayer3.prefixBeforeDigest ++ + [ Compiler.CompilationModel.Stmt.letVar "d" + (.keccak256 (.literal 0x00) (.literal 0x80)) + , Compiler.CompilationModel.Stmt.letVar "digitSum" (.literal 0) ]) = + .continue (SegmentLayer3.beforeDigitLoop ls) := + SegmentLayer3.beforeDigitLoop_eq ls + rw [MemoryKit.execStmtList_append_continue _ _ _ _ + (SegmentLayer3.beforeDigest_eq ls)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "d" _ _ rfl)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "digitSum" _ _ rfl)] at h + have hnil : ∀ (s : RuntimeState), execStmtList [] s [] = StmtResult.continue s := + fun _ => rfl + rw [hnil] at h + have he := StmtResult.continue.inj h + rw [← he] + rw [MemoryKit.lookupValue_bindValue_ne _ "digitSum" key _ hneSum] + rw [MemoryKit.lookupValue_bindValue_ne _ "d" key _ hneD] + +/-- The pre-checksum prefix does not rebind `"sigOff"`. -/ +private theorem probe_beforeDigitLoop_preserves_sigOff (ls : RuntimeState) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings "sigOff" = + lookupValue ls.bindings "sigOff" := by + refine BindingFrame.execStmtList_preserves_lookup "sigOff" + SegmentLayer3.prefixBeforeDigitLoop + ls (SegmentLayer3.beforeDigitLoop ls) ?_ (SegmentLayer3.beforeDigitLoop_eq ls) + intro s s'' stmt hmem hexec + simp [SegmentLayer3.prefixBeforeDigitLoop] at hmem + rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "idxLeaf" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_assignVar_preserves_lookup _ _ "idxTree" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "wotsAdrs" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "countOff" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "count" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "d" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "digitSum" "sigOff" _ (by decide) hexec + +set_option maxHeartbeats 2000000 in +/-- Seed cell at the lightweight entry state. -/ +private theorem probe_seed0 (pkSeed pkRoot message sig : Bytes) : + ((c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.memory 0x00).val = + C13Concrete.wordOfHash16 pkSeed := by + rw [probe_light_world] + rw [SegmentLayer3.afterDigit_preserves_memory_zero] + exact c13FirstLayerGuardState_seed_slot pkSeed pkRoot message sig + +set_option maxHeartbeats 2000000 in +/-- `"d"` binding at the lightweight entry state. -/ +private theorem probe_d0 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) (forsPk : Bytes) (lsig : XmssLayerSig) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) + (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk) + (hLayer0 : sigParsed.layers[0]? = some lsig) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "d" = + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) + lsig.wots.count (C13Concrete.wordOfHash16 forsPk) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "d" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "d" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "d" + (by decide) (by decide)] + exact SegmentLayer3.beforeDigitLoop_d_eq_wotsDigest_of_scratch + (c13FirstLayerGuardState pkSeed pkRoot message sig) + (C13Concrete.wordOfHash16 pkSeed) 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) + lsig.wots.count + (C13Concrete.wordOfHash16 forsPk) + (c13FirstLayerBeforeDigest_seed_slot pkSeed pkRoot message sig) + (c13FirstLayerBeforeDigest_wotsAdrs_slot_hyperIndex + pkSeed pkRoot message sig sigParsed hParse) + (c13FirstLayerBeforeDigest_currentNode_slot + pkSeed pkRoot message sig forsPk + (c13AfterFinalize_forsPk_of_parse_fors + pkSeed pkRoot message sig sigParsed forsPk hParse hFors)) + (c13FirstLayerBeforeDigest_count_slot_hyperIndex + pkSeed pkRoot message sig sigParsed lsig hParse hLayer0) + +set_option maxHeartbeats 2000000 in +/-- `"wotsAdrs"` binding at the lightweight entry state. -/ +private theorem probe_adrs0 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "wotsAdrs" = + C13Concrete.adrsWotsHashBase 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsAdrs" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "wotsAdrs" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + exact c13FirstLayerBeforeDigest_wotsAdrs_hyperIndex + pkSeed pkRoot message sig sigParsed hParse + +set_option maxHeartbeats 2000000 in +/-- `"wotsPtr"` value at the lightweight entry state. -/ +private theorem probe_wptr0 (pkSeed pkRoot message sig : Bytes) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "wotsPtr" = + sigDataOffset + 1952 := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsPtr" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_self] + have hSigBase : evalExpr [] + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigBase") = some sigDataOffset := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings + "sigBase") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "sigBase" + (by decide) (by decide)] + rw [SegmentLayer3.beforeDigitLoop_preserves_sigBase] + rw [c13FirstLayerGuardState_sigBase] + have hSigOff : evalExpr [] + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigOff") = some 1952 := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings + "sigOff") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "sigOff" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_preserves_sigOff] + rw [c13FirstLayerGuardState_sigOff] + rw [SegmentS2.wordNormalize_of_lt (by decide : 1952 < 2 ^ 256)] + rw [SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded + _ _ _ _ _ hSigBase hSigOff + (by decide) (by decide) (by decide)] + rfl + +set_option maxHeartbeats 2000000 in +/-- Frozen calldata at the lightweight entry state. -/ +private theorem probe_cd0 (pkSeed pkRoot message sig : Bytes) : + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.calldata = + headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + rw [probe_light_world] + rw [(SegmentLayer3.afterDigit_preserves_selector_calldata + (c13FirstLayerGuardState pkSeed pkRoot message sig)).2] + exact c13FirstLayerGuardState_calldata pkSeed pkRoot message sig + +set_option maxHeartbeats 2000000 in +/-- Probe twin of the axiom `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_inputs_layer0`. -/ +theorem probe_c13_inputs_layer0 : + ∀ pkSeed pkRoot message sig sigParsed forsPk specRoot, + C13Concrete.parseSignatureC13 c13 sig = some sigParsed → + forcedZeroOk c13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true → + C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk → + foldHypertree C13Concrete.c13PrimitivesConcrete c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + forsPk sigParsed.layers = .ok specRoot → + let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } + let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + ∀ d : C13Concrete.FoldHypertreeC13OkTwoLayerData + pk digest forsPk sigParsed.layers specRoot, + let st := + c13BeforeWotsPkLightState + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) + let wotsPtr := lookupValue st.bindings "wotsPtr" + C13WotsOuterExactInputs pkSeed pkRoot message sig st + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) wotsPtr 1952 := by + intro pkSeed pkRoot message sig sigParsed forsPk specRoot + hParse _hZero hFors _hFold pk digest d + rw [← c13FirstLayerGuardState_eq_c13LayerLoopState0 pkSeed pkRoot message sig] + intro st wotsPtr + have hWPtrVal : wotsPtr = sigDataOffset + 1952 := + probe_wptr0 pkSeed pkRoot message sig + have hCdSt : st.world.calldata = + headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := + probe_cd0 pkSeed pkRoot message sig + refine + { hSeed := ?_, hD := ?_, hAdrs := ?_, hWPtr := ?_, hCdLoad := ?_ } + · intro j hj + rw [wotsOuterFold_preserves_seed_cell st j (by omega)] + exact probe_seed0 pkSeed pkRoot message sig + · intro j _hj + rw [wotsOuterFold_preserves_binding st "d" + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) j] + exact probe_d0 pkSeed pkRoot message sig sigParsed forsPk d.lsig0 + hParse hFors d.hLayer0 + · intro j _hj + rw [wotsOuterFold_preserves_binding st "wotsAdrs" + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) j] + exact probe_adrs0 pkSeed pkRoot message sig sigParsed hParse + · intro j _hj + rw [wotsOuterFold_preserves_binding st "wotsPtr" + (by decide) (by decide) (by decide) (by decide) (by decide) (by decide) j] + rfl + · intro j hj s h1 h2 h3 + exact wotsOuterFold_cdload_raw pkSeed pkRoot message sig st 1952 + (by decide) hCdSt j hj s (h1.trans hWPtrVal) h2 h3 + +#print axioms probe_c13_inputs_layer0 + +end SphincsMinusVerifiers diff --git a/verity/probes/probe_layer1.lean b/verity/probes/probe_layer1.lean new file mode 100644 index 0000000..263efef --- /dev/null +++ b/verity/probes/probe_layer1.lean @@ -0,0 +1,475 @@ +/- + Probe v2: discharge of the + `c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer1` + axiom (Proofs.lean:11607). Layer-1 twin of the ok-path layer-0 probes. + The entry scalar facts at `c13BeforeWotsPkLightState (c13SecondLayerGuardState …)` + feed the verified closure `c13Layer1_copyFold43_wotsChainsEnd_cells_of_inputs`. + + The layer-1 `"currentNode"` fact (the heavy lemma `probe_current0Root`) is + derived through the LAYER-0-ONLY residual + `c13_ok_afterMerkle_initial_wotsPk_residual_layer0`, NOT through the layer-1 + afterMerkle residual (which itself depends on the axiom being discharged). + When folding into Proofs.lean the discharged theorem must therefore MOVE + after line 11812 (`c13_ok_afterMerkle_initial_wotsPk_residual_layer0`) and + its consumers (11645+) reorder below it. + + Split into per-fact lemmas so each declaration gets a fresh heartbeat budget + and any divergence is localized. +-/ +import SphincsMinusVerifiers.Proofs + +namespace SphincsMinusVerifiers + +open SphincsMinusVerifierSpec +open Compiler.Proofs.IRGeneration.SourceSemantics +open SphincsMinusVerifiers.MkC13State +open SphincsMinusVerifiers.SegmentCompose + +/-- Lightweight entry state world projection (bindings-only updates). -/ +private theorem probe_light_world (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).world = (SegmentLayer3.afterDigit ls).world := rfl + +/-- Lightweight entry state bindings shape. -/ +private theorem probe_light_bindings (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).bindings = + bindValue + (bindValue (SegmentLayer3.afterDigit ls).bindings "wotsPtr" + ((evalExpr [] (SegmentLayer3.afterDigit ls) + (.add (.localVar "sigBase") (.localVar "sigOff"))).getD 0)) + "i" (wordNormalize 0) := rfl + +/-- The two trailing `letVar`s of the pre-checksum prefix (`"d"`, `"digitSum"`) +preserve every other binding from the pre-digest cutpoint. -/ +private theorem probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (ls : RuntimeState) (key : String) + (hneD : "d" ≠ key) (hneSum : "digitSum" ≠ key) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings key = + lookupValue (SegmentLayer3.beforeDigest ls).bindings key := by + have h : execStmtList [] ls + (SegmentLayer3.prefixBeforeDigest ++ + [ Compiler.CompilationModel.Stmt.letVar "d" + (.keccak256 (.literal 0x00) (.literal 0x80)) + , Compiler.CompilationModel.Stmt.letVar "digitSum" (.literal 0) ]) = + .continue (SegmentLayer3.beforeDigitLoop ls) := + SegmentLayer3.beforeDigitLoop_eq ls + rw [MemoryKit.execStmtList_append_continue _ _ _ _ + (SegmentLayer3.beforeDigest_eq ls)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "d" _ _ rfl)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "digitSum" _ _ rfl)] at h + have hnil : ∀ (s : RuntimeState), execStmtList [] s [] = StmtResult.continue s := + fun _ => rfl + rw [hnil] at h + have he := StmtResult.continue.inj h + rw [← he] + rw [MemoryKit.lookupValue_bindValue_ne _ "digitSum" key _ hneSum] + rw [MemoryKit.lookupValue_bindValue_ne _ "d" key _ hneD] + +/-- The pre-checksum prefix does not rebind `"sigOff"`. -/ +private theorem probe_beforeDigitLoop_preserves_sigOff (ls : RuntimeState) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings "sigOff" = + lookupValue ls.bindings "sigOff" := by + refine BindingFrame.execStmtList_preserves_lookup "sigOff" + SegmentLayer3.prefixBeforeDigitLoop + ls (SegmentLayer3.beforeDigitLoop ls) ?_ (SegmentLayer3.beforeDigitLoop_eq ls) + intro s s'' stmt hmem hexec + simp [SegmentLayer3.prefixBeforeDigitLoop] at hmem + rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "idxLeaf" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_assignVar_preserves_lookup _ _ "idxTree" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "wotsAdrs" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "countOff" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "count" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "d" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "digitSum" "sigOff" _ (by decide) hexec + +set_option maxHeartbeats 2000000 in +/-- Seed cell at the layer-1 lightweight entry state. -/ +private theorem probe_seed1 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : + ((c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)).world.memory 0x00).val = + C13Concrete.wordOfHash16 pkSeed := by + rw [probe_light_world] + rw [SegmentLayer3.afterDigit_preserves_memory_zero] + unfold c13SecondLayerGuardState + rw [ClimbLoopGuarded.loopState_preserves_memory_val] + exact c13FirstStepLayer_seed_slot_of_memory_zero pkSeed pkRoot message sig + (by + simpa [c13FirstLayerGuardState_eq_c13LayerLoopState0] using + c13FirstLayerStep_preserves_memory_zero_of_parse + pkSeed pkRoot message sig sigParsed hParse) + +set_option maxHeartbeats 2000000 in +/-- The layer-1 guard-state `"currentNode"` binding is the layer-0 spec root, +derived through the LAYER-0-ONLY afterMerkle WOTS-PK residual. -/ +private theorem probe_current0Root (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) (forsPk specRoot : Bytes) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) + (hZero : forcedZeroOk c13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true) + (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk) + (hFold : foldHypertree C13Concrete.c13PrimitivesConcrete c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + forsPk sigParsed.layers = .ok specRoot) + (d : C13Concrete.FoldHypertreeC13OkTwoLayerData + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + forsPk sigParsed.layers specRoot) : + lookupValue (c13SecondLayerGuardState pkSeed pkRoot message sig).bindings + "currentNode" = C13Concrete.wordOfHash16 d.root0 := by + let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } + let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + have hWotsPk0 : + C13FoldOkAfterMerkleRawXmssClimbInitialWotsPkDataLayer0 + pkSeed pkRoot message sig sigParsed forsPk specRoot := + c13_ok_afterMerkle_initial_wotsPk_residual_layer0 + pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hZero hFors hFold + have hInit0 : + C13FoldOkAfterMerkleNormalizedXmssClimbInitialFrameDataLayer0 + pkSeed pkRoot message sig sigParsed forsPk specRoot := + c13FoldOkAfterMerkleNormalizedXmssClimbInitialFrameDataLayer0_of_wotsPk + pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hWotsPk0 + have hRawInit0 : + C13FoldOkAfterMerkleRawXmssClimbInitialFrameDataLayer0 + pkSeed pkRoot message sig sigParsed forsPk specRoot := + c13FoldOkAfterMerkleRawXmssClimbInitialFrameDataLayer0_of_wotsPk + pkSeed pkRoot message sig sigParsed forsPk specRoot hParse hWotsPk0 + have hD0 : + ∀ i, i < 11 → + SphincsMinusVerifiers.ClimbMemFrameMerkle.MerkleClimbData + d.lsig0.authPath + (c13XmssAuthCdAt pkSeed pkRoot message sig + (sigDataOffset + (1952 + 868 * 0 + 692))) i := by + simpa [pk, c13XmssAuthCdAt] using + SphincsMinusVerifiers.ClimbMemFrameMerkle.xmss_climb_data_range + pkSeed pkRoot message sig c13 sigParsed d.lsig0 0 + (sigDataOffset + (1952 + 868 * 0 + 692)) + hParse (by decide : 0 < 2) d.hLayer0 rfl + have hTreeLt0 : + C13Concrete.adrsXmssTree 0 (digest.hyperIndex / 2048) < 2 ^ 256 := + c13_adrsXmssTree_lt_of_bounds 0 (digest.hyperIndex / 2048) + (by decide : 0 < 2 ^ 32) + (lt_of_le_of_lt (Nat.div_le_self _ _) + (C13Concrete.hMsgC13_hyperIndex_lt pk sigParsed.R message)) + have hMIdxNorm0 : + wordNormalize (digest.hyperIndex % 2048) = digest.hyperIndex % 2048 := + wordNormalize_mod_2048 digest.hyperIndex + have hAfterRaw : + lookupValue + (SegmentLayer3.afterMerkle + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "merkleNode" + = + C13Concrete.xmssClimb (C13Concrete.wordOfHash16 pkSeed) + (C13Concrete.adrsXmssTree 0 (digest.hyperIndex / 2048)) + 11 0 (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 d.wotsPk0) d.lsig0.authPath := by + simpa [pk, digest] using + c13AfterMerkleRawXmssClimb_of_layer_site_bounded + pkSeed pkRoot message sig + (C13Concrete.wordOfHash16 pkSeed) + (C13Concrete.adrsXmssTree 0 (digest.hyperIndex / 2048)) + 0 d.lsig0.authPath + (by decide : 0 < 2) hTreeLt0 + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) + (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 d.wotsPk0) + hD0 + (by simpa [pk, digest] using hInit0 d) + (by simpa [pk, digest] using hRawInit0 d) + hMIdxNorm0 + have hRawStep : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "merkleNode" + = + C13Concrete.xmssClimb (C13Concrete.wordOfHash16 pkSeed) + (C13Concrete.adrsXmssTree 0 (digest.hyperIndex / 2048)) + 11 0 (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 d.wotsPk0) d.lsig0.authPath := + c13_stepLayer_merkleNode_eq_xmssClimb_of_afterMerkle + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) + _ _ _ _ _ hAfterRaw + have hMerkle0Root : + lookupValue + (SegmentLayer3.stepLayer + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig))).bindings + "merkleNode" + = C13Concrete.wordOfHash16 d.root0 := + SegmentAcceptSpec.stepLayer_merkleNode_eq_wordOfHash16_root_of_xmssClimb_wots_success + pk (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + forsPk d.wotsPk0 d.root0 d.lsig0.wots d.lsig0.authPath + (CurrentNodeFrame.c13LayerLoopState0 + (mkC13State pkSeed pkRoot message sig)) + (by + simpa [pk, digest, C13Concrete.c13PrimitivesConcrete, + C13Concrete.wotsPkFromSigC13AtLayer_zero] using d.hWots0) + (by + simpa [pk, digest, C13Concrete.c13PrimitivesConcrete, + C13Concrete.xmssRootFromSigC13AtLayer_zero] using d.hXmss0) + (by simpa [pk, digest] using hRawStep) + unfold c13SecondLayerGuardState ClimbLoopGuarded.loopState + rw [MemoryKit.lookupValue_bindValue_ne _ "layer" "currentNode" _ (by decide)] + rw [SegmentLayer3.stepLayer_currentNode_eq_merkleNode] + simpa [pk, digest] using hMerkle0Root + +set_option maxHeartbeats 2000000 in +/-- `"d"` binding at the layer-1 lightweight entry state, given the seed-cell +step fact and the layer-0 root `"currentNode"` fact. -/ +private theorem probe_d1 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) (root0 : Bytes) (lsig : XmssLayerSig) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) + (hLayer1 : sigParsed.layers[1]? = some lsig) + (hStepSeed : + ((SegmentLayer3.stepLayer + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.memory 0x00).val = + C13Concrete.wordOfHash16 pkSeed) + (hCurrent : + lookupValue (c13SecondLayerGuardState pkSeed pkRoot message sig).bindings + "currentNode" = C13Concrete.wordOfHash16 root0) : + lookupValue + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)).bindings "d" = + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 1 + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) / 2048) + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) % 2048) + lsig.wots.count (C13Concrete.wordOfHash16 root0) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "d" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "d" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13SecondLayerGuardState pkSeed pkRoot message sig) "d" + (by decide) (by decide)] + exact SegmentLayer3.beforeDigitLoop_d_eq_wotsDigest_of_scratch + (c13SecondLayerGuardState pkSeed pkRoot message sig) + (C13Concrete.wordOfHash16 pkSeed) 1 + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) / 2048) + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) % 2048) + lsig.wots.count + (C13Concrete.wordOfHash16 root0) + (c13SecondLayerBeforeDigest_seed_slot_of_first_step_seed_slot + pkSeed pkRoot message sig hStepSeed) + (c13SecondLayerBeforeDigest_wotsAdrs_slot_hyperIndex + pkSeed pkRoot message sig sigParsed hParse) + (c13SecondLayerBeforeDigest_currentNode_slot + pkSeed pkRoot message sig root0 hCurrent) + (c13SecondLayerBeforeDigest_count_slot_hyperIndex + pkSeed pkRoot message sig sigParsed lsig hParse hLayer1) + +set_option maxHeartbeats 2000000 in +/-- `"wotsAdrs"` binding at the layer-1 lightweight entry state. -/ +private theorem probe_adrs1 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : + lookupValue + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)).bindings "wotsAdrs" = + C13Concrete.adrsWotsHashBase 1 + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) / 2048) + (((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) % 2048) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsAdrs" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "wotsAdrs" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13SecondLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (c13SecondLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + exact c13SecondLayerBeforeDigest_wotsAdrs_hyperIndex + pkSeed pkRoot message sig sigParsed hParse + +set_option maxHeartbeats 2000000 in +/-- `"wotsPtr"` value at the layer-1 lightweight entry state. -/ +private theorem probe_wptr1 (pkSeed pkRoot message sig : Bytes) : + lookupValue + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)).bindings "wotsPtr" = + sigDataOffset + (1952 + 868) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsPtr" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_self] + have hSigBase : evalExpr [] + (SegmentLayer3.afterDigit + (c13SecondLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigBase") = some sigDataOffset := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13SecondLayerGuardState pkSeed pkRoot message sig)).bindings + "sigBase") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13SecondLayerGuardState pkSeed pkRoot message sig) "sigBase" + (by decide) (by decide)] + rw [SegmentLayer3.beforeDigitLoop_preserves_sigBase] + rw [c13SecondLayerGuardState_sigBase] + have hSigOff : evalExpr [] + (SegmentLayer3.afterDigit + (c13SecondLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigOff") = some 2820 := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13SecondLayerGuardState pkSeed pkRoot message sig)).bindings + "sigOff") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13SecondLayerGuardState pkSeed pkRoot message sig) "sigOff" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_preserves_sigOff] + rw [c13SecondLayerGuardState_sigOff] + rw [SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded + _ _ _ _ _ hSigBase hSigOff + (by decide) (by decide) (by decide)] + rfl + +set_option maxHeartbeats 2000000 in +/-- Frozen calldata at the layer-1 lightweight entry state. -/ +private theorem probe_cd1 (pkSeed pkRoot message sig : Bytes) : + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)).world.calldata = + headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + rw [probe_light_world] + rw [(SegmentLayer3.afterDigit_preserves_selector_calldata + (c13SecondLayerGuardState pkSeed pkRoot message sig)).2] + exact c13SecondLayerGuardState_calldata pkSeed pkRoot message sig + +set_option maxHeartbeats 2000000 in +/-- Probe twin of the axiom +`c13_ok_beforeAuthOff_wotsPk_lightweight_chain_cells_residual_layer1`. -/ +theorem probe_c13_layer1 : + ∀ pkSeed pkRoot message sig sigParsed forsPk specRoot, + C13Concrete.parseSignatureC13 c13 sig = some sigParsed → + forcedZeroOk c13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true → + C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk → + foldHypertree C13Concrete.c13PrimitivesConcrete c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + forsPk sigParsed.layers = .ok specRoot → + let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } + let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + ∀ d : C13Concrete.FoldHypertreeC13OkTwoLayerData + pk digest forsPk sigParsed.layers specRoot, + ∀ j, (h : j < 43) → + ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep + (c13BeforeWotsPkLightState + (CurrentNodeFrame.c13LayerLoopState1 + (mkC13State pkSeed pkRoot message sig))) + 0 43) + 0 43).world.memory (0x40 + 32 * j)).val = + (InitialNodeKeccak.wotsChainsEnd + (C13Concrete.wordOfHash16 pkSeed) 1 + ((digest.hyperIndex / 2048) / 2048) + ((digest.hyperIndex / 2048) % 2048) + (C13Concrete.wordOfHash16 d.root0) d.lsig1.wots)[j]'(by + rw [InitialNodeKeccak.wotsChainsEnd_length] + omega) := by + intro pkSeed pkRoot message sig sigParsed forsPk specRoot + hParse hZero hFors hFold pk digest d + rw [← c13SecondLayerGuardState_eq_c13LayerLoopState1 pkSeed pkRoot message sig] + have hStepSeed : + ((SegmentLayer3.stepLayer + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.memory 0x00).val = + C13Concrete.wordOfHash16 pkSeed := + c13FirstStepLayer_seed_slot_of_memory_zero pkSeed pkRoot message sig + (by + simpa [c13FirstLayerGuardState_eq_c13LayerLoopState0] using + c13FirstLayerStep_preserves_memory_zero_of_parse + pkSeed pkRoot message sig sigParsed hParse) + have hSeed1 := probe_seed1 pkSeed pkRoot message sig sigParsed hParse + have hCurrent0Root := + probe_current0Root pkSeed pkRoot message sig sigParsed forsPk specRoot + hParse hZero hFors hFold d + have hD1 := probe_d1 pkSeed pkRoot message sig sigParsed d.root0 d.lsig1 + hParse d.hLayer1 hStepSeed hCurrent0Root + have hAdrs1 := probe_adrs1 pkSeed pkRoot message sig sigParsed hParse + have hWPtrVal := probe_wptr1 pkSeed pkRoot message sig + have hCdSt := probe_cd1 pkSeed pkRoot message sig + have hHyLt : + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).hyperIndex + < 2 ^ 22 := + C13Concrete.hMsgC13_hyperIndex_lt pk sigParsed.R message + have hDigestLt : + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 1 ((digest.hyperIndex / 2048) / 2048) ((digest.hyperIndex / 2048) % 2048) + d.lsig1.wots.count (C13Concrete.wordOfHash16 d.root0) < 2 ^ 256 := + c13_wotsDigest_lt (C13Concrete.wordOfHash16 pkSeed) + 1 ((digest.hyperIndex / 2048) / 2048) ((digest.hyperIndex / 2048) % 2048) + d.lsig1.wots.count (C13Concrete.wordOfHash16 d.root0) + have hAdrsLt : + C13Concrete.adrsWotsHashBase 1 + ((digest.hyperIndex / 2048) / 2048) + ((digest.hyperIndex / 2048) % 2048) < 2 ^ 256 := by + have hT : ((digest.hyperIndex / 2048) / 2048) <<< 128 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + ((digest.hyperIndex / 2048) / 2048) * 2 ^ 128 ≤ 2 ^ 22 * 2 ^ 128 := + Nat.mul_le_mul_right _ + (le_of_lt (Nat.lt_of_le_of_lt (Nat.div_le_self _ _) + (Nat.lt_of_le_of_lt (Nat.div_le_self _ _) hHyLt))) + _ < 2 ^ 256 := by decide + have hL : ((digest.hyperIndex / 2048) % 2048) <<< 64 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + ((digest.hyperIndex / 2048) % 2048) * 2 ^ 64 ≤ 2047 * 2 ^ 64 := + Nat.mul_le_mul_right _ + (Nat.le_of_lt_succ (Nat.mod_lt _ (by decide : 0 < 2048))) + _ < 2 ^ 256 := by decide + have h224 : (1 : Nat) <<< 224 < 2 ^ 256 := by decide + exact Nat.bitwise_lt_two_pow + (Nat.bitwise_lt_two_pow h224 hT) hL + have e : C13WotsOuterEntry pkSeed + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)) + (C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 1 ((digest.hyperIndex / 2048) / 2048) ((digest.hyperIndex / 2048) % 2048) + d.lsig1.wots.count (C13Concrete.wordOfHash16 d.root0)) + (C13Concrete.adrsWotsHashBase 1 + ((digest.hyperIndex / 2048) / 2048) + ((digest.hyperIndex / 2048) % 2048)) + (sigDataOffset + (1952 + 868)) := + { seed0 := hSeed1, d0 := hD1, adrs0 := hAdrs1, wptr0 := hWPtrVal } + exact + c13Layer1_copyFold43_wotsChainsEnd_cells_of_inputs + pkSeed pkRoot message sig sigParsed + (c13BeforeWotsPkLightState + (c13SecondLayerGuardState pkSeed pkRoot message sig)) + ((digest.hyperIndex / 2048) / 2048) ((digest.hyperIndex / 2048) % 2048) + (C13Concrete.wordOfHash16 d.root0) + d.lsig1 hParse d.hLayer1 hDigestLt hAdrsLt e hCdSt + +#print axioms probe_c13_layer1 + +end SphincsMinusVerifiers diff --git a/verity/probes/probe_reverted_layer0.lean b/verity/probes/probe_reverted_layer0.lean new file mode 100644 index 0000000..d7f6e35 --- /dev/null +++ b/verity/probes/probe_reverted_layer0.lean @@ -0,0 +1,311 @@ +/- + Probe v2: discharge of the + `c13_reverted_layer0_beforeAuthOff_wotsPk_lightweight_chain_cells_residual` + axiom (Proofs.lean:12014). Same concrete entry state as the ok-path + layer-0 inputs obligation; the entry scalar facts feed the verified + reverted closure `c13RevertedLayer0_copyFold43_wotsChainsEnd_cells_of_inputs`. + Split into per-fact lemmas so each declaration gets a fresh heartbeat + budget and any divergence is localized. +-/ +import SphincsMinusVerifiers.Proofs + +namespace SphincsMinusVerifiers + +open SphincsMinusVerifierSpec +open Compiler.Proofs.IRGeneration.SourceSemantics +open SphincsMinusVerifiers.MkC13State +open SphincsMinusVerifiers.SegmentCompose + +/-- Lightweight entry state world projection (bindings-only updates). -/ +private theorem probe_light_world (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).world = (SegmentLayer3.afterDigit ls).world := rfl + +/-- Lightweight entry state bindings shape. -/ +private theorem probe_light_bindings (ls : RuntimeState) : + (c13BeforeWotsPkLightState ls).bindings = + bindValue + (bindValue (SegmentLayer3.afterDigit ls).bindings "wotsPtr" + ((evalExpr [] (SegmentLayer3.afterDigit ls) + (.add (.localVar "sigBase") (.localVar "sigOff"))).getD 0)) + "i" (wordNormalize 0) := rfl + +/-- The two trailing `letVar`s of the pre-checksum prefix (`"d"`, `"digitSum"`) +preserve every other binding from the pre-digest cutpoint. -/ +private theorem probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (ls : RuntimeState) (key : String) + (hneD : "d" ≠ key) (hneSum : "digitSum" ≠ key) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings key = + lookupValue (SegmentLayer3.beforeDigest ls).bindings key := by + have h : execStmtList [] ls + (SegmentLayer3.prefixBeforeDigest ++ + [ Compiler.CompilationModel.Stmt.letVar "d" + (.keccak256 (.literal 0x00) (.literal 0x80)) + , Compiler.CompilationModel.Stmt.letVar "digitSum" (.literal 0) ]) = + .continue (SegmentLayer3.beforeDigitLoop ls) := + SegmentLayer3.beforeDigitLoop_eq ls + rw [MemoryKit.execStmtList_append_continue _ _ _ _ + (SegmentLayer3.beforeDigest_eq ls)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "d" _ _ rfl)] at h + rw [SphincsMinusVerifiers.ClimbKit.execStmtList_cons_continue _ _ _ _ + (MemoryKit.execStmt_letVar_continue _ "digitSum" _ _ rfl)] at h + have hnil : ∀ (s : RuntimeState), execStmtList [] s [] = StmtResult.continue s := + fun _ => rfl + rw [hnil] at h + have he := StmtResult.continue.inj h + rw [← he] + rw [MemoryKit.lookupValue_bindValue_ne _ "digitSum" key _ hneSum] + rw [MemoryKit.lookupValue_bindValue_ne _ "d" key _ hneD] + +/-- The pre-checksum prefix does not rebind `"sigOff"`. -/ +private theorem probe_beforeDigitLoop_preserves_sigOff (ls : RuntimeState) : + lookupValue (SegmentLayer3.beforeDigitLoop ls).bindings "sigOff" = + lookupValue ls.bindings "sigOff" := by + refine BindingFrame.execStmtList_preserves_lookup "sigOff" + SegmentLayer3.prefixBeforeDigitLoop + ls (SegmentLayer3.beforeDigitLoop ls) ?_ (SegmentLayer3.beforeDigitLoop_eq ls) + intro s s'' stmt hmem hexec + simp [SegmentLayer3.prefixBeforeDigitLoop] at hmem + rcases hmem with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "idxLeaf" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_assignVar_preserves_lookup _ _ "idxTree" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "wotsAdrs" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "countOff" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "count" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_mstore_preserves_lookup _ _ "sigOff" _ _ hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "d" "sigOff" _ (by decide) hexec + · exact BindingFrame.execStmt_letVar_preserves_lookup _ _ "digitSum" "sigOff" _ (by decide) hexec + +set_option maxHeartbeats 2000000 in +/-- Seed cell at the lightweight entry state. -/ +private theorem probe_seed0 (pkSeed pkRoot message sig : Bytes) : + ((c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.memory 0x00).val = + C13Concrete.wordOfHash16 pkSeed := by + rw [probe_light_world] + rw [SegmentLayer3.afterDigit_preserves_memory_zero] + exact c13FirstLayerGuardState_seed_slot pkSeed pkRoot message sig + +set_option maxHeartbeats 2000000 in +/-- `"d"` binding at the lightweight entry state. -/ +private theorem probe_d0 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) (forsPk : Bytes) (lsig : XmssLayerSig) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) + (hFors : C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk) + (hLayer0 : sigParsed.layers[0]? = some lsig) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "d" = + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) + lsig.wots.count (C13Concrete.wordOfHash16 forsPk) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "d" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "d" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "d" + (by decide) (by decide)] + exact SegmentLayer3.beforeDigitLoop_d_eq_wotsDigest_of_scratch + (c13FirstLayerGuardState pkSeed pkRoot message sig) + (C13Concrete.wordOfHash16 pkSeed) 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) + lsig.wots.count + (C13Concrete.wordOfHash16 forsPk) + (c13FirstLayerBeforeDigest_seed_slot pkSeed pkRoot message sig) + (c13FirstLayerBeforeDigest_wotsAdrs_slot_hyperIndex + pkSeed pkRoot message sig sigParsed hParse) + (c13FirstLayerBeforeDigest_currentNode_slot + pkSeed pkRoot message sig forsPk + (c13AfterFinalize_forsPk_of_parse_fors + pkSeed pkRoot message sig sigParsed forsPk hParse hFors)) + (c13FirstLayerBeforeDigest_count_slot_hyperIndex + pkSeed pkRoot message sig sigParsed lsig hParse hLayer0) + +set_option maxHeartbeats 2000000 in +/-- `"wotsAdrs"` binding at the lightweight entry state. -/ +private theorem probe_adrs0 (pkSeed pkRoot message sig : Bytes) + (sigParsed : Signature) + (hParse : C13Concrete.parseSignatureC13 c13 sig = some sigParsed) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "wotsAdrs" = + C13Concrete.adrsWotsHashBase 0 + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex / 2048) + ((C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message).hyperIndex % 2048) := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsAdrs" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_ne _ "wotsPtr" "wotsAdrs" _ (by decide)] + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_lookup_eq_beforeDigest_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "wotsAdrs" + (by decide) (by decide)] + exact c13FirstLayerBeforeDigest_wotsAdrs_hyperIndex + pkSeed pkRoot message sig sigParsed hParse + +set_option maxHeartbeats 2000000 in +/-- `"wotsPtr"` value at the lightweight entry state. -/ +private theorem probe_wptr0 (pkSeed pkRoot message sig : Bytes) : + lookupValue + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings "wotsPtr" = + sigDataOffset + 1952 := by + rw [probe_light_bindings] + rw [MemoryKit.lookupValue_bindValue_ne _ "i" "wotsPtr" _ (by decide)] + rw [MemoryKit.lookupValue_bindValue_self] + have hSigBase : evalExpr [] + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigBase") = some sigDataOffset := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings + "sigBase") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "sigBase" + (by decide) (by decide)] + rw [SegmentLayer3.beforeDigitLoop_preserves_sigBase] + rw [c13FirstLayerGuardState_sigBase] + have hSigOff : evalExpr [] + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (.localVar "sigOff") = some 1952 := by + show some (lookupValue + (SegmentLayer3.afterDigit + (c13FirstLayerGuardState pkSeed pkRoot message sig)).bindings + "sigOff") = _ + rw [SegmentLayer3.afterDigit_preserves_lookup_of_ne + (c13FirstLayerGuardState pkSeed pkRoot message sig) "sigOff" + (by decide) (by decide)] + rw [probe_beforeDigitLoop_preserves_sigOff] + rw [c13FirstLayerGuardState_sigOff] + rw [SegmentS2.wordNormalize_of_lt (by decide : 1952 < 2 ^ 256)] + rw [SphincsMinusVerifiers.ClimbKeccakStep.evalExpr_add_bounded + _ _ _ _ _ hSigBase hSigOff + (by decide) (by decide) (by decide)] + rfl + +set_option maxHeartbeats 2000000 in +/-- Frozen calldata at the lightweight entry state. -/ +private theorem probe_cd0 (pkSeed pkRoot message sig : Bytes) : + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)).world.calldata = + headWords pkSeed pkRoot message sig.size ++ bytesToWords sig := by + rw [probe_light_world] + rw [(SegmentLayer3.afterDigit_preserves_selector_calldata + (c13FirstLayerGuardState pkSeed pkRoot message sig)).2] + exact c13FirstLayerGuardState_calldata pkSeed pkRoot message sig + +set_option maxHeartbeats 2000000 in +/-- Probe twin of the axiom +`c13_reverted_layer0_beforeAuthOff_wotsPk_lightweight_chain_cells_residual`. -/ +theorem probe_c13_reverted_layer0 : + ∀ pkSeed pkRoot message sig sigParsed forsPk, + C13Concrete.parseSignatureC13 c13 sig = some sigParsed → + forcedZeroOk c13 + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) = true → + C13Concrete.c13PrimitivesConcrete.forsPkFromSig c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + sigParsed.fors = some forsPk → + foldHypertree C13Concrete.c13PrimitivesConcrete c13 + { pkSeed := pkSeed, pkRoot := pkRoot } + (C13Concrete.c13PrimitivesConcrete.hMsg c13 + { pkSeed := pkSeed, pkRoot := pkRoot } sigParsed.R message) + forsPk sigParsed.layers = .reverted → + let pk : PublicKey := { pkSeed := pkSeed, pkRoot := pkRoot } + let digest := C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message + ∀ d : C13Concrete.FoldHypertreeC13RevertedLayer1Data + pk digest forsPk sigParsed.layers, + ∀ j, (h : j < 43) → + ((ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.copyStep + (ClimbLoop.foldLoop "i" SegmentLayer3CopyCells.wotsOuterStep + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + 0 43) + 0 43).world.memory (0x40 + 32 * j)).val = + (InitialNodeKeccak.wotsChainsEnd + (C13Concrete.wordOfHash16 pkSeed) 0 + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 forsPk) d.lsig0.wots)[j]'(by + rw [InitialNodeKeccak.wotsChainsEnd_length] + omega) := by + intro pkSeed pkRoot message sig sigParsed forsPk + hParse _hZero hFors _hFold pk digest d + have hSeed0 := probe_seed0 pkSeed pkRoot message sig + have hD0 := probe_d0 pkSeed pkRoot message sig sigParsed forsPk d.lsig0 + hParse hFors d.hLayer0 + have hAdrs0 := probe_adrs0 pkSeed pkRoot message sig sigParsed hParse + have hWPtrVal := probe_wptr0 pkSeed pkRoot message sig + have hCdSt := probe_cd0 pkSeed pkRoot message sig + have hHyLt : + (C13Concrete.c13PrimitivesConcrete.hMsg c13 pk sigParsed.R message).hyperIndex + < 2 ^ 22 := + C13Concrete.hMsgC13_hyperIndex_lt pk sigParsed.R message + have hDigestLt : + C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) < 2 ^ 256 := + c13_wotsDigest_lt (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk) + have hAdrsLt : + C13Concrete.adrsWotsHashBase 0 + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) < 2 ^ 256 := by + have hT : (digest.hyperIndex / 2048) <<< 128 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + (digest.hyperIndex / 2048) * 2 ^ 128 ≤ 2 ^ 22 * 2 ^ 128 := + Nat.mul_le_mul_right _ + (le_of_lt (Nat.lt_of_le_of_lt (Nat.div_le_self _ _) hHyLt)) + _ < 2 ^ 256 := by decide + have hL : (digest.hyperIndex % 2048) <<< 64 < 2 ^ 256 := by + rw [Nat.shiftLeft_eq] + calc + (digest.hyperIndex % 2048) * 2 ^ 64 ≤ 2047 * 2 ^ 64 := + Nat.mul_le_mul_right _ + (Nat.le_of_lt_succ (Nat.mod_lt _ (by decide : 0 < 2048))) + _ < 2 ^ 256 := by decide + have h224 : (0 : Nat) <<< 224 < 2 ^ 256 := by decide + exact Nat.bitwise_lt_two_pow + (Nat.bitwise_lt_two_pow h224 hT) hL + have e : C13WotsOuterEntry pkSeed + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (C13Concrete.wotsDigest (C13Concrete.wordOfHash16 pkSeed) + 0 (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + d.lsig0.wots.count (C13Concrete.wordOfHash16 forsPk)) + (C13Concrete.adrsWotsHashBase 0 + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048)) + (sigDataOffset + 1952) := + { seed0 := hSeed0, d0 := hD0, adrs0 := hAdrs0, wptr0 := hWPtrVal } + exact + c13RevertedLayer0_copyFold43_wotsChainsEnd_cells_of_inputs + pkSeed pkRoot message sig sigParsed + (c13BeforeWotsPkLightState + (c13FirstLayerGuardState pkSeed pkRoot message sig)) + (digest.hyperIndex / 2048) (digest.hyperIndex % 2048) + (C13Concrete.wordOfHash16 forsPk) + pk digest forsPk d hParse hDigestLt hAdrsLt e hCdSt + +#print axioms probe_c13_reverted_layer0 + +end SphincsMinusVerifiers diff --git a/verity/scripts/build.sh b/verity/scripts/build.sh new file mode 100755 index 0000000..3151642 --- /dev/null +++ b/verity/scripts/build.sh @@ -0,0 +1,15 @@ +#!/usr/bin/env bash +# Memory-safe build wrapper for the verity package. +# +# The proof modules here are very large (Proofs.lean ~630 KB, C12BridgePrep +# ~480 KB, ...); a single lean worker on one of them can peak at several GB. +# A bare `lake build` spawns one worker per core (8 on this machine), which +# has OOM'd a 16 GB machine. This wrapper caps Lake's scheduler at 2 +# concurrent lean processes (Lake 5 has no -j flag; it schedules onto the +# Lean task pool, bounded by LEAN_NUM_THREADS). +# +# Usage: scripts/build.sh [lake build args, e.g. a module name] +set -euo pipefail +cd "$(dirname "$0")/.." +export LEAN_NUM_THREADS="${VERITY_JOBS:-2}" +exec lake build "$@"