diff --git a/.gitignore b/.gitignore index 65cfbacbb..85b216ae8 100644 --- a/.gitignore +++ b/.gitignore @@ -14,4 +14,4 @@ /docs/Std-manifest.json.hash /docs/Std-manifest.json.trace .DS_Store -.claude \ No newline at end of file +.claude diff --git a/Cslib.lean b/Cslib.lean index a9d5ffc3e..69f935a7c 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -22,6 +22,16 @@ public import Cslib.Computability.Automata.NA.Prod public import Cslib.Computability.Automata.NA.Sum public import Cslib.Computability.Automata.NA.ToDA public import Cslib.Computability.Automata.NA.Total +public import Cslib.Computability.Circuits.Basis +public import Cslib.Computability.Circuits.Circuit.Basic +public import Cslib.Computability.Circuits.Formula.Basic +public import Cslib.Computability.Circuits.Formula.Measures +public import Cslib.Computability.Circuits.Formula.Std +public import Cslib.Computability.Complexity.CircuitHierarchy +public import Cslib.Computability.Complexity.Classes +public import Cslib.Computability.Complexity.NonUniform +public import Cslib.Computability.Complexity.Reductions +public import Cslib.Computability.Complexity.Space public import Cslib.Computability.Languages.Congruences.BuchiCongruence public import Cslib.Computability.Languages.Congruences.RightCongruence public import Cslib.Computability.Languages.ExampleEventuallyZero @@ -36,6 +46,30 @@ public import Cslib.Computability.URM.Defs public import Cslib.Computability.URM.Execution public import Cslib.Computability.URM.StandardForm public import Cslib.Computability.URM.StraightLine +public import Cslib.Cryptography.Assumptions.DiscreteLog +public import Cslib.Cryptography.Foundations.Indistinguishability +public import Cslib.Cryptography.Foundations.Negligible +public import Cslib.Cryptography.Foundations.OracleInteraction +public import Cslib.Cryptography.Foundations.PolyTimeDistinguisher +public import Cslib.Cryptography.Foundations.RandomOracle +public import Cslib.Cryptography.Foundations.SecurityGame +public import Cslib.Cryptography.Primitives.Commitment +public import Cslib.Cryptography.Primitives.Encryption +public import Cslib.Cryptography.Primitives.HashFunction +public import Cslib.Cryptography.Primitives.MAC +public import Cslib.Cryptography.Primitives.OneWayFunction +public import Cslib.Cryptography.Primitives.PRF +public import Cslib.Cryptography.Primitives.PRG +public import Cslib.Cryptography.Primitives.Signature +public import Cslib.Cryptography.Protocols.Combinators +public import Cslib.Cryptography.Protocols.FiatShamir +public import Cslib.Cryptography.Protocols.Schnorr +public import Cslib.Cryptography.Protocols.SigmaProtocol +public import Cslib.Cryptography.Reductions.FiatShamirROM +public import Cslib.Cryptography.Reductions.HashToCommitment +public import Cslib.Cryptography.Reductions.PRFtoEncryption +public import Cslib.Cryptography.Reductions.PRFtoMAC +public import Cslib.Cryptography.Reductions.PRGtoEncryption public import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects @@ -98,3 +132,5 @@ public import Cslib.Logics.LinearLogic.CLL.Basic public import Cslib.Logics.LinearLogic.CLL.CutElimination public import Cslib.Logics.LinearLogic.CLL.EtaExpansion public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic +public import Cslib.Probability.Discrete +public import Cslib.Probability.ForkingLemma diff --git a/Cslib/Computability/Circuits/Basis.lean b/Cslib/Computability/Circuits/Basis.lean new file mode 100644 index 000000000..20116e368 --- /dev/null +++ b/Cslib/Computability/Circuits/Basis.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Init + +@[expose] public section + +/-! # Circuit Basis + +A `Basis` defines the set of operations (gates) available in a circuit or formula. +Each operation declares an `Arity` — how many inputs it accepts — and provides +evaluation semantics via `Basis.eval`. + +## Design + +The key design choice is that `Basis.eval` requires a proof that the input list length +satisfies the operation's arity (`(arity op).admits bs.length`). This makes it impossible +to evaluate a gate with the wrong number of inputs at the type level. Because `Arity.admits` +has a `Decidable` instance, callers can obtain the proof via a run-time check when the +arity is not statically known. + +The circuit complexity hierarchy motivates two standard bases: + +- `BoundedFanInOp k` — AND/OR with fan-in at most `k`, NOT with arity 1. + The abbreviation `NCOp := BoundedFanInOp 2` gives the canonical bounded fan-in + basis used in **NC** circuits. +- `ACOp` — AND/OR with unbounded fan-in, NOT with arity 1. + This is the basis used in **AC** circuits. + +## Main definitions + +- `Arity` — `.exactly k`, `.atMost k`, or `.any` +- `Arity.admits` — predicate: does an arity accept a given input count? +- `Basis` — typeclass pairing an `arity` function with a type-safe `eval` +- `BoundedFanInOp k` — Boolean operations with fan-in bounded by `k` +- `NCOp` — `BoundedFanInOp 2`, the standard bounded fan-in basis +- `ACOp` — Boolean operations with unbounded fan-in + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +namespace Cslib.Circuits + +/-- An `Arity` specifies how many inputs a gate operation accepts: +exactly `k` inputs, at most `k` inputs, or any number of inputs. -/ +inductive Arity where + /-- The gate accepts exactly `k` inputs. -/ + | exactly : Nat → Arity + /-- The gate accepts at most `k` inputs. -/ + | atMost : Nat → Arity + /-- The gate accepts any number of inputs. -/ + | any : Arity + deriving DecidableEq, Repr + +/-- Predicate stating that arity `a` accepts `n` inputs. +For `.exactly k`, requires `n = k`; for `.atMost k`, requires `n ≤ k`; +for `.any`, always `True`. -/ +@[simp] +def Arity.admits : Arity → Nat → Prop + | .exactly k, n => n = k + | .atMost k, n => n ≤ k + | .any, _ => True + +instance (a : Arity) (n : Nat) : Decidable (a.admits n) := + match a with + | .exactly k => if h : n = k then isTrue h else isFalse h + | .atMost k => if h : n ≤ k then isTrue h else isFalse h + | .any => isTrue trivial + +/-- A `Basis` defines the arity and evaluation semantics for a set of gate operations. +Each operation declares its arity, and `eval` requires a proof that the input list +has the correct length. -/ +class Basis (Op : Type*) where + /-- The arity of a gate operation. -/ + arity : Op → Arity + /-- Evaluate a gate operation on a list of Boolean inputs of the correct length. -/ + eval : (op : Op) → (bs : List Bool) → (arity op).admits bs.length → Bool + +/-- Boolean operations with fan-in bounded by `k`: AND and OR accept at most `k` inputs, +NOT accepts exactly 1. This models the bounded fan-in gates used in NC-style circuits. -/ +inductive BoundedFanInOp (k : Nat) where + /-- Boolean conjunction (bounded fan-in). -/ + | and + /-- Boolean disjunction (bounded fan-in). -/ + | or + /-- Boolean negation. -/ + | not + deriving DecidableEq, Repr + +/-- The bounded fan-in basis assigns arity `.atMost k` to AND and OR, arity `.exactly 1` +to NOT. AND folds `&&` with identity `true`, OR folds `||` with identity `false`. -/ +instance : Basis (BoundedFanInOp k) where + arity + | .and => .atMost k + | .or => .atMost k + | .not => .exactly 1 + eval + | .and, bs, _ => bs.foldl (· && ·) true + | .or, bs, _ => bs.foldl (· || ·) false + | .not, [b], _ => !b + +/-- `NCOp` is the standard bounded fan-in basis with fan-in at most 2, corresponding +to the **NC** (Nick's Class) hierarchy in circuit complexity. -/ +abbrev NCOp := BoundedFanInOp 2 + +/-- Boolean operations with unbounded fan-in: AND and OR accept any number of inputs, +NOT accepts exactly 1. This models the unbounded fan-in gates used in AC-style circuits. -/ +inductive ACOp where + /-- Boolean conjunction (unbounded fan-in). -/ + | and + /-- Boolean disjunction (unbounded fan-in). -/ + | or + /-- Boolean negation. -/ + | not + deriving DecidableEq, Repr + +/-- The unbounded fan-in basis assigns arity `.any` to AND and OR, arity `.exactly 1` +to NOT. AND folds `&&` with identity `true`, OR folds `||` with identity `false`. -/ +instance : Basis ACOp where + arity + | .and => .any + | .or => .any + | .not => .exactly 1 + eval + | .and, bs, _ => bs.foldl (· && ·) true + | .or, bs, _ => bs.foldl (· || ·) false + | .not, [b], _ => !b + +end Cslib.Circuits diff --git a/Cslib/Computability/Circuits/Circuit/Basic.lean b/Cslib/Computability/Circuits/Circuit/Basic.lean new file mode 100644 index 000000000..cd384ea90 --- /dev/null +++ b/Cslib/Computability/Circuits/Circuit/Basic.lean @@ -0,0 +1,355 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Circuits.Basis + +@[expose] public section + +/-! # Boolean Circuits (DAG-based) + +A Boolean circuit is a directed acyclic graph (DAG) of gates, unlike a `Formula` which is +a tree (no fan-out sharing). A polynomial-size circuit can compute functions that would +require an exponential-size formula, making circuits the standard model for non-uniform +complexity classes like P/poly and SIZE(s). + +## Design notes + +A circuit over `n` input variables is represented as a list of `Gate`s in topological order. +Wires `0..n-1` carry the input variables; wire `n + i` carries the output of `gates[i]`. +Each gate references its inputs by wire index, and the circuit designates one wire as the +output. + +There is no well-formedness constraint in the `Circuit` structure. Instead, `Circuit.eval` +returns `Option Bool`: out-of-bounds wire references and arity mismatches produce `none`. +The `WellFormed` predicate ensures that well-formed circuits always evaluate to `some`. + +## Main definitions + +- `Gate` — a gate with an operation and a list of input wire indices +- `Circuit` — a circuit with `n` input variables, a list of gates, and an output wire +- `Circuit.eval` — evaluate a circuit on an input assignment, returning `Option Bool` +- `Circuit.size` — number of gates in a circuit +- `Circuit.depth` — longest path from an input to the output +- `CircuitFamily` — a family of circuits indexed by input size +- `CircuitFamily.Decides` — a circuit family decides a language + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +namespace Cslib.Circuits + +/-- A gate in a circuit, consisting of an operation and a list of input wire indices. -/ +structure Gate (Op : Type*) where + /-- The gate operation. -/ + op : Op + /-- The wire indices feeding into this gate. -/ + inputs : List ℕ + +/-- A Boolean circuit with `n` input variables. + +Wires `0..n-1` are input wires. Wire `n + i` is the output of `gates[i]`. +The circuit produces its result on `outputWire`. -/ +structure Circuit (Op : Type*) (n : ℕ) where + /-- The gates of the circuit, in topological order. -/ + gates : List (Gate Op) + /-- The wire carrying the circuit's output. -/ + outputWire : ℕ + +namespace Gate + +variable {Op Op' : Type*} + +/-- Map a function over the operation of a gate, preserving wire structure. -/ +def mapOp (f : Op → Op') (g : Gate Op) : Gate Op' := + { op := f g.op, inputs := g.inputs } + +end Gate + +namespace Circuit + +variable {Op : Type*} {n : ℕ} + +/-! ### Evaluation -/ + +/-- Evaluate a circuit on an input assignment. + +Builds a list of wire values by folding over the gates in order. Each gate reads its +inputs from previous wire values. Out-of-bounds wire references or arity mismatches +produce `none`. The result is the value on `outputWire`, or `none` if out of bounds. -/ +@[simp, scoped grind =] +def eval [Basis Op] (C : Circuit Op n) (input : Fin n → Bool) : Option Bool := + let inputList := List.ofFn input + let allWires := C.gates.foldl (fun (acc : Option (List Bool)) gate => + acc.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else + none) (some inputList) + allWires.bind fun wires => wires[C.outputWire]? + +/-! ### Measures -/ + +/-- The number of gates in a circuit. -/ +@[simp, scoped grind =] +def size (C : Circuit Op n) : ℕ := C.gates.length + +/-- The depth of a circuit: the longest path from any input wire to the output wire. + +Computed by tracking the depth of each wire. Input wires have depth 0. Each gate's depth +is one more than the maximum depth of its inputs. The circuit's depth is the depth of the +output wire. Returns 0 if the output wire is out of bounds. -/ +@[simp, scoped grind =] +def depth [Basis Op] (C : Circuit Op n) : ℕ := + let inputDepths := List.replicate n 0 + let allDepths := C.gates.foldl (fun depths gate => + let gateDepth := gate.inputs.foldl (fun maxD i => max maxD (depths.getD i 0)) 0 + 1 + depths ++ [gateDepth]) inputDepths + allDepths.getD C.outputWire 0 + +/-! ### Well-formedness -/ + +/-- A circuit is **gates-well-formed** if every gate's input list has a length +admitted by the gate's operation arity. This ensures that `eval` never hits the +`none` fallback for arity mismatches. -/ +def GatesWellFormed [Basis Op] (C : Circuit Op n) : Prop := + ∀ g ∈ C.gates, (Basis.arity g.op).admits g.inputs.length + +/-- A circuit has **well-formed wires** if every gate only references wires that +are already defined (input wires or outputs of earlier gates). -/ +def WiresWellFormed (C : Circuit Op n) : Prop := + ∀ (i : ℕ) (hi : i < C.gates.length), + ∀ w ∈ (C.gates.get ⟨i, hi⟩).inputs, w < n + i + +/-- A circuit has a **valid output wire** if the output wire index refers to +a wire that actually exists (input or gate output). -/ +def OutputWireValid (C : Circuit Op n) : Prop := + C.outputWire < n + C.gates.length + +/-- A circuit is **well-formed** if its gates have correct arities, its wire +references are in bounds, and its output wire is valid. Well-formed circuits +always evaluate to `some`. -/ +def WellFormed [Basis Op] (C : Circuit Op n) : Prop := + C.GatesWellFormed ∧ C.WiresWellFormed ∧ C.OutputWireValid + +/-- mapM over getElem? succeeds when all indices are in bounds. -/ +private theorem mapM_getElem_some (wires : List Bool) (inputs : List ℕ) + (h : ∀ w ∈ inputs, w < wires.length) : + ∃ bs, (inputs.mapM fun i => wires[i]?) = some bs ∧ bs.length = inputs.length := by + induction inputs with + | nil => exact ⟨[], rfl, rfl⟩ + | cons w ws ih => + have hw : w < wires.length := h w (by simp) + obtain ⟨bs', hbs', hlen'⟩ := ih (fun w' hw' => h w' (by simp [hw'])) + refine ⟨wires[w] :: bs', ?_, by simp [hlen']⟩ + simp [List.mapM_cons, List.getElem?_eq_getElem hw, hbs'] + +/-- Well-formed circuits always evaluate to `some`. -/ +theorem WellFormed.eval_isSome [Basis Op] (C : Circuit Op n) (hWF : C.WellFormed) + (input : Fin n → Bool) : (C.eval input).isSome = true := by + obtain ⟨hGates, hWires, hOut⟩ := hWF + -- Prove the foldl produces some wires with length n + gates.length + suffices h : ∀ (gs : List (Gate Op)) (acc : List Bool) + (harity : ∀ g ∈ gs, (Basis.arity g.op).admits g.inputs.length) + (hwires : ∀ (i : ℕ) (hi : i < gs.length), + ∀ w ∈ (gs.get ⟨i, hi⟩).inputs, w < acc.length + i), + ∃ wires, gs.foldl (fun (a : Option (List Bool)) gate => + a.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else none) (some acc) = some wires ∧ + wires.length = acc.length + gs.length by + obtain ⟨wires, hfold, hlen⟩ := h C.gates (List.ofFn input) hGates + (by intro i hi w hw; have := hWires i hi w hw; simp [List.length_ofFn]; omega) + change (eval C input).isSome = true + unfold eval + simp only [hfold, Option.bind_some] + have hlt : C.outputWire < wires.length := by + rw [hlen, List.length_ofFn]; exact hOut + rw [List.getElem?_eq_getElem hlt]; rfl + intro gs + induction gs with + | nil => intro acc _ _; exact ⟨acc, rfl, by simp⟩ + | cons g gs ih => + intro acc harity hwires + simp only [List.foldl_cons] + have hg_arity := harity g (by simp) + have hg_wires : ∀ w ∈ g.inputs, w < acc.length := by + intro w hw; have := hwires 0 (by simp) w hw; omega + obtain ⟨bs, hbs, hbs_len⟩ := mapM_getElem_some acc g.inputs hg_wires + have hadmits : (Basis.arity g.op).admits bs.length := hbs_len ▸ hg_arity + simp only [Option.bind_some, hbs, dif_pos hadmits] + obtain ⟨wires, hfold, hlen⟩ := ih (acc ++ [Basis.eval g.op bs hadmits]) + (fun g' hg' => harity g' (by simp [hg'])) + (fun i hi w hw => by + have := hwires (i + 1) (Nat.succ_lt_succ hi) w hw + simp only [List.length_append, List.length_cons, List.length_nil] + omega) + refine ⟨wires, hfold, ?_⟩ + simp only [List.length_append, List.length_singleton] at hlen + simp only [List.length_cons] + omega + +/-! ### Gate and circuit mapping -/ + +variable {Op' : Type*} + +/-- Map a function over the operations of every gate in a circuit. +This is used to embed a circuit over one basis into another +(e.g., `NCOp → ACOp` for the `NC ⊆ AC` inclusion). -/ +def mapOp (f : Op → Op') (C : Circuit Op n) : Circuit Op' n := + { gates := C.gates.map (Gate.mapOp f), outputWire := C.outputWire } + +@[simp] +theorem size_mapOp (f : Op → Op') (C : Circuit Op n) : + (C.mapOp f).size = C.size := by + simp [mapOp, size] + +/-- `mapOp` preserves gate well-formedness when the mapping preserves +arity admissibility: if every admitted input count for `op` is also +admitted for `f op`, then well-formedness transfers. -/ +theorem GatesWellFormed_mapOp [Basis Op] [Basis Op'] (f : Op → Op') (C : Circuit Op n) + (hadmits : ∀ op n, (Basis.arity op).admits n → (Basis.arity (f op)).admits n) + (hWF : C.GatesWellFormed) : + (C.mapOp f).GatesWellFormed := by + intro g hg + simp only [mapOp, List.mem_map] at hg + obtain ⟨g', hg'_mem, hg'_eq⟩ := hg + subst hg'_eq + simp only [Gate.mapOp] + exact hadmits g'.op g'.inputs.length (hWF g' hg'_mem) + +/-- `mapOp` preserves depth because depth only depends on wire connectivity, +not on gate operations. -/ +theorem depth_mapOp [Basis Op] [Basis Op'] (f : Op → Op') (C : Circuit Op n) : + (C.mapOp f).depth = C.depth := by + simp only [depth, mapOp] + suffices ∀ (gs : List (Gate Op)) (acc : List ℕ), + (gs.map (Gate.mapOp f)).foldl + (fun depths gate => + depths ++ [gate.inputs.foldl + (fun maxD i => max maxD (depths.getD i 0)) 0 + 1]) + acc = + gs.foldl + (fun depths gate => + depths ++ [gate.inputs.foldl + (fun maxD i => max maxD (depths.getD i 0)) 0 + 1]) + acc by + exact congr_arg (·.getD C.outputWire 0) (this C.gates _) + intro gs + induction gs with + | nil => simp + | cons g gs ih => + intro acc + simp only [List.map_cons, List.foldl_cons, Gate.mapOp] + exact ih _ + +/-- `mapOp` preserves evaluation when the function preserves gate semantics: +same arity and same evaluation on admitted inputs. -/ +theorem eval_mapOp [Basis Op] [Basis Op'] (f : Op → Op') (C : Circuit Op n) + (harity : ∀ op, Basis.arity (f op) = Basis.arity op) + (heval : ∀ op bs (h : (Basis.arity op).admits bs.length), + Basis.eval (f op) bs (harity op ▸ h) = Basis.eval op bs h) + (input : Fin n → Bool) : + (C.mapOp f).eval input = C.eval input := by + simp only [eval, mapOp] + -- Prove the foldls produce the same result, then the bind is the same + suffices ∀ (gs : List (Gate Op)) (acc : Option (List Bool)), + (gs.map (Gate.mapOp f)).foldl + (fun (acc : Option (List Bool)) gate => + acc.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else none) + acc = + gs.foldl + (fun (acc : Option (List Bool)) gate => + acc.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else none) + acc by + exact congr_arg (·.bind fun wires => wires[C.outputWire]?) (this C.gates _) + intro gs + induction gs with + | nil => simp + | cons g gs ih => + intro acc + simp only [List.map_cons, List.foldl_cons, Gate.mapOp] + -- Show the gate output is the same for f g.op vs g.op with same inputs + have h_output : ∀ (wires : List Bool), + ((g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity (f g.op)).admits bs.length then + some (wires ++ [Basis.eval (f g.op) bs h]) + else none) = + ((g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity g.op).admits bs.length then + some (wires ++ [Basis.eval g.op bs h]) + else none) := by + intro wires + cases hm : (g.inputs.mapM fun i => wires[i]?) with + | none => rfl + | some bs => + simp only [Option.bind_some] + by_cases hadmits : (Basis.arity g.op).admits bs.length + · have hadmits' : (Basis.arity (f g.op)).admits bs.length := by + rw [harity]; exact hadmits + rw [dif_pos hadmits', dif_pos hadmits] + simp only [heval g.op bs hadmits] + · have hadmits' : ¬(Basis.arity (f g.op)).admits bs.length := by + rw [harity]; exact hadmits + rw [dif_neg hadmits', dif_neg hadmits] + -- Simplify: the bind over acc with h_output means both sides agree + have h_step : + (acc.bind fun wires => + (g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity (f g.op)).admits bs.length then + some (wires ++ [Basis.eval (f g.op) bs h]) + else none) = + (acc.bind fun wires => + (g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity g.op).admits bs.length then + some (wires ++ [Basis.eval g.op bs h]) + else none) := by + cases acc with + | none => rfl + | some wires => simp only [Option.bind_some]; exact h_output wires + rw [h_step] + exact ih _ + +/-! ### Basic lemmas -/ + +@[simp] +theorem size_mk (gates : List (Gate Op)) (out : ℕ) : + (Circuit.mk gates out : Circuit Op n).size = gates.length := rfl + +end Circuit + +/-! ### Circuit Families -/ + +/-- A circuit family assigns a circuit to each input size `n`. -/ +def CircuitFamily (Op : Type*) := (n : ℕ) → Circuit Op n + +namespace CircuitFamily + +variable {Op : Type*} + +/-- A circuit family `C` **decides** a language `L : Set (List Bool)` when +for every input `x`, membership in `L` is equivalent to the circuit of size `x.length` +evaluating to `some true`. -/ +def Decides [Basis Op] (C : CircuitFamily Op) (L : Set (List Bool)) : Prop := + ∀ x : List Bool, x ∈ L ↔ (C x.length).eval (x.get ·) = some true + +end CircuitFamily + +end Cslib.Circuits diff --git a/Cslib/Computability/Circuits/Formula/Basic.lean b/Cslib/Computability/Circuits/Formula/Basic.lean new file mode 100644 index 000000000..656c780e3 --- /dev/null +++ b/Cslib/Computability/Circuits/Formula/Basic.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Circuits.Basis + +@[expose] public section + +/-! # Boolean Formulas + +A Boolean formula is a tree-structured expression built from variables and gates drawn +from a `Basis`. Unlike circuits, formulas require every gate output to feed into exactly +one parent — there is no fan-out sharing. This means every formula is a tree (not a DAG), +and its size is an upper bound on the number of distinct sub-computations. + +## Design notes + +The `Formula` type itself is basis-agnostic — it is parameterized by an arbitrary operation +type `Op` without requiring a `Basis` instance. This keeps the structural operations (`map`, +`size`, `depth`, etc.) independent of evaluation semantics. + +Arity enforcement happens at evaluation time: `Formula.eval` uses the `Decidable` instance +on `Arity.admits` to check whether each gate's children count matches its declared arity. +Gates with mismatched arity evaluate to `none`. For well-formed formulas (e.g., those built +via the smart constructors in `Formula.Std`), evaluation always returns `some`. + +## Main definitions + +- `Formula` — inductive type of Boolean formulas over variables `Var` and gates `Op` +- `Formula.eval` — evaluate a formula under a variable assignment (requires `[Basis Op]`), + returning `Option Bool` (`none` for malformed, `some b` for genuine computation) +- `Formula.WellFormed` — predicate ensuring every gate has the correct arity +- `Formula.WellFormed.eval_isSome` — well-formed formulas always evaluate to `some` +- `Formula.map` — rename variables by applying a function to every leaf +- `Formula.ind` — custom induction principle with membership-based hypothesis + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +namespace Cslib.Circuits + +/-- Collect a list of `Option α` into an `Option (List α)`. +Returns `some` of the collected values if all entries are `some`, +or `none` if any entry is `none`. -/ +def optionAll : List (Option α) → Option (List α) + | [] => some [] + | (some a) :: rest => (optionAll rest).map (a :: ·) + | none :: _ => none + +@[simp] +theorem optionAll_nil : (optionAll ([] : List (Option α))) = some [] := rfl + +@[simp] +theorem optionAll_cons_some (a : α) (rest : List (Option α)) : + optionAll (some a :: rest) = (optionAll rest).map (a :: ·) := rfl + +@[simp] +theorem optionAll_cons_none (rest : List (Option α)) : + optionAll (none :: rest) = none := rfl + +@[simp] +theorem optionAll_map_some (xs : List α) : + optionAll (xs.map some) = some xs := by + induction xs with + | nil => rfl + | cons x xs ih => simp [ih] + +/-- If every element of a list is `some`, then `optionAll` succeeds and preserves length. -/ +theorem optionAll_of_forall_isSome {xs : List (Option α)} + (h : ∀ x ∈ xs, x.isSome = true) : + ∃ ys, optionAll xs = some ys ∧ ys.length = xs.length := by + induction xs with + | nil => exact ⟨[], rfl, rfl⟩ + | cons x xs ih => + have hx := h x (by simp) + rw [Option.isSome_iff_exists] at hx + obtain ⟨a, ha⟩ := hx + obtain ⟨ys, hys, hlen⟩ := ih (fun x' hx' => h x' (by simp [hx'])) + exact ⟨a :: ys, by simp [ha, hys], by simp [hlen]⟩ + +/-- A Boolean formula over variables of type `Var` and gate operations of type `Op`. + +Formulas are trees: each gate takes a list of sub-formulas as children. The type +does not enforce arity constraints — any operation can be applied to any number of +children. Arity is checked dynamically during `eval`. -/ +inductive Formula (Var : Type*) (Op : Type*) where + /-- A variable leaf. -/ + | var : Var → Formula Var Op + /-- A gate applied to a list of sub-formula children. -/ + | gate : Op → List (Formula Var Op) → Formula Var Op + +namespace Formula + +variable {Var Var' : Type*} {Op : Type*} + +/-- Evaluate a formula under a variable assignment. + +Variables return `some` of the assignment. At each gate, children are evaluated +recursively; if any child returns `none`, the gate returns `none`. Otherwise, the +resulting list is passed to `Basis.eval` if the arity check succeeds. If the children +count does not match the operation's declared arity, the gate returns `none`. -/ +@[simp, scoped grind =] +def eval [Basis Op] (assignment : Var → Bool) : Formula Var Op → Option Bool + | .var v => some (assignment v) + | .gate op children => + (optionAll (children.map (eval assignment))).bind fun bs => + if h : (Basis.arity op).admits bs.length then + some (Basis.eval op bs h) + else + none + +/-- A formula is **well-formed** if every gate's children count matches its declared arity, +and all children are themselves well-formed. Variables are always well-formed. -/ +def WellFormed [Basis Op] : Formula Var Op → Prop + | .var _ => True + | .gate op children => + (Basis.arity op).admits children.length ∧ ∀ c ∈ children, WellFormed c + +/-- Rename variables in a formula by applying `f` to every variable leaf. +Gate structure and operations are preserved; only the `var` nodes change. -/ +@[scoped grind =] +def map (f : Var → Var') : Formula Var Op → Formula Var' Op + | .var v => .var (f v) + | .gate op children => .gate op (children.map (Formula.map f)) + +/-- Custom induction principle for `Formula` that provides `∀ c ∈ children, motive c` +as the induction hypothesis for the `gate` case, rather than Lean's default structural +induction on the nested `List`. Use with `induction f using Formula.ind`. -/ +@[elab_as_elim] +def ind {motive : Formula Var Op → Prop} + (hvar : ∀ v, motive (.var v)) + (hgate : ∀ op children, (∀ c ∈ children, motive c) → motive (.gate op children)) + : ∀ f, motive f + | .var v => hvar v + | .gate op children => hgate op children fun c hc => + have : sizeOf c < 1 + sizeOf op + sizeOf children := + Nat.lt_of_lt_of_le (List.sizeOf_lt_of_mem hc) (Nat.le_add_left _ _) + ind hvar hgate c +termination_by f => sizeOf f + +/-- Well-formed formulas always evaluate to `some`. -/ +theorem WellFormed.eval_isSome [Basis Op] {f : Formula Var Op} + (hf : f.WellFormed) (v : Var → Bool) : (f.eval v).isSome = true := by + induction f using Formula.ind with + | hvar _ => simp [eval] + | hgate op children ih => + unfold WellFormed at hf + obtain ⟨harity, hchildren⟩ := hf + have h_all : ∀ x ∈ children.map (eval v), x.isSome = true := by + simp only [List.mem_map] + rintro _ ⟨c, hc, rfl⟩ + exact ih c hc (hchildren c hc) + obtain ⟨bs, hbs, hlen⟩ := optionAll_of_forall_isSome h_all + have hadmits : (Basis.arity op).admits bs.length := by + rw [hlen, List.length_map]; exact harity + simp only [eval, hbs, Option.bind_some, dif_pos hadmits, Option.isSome_some] + +/-- Well-formedness is preserved by variable renaming. -/ +theorem WellFormed_map [Basis Op] {f : Formula Var Op} (g : Var → Var') + (hf : f.WellFormed) : (f.map g).WellFormed := by + induction f using Formula.ind with + | hvar _ => + unfold map WellFormed + trivial + | hgate op children ih => + unfold WellFormed at hf + obtain ⟨harity, hchildren⟩ := hf + unfold map + unfold WellFormed + exact ⟨by rw [List.length_map]; exact harity, + fun c hc => by + simp only [List.mem_map] at hc + obtain ⟨c', hc'_mem, rfl⟩ := hc + exact ih c' hc'_mem (hchildren c' hc'_mem)⟩ + +end Formula + +end Cslib.Circuits diff --git a/Cslib/Computability/Circuits/Formula/Measures.lean b/Cslib/Computability/Circuits/Formula/Measures.lean new file mode 100644 index 000000000..7714d9848 --- /dev/null +++ b/Cslib/Computability/Circuits/Formula/Measures.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Circuits.Formula.Basic + +@[expose] public section + +/-! # Formula Measures + +Structural measures on Boolean formulas: size, depth, leaf count, and gate count. +These are purely structural — they depend only on the tree shape, not on the `Basis` +or evaluation semantics, so they require no typeclass constraints. + +## Main definitions + +- `Formula.size` — total number of nodes (leaves + gates) +- `Formula.depth` — longest root-to-leaf path length +- `Formula.leafCount` — number of variable leaves +- `Formula.gateCount` — number of gate nodes + +## Main results + +- `size_pos` — every formula has at least one node +- `size_map`, `depth_map` — variable renaming preserves size and depth +- `size_eq_leafCount_add_gateCount` — size decomposes as leaves + gates + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +namespace Cslib.Circuits + +namespace Formula + +variable {Var Var' : Type*} {Op : Type*} + +/-- Total number of nodes in a formula. Each variable leaf and each gate contributes 1. +Equivalently, `size = leafCount + gateCount` (see `size_eq_leafCount_add_gateCount`). -/ +@[simp, scoped grind =] +def size : Formula Var Op → Nat + | .var _ => 1 + | .gate _ children => 1 + (children.map size).sum + +/-- The depth of a formula: longest root-to-leaf path length. Variables have depth 0; +a gate's depth is one more than the maximum depth of its children. -/ +@[simp, scoped grind =] +def depth : Formula Var Op → Nat + | .var _ => 0 + | .gate _ children => 1 + (children.map depth).foldl max 0 + +/-- Number of variable leaves in a formula. Gates contribute 0; each `var` contributes 1. -/ +@[simp, scoped grind =] +def leafCount : Formula Var Op → Nat + | .var _ => 1 + | .gate _ children => (children.map leafCount).sum + +/-- Number of gate nodes in a formula. Variables contribute 0; each `gate` contributes 1. -/ +@[simp, scoped grind =] +def gateCount : Formula Var Op → Nat + | .var _ => 0 + | .gate _ children => 1 + (children.map gateCount).sum + +/-! ### Base case lemmas -/ + +@[scoped grind =] +theorem size_var (v : Var) : (.var v : Formula Var Op).size = 1 := by simp [size] + +@[scoped grind =] +theorem depth_var (v : Var) : (.var v : Formula Var Op).depth = 0 := by simp [depth] + +@[scoped grind =] +theorem leafCount_var (v : Var) : (.var v : Formula Var Op).leafCount = 1 := by simp [leafCount] + +@[scoped grind =] +theorem gateCount_var (v : Var) : (.var v : Formula Var Op).gateCount = 0 := by simp [gateCount] + +/-! ### Size is always positive -/ + +theorem size_pos (f : Formula Var Op) : 0 < f.size := by + cases f with + | var _ => simp [size] + | gate _ _ => simp [size]; omega + +/-! ### Mapping preserves measures -/ + +@[scoped grind =] +theorem size_map (g : Var → Var') (f : Formula Var Op) : (f.map g).size = f.size := by + induction f using Formula.ind with + | hvar _ => simp [map, size] + | hgate op children ih => + simp only [map, size, List.map_map, Function.comp_def] + rw [List.map_congr_left ih] + +@[scoped grind =] +theorem depth_map (g : Var → Var') (f : Formula Var Op) : (f.map g).depth = f.depth := by + induction f using Formula.ind with + | hvar _ => simp [map, depth] + | hgate op children ih => + simp only [map, depth, List.map_map, Function.comp_def] + rw [List.map_congr_left ih] + +/-! ### Size decomposition -/ + +private theorem list_sum_map_add {l : List α} {f g : α → Nat} : + (l.map (fun x => f x + g x)).sum = (l.map f).sum + (l.map g).sum := by + induction l with + | nil => simp + | cons _ _ ih => simp [List.sum_cons]; omega + +@[scoped grind =] +theorem size_eq_leafCount_add_gateCount (f : Formula Var Op) : + f.size = f.leafCount + f.gateCount := by + induction f using Formula.ind with + | hvar _ => simp [size, leafCount, gateCount] + | hgate _ children ih => + simp only [size, leafCount, gateCount] + rw [List.map_congr_left ih, list_sum_map_add] + omega + +end Formula + +end Cslib.Circuits diff --git a/Cslib/Computability/Circuits/Formula/Std.lean b/Cslib/Computability/Circuits/Formula/Std.lean new file mode 100644 index 000000000..79d295222 --- /dev/null +++ b/Cslib/Computability/Circuits/Formula/Std.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Circuits.Formula.Measures + +@[expose] public section + +/-! # Standard-Basis Boolean Formulas + +Convenience constructors and evaluation/measure lemmas for formulas over the standard +bounded fan-in basis (`NCOp`): binary AND, binary OR, and unary NOT. + +The smart constructors `Formula.and`, `Formula.or`, and `Formula.not` build formulas +with the correct number of children for each operation, so `Formula.eval` always +returns `some` for formulas built this way. + +## Main definitions + +- `Formula.and`, `Formula.or`, `Formula.not` — smart constructors that guarantee + correct arity +- `eval_and`, `eval_or`, `eval_not` — evaluation reduces to `Option.bind`/`Option.map` + of native Boolean operations +- `WellFormed_and`, `WellFormed_or`, `WellFormed_not`, `WellFormed_var` — smart + constructors produce well-formed formulas +- `eval_not_not` — double negation elimination +- `deMorgan_and`, `deMorgan_or` — De Morgan's laws at the formula level +- `size_and`, `size_or`, `size_not` — size of standard constructs +- `depth_and`, `depth_or`, `depth_not` — depth of standard constructs + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +namespace Cslib.Circuits + +namespace Formula + +variable {Var : Type*} + +/-- Binary AND of two formulas over the standard basis. +Constructs `.gate .and [a, b]`, which has exactly 2 children matching `NCOp.and`'s arity. -/ +@[scoped grind =] +def and (a b : Formula Var NCOp) : Formula Var NCOp := .gate .and [a, b] + +/-- Binary OR of two formulas over the standard basis. +Constructs `.gate .or [a, b]`, which has exactly 2 children matching `NCOp.or`'s arity. -/ +@[scoped grind =] +def or (a b : Formula Var NCOp) : Formula Var NCOp := .gate .or [a, b] + +/-- Negation of a formula over the standard basis. +Constructs `.gate .not [a]`, which has exactly 1 child matching `NCOp.not`'s arity. -/ +@[scoped grind =] +def not (a : Formula Var NCOp) : Formula Var NCOp := .gate .not [a] + +/-! ### Well-formedness lemmas -/ + +@[simp] +theorem WellFormed_var : (Formula.var v : Formula Var NCOp).WellFormed := by + unfold WellFormed; trivial + +@[simp] +theorem WellFormed_and {a b : Formula Var NCOp} + (ha : a.WellFormed) (hb : b.WellFormed) : (Formula.and a b).WellFormed := by + unfold Formula.and WellFormed + exact ⟨by simp [Arity.admits], fun c hc => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hc + rcases hc with rfl | rfl <;> assumption⟩ + +@[simp] +theorem WellFormed_or {a b : Formula Var NCOp} + (ha : a.WellFormed) (hb : b.WellFormed) : (Formula.or a b).WellFormed := by + unfold Formula.or WellFormed + exact ⟨by simp [Arity.admits], fun c hc => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hc + rcases hc with rfl | rfl <;> assumption⟩ + +@[simp] +theorem WellFormed_not {a : Formula Var NCOp} + (ha : a.WellFormed) : (Formula.not a).WellFormed := by + unfold Formula.not WellFormed + exact ⟨by simp [Arity.admits], fun c hc => by + simp only [List.mem_cons, List.not_mem_nil, or_false] at hc; rw [hc]; exact ha⟩ + +/-! ### Evaluation lemmas -/ + +@[simp, scoped grind =] +theorem eval_and (v : Var → Bool) (a b : Formula Var NCOp) : + (Formula.and a b).eval v = + (a.eval v).bind fun a' => (b.eval v).map (a' && ·) := by + simp only [Formula.and, eval] + cases ha : eval v a with + | none => simp [ha] + | some a' => + cases hb : eval v b with + | none => simp [ha, hb] + | some b' => simp [ha, hb, Basis.eval, Arity.admits] + +@[simp, scoped grind =] +theorem eval_or (v : Var → Bool) (a b : Formula Var NCOp) : + (Formula.or a b).eval v = + (a.eval v).bind fun a' => (b.eval v).map (a' || ·) := by + simp only [Formula.or, eval] + cases ha : eval v a with + | none => simp [ha] + | some a' => + cases hb : eval v b with + | none => simp [ha, hb] + | some b' => simp [ha, hb, Basis.eval, Arity.admits] + +@[simp, scoped grind =] +theorem eval_not (v : Var → Bool) (a : Formula Var NCOp) : + (Formula.not a).eval v = (a.eval v).map (!·) := by + simp only [Formula.not, eval] + cases ha : eval v a with + | none => simp [ha] + | some a' => simp [ha, Basis.eval, Arity.admits] + +/-! ### Double negation -/ + +@[simp, scoped grind =] +theorem eval_not_not (v : Var → Bool) (a : Formula Var NCOp) : + (Formula.not (Formula.not a)).eval v = a.eval v := by + simp only [eval_not, Option.map_map, Function.comp_def, Bool.not_not, Option.map_id'] + +/-! ### De Morgan's laws -/ + +@[scoped grind =] +theorem deMorgan_and (v : Var → Bool) (a b : Formula Var NCOp) : + (Formula.not (Formula.and a b)).eval v = + (Formula.or (Formula.not a) (Formula.not b)).eval v := by + simp only [eval_not, eval_and, eval_or] + cases a.eval v <;> cases b.eval v <;> + simp [Option.bind, Option.map, Bool.not_and] + +@[scoped grind =] +theorem deMorgan_or (v : Var → Bool) (a b : Formula Var NCOp) : + (Formula.not (Formula.or a b)).eval v = + (Formula.and (Formula.not a) (Formula.not b)).eval v := by + simp only [eval_not, eval_and, eval_or] + cases a.eval v <;> cases b.eval v <;> + simp [Option.bind, Option.map, Bool.not_or] + +/-! ### Measure lemmas for standard constructors -/ + +@[simp, scoped grind =] +theorem size_and (a b : Formula Var NCOp) : + (Formula.and a b).size = 1 + a.size + b.size := by + simp [Formula.and, size, List.map, List.sum]; omega + +@[simp, scoped grind =] +theorem size_or (a b : Formula Var NCOp) : + (Formula.or a b).size = 1 + a.size + b.size := by + simp [Formula.or, size, List.map, List.sum]; omega + +@[simp, scoped grind =] +theorem size_not (a : Formula Var NCOp) : + (Formula.not a).size = 1 + a.size := by + simp [Formula.not, size, List.map, List.sum] + +@[simp, scoped grind =] +theorem depth_and (a b : Formula Var NCOp) : + (Formula.and a b).depth = 1 + max a.depth b.depth := by + simp [Formula.and, depth, List.map, List.foldl, Nat.max_def] + +@[simp, scoped grind =] +theorem depth_or (a b : Formula Var NCOp) : + (Formula.or a b).depth = 1 + max a.depth b.depth := by + simp [Formula.or, depth, List.map, List.foldl, Nat.max_def] + +@[simp, scoped grind =] +theorem depth_not (a : Formula Var NCOp) : + (Formula.not a).depth = 1 + a.depth := by + simp [Formula.not, depth, List.map, List.foldl] + +end Formula + +end Cslib.Circuits diff --git a/Cslib/Computability/Complexity/CircuitHierarchy.lean b/Cslib/Computability/Complexity/CircuitHierarchy.lean new file mode 100644 index 000000000..57c824668 --- /dev/null +++ b/Cslib/Computability/Complexity/CircuitHierarchy.lean @@ -0,0 +1,296 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.NonUniform +public import Mathlib.Data.Nat.Log + +@[expose] public section + +/-! +# Circuit Complexity Hierarchy: NC and AC + +This file defines the circuit complexity classes **NC** and **AC** +via size and depth bounds on circuit families, and proves basic +containment relations in the hierarchy. + +## Main Definitions + +* `SizeDepth Op s d` — languages decidable by well-formed circuit families over `Op` + with size ≤ `s(n)` and depth ≤ `d(n)` +* `NC k` — poly size, O(log^k n) depth, bounded fan-in +* `AC k` — poly size, O(log^k n) depth, unbounded fan-in + +## Design Notes + +The depth bound uses `(Nat.log 2 n + 1) ^ k` rather than `(Nat.log 2 n) ^ k`. +Since `Nat.log 2 0 = 0` and `Nat.log 2 1 = 0`, the bare `log` would make the +depth bound zero for small inputs when `k ≥ 1`, which is pathological. Adding 1 +ensures the base is always ≥ 1, making the hierarchy monotone (`NC^k ⊆ NC^(k+1)`) +provable by simple exponent comparison. + +`SizeDepth` includes a `GatesWellFormed` condition ensuring every gate's input list +has a length admitted by its operation's arity. This matches the standard mathematical +convention that circuit gates are well-formed, and is essential for proving +`NC^k ⊆ AC^k` (the gate embedding preserves evaluation only for well-formed gates). + +## Main Results + +* `SizeDepth_mono_size` — monotone in size bound +* `SizeDepth_mono_depth` — monotone in depth bound +* `NC_mono` — NC^k ⊆ NC^(k+1) +* `AC_mono` — AC^k ⊆ AC^(k+1) +* `NC_subset_AC` — NC^k ⊆ AC^k +* `NC_subset_SIZE` — NC^k ⊆ P/poly +* `AC_subset_SIZE` — AC^k ⊆ P/poly + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +open Cslib.Circuits Polynomial + +variable {Op : Type*} [Basis Op] + +/-- `SizeDepth Op s d` is the class of languages decidable by well-formed circuit +families over basis `Op` whose circuit at input size `n` has at most +`s n` gates and depth at most `d n`. + +The well-formedness condition (`GatesWellFormed`) requires that every gate's +input list has a length admitted by its operation's arity. This matches the +standard mathematical convention and ensures that circuit evaluation always +returns `some` (never `none` due to arity mismatches). -/ +def SizeDepth (Op : Type*) [Basis Op] + (s d : ℕ → ℕ) : Set (Set (List Bool)) := + { L | ∃ C : CircuitFamily Op, + C.Decides L ∧ (∀ n, (C n).GatesWellFormed) ∧ + (∀ n, (C n).size ≤ s n) ∧ (∀ n, (C n).depth ≤ d n) } + +/-- **NC^k** is the class of languages decidable by polynomial-size, +O(log^k n)-depth circuit families with bounded fan-in (at most 2). + +We parameterize by a size polynomial `p` and a depth constant `c` +and require `size ≤ p(n)` and `depth ≤ c · (log₂ n + 1)^k`. -/ +def NC (k : ℕ) : Set (Set (List Bool)) := + { L | ∃ (p : Polynomial ℕ) (c : ℕ), + L ∈ SizeDepth NCOp + (fun n => p.eval n) + (fun n => c * (Nat.log 2 n + 1) ^ k) } + +/-- **AC^k** is the class of languages decidable by polynomial-size, +O(log^k n)-depth circuit families with unbounded fan-in. -/ +def AC (k : ℕ) : Set (Set (List Bool)) := + { L | ∃ (p : Polynomial ℕ) (c : ℕ), + L ∈ SizeDepth ACOp + (fun n => p.eval n) + (fun n => c * (Nat.log 2 n + 1) ^ k) } + +end + +open Cslib.Circuits Polynomial + +/-! ### Monotonicity of SizeDepth -/ + +/-- `SizeDepth` is monotone in the size bound. -/ +theorem SizeDepth_mono_size {Op : Type*} [Basis Op] + {s s' d : ℕ → ℕ} (h : ∀ n, s n ≤ s' n) : + SizeDepth Op s d ⊆ SizeDepth Op s' d := by + intro L ⟨C, hDec, hWF, hSize, hDepth⟩ + exact ⟨C, hDec, hWF, fun n => (hSize n).trans (h n), hDepth⟩ + +/-- `SizeDepth` is monotone in the depth bound. -/ +theorem SizeDepth_mono_depth {Op : Type*} [Basis Op] + {s d d' : ℕ → ℕ} (h : ∀ n, d n ≤ d' n) : + SizeDepth Op s d ⊆ SizeDepth Op s d' := by + intro L ⟨C, hDec, hWF, hSize, hDepth⟩ + exact ⟨C, hDec, hWF, hSize, fun n => (hDepth n).trans (h n)⟩ + +/-! ### NC hierarchy -/ + +/-- **NC^k ⊆ NC^(k+1)**: the NC hierarchy is monotone. + +Since the depth bound uses `(log₂ n + 1)^k` and `log₂ n + 1 ≥ 1`, +we have `(log₂ n + 1)^k ≤ (log₂ n + 1)^(k+1)` by exponent monotonicity. -/ +public theorem NC_mono {k : ℕ} : NC k ⊆ NC (k + 1) := by + intro L ⟨p, c, C, hDec, hWF, hSize, hDepth⟩ + exact ⟨p, c, C, hDec, hWF, hSize, fun n => (hDepth n).trans + (Nat.mul_le_mul_left c (Nat.pow_le_pow_right (Nat.succ_pos _) (Nat.le_succ k)))⟩ + +/-! ### AC hierarchy -/ + +/-- **AC^k ⊆ AC^(k+1)**: the AC hierarchy is monotone. -/ +public theorem AC_mono {k : ℕ} : AC k ⊆ AC (k + 1) := by + intro L ⟨p, c, C, hDec, hWF, hSize, hDepth⟩ + exact ⟨p, c, C, hDec, hWF, hSize, fun n => (hDepth n).trans + (Nat.mul_le_mul_left c (Nat.pow_le_pow_right (Nat.succ_pos _) (Nat.le_succ k)))⟩ + +/-! ### NC^k ⊆ AC^k -/ + +/-- Embed bounded fan-in operations into unbounded fan-in operations. -/ +private def ncToAc : NCOp → ACOp + | .and => .and + | .or => .or + | .not => .not + +/-- The embedding preserves arity admissibility: if NCOp admits an input count, +so does the corresponding ACOp (since `.atMost 2` implies `.any`). -/ +private theorem ncToAc_admits (op : NCOp) (n : ℕ) : + (Basis.arity op).admits n → (Basis.arity (ncToAc op)).admits n := by + cases op <;> simp [ncToAc, Basis.arity] + +/-- The embedding preserves evaluation: on admitted inputs, NCOp and ACOp +compute the same Boolean function (both use the same foldl semantics). -/ +private theorem ncToAc_eval (op : NCOp) (bs : List Bool) + (h : (Basis.arity op).admits bs.length) : + Basis.eval (ncToAc op) bs (ncToAc_admits op bs.length h) = + Basis.eval op bs h := by + cases op with + | and => simp [ncToAc, Basis.eval] + | or => simp [ncToAc, Basis.eval] + | not => + -- h : bs.length = 1, so bs = [b] for some b + simp only [Arity.admits] at h + match bs, h with + | [b], _ => simp [ncToAc, Basis.eval] + +/-- `mapM` for `Option` preserves list length. -/ +private theorem mapM_option_length {f : α → Option β} {xs : List α} {ys : List β} + (h : xs.mapM f = some ys) : ys.length = xs.length := by + induction xs generalizing ys with + | nil => + have : ys = [] := by simpa [List.mapM_nil] using h + subst this; rfl + | cons x xs ih => + rw [List.mapM_cons] at h + match hfx : f x, h with + | some a, h => + match hxs : xs.mapM f, h with + | some bs, h => + have : ys = a :: bs := by simpa [hfx, hxs] using h.symm + subst this; simp [ih hxs] + +/-- The embedding preserves circuit evaluation for well-formed circuits. + +Well-formedness ensures every gate has the correct number of inputs for its +NCOp arity (≤ 2 for AND/OR, exactly 1 for NOT). Since ACOp admits at least as +many inputs, the embedded circuit computes the same function. -/ +private theorem ncToAc_circuit_eval {n : ℕ} (C : Circuit NCOp n) + (hWF : C.GatesWellFormed) + (input : Fin n → Bool) : + (C.mapOp ncToAc).eval input = C.eval input := by + simp only [Circuit.eval, Circuit.mapOp] + -- We prove the stronger statement that the foldls agree after + -- processing any prefix of gates, as long as all processed gates are well-formed. + suffices ∀ (gs : List (Gate NCOp)) + (hgs : ∀ g ∈ gs, (Basis.arity g.op).admits g.inputs.length) + (acc : Option (List Bool)), + (gs.map (Gate.mapOp ncToAc)).foldl + (fun (acc : Option (List Bool)) gate => + acc.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else none) + acc = + gs.foldl + (fun (acc : Option (List Bool)) gate => + acc.bind fun wires => + (gate.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity gate.op).admits bs.length then + some (wires ++ [Basis.eval gate.op bs h]) + else none) + acc by + exact congr_arg (·.bind fun wires => wires[C.outputWire]?) (this C.gates hWF _) + intro gs hgs + induction gs with + | nil => simp + | cons g gs ih => + intro acc + simp only [List.map_cons, List.foldl_cons, Gate.mapOp] + -- The gate g is well-formed: its NCOp arity admits g.inputs.length + have hg_wf : (Basis.arity g.op).admits g.inputs.length := + hgs g (by simp) + -- For any wires, the gate evaluation gives the same result + have h_output : ∀ (wires : List Bool), + ((g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity (ncToAc g.op)).admits bs.length then + some (wires ++ [Basis.eval (ncToAc g.op) bs h]) + else none) = + ((g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity g.op).admits bs.length then + some (wires ++ [Basis.eval g.op bs h]) + else none) := by + intro wires + cases hm : (g.inputs.mapM fun i => wires[i]?) with + | none => rfl + | some bs => + simp only [Option.bind_some] + have hbs_len : bs.length = g.inputs.length := + mapM_option_length hm + have hbs : (Basis.arity g.op).admits bs.length := hbs_len ▸ hg_wf + have hbs' : (Basis.arity (ncToAc g.op)).admits bs.length := + ncToAc_admits g.op bs.length hbs + rw [dif_pos hbs', dif_pos hbs] + simp only [ncToAc_eval g.op bs hbs] + -- Simplify: the bind over acc with h_output means both sides agree + have h_step : + (acc.bind fun wires => + (g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity (ncToAc g.op)).admits bs.length then + some (wires ++ [Basis.eval (ncToAc g.op) bs h]) + else none) = + (acc.bind fun wires => + (g.inputs.mapM fun i => wires[i]?).bind fun bs => + if h : (Basis.arity g.op).admits bs.length then + some (wires ++ [Basis.eval g.op bs h]) + else none) := by + cases acc with + | none => rfl + | some wires => simp only [Option.bind_some]; exact h_output wires + rw [h_step] + exact ih (fun g' hg' => hgs g' (by simp [hg'])) _ + +/-- **NC^k ⊆ AC^k**: every language computable by polynomial-size, +O(log^k n)-depth bounded fan-in circuits is also computable by +polynomial-size, O(log^k n)-depth unbounded fan-in circuits. + +The proof maps each NCOp gate to the corresponding ACOp gate via `ncToAc`. +Since bounded fan-in AND/OR/NOT compute the same functions as their +unbounded fan-in counterparts (just with a tighter arity constraint), +the mapped circuit computes the same function with the same size and depth. -/ +public theorem NC_subset_AC {k : ℕ} : NC k ⊆ AC k := by + intro L ⟨p, c, C, hDec, hWF, hSize, hDepth⟩ + refine ⟨p, c, fun n => (C n).mapOp ncToAc, ?_, ?_, ?_, ?_⟩ + · -- Decides: the mapped circuit decides the same language + intro x + rw [hDec x] + exact ⟨fun h => by rw [ncToAc_circuit_eval (C x.length) (hWF x.length)]; exact h, + fun h => by rw [ncToAc_circuit_eval (C x.length) (hWF x.length)] at h; exact h⟩ + · -- WellFormed: the mapping preserves well-formedness + intro n + exact Circuit.GatesWellFormed_mapOp ncToAc (C n) ncToAc_admits (hWF n) + · -- Size: mapOp preserves size + intro n; simp only [Circuit.size_mapOp]; exact hSize n + · -- Depth: mapOp preserves depth + intro n; rw [Circuit.depth_mapOp]; exact hDepth n + +/-! ### NC, AC ⊆ P/poly -/ + +/-- **NC^k ⊆ P/poly**: NC circuits have polynomial size, +so they are captured by P/poly. -/ +public theorem NC_subset_SIZE {k : ℕ} : + NC k ⊆ PPoly (Op := NCOp) := by + intro L ⟨p, _, C, hDec, hWF, hSize, _⟩ + exact ⟨C, p, hDec, hWF, hSize⟩ + +/-- **AC^k ⊆ P/poly**: AC circuits have polynomial size, +so they are captured by P/poly. -/ +public theorem AC_subset_SIZE {k : ℕ} : + AC k ⊆ PPoly (Op := ACOp) := by + intro L ⟨p, _, C, hDec, hWF, hSize, _⟩ + exact ⟨C, p, hDec, hWF, hSize⟩ diff --git a/Cslib/Computability/Complexity/Classes.lean b/Cslib/Computability/Complexity/Classes.lean new file mode 100644 index 000000000..dea3e412b --- /dev/null +++ b/Cslib/Computability/Complexity/Classes.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.Classes.Core +public import Cslib.Computability.Complexity.Classes.Time +public import Cslib.Computability.Complexity.Classes.Space diff --git a/Cslib/Computability/Complexity/Classes/Core.lean b/Cslib/Computability/Complexity/Classes/Core.lean new file mode 100644 index 000000000..0eb6cae0c --- /dev/null +++ b/Cslib/Computability/Complexity/Classes/Core.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Machines.SingleTapeTuring.Basic + +@[expose] public section + +/-! +# Complexity Class Core Definitions + +This file contains shared language-level definitions used by both +time and space complexity classes. + +## Main Definitions + +* `Decides f L` — `f` decides language `L` (non-empty output means accept) +* `Verifies verify L p` — `verify` verifies language `L` with polynomial witness bound `p` +-/ + +variable {Symbol : Type} + +namespace Cslib.Complexity + +/-- +A function `f : List Symbol → List Symbol` **decides** a language `L` when +membership in `L` corresponds to `f` producing non-empty output. +-/ +def Decides (f : List Symbol → List Symbol) (L : Set (List Symbol)) : Prop := + ∀ x, x ∈ L ↔ f x ≠ [] + +/-- +A verifier `verify` **verifies** a language `L` with polynomial witness bound `p` when +membership in `L` is equivalent to the existence of a short witness `w` such that +`verify (x ++ w)` produces non-empty output. +-/ +-- TODO: The verifier receives `x ++ w` as a bare concatenation, so it cannot +-- distinguish the input/witness boundary. A more robust formulation would use +-- a two-tape machine with a separate read-only witness tape. +def Verifies (verify : List Symbol → List Symbol) (L : Set (List Symbol)) + (p : Polynomial ℕ) : Prop := + ∀ x, x ∈ L ↔ ∃ w : List Symbol, w.length ≤ p.eval x.length ∧ verify (x ++ w) ≠ [] + +end Cslib.Complexity + +end diff --git a/Cslib/Computability/Complexity/Classes/Space.lean b/Cslib/Computability/Complexity/Classes/Space.lean new file mode 100644 index 000000000..79f5550cb --- /dev/null +++ b/Cslib/Computability/Complexity/Classes/Space.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.Classes.Time + +@[expose] public section + +/-! +# Space Complexity Classes + +This file defines space-bounded computation and the complexity class **PSPACE**. + +## Main Definitions + +* `OutputsWithinSpace` — TM outputs on input using at most `s` additional work cells +* `SpaceBoundedComputable f s` — `f` is computable within space `s` +* `PSPACE` — languages decidable in polynomial space + +## Main Results + +* `P_subset_PSPACE` — P ⊆ PSPACE + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +open Turing SingleTapeTM Polynomial Relation + +variable {Symbol : Type} + +namespace Cslib.Complexity + +/-- The work space used by a configuration on input `l`: total tape space +minus the initial input footprint `max 1 l.length`. -/ +def Cfg.work_space_used (tm : SingleTapeTM Symbol) (l : List Symbol) (cfg : tm.Cfg) : ℕ := + SingleTapeTM.Cfg.space_used tm cfg - max 1 l.length + +/-- A TM `tm` **outputs** `l'` on input `l` using at most `s` additional work cells +throughout the computation. This combines the time-based reachability +with a space bound: every configuration along the computation path +uses at most `s` work space beyond the initial input footprint. -/ +def OutputsWithinSpace (tm : SingleTapeTM Symbol) + (l l' : List Symbol) (s : ℕ) : Prop := + ∃ t : ℕ, tm.OutputsWithinTime l l' t ∧ + ∀ cfg : tm.Cfg, + ReflTransGen tm.TransitionRelation (tm.initCfg l) cfg → + Cfg.work_space_used tm l cfg ≤ s + +/-- A function `f` is **space-bounded computable** with space bound `s` +if there exists a TM computing `f` that uses at most `s(|x|)` additional +work cells on input `x`. -/ +structure SpaceBoundedComputable + (f : List Symbol → List Symbol) (s : ℕ → ℕ) where + /-- The underlying Turing machine -/ + tm : SingleTapeTM Symbol + /-- Proof that the machine computes `f` within space `s` -/ + outputsInSpace : ∀ a, + OutputsWithinSpace tm a (f a) (s a.length) + +/-- **PSPACE** is the class of languages decidable by a Turing machine +using polynomial work space. -/ +def PSPACE : Set (Set (List Symbol)) := + { L | ∃ f : List Symbol → List Symbol, + ∃ p : Polynomial ℕ, + Nonempty (SpaceBoundedComputable f (fun n => p.eval n)) ∧ + Decides f L } + +-- TODO: Define L (LOGSPACE) using multi-tape Turing machines with a +-- read-only input tape. The single-tape model allows overwriting input +-- cells, giving O(n) writable space instead of O(log n). + +/-- Any configuration reachable during a halting computation has its space +bounded by the initial space plus the halting time. -/ +private lemma space_bounded_of_time_bounded (tm : SingleTapeTM Symbol) + (l l' : List Symbol) (t : ℕ) + (htime : tm.OutputsWithinTime l l' t) + (cfg : tm.Cfg) + (hreach : ReflTransGen tm.TransitionRelation (tm.initCfg l) cfg) : + Cfg.space_used tm cfg ≤ max 1 l.length + t := by + -- Convert ReflTransGen to RelatesInSteps. + obtain ⟨m, hm⟩ := ReflTransGen.relatesInSteps hreach + -- Extract the halting computation. + obtain ⟨t', ht'_le, ht'⟩ := htime + -- `haltCfg` has no successors. + have hhalt : ∀ cfg', ¬tm.TransitionRelation (tm.haltCfg l') cfg' := + fun cfg' => no_step_from_halt tm _ cfg' rfl + -- By determinism, m ≤ t' ≤ t. + have hm_le := reachable_steps_le_halting_steps tm ht' hhalt hm + -- Space grows by at most 1 per step. + have hspace := RelatesInSteps.apply_le_apply_add hm (Cfg.space_used tm) + fun a b hstep => Cfg.space_used_step a b (Option.mem_def.mp hstep) + rw [Cfg.space_used_initCfg] at hspace + omega + +/-- Any configuration reachable during a halting computation uses at most `t` +work cells beyond the initial input footprint. -/ +private lemma work_space_bounded_of_time_bounded (tm : SingleTapeTM Symbol) + (l l' : List Symbol) (t : ℕ) + (htime : tm.OutputsWithinTime l l' t) + (cfg : tm.Cfg) + (hreach : ReflTransGen tm.TransitionRelation (tm.initCfg l) cfg) : + Cfg.work_space_used tm l cfg ≤ t := by + have htotal := space_bounded_of_time_bounded tm l l' t htime cfg hreach + apply (Nat.sub_le_iff_le_add).2 + simpa [Cfg.work_space_used, Nat.add_comm, Nat.add_left_comm, + Nat.add_assoc] using htotal + +/-- **P ⊆ PSPACE**: every language decidable in polynomial time is also +decidable in polynomial space. + +A TM running in time `t` can use at most `t` additional work cells +beyond the initial input footprint (at most one new cell per step). +So a polynomial time bound gives a polynomial work-space bound. -/ +public theorem P_subset_PSPACE : + P (Symbol := Symbol) ⊆ PSPACE := by + intro L ⟨f, ⟨hf⟩, hDecides⟩ + refine ⟨f, hf.poly, ⟨{ + tm := hf.tm + outputsInSpace := fun a => + ⟨hf.time_bound a.length, hf.outputsFunInTime a, fun cfg hreach => + le_trans + (work_space_bounded_of_time_bounded hf.tm a (f a) (hf.time_bound a.length) + (hf.outputsFunInTime a) cfg hreach) + (hf.bounds a.length)⟩ + }⟩, hDecides⟩ + +end Cslib.Complexity diff --git a/Cslib/Computability/Complexity/Classes/Time.lean b/Cslib/Computability/Complexity/Classes/Time.lean new file mode 100644 index 000000000..b5b4a3cee --- /dev/null +++ b/Cslib/Computability/Complexity/Classes/Time.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.Classes.Core + +@[expose] public section + +/-! +# Time Complexity Classes + +This file defines the fundamental time complexity classes **P**, **NP**, and **coNP** +using single-tape Turing machines, and states the **P ≠ NP** conjecture. + +## Main Definitions + +* `P` — the class **P** of languages decidable in polynomial time +* `NP` — the class **NP** of languages verifiable in polynomial time +* `CoNP` — the class **coNP**, complements of **NP** languages +* `PNeNP` — the proposition **P ≠ NP** + +## Main Results + +* `P_subset_NP` — **P ⊆ NP** +-/ + +open Turing SingleTapeTM + +variable {Symbol : Type} + +namespace Cslib.Complexity + +/-- +**P** is the class of languages decidable by a polynomial-time Turing machine. + +We use `Nonempty (PolyTimeComputable f)` because `PolyTimeComputable` is a structure +(carrying computational data), while set membership requires a `Prop`. +-/ +def P : Set (Set (List Symbol)) := + { L | ∃ f, Nonempty (PolyTimeComputable f) ∧ Decides f L } + +/-- +**NP** is the class of languages for which membership can be verified +in polynomial time given a polynomial-length witness (certificate). +-/ +def NP : Set (Set (List Symbol)) := + { L | ∃ verify p, Nonempty (PolyTimeComputable verify) ∧ Verifies verify L p } + +/-- +**coNP** is the class of languages whose complements are in **NP**. +-/ +def CoNP : Set (Set (List Symbol)) := + { L | Lᶜ ∈ NP } + +/-- +The **P ≠ NP** conjecture states that the complexity classes P and NP are distinct. +This is stated as a `Prop` definition rather than an axiom. +-/ +def PNeNP : Prop := P (Symbol := Symbol) ≠ NP + +end Cslib.Complexity + +end + +open Cslib.Complexity + +namespace Cslib.Complexity + +/-- +**P ⊆ NP**: Every language decidable in polynomial time is also verifiable +in polynomial time. + +*Proof sketch*: Given a polytime decider `f` for `L`, use `f` as a verifier +that ignores the witness. The witness is taken to be empty (`[]`), +and the polynomial witness bound is `0`. +-/ +public theorem P_subset_NP + {Symbol : Type} : + P (Symbol := Symbol) ⊆ NP := by + intro L ⟨f, hf, hDecides⟩ + refine ⟨f, 0, hf, fun x => ?_⟩ + simp only [Polynomial.eval_zero] + constructor + · intro hx + exact ⟨[], Nat.le_refl 0, by rwa [List.append_nil, ← hDecides]⟩ + · rintro ⟨w, hw, hverify⟩ + rw [hDecides] + have : w = [] := List.eq_nil_of_length_eq_zero (Nat.le_zero.mp hw) + rwa [this, List.append_nil] at hverify + +/-- **NP ⊆ coNP ↔ ∀ L ∈ NP, Lᶜ ∈ NP**. This is just the unfolding of +the definitions: coNP is defined as `{L | Lᶜ ∈ NP}`, so `NP ⊆ coNP` +means every NP language has its complement in NP. -/ +public theorem NP_subset_CoNP_iff + {Symbol : Type} : + NP (Symbol := Symbol) ⊆ CoNP ↔ + ∀ L ∈ NP (Symbol := Symbol), Lᶜ ∈ NP := by rfl + +end Cslib.Complexity diff --git a/Cslib/Computability/Complexity/NonUniform.lean b/Cslib/Computability/Complexity/NonUniform.lean new file mode 100644 index 000000000..608bd02ca --- /dev/null +++ b/Cslib/Computability/Complexity/NonUniform.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Circuits.Circuit.Basic +public import Cslib.Computability.Complexity.Classes + +@[expose] public section + +/-! # Non-Uniform Complexity Classes + +This file defines non-uniform complexity classes based on circuit families and +polynomial advice. + +## Main definitions + +* `SIZE s` — languages decidable by circuit families of size at most `s(n)` +* `PPoly` — **P/poly** (circuit-based): languages decidable by polynomial-size circuits +* `PPolyAdvice` — **P/poly** (advice-based): poly-time TM with poly-length advice + +## Main results + +* `SIZE_mono` — `SIZE` is monotone: if `s ≤ s'` pointwise then `SIZE s ⊆ SIZE s'` +* `SIZE_subset_PPoly` — `SIZE s ⊆ PPoly` when `s` is bounded by a polynomial +* `ComplexityP_subset_PPolyAdvice` — **P ⊆ P/poly** (advice-based) + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +open Cslib.Circuits Polynomial Turing SingleTapeTM + +variable {Op : Type*} [Basis Op] +variable {Symbol : Type} [Inhabited Symbol] [Fintype Symbol] + +/-- `SIZE s` is the class of languages decidable by circuit families whose circuit +at input size `n` has at most `s n` gates. -/ +def SIZE (s : ℕ → ℕ) : Set (Set (List Bool)) := + { L | ∃ C : CircuitFamily Op, + C.Decides L ∧ (∀ n, (C n).GatesWellFormed) ∧ ∀ n, (C n).size ≤ s n } + +/-- **P/poly** (circuit-based): the class of languages decidable by polynomial-size +circuit families. A language is in P/poly if there exists a circuit family and a +polynomial `p` such that the family decides the language and every circuit has at +most `p(n)` gates. -/ +def PPoly : Set (Set (List Bool)) := + { L | ∃ C : CircuitFamily Op, ∃ p : Polynomial ℕ, + C.Decides L ∧ (∀ n, (C n).GatesWellFormed) ∧ ∀ n, (C n).size ≤ p.eval n } + +/-- **P/poly** (advice-based): the class of languages decidable by a polynomial-time +Turing machine augmented with polynomial-length advice strings. The advice string +depends only on the input length, not the input itself. -/ +def PPolyAdvice : Set (Set (List Symbol)) := + { L | ∃ (f : List Symbol → List Symbol) (advice : ℕ → List Symbol) (p : Polynomial ℕ), + Nonempty (PolyTimeComputable f) ∧ + (∀ n, (advice n).length ≤ p.eval n) ∧ + (∀ x, x ∈ L ↔ f (x ++ advice x.length) ≠ []) } + +end + +open Cslib.Circuits Cslib.Complexity Polynomial Turing SingleTapeTM + +/-! ### Monotonicity and containment -/ + +/-- `SIZE` is monotone: if `s ≤ s'` pointwise then `SIZE s ⊆ SIZE s'`. -/ +theorem SIZE_mono {Op : Type*} [Basis Op] {s s' : ℕ → ℕ} (h : ∀ n, s n ≤ s' n) : + SIZE (Op := Op) s ⊆ SIZE (Op := Op) s' := by + intro L ⟨C, hDecides, hWF, hSize⟩ + exact ⟨C, hDecides, hWF, fun n => Nat.le_trans (hSize n) (h n)⟩ + +/-- If `s` is bounded by a polynomial then `SIZE s ⊆ PPoly`. -/ +theorem SIZE_subset_PPoly {Op : Type*} [Basis Op] {s : ℕ → ℕ} + {p : Polynomial ℕ} (h : ∀ n, s n ≤ p.eval n) : + SIZE (Op := Op) s ⊆ PPoly (Op := Op) := by + intro L ⟨C, hDecides, hWF, hSize⟩ + exact ⟨C, p, hDecides, hWF, fun n => Nat.le_trans (hSize n) (h n)⟩ + +/-- **P ⊆ P/poly** (advice-based): Every language in P is in P/poly. + +*Proof sketch*: Given a polytime decider `f` for `L`, use `f` with empty advice +`fun _ => []` and advice polynomial `0`. Since the advice is always empty, +`f (x ++ []) = f x`, so the decider works unchanged. -/ +theorem ComplexityP_subset_PPolyAdvice {Symbol : Type} : + P (Symbol := Symbol) ⊆ PPolyAdvice := by + intro L ⟨f, hf, hDecides⟩ + refine ⟨f, fun _ => [], 0, hf, fun _ => ?_, fun x => ?_⟩ + · simp + · rw [List.append_nil] + exact hDecides x + diff --git a/Cslib/Computability/Complexity/Reductions.lean b/Cslib/Computability/Complexity/Reductions.lean new file mode 100644 index 000000000..f6ff9dc16 --- /dev/null +++ b/Cslib/Computability/Complexity/Reductions.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.Classes.Time + +@[expose] public section + +/-! +# Polynomial-Time Reductions and NP-Completeness + +This file defines polynomial-time many-one reductions between languages, +and uses them to define NP-hardness and NP-completeness. + +## Main Definitions + +* `PolyTimeReduces L₁ L₂` — `L₁` poly-time reduces to `L₂` +* `NPHard L` — every NP language poly-time reduces to `L` +* `NPComplete L` — `L` is NP-hard and in NP + +## Main Results + +* `PolyTimeReduces.refl` — reflexivity +* `PolyTimeReduces.trans` — transitivity +* `PolyTimeReduces.mem_P` — downward closure under P +* `NPHard.p_eq_np` — if any NP-hard language is in P then P = NP + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraB2009] +-/ + +open Turing SingleTapeTM + +variable {Symbol : Type} + +namespace Cslib.Complexity + +/-- +A language `L₁` **polynomial-time reduces** to `L₂` if there exists a +polynomial-time computable function `f` such that +for all `x`, `x ∈ L₁ ↔ f x ∈ L₂`. + +This is also called a **many-one** or **Karp** reduction. +-/ +def PolyTimeReduces (L₁ L₂ : Set (List Symbol)) : Prop := + ∃ f, Nonempty (PolyTimeComputable f) ∧ ∀ x, x ∈ L₁ ↔ f x ∈ L₂ + +/-- +A language `L` is **NP-hard** if every language in NP polynomial-time +reduces to `L`. +-/ +def NPHard (L : Set (List Symbol)) : Prop := + ∀ L' ∈ NP (Symbol := Symbol), PolyTimeReduces L' L + +/-- +A language `L` is **NP-complete** if it is NP-hard and in NP. +-/ +def NPComplete (L : Set (List Symbol)) : Prop := + NPHard L ∧ L ∈ NP + +end Cslib.Complexity + +end + +open Turing SingleTapeTM Cslib.Complexity + +variable {Symbol : Type} + +namespace Cslib.Complexity + +/-- `≤ₚ` is reflexive: every language reduces to itself via the identity. -/ +theorem PolyTimeReduces.refl + [Inhabited Symbol] + [Finite Symbol] + (L : Set (List Symbol)) : PolyTimeReduces L L := + let _ : Fintype Symbol := Fintype.ofFinite Symbol + ⟨id, ⟨PolyTimeComputable.id⟩, fun _ => Iff.rfl⟩ + +/-- `≤ₚ` is transitive: if `L₁ ≤ₚ L₂` and `L₂ ≤ₚ L₃` then `L₁ ≤ₚ L₃`. -/ +theorem PolyTimeReduces.trans + {L₁ L₂ L₃ : Set (List Symbol)} + (h₁₂ : PolyTimeReduces L₁ L₂) + (h₂₃ : PolyTimeReduces L₂ L₃) : + PolyTimeReduces L₁ L₃ := by + obtain ⟨f, ⟨hf⟩, hf_mem⟩ := h₁₂ + obtain ⟨g, ⟨hg⟩, hg_mem⟩ := h₂₃ + let _ : Inhabited Symbol := hf.toTimeComputable.tm.SymbolInhabited + let _ : Fintype Symbol := hf.toTimeComputable.tm.SymbolFintype + exact ⟨g ∘ f, ⟨hf.comp hg⟩, + fun x => (hf_mem x).trans (hg_mem (f x))⟩ + +/-- If `L₁ ≤ₚ L₂` and `L₂ ∈ P` then `L₁ ∈ P`. -/ +theorem PolyTimeReduces.mem_P + {L₁ L₂ : Set (List Symbol)} + (hred : PolyTimeReduces L₁ L₂) + (hL₂ : L₂ ∈ P (Symbol := Symbol)) : + L₁ ∈ P := by + obtain ⟨f, ⟨hf⟩, hf_mem⟩ := hred + obtain ⟨g, ⟨hg⟩, hg_dec⟩ := hL₂ + let _ : Inhabited Symbol := hf.toTimeComputable.tm.SymbolInhabited + let _ : Fintype Symbol := hf.toTimeComputable.tm.SymbolFintype + refine ⟨g ∘ f, ⟨hf.comp hg⟩, fun x => ?_⟩ + simp only [Function.comp] + exact (hf_mem x).trans (hg_dec (f x)) + +/-- If any NP-hard language is in P, then P = NP. + +This is the fundamental theorem connecting NP-completeness to the +P vs NP question. -/ +theorem NPHard.p_eq_np + {L : Set (List Symbol)} + (hL : NPHard L) + (hP : L ∈ P (Symbol := Symbol)) : + P (Symbol := Symbol) = NP := by + apply Set.eq_of_subset_of_subset + · exact P_subset_NP + · intro L' hL' + exact (hL L' hL').mem_P hP + +end Cslib.Complexity diff --git a/Cslib/Computability/Complexity/Space.lean b/Cslib/Computability/Complexity/Space.lean new file mode 100644 index 000000000..4562261c5 --- /dev/null +++ b/Cslib/Computability/Complexity/Space.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Computability.Complexity.Classes.Space + +/-! +Compatibility shim. + +The primary home for space complexity classes is now +`Cslib.Computability.Complexity.Classes.Space`. +-/ diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 4f31c1530..4435bf6e7 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -89,11 +89,15 @@ end SingleTapeTM A single-tape Turing machine over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol). -/ -structure SingleTapeTM Symbol [Inhabited Symbol] [Fintype Symbol] where +structure SingleTapeTM Symbol where + /-- Inhabited instance for the alphabet -/ + [SymbolInhabited : Inhabited Symbol] + /-- Finiteness of the alphabet -/ + [SymbolFintype : Fintype Symbol] /-- type of state labels -/ (State : Type) /-- finiteness of the state type -/ - [stateFintype : Fintype State] + [StateFintype : Fintype State] /-- Initial state -/ (q₀ : State) /-- Transition function, mapping a state and a head symbol to a `Stmt` to invoke, @@ -112,11 +116,11 @@ the step function that lets the machine transition from one configuration to the and the intended initial and final configurations. -/ -variable [Inhabited Symbol] [Fintype Symbol] (tm : SingleTapeTM Symbol) +variable (tm : SingleTapeTM Symbol) instance : Inhabited tm.State := ⟨tm.q₀⟩ -instance : Fintype tm.State := tm.stateFintype +instance : Fintype tm.State := tm.StateFintype instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance @@ -186,8 +190,6 @@ end Cfg open Cfg -variable [Inhabited Symbol] [Fintype Symbol] - /-- The `TransitionRelation` corresponding to a `SingleTapeTM Symbol` is defined by the `step` function, @@ -196,6 +198,42 @@ which maps a configuration to its next configuration, if it exists. @[scoped grind =] def TransitionRelation (tm : SingleTapeTM Symbol) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ +/-- The transition relation is deterministic: each configuration has at most +one successor, since `step` is a function. -/ +lemma TransitionRelation_deterministic (tm : SingleTapeTM Symbol) + (a b c : tm.Cfg) (hab : tm.TransitionRelation a b) (hac : tm.TransitionRelation a c) : + b = c := by + simp only [TransitionRelation] at hab hac + rw [hab] at hac + exact Option.some.inj hac + +/-- No transitions from a halted configuration (state = none). -/ +lemma no_step_from_halt (tm : SingleTapeTM Symbol) (cfg cfg' : tm.Cfg) + (h : cfg.state = none) : ¬tm.TransitionRelation cfg cfg' := by + simp only [TransitionRelation, step] + cases cfg with | mk state tape => subst h; simp + +/-- In a deterministic relation where the endpoint has no successors, +any chain starting from the same origin has length at most `n`. -/ +lemma reachable_steps_le_halting_steps (tm : SingleTapeTM Symbol) + {a b : tm.Cfg} {n : ℕ} (hab : RelatesInSteps tm.TransitionRelation a b n) + (hhalt : ∀ cfg', ¬tm.TransitionRelation b cfg') + {c : tm.Cfg} {m : ℕ} (hac : RelatesInSteps tm.TransitionRelation a c m) : + m ≤ n := by + induction m generalizing a n with + | zero => omega + | succ k ih => + obtain ⟨a', ha_a', hac'⟩ := hac.succ' + match n, hab with + | 0, hab => + have := hab.zero; subst this + exact absurd ha_a' (hhalt a') + | n'+1, hab => + obtain ⟨a'', ha_a'', hab'⟩ := hab.succ' + have := TransitionRelation_deterministic tm a a' a'' ha_a' ha_a'' + subst this + exact Nat.succ_le_succ (ih hab' hac') + /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : SingleTapeTM Symbol) (l l' : List Symbol) : Prop := ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') @@ -220,6 +258,8 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM Symbol) (l l' : section Computers +variable [Inhabited Symbol] [Fintype Symbol] + /-- A Turing machine computing the identity. -/ def idComputer : SingleTapeTM Symbol where State := PUnit @@ -374,6 +414,38 @@ end compComputerLemmas end Computers +/-! +## Monotone Envelope + +The running maximum of a function, used to convert arbitrary time bounds +into monotone time bounds without changing the underlying Turing machine. +-/ + +/-- The running maximum of `f`: `monotoneEnvelope f n = max (f 0) (f 1) ⋯ (f n)`. -/ +def monotoneEnvelope (f : ℕ → ℕ) : ℕ → ℕ + | 0 => f 0 + | n + 1 => max (monotoneEnvelope f n) (f (n + 1)) + +theorem monotoneEnvelope_mono (f : ℕ → ℕ) : Monotone (monotoneEnvelope f) := by + intro a b hab + induction hab with + | refl => exact le_refl _ + | step _ ih => exact le_trans ih (le_max_left _ _) + +theorem le_monotoneEnvelope (f : ℕ → ℕ) (n : ℕ) : f n ≤ monotoneEnvelope f n := by + cases n with + | zero => exact le_refl _ + | succ n => exact le_max_right _ _ + +theorem monotoneEnvelope_le_of_le_monotone {f g : ℕ → ℕ} + (hle : ∀ n, f n ≤ g n) (hg : Monotone g) (n : ℕ) : + monotoneEnvelope f n ≤ g n := by + induction n with + | zero => exact hle 0 + | succ n ih => + simp only [monotoneEnvelope] + exact max_le (le_trans ih (hg (Nat.le_succ n))) (hle (n + 1)) + /-! ## Time Computability @@ -401,6 +473,15 @@ def TimeComputable.id : TimeComputable (Symbol := Symbol) id where time_bound _ := 1 outputsFunInTime _ := ⟨1, le_rfl, RelatesInSteps.single rfl⟩ +/-- Convert a `TimeComputable` to one with a monotone time bound, +using the same TM but replacing the time bound with its monotone envelope. -/ +def TimeComputable.toMonotone {f : List Symbol → List Symbol} + (hf : TimeComputable f) : TimeComputable f where + tm := hf.tm + time_bound := monotoneEnvelope hf.time_bound + outputsFunInTime a := RelatesWithinSteps.of_le + (hf.outputsFunInTime a) (le_monotoneEnvelope hf.time_bound a.length) + /-- Time bounds for `compComputer`. @@ -410,46 +491,44 @@ The `compComputer` of two machines which have time bounds is bounded by * added to the time taken by the second machine on the output size of the first machine (which is itself bounded by the time taken by the first machine) -Note that we require the time function of the second machine to be monotone; -this is to ensure that if the first machine returns an output -which is shorter than the maximum possible length of output for that input size, -then the time bound for the second machine still holds for that shorter input to the second machine. +The time bound of the second machine is automatically made monotone using +`monotoneEnvelope`, so the caller does not need to supply a monotonicity proof. -/ def TimeComputable.comp {f g : List Symbol → List Symbol} - (hf : TimeComputable f) (hg : TimeComputable g) - (h_mono : Monotone hg.time_bound) : - (TimeComputable (g ∘ f)) where - tm := compComputer hf.tm hg.tm - -- perhaps it would be good to track the blow up separately? - time_bound l := (hf.time_bound l) + hg.time_bound (max 1 l + hf.time_bound l) - outputsFunInTime a := by - have hf_outputsFun := hf.outputsFunInTime a - have hg_outputsFun := hg.outputsFunInTime (f a) - simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, - haltCfg] at hg_outputsFun hf_outputsFun ⊢ - -- The computer reduces a to f a in time hf.time_bound a.length - have h_a_reducesTo_f_a : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - (initialCfg hf.tm hg.tm a) - (intermediateCfg hf.tm hg.tm (f a)) - (hf.time_bound a.length) := - comp_left_relatesWithinSteps hf.tm hg.tm a (f a) - (hf.time_bound a.length) hf_outputsFun - -- The computer reduces f a to g (f a) in time hg.time_bound (f a).length - have h_f_a_reducesTo_g_f_a : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - (intermediateCfg hf.tm hg.tm (f a)) - (finalCfg hf.tm hg.tm (g (f a))) - (hg.time_bound (f a).length) := - comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) - (hg.time_bound (f a).length) hg_outputsFun - -- Therefore, the computer reduces a to g (f a) in the sum of those times. - have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a - apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a - refine Nat.add_le_add_left ?_ (hf.time_bound a.length) - · apply h_mono - -- Use the lemma about output length being bounded by input length + time - exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) + (hf : TimeComputable f) (hg : TimeComputable g) : + (TimeComputable (g ∘ f)) := + let hg' := hg.toMonotone + { tm := compComputer hf.tm hg'.tm + -- perhaps it would be good to track the blow up separately? + time_bound := fun l => (hf.time_bound l) + hg'.time_bound (max 1 l + hf.time_bound l) + outputsFunInTime := fun a => by + have hf_outputsFun := hf.outputsFunInTime a + have hg_outputsFun := hg'.outputsFunInTime (f a) + simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, + haltCfg] at hg_outputsFun hf_outputsFun ⊢ + -- The computer reduces a to f a in time hf.time_bound a.length + have h_a_reducesTo_f_a : + RelatesWithinSteps (compComputer hf.tm hg'.tm).TransitionRelation + (initialCfg hf.tm hg'.tm a) + (intermediateCfg hf.tm hg'.tm (f a)) + (hf.time_bound a.length) := + comp_left_relatesWithinSteps hf.tm hg'.tm a (f a) + (hf.time_bound a.length) hf_outputsFun + -- The computer reduces f a to g (f a) in time hg'.time_bound (f a).length + have h_f_a_reducesTo_g_f_a : + RelatesWithinSteps (compComputer hf.tm hg'.tm).TransitionRelation + (intermediateCfg hf.tm hg'.tm (f a)) + (finalCfg hf.tm hg'.tm (g (f a))) + (hg'.time_bound (f a).length) := + comp_right_relatesWithinSteps hf.tm hg'.tm (f a) (g (f a)) + (hg'.time_bound (f a).length) hg_outputsFun + -- Therefore, the computer reduces a to g (f a) in the sum of those times. + have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a + apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a + refine Nat.add_le_add_left ?_ (hf.time_bound a.length) + · apply monotoneEnvelope_mono + -- Use the lemma about output length being bounded by input length + time + exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) } end TimeComputable @@ -468,6 +547,17 @@ section PolyTimeComputable open Polynomial +/-- Evaluation of a polynomial with natural number coefficients is monotone. -/ +private theorem poly_eval_nat_mono (p : Polynomial ℕ) : Monotone (fun n => p.eval n) := by + intro a b hab + induction p using Polynomial.induction_on' with + | add p q ihp ihq => + simp only [eval_add] + exact Nat.add_le_add (ihp) (ihq) + | monomial n c => + simp only [eval_monomial] + exact Nat.mul_le_mul_left c (pow_le_pow_left' hab n) + variable [Inhabited Symbol] [Fintype Symbol] /-- A Turing machine + a polynomial time function + @@ -479,27 +569,32 @@ structure PolyTimeComputable (f : List Symbol → List Symbol) extends TimeCompu bounds : ∀ n, time_bound n ≤ poly.eval n /-- A proof that the identity map on Symbol is computable in polytime. -/ -noncomputable def PolyTimeComputable.id : PolyTimeComputable (Symbol := Symbol) id where +noncomputable def PolyTimeComputable.id : @PolyTimeComputable (Symbol := Symbol) id where toTimeComputable := TimeComputable.id poly := 1 bounds _ := by simp [TimeComputable.id] --- TODO remove `h_mono` assumption --- by developing function to convert PolyTimeComputable into one with monotone time bound /-- A proof that the composition of two polytime computable functions is polytime computable. + +The monotonicity of time bounds is handled internally via `monotoneEnvelope`, +so no monotonicity assumption is needed from the caller. -/ noncomputable def PolyTimeComputable.comp {f g : List Symbol → List Symbol} - (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) - (h_mono : Monotone hg.time_bound) : + (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) : PolyTimeComputable (g ∘ f) where - toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono + toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable poly := hf.poly + hg.poly.comp (1 + X + hf.poly) bounds n := by - simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] + simp only [TimeComputable.comp, TimeComputable.toMonotone, eval_add, eval_comp, eval_X, + eval_one] apply add_le_add · exact hf.bounds n - · exact (h_mono (add_le_add (by omega) (hf.bounds n))).trans (hg.bounds _) + · calc monotoneEnvelope hg.time_bound (max 1 n + hf.time_bound n) + _ ≤ hg.poly.eval (max 1 n + hf.time_bound n) := + monotoneEnvelope_le_of_le_monotone hg.bounds (poly_eval_nat_mono hg.poly) _ + _ ≤ hg.poly.eval (1 + n + hf.poly.eval n) := + poly_eval_nat_mono hg.poly (add_le_add (by omega) (hf.bounds n)) end PolyTimeComputable diff --git a/Cslib/Cryptography/Assumptions/DiscreteLog.lean b/Cslib/Cryptography/Assumptions/DiscreteLog.lean new file mode 100644 index 000000000..aac9ab28b --- /dev/null +++ b/Cslib/Cryptography/Assumptions/DiscreteLog.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame +public import Mathlib.Data.ZMod.Basic + +@[expose] public section + +/-! +# The Discrete Logarithm Assumption + +The **discrete logarithm (DL) assumption** states that no efficient +adversary, given a random group element `u = g^α` in a cyclic group +of prime order, can recover the exponent `α` with non-negligible +probability. + +This is the foundational hardness assumption for Schnorr signatures, +Diffie-Hellman key exchange, and many zero-knowledge protocols. + +## Main Definitions + +* `CyclicGroupFamily` — a family of cyclic groups of prime order + indexed by the security parameter, with an explicit exponentiation + map `gpow : ZMod q → G` +* `DL_Adversary` — an adversary for the discrete log problem +* `DL_Game` — the DL security game +* `DL_Assumption` — the DL assumption (DL game is secure against + admissible adversaries) + +## Design Notes + +We model cyclic groups abstractly via a family indexed by the security +parameter. The exponentiation map `gpow n : ZMod (order n) → Group n` +provides a group isomorphism from `(ZMod q, +)` to `(G, ·)`, capturing +the standard encoding of group elements via discrete logarithms. + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +-/ + +/-- A **family of cyclic groups of prime order** indexed by the security +parameter. At each level `n`: +- `Group n` is a finite commutative group of prime order `order n` +- `gpow n` is a group isomorphism from `(ZMod (order n), +)` to `(Group n, ·)` +- `gpow n 1 = generator n` identifies the canonical generator -/ +structure CyclicGroupFamily where + /-- The group type at security level `n` -/ + Group : ℕ → Type + /-- The group order at security level `n` -/ + order : ℕ → ℕ + /-- Each group is a commutative group -/ + groupInst : ∀ n, CommGroup (Group n) + /-- Each group is finite -/ + fintypeInst : ∀ n, Fintype (Group n) + /-- Each group has decidable equality -/ + decEqInst : ∀ n, DecidableEq (Group n) + /-- Each group is nonempty -/ + nonemptyInst : ∀ n, Nonempty (Group n) + /-- The order is positive -/ + order_pos : ∀ n, 0 < order n + /-- The order is prime -/ + order_prime : ∀ n, Nat.Prime (order n) + /-- The canonical generator -/ + generator : ∀ n, Group n + /-- The exponentiation map `α ↦ g^α`, a group isomorphism + `(ZMod q, +) → (G, ·)` -/ + gpow : ∀ n, ZMod (order n) → Group n + /-- `g^0 = 1` -/ + gpow_zero : ∀ n, gpow n 0 = 1 + /-- `g^(a+b) = g^a · g^b` — `gpow` is a group homomorphism -/ + gpow_add : ∀ n (a b : ZMod (order n)), + gpow n (a + b) = @HMul.hMul _ _ _ (@instHMul _ (groupInst n).toMul) (gpow n a) (gpow n b) + /-- `g^1 = generator` -/ + gpow_generator : ∀ n, gpow n 1 = generator n + /-- `gpow` is injective (hence bijective, since domain and codomain + have the same finite cardinality) -/ + gpow_injective : ∀ n, Function.Injective (gpow n) + /-- `gpow` is surjective — every group element has a discrete log -/ + gpow_surjective : ∀ n, Function.Surjective (gpow n) + +attribute [instance] CyclicGroupFamily.groupInst CyclicGroupFamily.fintypeInst + CyclicGroupFamily.decEqInst CyclicGroupFamily.nonemptyInst + +namespace CyclicGroupFamily + +variable (C : CyclicGroupFamily) + +/-- `NeZero` instance for the order, required by many `ZMod` lemmas. -/ +instance orderNeZero (n : ℕ) : NeZero (C.order n) := + ⟨Nat.pos_iff_ne_zero.mp (C.order_pos n)⟩ + +/-- `ZMod (order n)` is finite (for sampling). -/ +noncomputable instance zmodFintype (n : ℕ) : Fintype (ZMod (C.order n)) := + ZMod.fintype (C.order n) + +/-- `ZMod (order n)` is nonempty. -/ +instance zmodNonempty (n : ℕ) : Nonempty (ZMod (C.order n)) := ⟨0⟩ + +/-- `ZMod (order n)` has decidable equality. -/ +instance zmodDecEq (n : ℕ) : DecidableEq (ZMod (C.order n)) := + ZMod.decidableEq (C.order n) + +/-- The discrete logarithm: the unique `α` such that `g^α = y`. +This is the inverse of `gpow`. It is noncomputable (computing it +is exactly the discrete log problem). -/ +noncomputable def dlog (n : ℕ) (y : C.Group n) : ZMod (C.order n) := + (C.gpow_surjective n y).choose + +/-- `g^(dlog y) = y` — the discrete log inverts `gpow`. -/ +theorem gpow_dlog (n : ℕ) (y : C.Group n) : + C.gpow n (C.dlog n y) = y := + (C.gpow_surjective n y).choose_spec + +/-- `dlog (g^α) = α` — `dlog` inverts `gpow`. -/ +theorem dlog_gpow (n : ℕ) (a : ZMod (C.order n)) : + C.dlog n (C.gpow n a) = a := + C.gpow_injective n (by rw [C.gpow_dlog]) + +/-- The exponentiation map distributes over natural scalar multiplication: +`g^(k • α) = (g^α)^k`. -/ +theorem gpow_nsmul (n : ℕ) (k : ℕ) (a : ZMod (C.order n)) : + C.gpow n (k • a) = C.gpow n a ^ k := by + induction k with + | zero => simp [C.gpow_zero] + | succ k ih => + rw [succ_nsmul, C.gpow_add, ih, pow_succ] + +/-- `g^(c * α) = (g^α) ^ (ZMod.val c)` — connects ring multiplication +in `ZMod q` with group exponentiation. -/ +theorem gpow_mul (n : ℕ) (c a : ZMod (C.order n)) : + C.gpow n (c * a) = C.gpow n a ^ (ZMod.val c) := by + rw [← C.gpow_nsmul n (ZMod.val c) a] + congr 1 + rw [nsmul_eq_mul] + have : (ZMod.val c : ZMod (C.order n)) = c := by + rw [ZMod.natCast_val, ZMod.cast_id] + rw [this] + +/-- Negation: `g^(-α) = (g^α)⁻¹`. -/ +theorem gpow_neg (n : ℕ) (a : ZMod (C.order n)) : + C.gpow n (-a) = (C.gpow n a)⁻¹ := by + have h : C.gpow n (-a) * C.gpow n a = 1 := by + rw [← C.gpow_add, neg_add_cancel, C.gpow_zero] + exact mul_eq_one_iff_eq_inv.mp h + +/-- Subtraction: `g^(a - b) = g^a · (g^b)⁻¹`. -/ +theorem gpow_sub (n : ℕ) (a b : ZMod (C.order n)) : + C.gpow n (a - b) = C.gpow n a * (C.gpow n b)⁻¹ := by + rw [sub_eq_add_neg, C.gpow_add, C.gpow_neg] + +/-- Commutativity variant of `gpow_mul`: `g^(a * c) = (g^a) ^ val(c)`. -/ +theorem gpow_mul' (n : ℕ) (a c : ZMod (C.order n)) : + C.gpow n (a * c) = C.gpow n a ^ (ZMod.val c) := by + rw [mul_comm, C.gpow_mul] + +end CyclicGroupFamily + +/-- A **discrete logarithm adversary**: given a group element `u`, +output a candidate exponent `α`. -/ +structure DL_Adversary (C : CyclicGroupFamily) where + /-- Given the security parameter and a group element, guess the + discrete logarithm. -/ + guess : (n : ℕ) → C.Group n → ZMod (C.order n) + +/-- The **discrete logarithm security game**: the challenger samples +`α ← ZMod q` uniformly and gives `u = g^α` to the adversary. +The adversary wins if it outputs `α' = α` (equivalently, `g^α' = u`). -/ +noncomputable def DL_Game (C : CyclicGroupFamily) : + SecurityGame (DL_Adversary C) := + SecurityGame.ofCoinGame + (Coins := fun n => ZMod (C.order n)) + (fun A n α => + let u := C.gpow n α + let α' := A.guess n u + Cslib.Probability.boolToReal (decide (C.gpow n α' = u))) + +/-- The **DL assumption** for a cyclic group family: the DL game is +secure against all adversaries in the admissible class. -/ +def DL_Assumption (C : CyclicGroupFamily) + (Admissible : DL_Adversary C → Prop) : Prop := + (DL_Game C).SecureAgainst Admissible + +end diff --git a/Cslib/Cryptography/Foundations/Indistinguishability.lean b/Cslib/Cryptography/Foundations/Indistinguishability.lean new file mode 100644 index 000000000..e5e07be29 --- /dev/null +++ b/Cslib/Cryptography/Foundations/Indistinguishability.lean @@ -0,0 +1,278 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.Negligible +public import Mathlib.Probability.ProbabilityMassFunction.Basic +public import Mathlib.Probability.Distributions.Uniform + +@[expose] public section + +/-! +# Computational and Statistical Indistinguishability + +This file defines the core notions of indistinguishability that underpin +cryptographic security: **statistical distance** and **computational +indistinguishability** of probability ensembles. + +An ensemble is a family of distributions indexed by the security parameter, +where the outcome type may depend on the parameter (`α : ℕ → Type*`). +Two ensembles are computationally indistinguishable if no admissible bounded +distinguisher can tell them apart with non-negligible advantage. + +## Main Definitions + +* `Ensemble` — a family of distributions indexed by security parameter +* `Distinguisher` — a family of distinguishing functions +* `Distinguisher.IsBounded` — distinguisher outputs in `[0, 1]` +* `DistinguishingAdvantage` — the advantage of a distinguisher +* `CompIndistinguishable` — computational indistinguishability (parametric in admissibility) +* `StatIndistinguishable` — statistical indistinguishability +* `PerfectlyIndistinguishable` — perfect indistinguishability + +## Design Notes + +The outcome type `α : ℕ → Type*` depends on the security parameter. This is +essential for poly-time restrictions to be meaningful: with a fixed finite type, +every function is trivially computable by lookup table. + +`CompIndistinguishable` takes an `Admissible : Distinguisher α → Prop` parameter: +- `fun _ => True` recovers the information-theoretic setting (all bounded D) +- `IsPolyTimeDistinguisher` (defined in `PolyTimeDistinguisher.lean`) gives PPT + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- A **probability ensemble** over a parameter-dependent type `α` is a family +of probability distributions indexed by the security parameter `n : ℕ`. + +For each `n`, `ens n a` gives the probability of outcome `a : α n`. -/ +def Ensemble (α : ℕ → Type*) := (n : ℕ) → α n → ℝ + +/-- A **distinguisher** for ensembles over `α` is a (possibly randomized) +algorithm that, given the security parameter and a sample, outputs a +decision bit. We model the distinguishing probability as a real-valued +function: `D n a` is the probability that `D` outputs 1 on input +`(n, a)`. -/ +def Distinguisher (α : ℕ → Type*) := (n : ℕ) → α n → ℝ + +variable {α : ℕ → Type*} + +/-- A distinguisher is **bounded** if its output is in `[0, 1]` for all +inputs. This models the probability of outputting 1, and implies +`|D n a| ≤ 1`. -/ +def Distinguisher.IsBounded (D : Distinguisher α) : Prop := + ∀ n (a : α n), 0 ≤ D n a ∧ D n a ≤ 1 + +/-- The **distinguishing advantage** of distinguisher `D` between +ensembles `X` and `Y` at security parameter `n`: +$$\mathsf{Adv}(D, n) = \left| \sum_a X(n, a) \cdot D(n, a) - + \sum_a Y(n, a) \cdot D(n, a) \right|$$ + +In the standard formulation, this is +`|Pr[D(X_n) = 1] - Pr[D(Y_n) = 1]|`. -/ +noncomputable def DistinguishingAdvantage + [∀ n, Fintype (α n)] (D : Distinguisher α) (X Y : Ensemble α) (n : ℕ) : ℝ := + |∑ a : α n, X n a * D n a - ∑ a : α n, Y n a * D n a| + +/-- Two ensembles `X` and `Y` are **computationally indistinguishable** +with respect to an admissibility predicate `Admissible` if no bounded, +admissible distinguisher has non-negligible advantage. + +Instantiations: +- `CompIndistinguishable (fun _ => True) X Y` — all bounded distinguishers +- `CompIndistinguishable IsPolyTimeDistinguisher X Y` — PPT distinguishers -/ +def CompIndistinguishable + [∀ n, Fintype (α n)] + (Admissible : Distinguisher α → Prop) + (X Y : Ensemble α) : Prop := + ∀ D : Distinguisher α, D.IsBounded → Admissible D → + Negligible (fun n => DistinguishingAdvantage D X Y n) + +/-- Two ensembles are **statistically indistinguishable** if the +statistical distance between them is negligible. -/ +noncomputable def StatisticalDistance + [∀ n, Fintype (α n)] (X Y : Ensemble α) (n : ℕ) : ℝ := + (1 / 2) * ∑ a : α n, |X n a - Y n a| + +def StatIndistinguishable + [∀ n, Fintype (α n)] (X Y : Ensemble α) : Prop := + Negligible (fun n => StatisticalDistance X Y n) + +/-- Two ensembles are **perfectly indistinguishable** if they are +identical for all security parameters. -/ +def PerfectlyIndistinguishable + (X Y : Ensemble α) : Prop := + ∀ n (a : α n), X n a = Y n a + +end + +variable {α : ℕ → Type*} [∀ n, Fintype (α n)] + +/-! ### Basic relationships -/ + +/-- Perfect indistinguishability implies statistical indistinguishability. -/ +theorem PerfectlyIndistinguishable.stat + {X Y : Ensemble α} + (h : PerfectlyIndistinguishable X Y) : + StatIndistinguishable X Y := by + unfold StatIndistinguishable + suffices h0 : (fun n => StatisticalDistance X Y n) = fun _ => 0 by + rw [h0]; exact Negligible.zero + ext n + unfold StatisticalDistance + have : ∀ a : α n, X n a - Y n a = 0 := fun a => sub_eq_zero.mpr (h n a) + simp only [this, abs_zero, Finset.sum_const_zero, mul_zero] + +/-- Statistical indistinguishability implies computational +indistinguishability for any admissibility predicate. + +The standard proof bounds `|∑(X-Y)·D| ≤ ∑|X-Y|·|D| ≤ ∑|X-Y|` +when `D` is bounded (outputs in `[0,1]`), giving +`Adv(D) ≤ 2 · StatisticalDistance`. -/ +theorem StatIndistinguishable.comp + {X Y : Ensemble α} + (h : StatIndistinguishable X Y) + (Admissible : Distinguisher α → Prop) : + CompIndistinguishable Admissible X Y := by + intro D hBound _ + -- Key lemma: Adv(D, n) ≤ ∑ |X - Y| for bounded D + have h_adv_le : ∀ n, DistinguishingAdvantage D X Y n ≤ + ∑ a : α n, |X n a - Y n a| := by + intro n + unfold DistinguishingAdvantage + rw [← Finset.sum_sub_distrib] + calc |∑ a : α n, (X n a * D n a - Y n a * D n a)| + ≤ ∑ a : α n, |X n a * D n a - Y n a * D n a| := + Finset.abs_sum_le_sum_abs _ _ + _ = ∑ a : α n, |X n a - Y n a| * |D n a| := by + congr 1; ext a; rw [← sub_mul, abs_mul] + _ ≤ ∑ a : α n, |X n a - Y n a| * 1 := by + apply Finset.sum_le_sum; intro a _ + apply mul_le_mul_of_nonneg_left _ (abs_nonneg _) + rw [abs_le]; exact ⟨by linarith [(hBound n a).1], (hBound n a).2⟩ + _ = ∑ a : α n, |X n a - Y n a| := by simp [mul_one] + -- ∑ |X - Y| = 2 · SD = SD + SD + have h_sum_eq : ∀ n, ∑ a : α n, |X n a - Y n a| = + StatisticalDistance X Y n + StatisticalDistance X Y n := by + intro n; unfold StatisticalDistance; ring + -- SD + SD is negligible + apply Negligible.mono (Negligible.add h h) + refine ⟨0, fun n _ => ?_⟩ + -- |Adv(D,n)| = Adv(D,n) since Adv is already an absolute value + have h_adv_nn : 0 ≤ DistinguishingAdvantage D X Y n := by + unfold DistinguishingAdvantage; exact abs_nonneg _ + rw [abs_of_nonneg h_adv_nn] + -- |SD + SD| = SD + SD since SD is non-negative + have h_sd_nn : 0 ≤ StatisticalDistance X Y n := by + unfold StatisticalDistance + exact mul_nonneg (by norm_num) (Finset.sum_nonneg (fun a _ => abs_nonneg _)) + rw [abs_of_nonneg (by linarith)] + calc DistinguishingAdvantage D X Y n + ≤ ∑ a : α n, |X n a - Y n a| := h_adv_le n + _ = StatisticalDistance X Y n + StatisticalDistance X Y n := h_sum_eq n + +/-! ### Transitivity -/ + +/-- Computational indistinguishability is reflexive. -/ +theorem CompIndistinguishable.refl + (Admissible : Distinguisher α → Prop) + (X : Ensemble α) : + CompIndistinguishable Admissible X X := by + intro D _ _ + suffices h : (fun n => DistinguishingAdvantage D X X n) = fun _ => 0 by + rw [h]; exact Negligible.zero + ext n + simp [DistinguishingAdvantage] + +/-- Computational indistinguishability is symmetric. -/ +theorem CompIndistinguishable.symm + {Admissible : Distinguisher α → Prop} + {X Y : Ensemble α} + (h : CompIndistinguishable Admissible X Y) : + CompIndistinguishable Admissible Y X := by + intro D hB hA + have hD := h D hB hA + intro c hc + obtain ⟨N, hN⟩ := hD c hc + refine ⟨N, fun n hn => ?_⟩ + have h' := hN n hn + dsimp only [] at h' ⊢ + simp only [DistinguishingAdvantage, abs_abs] at h' ⊢ + rwa [abs_sub_comm] + +/-- Computational indistinguishability is transitive (the **hybrid +argument**). + +If `X ≈_c Y` and `Y ≈_c Z`, then for any distinguisher `D`, the +advantages against `(X, Y)` and `(Y, Z)` are both negligible, and the +advantage against `(X, Z)` is bounded by their sum, hence negligible. -/ +theorem CompIndistinguishable.trans + {Admissible : Distinguisher α → Prop} + {X Y Z : Ensemble α} + (hXY : CompIndistinguishable Admissible X Y) + (hYZ : CompIndistinguishable Admissible Y Z) : + CompIndistinguishable Admissible X Z := by + intro D hB hA + have hXY' := hXY D hB hA + have hYZ' := hYZ D hB hA + -- Sum of negligible advantages is negligible + have hsum := Negligible.add hXY' hYZ' + intro c hc + obtain ⟨N, hN⟩ := hsum c hc + refine ⟨N, fun n hn => ?_⟩ + have h_bound := hN n hn + dsimp only [] at h_bound ⊢ + -- Triangle inequality: Adv(D,X,Z) ≤ Adv(D,X,Y) + Adv(D,Y,Z) + have h_tri : DistinguishingAdvantage D X Z n ≤ + DistinguishingAdvantage D X Y n + + DistinguishingAdvantage D Y Z n := by + unfold DistinguishingAdvantage + have : ∑ a : α n, X n a * D n a - ∑ a : α n, Z n a * D n a = + (∑ a : α n, X n a * D n a - ∑ a : α n, Y n a * D n a) + + (∑ a : α n, Y n a * D n a - ∑ a : α n, Z n a * D n a) := by + ring + rw [this]; exact abs_add_le _ _ + -- Adv is non-negative (it's an absolute value) + have h_nn : 0 ≤ DistinguishingAdvantage D X Z n := by + unfold DistinguishingAdvantage; exact abs_nonneg _ + rw [abs_of_nonneg h_nn] + exact lt_of_le_of_lt + (le_trans h_tri (le_abs_self _)) h_bound + +/-! ### PMF-backed ensembles -/ + +/-- A **PMF ensemble** is a family of probability mass functions indexed by +the security parameter. Unlike `Ensemble` (which is just `ℕ → α n → ℝ`), +a `PMFEnsemble` carries Mathlib's `PMF` structure guaranteeing that +probabilities are non-negative and sum to 1. + +This type bridges Mathlib's probability library to the cryptographic +indistinguishability framework. -/ +def PMFEnsemble (α : ℕ → Type*) := (n : ℕ) → PMF (α n) + +variable {α : ℕ → Type*} + +/-- Convert a `PMFEnsemble` to an `Ensemble` by extracting real-valued +probabilities via `ENNReal.toReal`. -/ +noncomputable def PMFEnsemble.toEnsemble (E : PMFEnsemble α) : Ensemble α := + fun n a => (E n a).toReal + +/-- The **uniform PMF ensemble**: at each security parameter, the +distribution is uniform over the finite type. -/ +noncomputable def PMFEnsemble.uniform + [∀ n, Fintype (α n)] [∀ n, Nonempty (α n)] : PMFEnsemble α := + fun n => PMF.uniformOfFintype (α n) + +/-- The ensemble derived from a PMF ensemble has non-negative values. -/ +theorem PMFEnsemble.toEnsemble_nonneg (E : PMFEnsemble α) : + ∀ n (a : α n), 0 ≤ E.toEnsemble n a := by + intro n a + exact ENNReal.toReal_nonneg diff --git a/Cslib/Cryptography/Foundations/Negligible.lean b/Cslib/Cryptography/Foundations/Negligible.lean new file mode 100644 index 000000000..7c96aaf97 --- /dev/null +++ b/Cslib/Cryptography/Foundations/Negligible.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Init +public import Mathlib.Algebra.Polynomial.Eval.Defs +public import Mathlib.Analysis.SpecialFunctions.Pow.Real + +@[expose] public section + +/-! +# Negligible and Polynomial Functions + +This file defines the asymptotic notions that underpin cryptographic +security: **negligible** functions (decrease faster than any inverse +polynomial) and **polynomially bounded** functions. + +These notions are used throughout modern cryptography to formalize +"the adversary's advantage is negligible in the security parameter." + +## Main Definitions + +* `Negligible` — `f : ℕ → ℝ` eventually smaller than `1/n^c` for all `c` +* `PolynomiallyBounded` — `|f(n)| ≤ p(n)` for some polynomial `p` + +## Main Results + +* `Negligible.zero` — the zero function is negligible +* `Negligible.neg` — negligible is closed under negation +* `Negligible.mono` — eventually dominated by negligible implies negligible +* `Negligible.add` — negligible is closed under addition +* `Negligible.mul_polyBounded` — negligible · polynomially bounded is negligible + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +open Polynomial + +/-- A function `f : ℕ → ℝ` is **negligible** if for every positive exponent `c`, +there exists `N` such that `|f(n)| < 1/n^c` for all `n ≥ N`. + +This is the standard definition from modern cryptography. A negligible +function decreases faster than the inverse of any polynomial. -/ +def Negligible (f : ℕ → ℝ) : Prop := + ∀ (c : ℕ), c > 0 → ∃ N : ℕ, ∀ n ≥ N, |f n| < (1 : ℝ) / (n : ℝ) ^ c + +/-- A function `f : ℕ → ℝ` is **polynomially bounded** if there exists a +polynomial `p` such that `|f(n)| ≤ p(n)` for all `n`. -/ +def PolynomiallyBounded (f : ℕ → ℝ) : Prop := + ∃ (p : Polynomial ℕ), ∀ n, |f n| ≤ ↑(p.eval n) + +/-- A function `f : ℕ → ℝ` is **non-negligible** if it is not negligible: +there exists a positive exponent `c` such that `|f(n)| ≥ 1/n^c` +infinitely often. -/ +def NonNegligible (f : ℕ → ℝ) : Prop := ¬Negligible f + +/-- A function `f : ℕ → ℝ` is **noticeable** (or **non-negligible with a +polynomial lower bound**) if there exist `c > 0` and `N` such that +`|f(n)| ≥ 1/n^c` for all `n ≥ N`. -/ +def Noticeable (f : ℕ → ℝ) : Prop := + ∃ (c : ℕ), c > 0 ∧ ∃ N : ℕ, ∀ n ≥ N, |f n| ≥ (1 : ℝ) / (n : ℝ) ^ c + +/-! ### Basic negligible functions -/ + +/-- The zero function is negligible. -/ +theorem Negligible.zero : Negligible (fun _ => 0) := by + intro c _ + refine ⟨1, fun n hn => ?_⟩ + simp only [abs_zero] + exact div_pos one_pos (pow_pos (by exact_mod_cast (show 0 < n by omega)) c) + +/-- A function that is eventually zero is negligible. -/ +theorem Negligible.eventuallyZero {f : ℕ → ℝ} (hf : ∃ N, ∀ n ≥ N, f n = 0) : + Negligible f := by + intro c _ + obtain ⟨N, hN⟩ := hf + refine ⟨max N 1, fun n hn => ?_⟩ + have hfn : f n = 0 := hN n (by omega) + have hn_pos : (0 : ℝ) < (n : ℝ) := by exact_mod_cast (show 0 < n by omega) + rw [hfn, abs_zero] + exact div_pos one_pos (pow_pos hn_pos c) + +/-! ### Closure properties -/ + +/-- If `f` is negligible, so is `-f`. -/ +theorem Negligible.neg {f : ℕ → ℝ} (hf : Negligible f) : + Negligible (fun n => -f n) := by + intro c hc + obtain ⟨N, hN⟩ := hf c hc + exact ⟨N, fun n hn => by rw [abs_neg]; exact hN n hn⟩ + +/-- If `f` is negligible, so is `|f|`. -/ +theorem Negligible.abs {f : ℕ → ℝ} (hf : Negligible f) : + Negligible (fun n => |f n|) := by + intro c hc + obtain ⟨N, hN⟩ := hf c hc + exact ⟨N, fun n hn => by rw [abs_abs]; exact hN n hn⟩ + +/-- If `g` is negligible and `|f n| ≤ |g n|` eventually, then `f` is negligible. -/ +theorem Negligible.mono {f g : ℕ → ℝ} + (hg : Negligible g) (hle : ∃ N, ∀ n ≥ N, |f n| ≤ |g n|) : + Negligible f := by + intro c hc + obtain ⟨N_g, hN_g⟩ := hg c hc + obtain ⟨N_h, hN_h⟩ := hle + refine ⟨max N_g N_h, fun n hn => ?_⟩ + calc |f n| ≤ |g n| := hN_h n (by omega) + _ < 1 / (n : ℝ) ^ c := hN_g n (by omega) + +/-- The sum of two negligible functions is negligible. + +*Proof sketch*: Use exponent `c+1` for each summand; then +`|f n| + |g n| < 2/n^(c+1) = 2/(n · n^c) ≤ 1/n^c` for `n ≥ 2`. -/ +theorem Negligible.add {f g : ℕ → ℝ} (hf : Negligible f) (hg : Negligible g) : + Negligible (fun n => f n + g n) := by + intro c hc + obtain ⟨Nf, hNf⟩ := hf (c + 1) (by omega) + obtain ⟨Ng, hNg⟩ := hg (c + 1) (by omega) + refine ⟨max (max Nf Ng) 2, fun n hn => ?_⟩ + have hn_ge : n ≥ 2 := by omega + have hNf' := hNf n (by omega) + have hNg' := hNg n (by omega) + have hn_pos : (0 : ℝ) < (n : ℝ) := by positivity + have hn2 : (2 : ℝ) ≤ (n : ℝ) := by exact_mod_cast hn_ge + have hnc_pos := pow_pos hn_pos c + calc |f n + g n| + ≤ |f n| + |g n| := abs_add_le _ _ + _ < 1 / (n : ℝ) ^ (c + 1) + 1 / (n : ℝ) ^ (c + 1) := add_lt_add hNf' hNg' + _ = 2 / ((n : ℝ) ^ c * (n : ℝ)) := by rw [pow_succ]; ring + _ ≤ 1 / (n : ℝ) ^ c := by + rw [div_le_div_iff₀ (mul_pos hnc_pos hn_pos) hnc_pos] + nlinarith + +/-- A natural number polynomial evaluated at `n` is eventually at most `n^(natDegree + 1)`. + +The bound holds for `n ≥ max 1 (p.eval 1 + 1)`: since +`p.eval n = ∑ coeff_i · n^i ≤ (∑ coeff_i) · n^d = p.eval(1) · n^d ≤ n^(d+1)`. -/ +private theorem nat_poly_eval_le_pow (p : Polynomial ℕ) : + ∃ N : ℕ, ∀ n ≥ N, p.eval n ≤ n ^ (p.natDegree + 1) := by + refine ⟨max 1 (p.eval 1 + 1), fun n hn => ?_⟩ + have hn1 : 1 ≤ n := by omega + have hn0 : 0 < n := by omega + have hn_eval : p.eval 1 ≤ n := by omega + rw [Polynomial.eval_eq_sum_range] + calc ∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i * n ^ i + ≤ ∑ i ∈ Finset.range (p.natDegree + 1), + p.coeff i * n ^ p.natDegree := by + apply Finset.sum_le_sum + intro i hi + exact Nat.mul_le_mul_left _ + (Nat.pow_le_pow_right hn0 + (Nat.lt_succ_iff.mp (Finset.mem_range.mp hi))) + _ = (∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i) * + n ^ p.natDegree := by + rw [← Finset.sum_mul] + _ ≤ n * n ^ p.natDegree := by + apply Nat.mul_le_mul_right + -- ∑ coeff i = p.eval 1 + have heval1 : ∑ i ∈ Finset.range (p.natDegree + 1), + p.coeff i = p.eval 1 := by + rw [Polynomial.eval_eq_sum_range] + congr 1; ext i; simp + omega + _ = n ^ (p.natDegree + 1) := by ring + +/-- If `f` is negligible and `g` is polynomially bounded, then `f · g` is negligible. + +This is the key lemma for security reductions: a negligible advantage +composed with a polynomial-time reduction remains negligible. + +*Proof*: Pick exponent `c + natDegree(p) + 1` for `f`'s negligibility; +then `|f(n)| · |g(n)| < n^d / n^{c+d} = 1/n^c` for large `n`. -/ +theorem Negligible.mul_polyBounded {f g : ℕ → ℝ} + (hf : Negligible f) (hg : PolynomiallyBounded g) : + Negligible (fun n => f n * g n) := by + obtain ⟨p, hp⟩ := hg + intro c hc + let d := p.natDegree + 1 + obtain ⟨Nf, hNf⟩ := hf (c + d) (by omega) + obtain ⟨Np, hNp⟩ := nat_poly_eval_le_pow p + refine ⟨max (max Nf Np) 1, fun n hn => ?_⟩ + have hn_pos : (0 : ℝ) < (n : ℝ) := by + exact_mod_cast (show 0 < n by omega) + have h_f := hNf n (by omega) + have h_p : (↑(p.eval n) : ℝ) ≤ (n : ℝ) ^ d := by + exact_mod_cast hNp n (by omega) + have h_g := hp n + calc |f n * g n| + = |f n| * |g n| := abs_mul _ _ + _ ≤ |f n| * ↑(p.eval n) := + mul_le_mul_of_nonneg_left h_g (abs_nonneg _) + _ ≤ |f n| * (n : ℝ) ^ d := + mul_le_mul_of_nonneg_left h_p (abs_nonneg _) + _ < (1 / (n : ℝ) ^ (c + d)) * (n : ℝ) ^ d := + mul_lt_mul_of_pos_right h_f (pow_pos hn_pos d) + _ = 1 / (n : ℝ) ^ c := by + have hnd : (n : ℝ) ^ d ≠ 0 := ne_of_gt (pow_pos hn_pos d) + rw [pow_add, one_div, mul_inv, mul_assoc, + inv_mul_cancel₀ hnd, mul_one, ← one_div] + +/-- The product of two polynomially bounded functions is polynomially bounded. + +If `|f(n)| ≤ p(n)` and `|g(n)| ≤ q(n)` for natural-number polynomials `p, q`, +then `|f(n) · g(n)| ≤ (p · q)(n)`. -/ +theorem PolynomiallyBounded.mul {f g : ℕ → ℝ} + (hf : PolynomiallyBounded f) (hg : PolynomiallyBounded g) : + PolynomiallyBounded (fun n => f n * g n) := by + obtain ⟨p, hp⟩ := hf + obtain ⟨q, hq⟩ := hg + refine ⟨p * q, fun n => ?_⟩ + calc |f n * g n| + = |f n| * |g n| := abs_mul _ _ + _ ≤ ↑(p.eval n) * ↑(q.eval n) := + mul_le_mul (hp n) (hq n) (abs_nonneg _) (by exact_mod_cast Nat.zero_le _) + _ = ↑((p * q).eval n) := by rw [Polynomial.eval_mul, Nat.cast_mul] + +/-- The square of a polynomially bounded function is polynomially bounded. -/ +theorem PolynomiallyBounded.sq {f : ℕ → ℝ} + (hf : PolynomiallyBounded f) : + PolynomiallyBounded (fun n => f n ^ 2) := by + have : (fun n => f n ^ 2) = (fun n => f n * f n) := + funext fun n => _root_.sq (f n) + rw [this] + exact hf.mul hf + +/-- A noticeable function is non-negligible. -/ +theorem Noticeable.nonNegligible {f : ℕ → ℝ} (hf : Noticeable f) : + NonNegligible f := by + intro hnegl + obtain ⟨c, hc, N, hN⟩ := hf + obtain ⟨N', hN'⟩ := hnegl c hc + have := hN (max N N') (le_max_left _ _) + have := hN' (max N N') (le_max_right _ _) + linarith + +/-- If `f` is negligible and nonneg, then `fun n => Real.sqrt (f n)` is negligible. + +For any target exponent `c`, use `2c` for `f`'s negligibility: +`f n < 1/n^{2c}` implies `√(f n) < 1/n^c`. -/ +theorem Negligible.sqrt_nonneg {f : ℕ → ℝ} (hf : Negligible f) + (hnn : ∀ n, 0 ≤ f n) : + Negligible (fun n => Real.sqrt (f n)) := by + intro c hc + obtain ⟨N, hN⟩ := hf (2 * c) (by omega) + refine ⟨max N 1, fun n hn => ?_⟩ + have hn_pos : (0 : ℝ) < (n : ℝ) := by exact_mod_cast (show 0 < n by omega) + have hfn := hN n (by omega) + rw [abs_of_nonneg (hnn n)] at hfn + rw [abs_of_nonneg (Real.sqrt_nonneg _)] + calc Real.sqrt (f n) + < Real.sqrt (1 / (n : ℝ) ^ (2 * c)) := + Real.sqrt_lt_sqrt (hnn n) hfn + _ = 1 / (n : ℝ) ^ c := by + rw [show (n : ℝ) ^ (2 * c) = ((n : ℝ) ^ c) ^ 2 from by ring, + Real.sqrt_div (le_of_lt one_pos), + Real.sqrt_one, Real.sqrt_sq (le_of_lt (pow_pos hn_pos c))] + +end diff --git a/Cslib/Cryptography/Foundations/OracleInteraction.lean b/Cslib/Cryptography/Foundations/OracleInteraction.lean new file mode 100644 index 000000000..7c94516e4 --- /dev/null +++ b/Cslib/Cryptography/Foundations/OracleInteraction.lean @@ -0,0 +1,557 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +@[expose] public section + +/-! +# Oracle Interactions + +An **oracle interaction** models an adversary that adaptively queries +an oracle, choosing each query based on the responses to all previous +queries. This is the standard model for security games where the +adversary has oracle access (e.g., signing oracles in EUF-CMA). + +## Main Definitions + +* `OracleInteraction Q R A` — an inductive type representing an + adaptive sequence of queries of type `Q` receiving responses of + type `R`, eventually producing a result of type `A` +* `OracleInteraction.run` — execute an interaction against a concrete + oracle with a fuel budget, returning the query log and result + +## Design Notes + +The interaction is modeled as a free monad over the query/response +interface. The `run` function uses fuel-based recursion to ensure +termination: each query consumes one unit of fuel, and the oracle +at step `i` is indexed by `Fin fuel` to enable structural recursion +on the fuel parameter. + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- An **oracle interaction** where the adversary adaptively queries +an oracle of type `Q → R` and eventually produces a value of type `A`. + +- `done a` — the adversary is finished and returns `a` +- `query q k` — the adversary asks query `q` and continues with + the continuation `k` applied to the oracle's response -/ +inductive OracleInteraction (Q : Type) (R : Type) (A : Type) where + /-- The adversary is done and returns a result -/ + | done : A → OracleInteraction Q R A + /-- The adversary makes a query and continues based on the response -/ + | query : Q → (R → OracleInteraction Q R A) → OracleInteraction Q R A + +/-- Execute an oracle interaction against a concrete oracle, with a +fuel budget limiting the number of queries. + +The oracle is `Fin fuel → Q → R`, where the `Fin fuel` index +represents which query step we are at (enabling the game to use +independent randomness for each query). Returns `none` if the +fuel is exhausted before the interaction completes, or +`some (queries, result)` with the list of queries made and the +final result. + +Uses structural recursion on `fuel`. -/ +def OracleInteraction.run {Q R A : Type} + : (interaction : OracleInteraction Q R A) → + (fuel : Nat) → + (oracle : Fin fuel → Q → R) → + Option (List Q × A) + | .done a, _, _ => some ([], a) + | .query _ _, 0, _ => none + | .query q k, fuel + 1, oracle => + let response := oracle ⟨0, Nat.zero_lt_succ fuel⟩ q + let shiftedOracle : Fin fuel → Q → R := + fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + match (k response).run fuel shiftedOracle with + | none => none + | some (qs, a) => some (q :: qs, a) + +/-- The query log produced by `run` has length at most `fuel`. -/ +theorem OracleInteraction.run_length_le {Q R A : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → Q → R) + {queries : List Q} {a : A} + (h : interaction.run fuel oracle = some (queries, a)) : + queries.length ≤ fuel := by + induction fuel generalizing interaction queries a with + | zero => + cases interaction with + | done _ => + change some ([], _) = some (queries, a) at h + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h) + exact Nat.le.refl + | query _ _ => + change (none : Option _) = some (queries, a) at h + exact absurd h nofun + | succ n ih => + cases interaction with + | done _ => + change some ([], _) = some (queries, a) at h + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h) + exact Nat.zero_le _ + | query q k => + have h_red : OracleInteraction.run (.query q k) (n + 1) oracle = + match (k (oracle ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none + | some (qs, a') => some (q :: qs, a') := rfl + rw [h_red] at h + rcases h_rec : (k (oracle ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs, a'⟩ + · rw [h_rec] at h; exact absurd h nofun + · rw [h_rec] at h + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h) + exact Nat.succ_le_succ (ih _ _ h_rec) + +/-- **Deterministic prefix**: if two oracles agree on the first `k` +indices, both runs complete, and both query logs have an entry at +position `k`, then the `k`-th query is the same. + +This captures the fact that adaptive oracle interactions are +deterministic given the oracle responses: if two oracles agree +on the first `k` steps, the interaction reaches the same state +at step `k`, and hence issues the same query. -/ +theorem OracleInteraction.run_prefix_query_eq {Q R A : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → Q → R) + (k : Nat) + (h_agree : ∀ (i : Fin fuel), i.val < k → oracle₁ i = oracle₂ i) + {queries₁ queries₂ : List Q} {a₁ a₂ : A} + (h₁ : interaction.run fuel oracle₁ = some (queries₁, a₁)) + (h₂ : interaction.run fuel oracle₂ = some (queries₂, a₂)) + (hk₁ : k < queries₁.length) (hk₂ : k < queries₂.length) : + queries₁[k] = queries₂[k] := by + induction fuel generalizing interaction k queries₁ queries₂ a₁ a₂ with + | zero => + cases interaction with + | done _ => + change some ([], _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done _ => + change some ([], _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query q cont => + -- Reduce run in both hypotheses + have red₁ : OracleInteraction.run (.query q cont) (n + 1) oracle₁ = + match (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + have red₂ : OracleInteraction.run (.query q cont) (n + 1) oracle₂ = + match (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + rw [red₁] at h₁; rw [red₂] at h₂ + -- Extract recursive results + rcases h_rec₁ : (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs₁, a₁'⟩ + · rw [h_rec₁] at h₁; exact absurd h₁ nofun + · rw [h_rec₁] at h₁ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₁) + rcases h_rec₂ : (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs₂, a₂'⟩ + · rw [h_rec₂] at h₂; exact absurd h₂ nofun + · rw [h_rec₂] at h₂ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₂) + -- queries₁ = q :: qs₁, queries₂ = q :: qs₂ + cases k with + | zero => rfl + | succ k' => + simp only [List.length_cons, Nat.succ_lt_succ_iff] at hk₁ hk₂ + show qs₁[k'] = qs₂[k'] + -- Oracle responses at step 0 agree (0 < k'+1) + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q := + congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ (Nat.zero_lt_succ k')) q + -- So the continuations are the same + rw [h_r] at h_rec₁ + exact ih (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + k' + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (Nat.succ_lt_succ hi)) + h_rec₁ h_rec₂ hk₁ hk₂ + +/-- **Prefix length preservation**: if two oracles agree on the first +`k` indices, both runs complete, and the first run has `k < queries₁.length`, +then the second run also has `k < queries₂.length`. + +This captures the fact that the interaction's decision to continue or +terminate at step `k` depends only on oracle responses at steps `< k`. -/ +theorem OracleInteraction.run_prefix_implies_length {Q R A : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → Q → R) + (k : Nat) + (h_agree : ∀ (i : Fin fuel), i.val < k → oracle₁ i = oracle₂ i) + {queries₁ queries₂ : List Q} {a₁ a₂ : A} + (h₁ : interaction.run fuel oracle₁ = some (queries₁, a₁)) + (h₂ : interaction.run fuel oracle₂ = some (queries₂, a₂)) + (hk₁ : k < queries₁.length) : + k < queries₂.length := by + induction fuel generalizing interaction k queries₁ queries₂ a₁ a₂ with + | zero => + cases interaction with + | done _ => + change some ([], _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done _ => + change some ([], _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query q cont => + have red₁ : OracleInteraction.run (.query q cont) (n + 1) oracle₁ = + match (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + have red₂ : OracleInteraction.run (.query q cont) (n + 1) oracle₂ = + match (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + rw [red₁] at h₁; rw [red₂] at h₂ + rcases h_rec₁ : (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs₁, a₁'⟩ + · rw [h_rec₁] at h₁; exact absurd h₁ nofun + · rw [h_rec₁] at h₁ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₁) + rcases h_rec₂ : (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs₂, a₂'⟩ + · rw [h_rec₂] at h₂; exact absurd h₂ nofun + · rw [h_rec₂] at h₂ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₂) + cases k with + | zero => simp [List.length_cons] + | succ k' => + simp only [List.length_cons, Nat.succ_lt_succ_iff] at hk₁ ⊢ + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q := + congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ (Nat.zero_lt_succ k')) q + rw [h_r] at h_rec₁ + exact ih (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + k' + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (Nat.succ_lt_succ hi)) + h_rec₁ h_rec₂ hk₁ + +/-- **Deterministic prefix (full)**: if two oracles agree on all indices +`< queries.length`, and the first run succeeds producing `(queries, a)`, +then the second run produces the same `(queries, a)`. + +This strengthens `run_prefix_query_eq` from agreement at a single position +to identical outputs: if the oracles agree on all steps the interaction +actually used, the interaction is fully deterministic. -/ +theorem OracleInteraction.run_det_prefix {Q R A : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → Q → R) + {queries : List Q} {a : A} + (h₁ : interaction.run fuel oracle₁ = some (queries, a)) + (h_agree : ∀ (i : Fin fuel), i.val < queries.length → + oracle₁ i = oracle₂ i) : + interaction.run fuel oracle₂ = some (queries, a) := by + induction fuel generalizing interaction queries a with + | zero => + cases interaction with + | done a' => + change some ([], a') = some (queries, a) at h₁ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₁) + rfl + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done a' => + change some ([], a') = some (queries, a) at h₁ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₁) + rfl + | query q k => + have red₁ : OracleInteraction.run (.query q k) (n + 1) oracle₁ = + match (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + rw [red₁] at h₁ + rcases h_rec : (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + with _ | ⟨qs, a'⟩ + · rw [h_rec] at h₁; exact absurd h₁ nofun + · rw [h_rec] at h₁ + obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj h₁) + -- queries = q :: qs, so queries.length = qs.length + 1 + -- Oracle responses at step 0 agree (0 < (q :: qs).length) + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q := + congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ + (by simp [List.length_cons])) q + -- Apply IH with shifted oracles + have h_ih := ih (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ q)) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + h_rec + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (by simp [List.length_cons]; omega)) + -- Now show run oracle₂ = some (q :: qs, a) + have red₂ : OracleInteraction.run (.query q k) (n + 1) oracle₂ = + match (k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ q)).run n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) with + | none => none | some (qs, a') => some (q :: qs, a') := rfl + rw [red₂, ← h_r, h_ih] + +/-- Execute an oracle interaction against a **stateful** oracle, with a +fuel budget. The oracle at each step receives the current state `S` and +returns a response along with an updated state. + +Returns `none` if fuel is exhausted, otherwise +`some (queries, result, finalState)`. +Uses structural recursion on `fuel`. -/ +def OracleInteraction.runWithState {Q R A S : Type} + : (interaction : OracleInteraction Q R A) → + (fuel : Nat) → + (oracle : Fin fuel → S → Q → R × S) → + (initState : S) → + Option (List Q × A × S) + | .done a, _, _, s => some ([], a, s) + | .query _ _, 0, _, _ => none + | .query q k, fuel + 1, oracle, s => + let (response, s') := oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q + let shiftedOracle : Fin fuel → S → Q → R × S := + fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + match (k response).runWithState fuel shiftedOracle s' with + | none => none + | some (qs, a, sf) => some (q :: qs, a, sf) + +/-- **Deterministic prefix (stateful)**: if two stateful oracles agree on +the first `k` indices, both runs complete from the same initial state, +and both query logs have an entry at position `k`, then the `k`-th query +is the same. -/ +theorem OracleInteraction.runWithState_prefix_query_eq {Q R A S : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → S → Q → R × S) + (s : S) (k : Nat) + (h_agree : ∀ (i : Fin fuel), i.val < k → oracle₁ i = oracle₂ i) + {queries₁ queries₂ : List Q} {a₁ a₂ : A} {sf₁ sf₂ : S} + (h₁ : interaction.runWithState fuel oracle₁ s = some (queries₁, a₁, sf₁)) + (h₂ : interaction.runWithState fuel oracle₂ s = some (queries₂, a₂, sf₂)) + (hk₁ : k < queries₁.length) (hk₂ : k < queries₂.length) : + queries₁[k] = queries₂[k] := by + induction fuel generalizing interaction k queries₁ queries₂ a₁ a₂ sf₁ sf₂ s with + | zero => + cases interaction with + | done _ => + change some ([], _, _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done _ => + change some ([], _, _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query q cont => + have red₁ : OracleInteraction.runWithState (.query q cont) (n + 1) oracle₁ s = + match (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + have red₂ : OracleInteraction.runWithState (.query q cont) (n + 1) oracle₂ s = + match (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + rw [red₁] at h₁; rw [red₂] at h₂ + rcases h_rec₁ : (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + with _ | ⟨qs₁, a₁', sf₁'⟩ + · rw [h_rec₁] at h₁; exact absurd h₁ nofun + · rw [h_rec₁] at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + rcases h_rec₂ : (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + with _ | ⟨qs₂, a₂', sf₂'⟩ + · rw [h_rec₂] at h₂; exact absurd h₂ nofun + · rw [h_rec₂] at h₂ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₂) + cases k with + | zero => rfl + | succ k' => + simp only [List.length_cons, Nat.succ_lt_succ_iff] at hk₁ hk₂ + show qs₁[k'] = qs₂[k'] + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q := + congrFun (congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ + (Nat.zero_lt_succ k')) s) q + rw [h_r] at h_rec₁ + exact ih (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + k' + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (Nat.succ_lt_succ hi)) + h_rec₁ h_rec₂ hk₁ hk₂ + +/-- **Prefix length preservation (stateful)**: if two stateful oracles +agree on the first `k` indices, both runs complete from the same initial +state, and the first run has `k < queries₁.length`, then the second run +also has `k < queries₂.length`. -/ +theorem OracleInteraction.runWithState_prefix_implies_length {Q R A S : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → S → Q → R × S) + (s : S) (k : Nat) + (h_agree : ∀ (i : Fin fuel), i.val < k → oracle₁ i = oracle₂ i) + {queries₁ queries₂ : List Q} {a₁ a₂ : A} {sf₁ sf₂ : S} + (h₁ : interaction.runWithState fuel oracle₁ s = some (queries₁, a₁, sf₁)) + (h₂ : interaction.runWithState fuel oracle₂ s = some (queries₂, a₂, sf₂)) + (hk₁ : k < queries₁.length) : + k < queries₂.length := by + induction fuel generalizing interaction k queries₁ queries₂ a₁ a₂ sf₁ sf₂ s with + | zero => + cases interaction with + | done _ => + change some ([], _, _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done _ => + change some ([], _, _) = _ at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + exact absurd hk₁ (by simp) + | query q cont => + have red₁ : OracleInteraction.runWithState (.query q cont) (n + 1) oracle₁ s = + match (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + have red₂ : OracleInteraction.runWithState (.query q cont) (n + 1) oracle₂ s = + match (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + rw [red₁] at h₁; rw [red₂] at h₂ + rcases h_rec₁ : (cont (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + with _ | ⟨qs₁, a₁', sf₁'⟩ + · rw [h_rec₁] at h₁; exact absurd h₁ nofun + · rw [h_rec₁] at h₁ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₁) + rcases h_rec₂ : (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + with _ | ⟨qs₂, a₂', sf₂'⟩ + · rw [h_rec₂] at h₂; exact absurd h₂ nofun + · rw [h_rec₂] at h₂ + obtain ⟨rfl, -⟩ := Prod.mk.inj (Option.some.inj h₂) + cases k with + | zero => simp [List.length_cons] + | succ k' => + simp only [List.length_cons, Nat.succ_lt_succ_iff] at hk₁ ⊢ + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q := + congrFun (congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ + (Nat.zero_lt_succ k')) s) q + rw [h_r] at h_rec₁ + exact ih (cont (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + k' + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (Nat.succ_lt_succ hi)) + h_rec₁ h_rec₂ hk₁ + +/-- **Deterministic prefix (stateful, full)**: if two stateful oracles +agree on all indices `< queries.length`, both start from the same state, +and the first run succeeds producing `(queries, a, sf)`, then the second +run produces the same result. -/ +theorem OracleInteraction.runWithState_det_prefix {Q R A S : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → S → Q → R × S) + (s : S) + {queries : List Q} {a : A} {sf : S} + (h₁ : interaction.runWithState fuel oracle₁ s = some (queries, a, sf)) + (h_agree : ∀ (i : Fin fuel), i.val < queries.length → + oracle₁ i = oracle₂ i) : + interaction.runWithState fuel oracle₂ s = some (queries, a, sf) := by + induction fuel generalizing interaction queries a sf s with + | zero => + cases interaction with + | done a' => + change some ([], a', s) = some (queries, a, sf) at h₁ + obtain ⟨rfl, hrest⟩ := Prod.mk.inj (Option.some.inj h₁) + obtain ⟨rfl, rfl⟩ := Prod.mk.inj hrest + rfl + | query _ _ => + exact absurd (show (none : Option _) = _ from h₁) nofun + | succ n ih => + cases interaction with + | done a' => + change some ([], a', s) = some (queries, a, sf) at h₁ + obtain ⟨rfl, hrest⟩ := Prod.mk.inj (Option.some.inj h₁) + obtain ⟨rfl, rfl⟩ := Prod.mk.inj hrest + rfl + | query q k => + have red₁ : OracleInteraction.runWithState (.query q k) (n + 1) oracle₁ s = + match (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + rw [red₁] at h₁ + rcases h_rec : (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + with _ | ⟨qs, a', sf'⟩ + · rw [h_rec] at h₁; exact absurd h₁ nofun + · rw [h_rec] at h₁ + obtain ⟨rfl, hrest⟩ := Prod.mk.inj (Option.some.inj h₁) + obtain ⟨rfl, rfl⟩ := Prod.mk.inj hrest + have h_r : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q := + congrFun (congrFun (h_agree ⟨0, Nat.zero_lt_succ n⟩ + (by simp [List.length_cons])) s) q + have h_ih := ih (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).1) + (fun i : Fin n => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + h_rec + (fun i hi => h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + (by simp [List.length_cons]; omega)) + have red₂ : OracleInteraction.runWithState (.query q k) (n + 1) oracle₂ s = + match (k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1).runWithState n + (fun i : Fin n => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 with + | none => none | some (qs, a', sf') => some (q :: qs, a', sf') := rfl + rw [red₂, ← h_r, h_ih] + +end diff --git a/Cslib/Cryptography/Foundations/PolyTimeDistinguisher.lean b/Cslib/Cryptography/Foundations/PolyTimeDistinguisher.lean new file mode 100644 index 000000000..f469751b5 --- /dev/null +++ b/Cslib/Cryptography/Foundations/PolyTimeDistinguisher.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.Indistinguishability +public import Cslib.Computability.Machines.SingleTapeTuring.Basic + +@[expose] public section + +/-! +# Poly-Time Distinguishers + +This file bridges the abstract crypto definitions in `Indistinguishability.lean` +with the Turing-machine–based computability definitions. + +## Main Definitions + +* `PolyTimeEncodable` — a type class providing polynomial-length encodings to `List Bool` +* `IsPolyTimeDistinguisher` — a distinguisher computed by a poly-time Turing machine +* `PPTIndistinguishable` — computational indistinguishability restricted to PPT distinguishers + +## Design Notes + +`PolyTimeEncodable` bridges abstract crypto types (`α : ℕ → Type*`) to `List Bool`, +where `PolyTimeComputable` lives. The encoding length is polynomially bounded in `n`, +ensuring that poly-time on the encoding is poly-time in the security parameter. + +`IsPolyTimeDistinguisher` requires that a single poly-time TM computes the +accept/reject decision on all encoded inputs. The output is deterministic (0 or 1), +modeling the standard accept/reject paradigm. +-/ + +open Turing Turing.SingleTapeTM Polynomial + +/-- A type family `α : ℕ → Type*` is **poly-time encodable** if there exists +an encoding into `List Bool` with a polynomial length bound, together with +a decoding function that is a left inverse. -/ +class PolyTimeEncodable (α : ℕ → Type*) where + /-- Encode an element at security parameter `n` to a bitstring. -/ + encode : (n : ℕ) → α n → List Bool + /-- Decode a bitstring back to an element. -/ + decode : (n : ℕ) → List Bool → Option (α n) + /-- Decoding is a left inverse of encoding. -/ + encodeDecode : ∀ n a, decode n (encode n a) = some a + /-- A polynomial bounding the length of encoded elements. -/ + lengthPoly : Polynomial ℕ + /-- The encoding length is bounded by `lengthPoly.eval n`. -/ + encodeLengthBound : ∀ n (a : α n), (encode n a).length ≤ lengthPoly.eval n + +/-- A family of functions `f : (n : ℕ) → α n → β n` is **poly-time computable** +if there exists a poly-time TM function on bitstrings that correctly computes +`f` when composed with the polynomial-time encodings. + +Concretely, there exists `g : List Bool → List Bool` with a +`PolyTimeComputable g` proof such that decoding `g(encode(n, a))` at +security parameter `n` yields `f n a`. -/ +def IsPolyTimeFamily {α β : ℕ → Type*} + [PolyTimeEncodable α] [PolyTimeEncodable β] + (f : (n : ℕ) → α n → β n) : Prop := + ∃ (g : List Bool → List Bool), + Nonempty (PolyTimeComputable (Symbol := Bool) g) ∧ + ∀ n (a : α n), + PolyTimeEncodable.decode n (g (PolyTimeEncodable.encode n a)) = some (f n a) + +/-- A distinguisher is a **poly-time distinguisher** if there exists a poly-time +computable function `f : List Bool → List Bool` on bitstrings such that the +distinguisher's output (0 or 1) is determined by whether `f` returns a nonempty +list on the encoded input. -/ +def IsPolyTimeDistinguisher {α : ℕ → Type*} [PolyTimeEncodable α] + (D : Distinguisher α) : Prop := + ∃ (f : List Bool → List Bool), + Nonempty (PolyTimeComputable (Symbol := Bool) f) ∧ + ∀ n (a : α n), + D n a = if f (PolyTimeEncodable.encode n a) ≠ [] then 1 else 0 + +/-- A poly-time distinguisher is automatically bounded: its output is always +0 or 1, so it satisfies `IsBounded`. -/ +theorem IsPolyTimeDistinguisher.isBounded + {α : ℕ → Type*} [PolyTimeEncodable α] + {D : Distinguisher α} (h : IsPolyTimeDistinguisher D) : + D.IsBounded := by + obtain ⟨f, _, hD⟩ := h + intro n a + rw [hD n a] + split <;> norm_num + +/-- Restricting the admissibility predicate preserves computational +indistinguishability: if all `Q`-admissible distinguishers are also +`P`-admissible, then `P`-indistinguishability implies `Q`-indistinguishability. -/ +theorem CompIndistinguishable.mono + {α : ℕ → Type*} [∀ n, Fintype (α n)] + {P Q : Distinguisher α → Prop} + {X Y : Ensemble α} + (hPQ : ∀ D, Q D → P D) + (h : CompIndistinguishable P X Y) : + CompIndistinguishable Q X Y := by + intro D hB hQ + exact h D hB (hPQ D hQ) + +/-- **PPT-indistinguishability**: two ensembles are computationally +indistinguishable against probabilistic polynomial-time distinguishers. -/ +abbrev PPTIndistinguishable + {α : ℕ → Type*} [∀ n, Fintype (α n)] [PolyTimeEncodable α] + (X Y : Ensemble α) : Prop := + CompIndistinguishable IsPolyTimeDistinguisher X Y + +end diff --git a/Cslib/Cryptography/Foundations/RandomOracle.lean b/Cslib/Cryptography/Foundations/RandomOracle.lean new file mode 100644 index 000000000..0a5780537 --- /dev/null +++ b/Cslib/Cryptography/Foundations/RandomOracle.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Protocols.SigmaProtocol +public import Cslib.Cryptography.Foundations.OracleInteraction + +@[expose] public section + +/-! +# ROM EUF-CMA Security Games for Fiat-Shamir Signatures + +This file defines the **security games** used to state and prove the +ROM (Random Oracle Model) security of Fiat-Shamir signature schemes +derived from Sigma protocols. It provides the game definitions; the +security reduction is in `Cslib.Cryptography.Reductions.FiatShamirROM`. + +## Main Definitions + +* `assocLookup` — association-list lookup, used for Map-based ROM + simulations throughout the game-hop chain +* `ROM_EUF_CMA_Adversary` — an adversary that adaptively queries a + signing oracle and a hash oracle (modeled via a sum-type + `OracleInteraction`), then outputs a forgery `(m★, t★, z★)` +* `romCmaOracle` — the stateful oracle that handles signing and hash + queries in the real ROM game, using lazy sampling with an association + list for consistency +* `romCmaWinCondition` — the win-condition predicate: the forgery + verifies, the message is fresh, and `(m★, t★)` was explicitly + hash-queried +* `ROM_EUF_CMA_Game` — the full ROM EUF-CMA security game, as a + `SecurityGame` instance +* `RelationSolver` — an adversary that, given a statement, attempts to + find a valid witness +* `RelationGame` — the relation-hardness game (natural-keygen variant): + sample `w` uniformly, give `keyOf w` to the solver, check the output + +## Design Notes + +**Two-oracle model via sum types.** The adversary issues queries of type +`Msg ⊕ (Msg × Commitment)`: +- `Sum.inl m` — signing query for message `m`, answered with `(t, z)` +- `Sum.inr (m, t)` — hash query for `(m, t)`, answered with challenge `c` + +**Lazy-sampling ROM.** The random oracle is implemented by threading an +association list `List ((Msg × Commitment) × Challenge)` as state: fresh +keys receive a uniformly sampled challenge; repeated keys are answered +consistently from the list. + +**Explicit-query requirement.** Following the proof-friendly setup in +Boneh-Shoup §19.2.2 / §19.6 (Theorem 19.7), the win condition requires +`(m★, t★)` to appear among the adversary's explicit hash queries +(`Sum.inr`). This is a standard simplification that loses nothing +asymptotically. + +**Single query bound.** We use one total query count `q = A.numQueries n` +covering both hash and signing queries. In the book notation this +corresponds to the combined budget `Qs + Qro`. + +## References + +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, §19.6 +* [M. Bellare, P. Rogaway, *Random Oracles are Practical*][BellareR1993] +-/ + +open Cslib.Probability + +/-- Association-list lookup for map-style ROM simulations. -/ +noncomputable def assocLookup {α β : Type} [DecidableEq α] + (key : α) : List (α × β) → Option β + | [] => none + | (k, v) :: rest => if k = key then some v else assocLookup key rest + +/-- A **ROM EUF-CMA adversary** for a Fiat-Shamir signature scheme. + +The adversary receives the public key (statement) and adaptively +queries either: +- `Sum.inl m` — request a signature on message `m` +- `Sum.inr (m, t)` — request the hash of `(m, t)` + +The responses are: +- `Sum.inl (t, z)` — a signature (commitment, response) +- `Sum.inr c` — a hash value (challenge) + +The adversary eventually outputs a forgery `(m★, t★, z★)`. -/ +structure ROM_EUF_CMA_Adversary {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) where + /-- Upper bound on the total number of queries (hash + sign) -/ + numQueries : ℕ → ℕ + /-- The adaptive oracle interaction -/ + interact : (n : ℕ) → R.Statement n → + OracleInteraction + (Msg n ⊕ (Msg n × P.Commitment n)) + ((P.Commitment n × P.Response n) ⊕ P.Challenge n) + (Msg n × P.Commitment n × P.Response n) + +/-- The **stateful oracle** for the ROM EUF-CMA game. + +The oracle handles two kinds of queries via a sum type: + +- **Signing queries** (`Sum.inl m`): commit using `rs i`, look up or lazily + sample the challenge for `(m, t)`, then respond — returning the signature + `(t, z)` and updating the association list. +- **Hash queries** (`Sum.inr (m, t)`): look up or lazily sample the challenge + for `(m, t)`, returning it and updating the association list. -/ +noncomputable def romCmaOracle {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) [∀ n, DecidableEq (Msg n)] + (n : ℕ) (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (Hs : Fin q → (Msg n × P.Commitment n → P.Challenge n)) + [DecidableEq (P.Commitment n)] : + Fin q → + List ((Msg n × P.Commitment n) × P.Challenge n) → + (Msg n ⊕ (Msg n × P.Commitment n)) → + ((P.Commitment n × P.Response n) ⊕ P.Challenge n) × + List ((Msg n × P.Commitment n) × P.Challenge n) := + fun i map qry => + match qry with + | .inl m => + let t := P.commit n w y (rs i) + match assocLookup (m, t) map with + | some c => (.inl (t, P.respond n w y (rs i) c), map) + | none => + let c := Hs i (m, t) + (.inl (t, P.respond n w y (rs i) c), ((m, t), c) :: map) + | .inr (m, t) => + match assocLookup (m, t) map with + | some c => (.inr c, map) + | none => + let c := Hs i (m, t) + (.inr c, ((m, t), c) :: map) + +/-- The **win condition** for the ROM EUF-CMA game. + +Given the result of running the adversary's oracle interaction, returns `1` +if the adversary wins and `0` otherwise. The adversary wins when all three +conditions hold: + +1. **Forgery verifies**: `P.verify y t★ c z★ = true` where `c` is the + challenge recorded for `(m★, t★)` in the hash table. +2. **Message is fresh**: `m★` was not previously submitted as a signing query. +3. **Explicit hash query**: `(m★, t★)` appears among the adversary's queries + as an explicit hash query (`Sum.inr (m★, t★)`). -/ +noncomputable def romCmaWinCondition {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) (y : R.Statement n) + [DecidableEq (P.Commitment n)] : + Option (List (Msg n ⊕ (Msg n × P.Commitment n)) × + (Msg n × P.Commitment n × P.Response n) × + List ((Msg n × P.Commitment n) × P.Challenge n)) → ℝ + | none => 0 + | some (queries, (mf, tf, zf), finalMap) => + let j := queries.findIdx (fun x => decide (x = .inr (mf, tf))) + if _hj : j < q then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + match assocLookup (mf, tf) finalMap with + | some c => + boolToReal (P.verify n y tf c zf && !(signMsgs.contains mf)) + | none => 0 + else + 0 + +/-- The **ROM EUF-CMA security game** for a Fiat-Shamir signature scheme. + +The game (proof-friendly ROM-EUF-CMA variant): +1. Samples a witness `w` uniformly +2. Samples lazy-sampling coins for random-oracle replies +3. Samples signing randomness `rs : Fin q → ProverRandomness` +4. Gives the adversary the statement `y = keyOf w` +5. Answers signing queries using honest Fiat-Shamir signing +6. Answers hash queries consistently via lazy sampling +7. Accepts only if: + - the forgery verifies, + - the message is fresh (not signed before), and + - `(m★, t★)` was explicitly hash-queried -/ +noncomputable def ROM_EUF_CMA_Game {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) : + SecurityGame (ROM_EUF_CMA_Adversary P Msg) where + advantage A n := + let q := A.numQueries n + uniformExpect + ((R.Witness n × (Fin q → P.ProverRandomness n)) × + (Fin q → (Msg n × P.Commitment n → P.Challenge n))) + (fun ⟨⟨w, rs⟩, Hs⟩ => + let y := kg.keyOf n w + letI := P.commitmentDecEq n + romCmaWinCondition P Msg n q y + ((A.interact n y).runWithState q (romCmaOracle P Msg n w y rs Hs) [])) + +/-- A **relation solver** is an adversary that attempts to find a +witness given a statement. -/ +structure RelationSolver (R : EffectiveRelation) where + /-- Given a statement, attempt to find a witness. -/ + find : (n : ℕ) → R.Statement n → R.Witness n + +/-- The **relation hardness game**: the challenger samples a witness `w` +uniformly, computes the statement `y = keyOf w`, and gives `y` to the +solver. The solver wins if it outputs a valid witness for `y`. + +This is the natural-keygen specialization of Boneh-Shoup Attack +Game 19.2 where key generation is `w ←$ Witness; pk := keyOf w`. -/ +noncomputable def RelationGame (R : EffectiveRelation) + (kg : R.WithKeyGen) + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] : + SecurityGame (RelationSolver R) where + advantage B n := uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n (B.find n (kg.keyOf n w)) (kg.keyOf n w)))) + +end diff --git a/Cslib/Cryptography/Foundations/SecurityGame.lean b/Cslib/Cryptography/Foundations/SecurityGame.lean new file mode 100644 index 000000000..f686ee5a7 --- /dev/null +++ b/Cslib/Cryptography/Foundations/SecurityGame.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.Negligible +public import Cslib.Probability.Discrete + +@[expose] public section + +/-! +# Security Games + +This file provides the abstract framework for **game-based security +definitions**, the dominant paradigm in modern cryptography. + +A security game formalizes the interaction between a **challenger** (the +cryptographic scheme) and an **adversary** (the attacker). The adversary's +goal is to win the game; the scheme is secure if every efficient adversary +wins with probability negligibly close to some baseline (often 1/2). + +## Main Definitions + +* `SecurityGame` — an abstract security game parameterized by adversary type +* `Secure` — a scheme is secure if every adversary has negligible advantage +* `SecurityReduction` — a reduction from one game to another + +## Design Notes + +We parametrize games by an abstract adversary type `Adv` and define +the advantage function `ℕ → ℝ` mapping security parameter to winning +probability minus baseline. This allows both: +- **Decision games** (e.g., IND-CPA): adversary tries to distinguish, + baseline is 1/2 +- **Search games** (e.g., OWF inversion): adversary tries to find a + value, baseline is 0 + +## References + +* [M. Bellare, P. Rogaway, *The Security of Triple Encryption and a + Framework for Code-Based Game-Playing Proofs*][BellareR2006] +* [V. Shoup, *Sequences of Games: A Tool for Taming Complexity in + Security Proofs*][Shoup2004] +-/ + +/-- A **security game** captures the interaction between a cryptographic +scheme and an adversary. The game is parameterized by: +- `Adv` — the type of adversaries +- `advantage` — maps (adversary, security parameter) to the adversary's advantage, + i.e., `|Pr[adversary wins] - baseline|` -/ +structure SecurityGame (Adv : Type*) where + /-- The advantage of adversary `A` at security parameter `n`. -/ + advantage : Adv → ℕ → ℝ + +open Cslib.Probability in +/-- Construct a `SecurityGame` from a **coin-passing game**. + +The advantage of adversary `A` at security parameter `n` is the expected +value of `play A n c` when `c` is drawn uniformly from `Coins n`. + +This captures the standard pattern for search games (e.g., OWF inversion) +where a single uniform sample is drawn and the adversary's success +probability is the expectation over that sample. -/ +noncomputable def SecurityGame.ofCoinGame + {Adv : Type*} + (Coins : ℕ → Type) [∀ n, Fintype (Coins n)] [∀ n, Nonempty (Coins n)] + (play : Adv → (n : ℕ) → Coins n → ℝ) : + SecurityGame Adv where + advantage A n := uniformExpect (Coins n) (play A n) + +/-- A security game is **(information-theoretically) secure** if every +adversary has negligible advantage. + +This is the strongest notion: it quantifies over *all* adversaries, +including computationally unbounded ones. For computational security +(the standard cryptographic notion), use `SecureAgainst` with an +efficiency predicate. -/ +def SecurityGame.Secure (G : SecurityGame Adv) : Prop := + ∀ A : Adv, Negligible (G.advantage A) + +/-- A security game is **secure against** a class of adversaries defined +by the predicate `Admissible` if every admissible adversary has negligible +advantage. + +This is the standard cryptographic notion: no *efficient* adversary can +win the game with non-negligible probability beyond the baseline. + +Instantiations: +- `G.SecureAgainst (fun _ => True)` — information-theoretic security (= `G.Secure`) +- `G.SecureAgainst IsEfficient` — computational security against poly-time adversaries -/ +def SecurityGame.SecureAgainst (G : SecurityGame Adv) + (Admissible : Adv → Prop) : Prop := + ∀ A : Adv, Admissible A → Negligible (G.advantage A) + +/-- A **security reduction** from game `G₁` to game `G₂` is a +transformation of adversaries such that any adversary against `G₁` +can be turned into an adversary against `G₂` with comparable advantage. + +Specifically, `R A` is the reduction of adversary `A`, and the advantage +of `A` against `G₁` is bounded by a polynomial factor times the +advantage of `R A` against `G₂`. -/ +structure SecurityReduction (G₁ : SecurityGame Adv₁) + (G₂ : SecurityGame Adv₂) where + /-- The reduction maps adversaries for `G₁` to adversaries for `G₂`. -/ + reduce : Adv₁ → Adv₂ + /-- The advantage of `A` against `G₁` is bounded by the advantage + of `reduce A` against `G₂` plus a negligible term. -/ + advantage_bound : ∀ A, + Negligible (fun n => G₁.advantage A n - G₂.advantage (reduce A) n) + +end + +/-! ### Security reductions transfer security -/ + +/-- If there is a security reduction from `G₁` to `G₂` and `G₂` is +secure, then `G₁` is secure. + +This is the fundamental theorem of game-based cryptography: security +of the target game transfers through the reduction. -/ +theorem SecurityReduction.secure_transfer + {G₁ : SecurityGame Adv₁} {G₂ : SecurityGame Adv₂} + (R : SecurityReduction G₁ G₂) + (h : G₂.Secure) : + G₁.Secure := by + intro A + have hbound := R.advantage_bound A + have hG₂ := h (R.reduce A) + -- G₁.advantage A n + -- = (G₁.adv - G₂.adv) + G₂.adv; both terms are negligible + have : Negligible (fun n => + (G₁.advantage A n - G₂.advantage (R.reduce A) n) + + G₂.advantage (R.reduce A) n) := + Negligible.add hbound hG₂ + intro c hc + obtain ⟨N, hN⟩ := this c hc + refine ⟨N, fun n hn => ?_⟩ + have := hN n hn + simp only [sub_add_cancel] at this + exact this + +/-- `Secure` implies `SecureAgainst` for any admissibility predicate. -/ +theorem SecurityGame.Secure.secureAgainst + {G : SecurityGame Adv} (h : G.Secure) + (Admissible : Adv → Prop) : + G.SecureAgainst Admissible := by + intro A _ + exact h A + +/-- A reduction from `G₁` to `G₂` transfers `SecureAgainst` when the +reduction maps admissible adversaries to admissible adversaries. -/ +theorem SecurityReduction.secure_against_transfer + {G₁ : SecurityGame Adv₁} {G₂ : SecurityGame Adv₂} + (R : SecurityReduction G₁ G₂) + {P₁ : Adv₁ → Prop} {P₂ : Adv₂ → Prop} + (hP : ∀ A, P₁ A → P₂ (R.reduce A)) + (h : G₂.SecureAgainst P₂) : + G₁.SecureAgainst P₁ := by + intro A hA + have hbound := R.advantage_bound A + have hG₂ := h (R.reduce A) (hP A hA) + have : Negligible (fun n => + (G₁.advantage A n - G₂.advantage (R.reduce A) n) + + G₂.advantage (R.reduce A) n) := + Negligible.add hbound hG₂ + intro c hc + obtain ⟨N, hN⟩ := this c hc + refine ⟨N, fun n hn => ?_⟩ + have := hN n hn + simp only [sub_add_cancel] at this + exact this + +/-! ### Game composition -/ + +/-- The **trivial game** where every adversary has zero advantage. -/ +def SecurityGame.trivial : SecurityGame Adv where + advantage _ _ := 0 + +/-- The trivial game is secure. -/ +theorem SecurityGame.trivial_secure : (SecurityGame.trivial : SecurityGame Adv).Secure := by + intro A + exact Negligible.zero diff --git a/Cslib/Cryptography/Primitives/Commitment.lean b/Cslib/Cryptography/Primitives/Commitment.lean new file mode 100644 index 000000000..6041b795c --- /dev/null +++ b/Cslib/Cryptography/Primitives/Commitment.lean @@ -0,0 +1,287 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Commitment Schemes + +A **commitment scheme** allows a party to commit to a value while +keeping it hidden, and later reveal the committed value. It satisfies +two security properties: + +- **Hiding**: the commitment reveals nothing about the committed value +- **Binding**: the committer cannot change the committed value + +Commitment schemes are fundamental building blocks for zero-knowledge +proofs, secure computation, and many other cryptographic protocols. + +## Main Definitions + +* `CommitmentScheme` — a commitment scheme (Commit, Open) +* `CommitmentScheme.Hiding` — computational hiding property +* `CommitmentScheme.Binding` — computational binding property + +## Design Notes + +We model commitment as a two-phase process: `commit` produces a +commitment and an opening (decommitment), and `verify` checks that +a claimed value matches the commitment. + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +* [M. Blum, *Coin Flipping by Telephone*][Blum1981] +-/ + +/-- A **commitment scheme** parameterized by the security parameter. + +- `Message n` — the type of messages that can be committed +- `Commitment n` — the type of commitments +- `Opening n` — the decommitment information +- `Randomness n` — randomness used in commitment +-/ +structure CommitmentScheme where + /-- Message type at security level n -/ + Message : ℕ → Type + /-- Commitment type -/ + Commitment : ℕ → Type + /-- Opening (decommitment) type -/ + Opening : ℕ → Type + /-- Randomness for commitment -/ + Randomness : ℕ → Type + /-- Randomness type is finite (for sampling) -/ + randomnessFintype : ∀ n, Fintype (Randomness n) + /-- Randomness type is nonempty -/ + randomnessNonempty : ∀ n, Nonempty (Randomness n) + /-- Create a commitment: given message and randomness, produce + commitment and opening -/ + commit : (n : ℕ) → Message n → Randomness n → + Commitment n × Opening n + /-- Verify an opening: check that the opening matches the + commitment for the claimed message -/ + verify : (n : ℕ) → Commitment n → Message n → Opening n → Bool + +/-! ### Correctness -/ + +/-- A commitment scheme is **correct** if verification always accepts +honestly generated commitments. -/ +def CommitmentScheme.Correct (C : CommitmentScheme) : Prop := + ∀ (n : ℕ) (m : C.Message n) (r : C.Randomness n), + let (com, opening) := C.commit n m r + C.verify n com m opening = true + +/-! ### Security: Hiding -/ + +/-- A **hiding adversary** tries to determine which of two messages +was committed. -/ +structure CommitmentScheme.HidingAdversary (C : CommitmentScheme) where + /-- Adversary state -/ + State : ℕ → Type + /-- Phase 1: choose two messages -/ + choose : (n : ℕ) → C.Message n × C.Message n × State n + /-- Phase 2: given a commitment, guess which message was committed -/ + guess : (n : ℕ) → C.Commitment n → State n → Bool + +/-- The **hiding game**: the advantage of an adversary is +$$\left|\mathbb{E}_{r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2\right|$$ +where `r` is random commitment coins and `b` is a random challenge bit. -/ +noncomputable def CommitmentScheme.HidingGame (C : CommitmentScheme) : + SecurityGame (CommitmentScheme.HidingAdversary C) where + advantage A n := + letI := C.randomnessFintype n; letI := C.randomnessNonempty n + |Cslib.Probability.uniformExpect (C.Randomness n × Bool) + (fun ⟨r, b⟩ => + let (m₀, m₁, σ) := A.choose n + let m := if b then m₁ else m₀ + let (com, _) := C.commit n m r + let b' := A.guess n com σ + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-- A commitment scheme is **(computationally) hiding** if the hiding +game is secure against all adversaries. -/ +def CommitmentScheme.Hiding (C : CommitmentScheme) : Prop := + C.HidingGame.Secure + +/-- A commitment scheme is **hiding against** a class of adversaries. -/ +def CommitmentScheme.HidingAgainst (C : CommitmentScheme) + (Admissible : CommitmentScheme.HidingAdversary C → Prop) : Prop := + C.HidingGame.SecureAgainst Admissible + +/-! ### Security: Binding -/ + +/-- A **binding adversary** tries to open a commitment to two different +messages. The adversary has its own randomness (`Coins`) so that the +binding game is probabilistic — without coins, the advantage is {0,1} +and negligibility would imply eventual perfect binding. -/ +structure CommitmentScheme.BindingAdversary (C : CommitmentScheme) where + /-- Adversary coin type -/ + Coins : ℕ → Type + /-- Coins type is finite (for sampling) -/ + coinsFintype : ∀ n, Fintype (Coins n) + /-- Coins type is nonempty -/ + coinsNonempty : ∀ n, Nonempty (Coins n) + /-- Given the security parameter and coins, produce a commitment that + can be opened to two different messages. Returns (commitment, msg1, + opening1, msg2, opening2). -/ + forge : (n : ℕ) → Coins n → C.Commitment n × C.Message n × C.Opening n × + C.Message n × C.Opening n + +/-- The **binding game**: the adversary wins if it opens a commitment +to two different messages. The advantage is +`E_coins[1[double-opening succeeds]]`. -/ +noncomputable def CommitmentScheme.BindingGame (C : CommitmentScheme) + [∀ n, DecidableEq (C.Message n)] : + SecurityGame (CommitmentScheme.BindingAdversary C) where + advantage A n := + letI := A.coinsFintype n; letI := A.coinsNonempty n + Cslib.Probability.uniformExpect (A.Coins n) (fun coins => + let (com, m₁, o₁, m₂, o₂) := A.forge n coins + if m₁ ≠ m₂ ∧ C.verify n com m₁ o₁ = true ∧ + C.verify n com m₂ o₂ = true + then 1 else 0) + +/-- A commitment scheme is **(computationally) binding** if the binding +game is secure against all adversaries. -/ +def CommitmentScheme.Binding (C : CommitmentScheme) + [∀ n, DecidableEq (C.Message n)] : Prop := + (C.BindingGame).Secure + +/-- A commitment scheme is **binding against** a class of adversaries. -/ +def CommitmentScheme.BindingAgainst (C : CommitmentScheme) + [∀ n, DecidableEq (C.Message n)] + (Admissible : CommitmentScheme.BindingAdversary C → Prop) : Prop := + C.BindingGame.SecureAgainst Admissible + +/-! ### Keyed Commitment Schemes + +A **keyed commitment scheme** has a public commitment key (e.g., a hash +function description) sampled by the challenger and given to both the +committer and verifier. The binding property is defined with respect to +this random key. -/ + +/-- A **keyed commitment scheme** has an additional `CommitKey` type +that is sampled uniformly and given to the adversary. The `commit` +and `verify` operations both take this key. + +This models commitment schemes based on collision-resistant hashing +or other keyed primitives where the binding property depends on the +key being honestly generated. -/ +structure KeyedCommitmentScheme where + /-- Commitment key type (e.g., hash function description) -/ + CommitKey : ℕ → Type + /-- Message type -/ + Message : ℕ → Type + /-- Commitment type -/ + Commitment : ℕ → Type + /-- Opening (decommitment) type -/ + Opening : ℕ → Type + /-- Randomness for commitment -/ + Randomness : ℕ → Type + /-- Commit key type is finite (for sampling) -/ + commitKeyFintype : ∀ n, Fintype (CommitKey n) + /-- Commit key type is nonempty -/ + commitKeyNonempty : ∀ n, Nonempty (CommitKey n) + /-- Randomness type is finite (for sampling) -/ + randomnessFintype : ∀ n, Fintype (Randomness n) + /-- Randomness type is nonempty -/ + randomnessNonempty : ∀ n, Nonempty (Randomness n) + /-- Create a commitment given key, message, and randomness -/ + commit : (n : ℕ) → CommitKey n → Message n → Randomness n → + Commitment n × Opening n + /-- Verify an opening -/ + verify : (n : ℕ) → CommitKey n → Commitment n → Message n → Opening n → Bool + +/-- A keyed commitment scheme is **correct** if verification always +accepts honestly generated commitments. -/ +def KeyedCommitmentScheme.Correct (C : KeyedCommitmentScheme) : Prop := + ∀ (n : ℕ) (ck : C.CommitKey n) (m : C.Message n) (r : C.Randomness n), + let (com, opening) := C.commit n ck m r + C.verify n ck com m opening = true + +/-! ### Keyed Commitment: Hiding -/ + +/-- A **keyed hiding adversary** receives a random commitment key +and tries to determine which of two messages was committed. -/ +structure KeyedCommitmentScheme.HidingAdversary (C : KeyedCommitmentScheme) where + /-- Adversary state -/ + State : ℕ → Type + /-- Phase 1: given a commitment key, choose two messages -/ + choose : (n : ℕ) → C.CommitKey n → C.Message n × C.Message n × State n + /-- Phase 2: given a commitment, guess which message was committed -/ + guess : (n : ℕ) → C.Commitment n → State n → Bool + +/-- The **keyed hiding game**: the advantage of an adversary is +$$\left|\mathbb{E}_{ck,r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2\right|$$ +where `ck` is a random commitment key, `r` is random commitment coins, +and `b` is a random challenge bit. -/ +noncomputable def KeyedCommitmentScheme.HidingGame (C : KeyedCommitmentScheme) : + SecurityGame (KeyedCommitmentScheme.HidingAdversary C) where + advantage A n := + letI := C.commitKeyFintype n; letI := C.commitKeyNonempty n + letI := C.randomnessFintype n; letI := C.randomnessNonempty n + |Cslib.Probability.uniformExpect (C.CommitKey n × C.Randomness n × Bool) + (fun ⟨ck, r, b⟩ => + let (m₀, m₁, σ) := A.choose n ck + let m := if b then m₁ else m₀ + let (com, _) := C.commit n ck m r + let b' := A.guess n com σ + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-- A keyed commitment scheme is **(computationally) hiding** if the +keyed hiding game is secure against all adversaries. -/ +def KeyedCommitmentScheme.Hiding (C : KeyedCommitmentScheme) : Prop := + C.HidingGame.Secure + +/-- A keyed commitment scheme is **hiding against** a class of +adversaries. -/ +def KeyedCommitmentScheme.HidingAgainst (C : KeyedCommitmentScheme) + (Admissible : KeyedCommitmentScheme.HidingAdversary C → Prop) : Prop := + C.HidingGame.SecureAgainst Admissible + +/-! ### Keyed Commitment: Binding -/ + +/-- A **keyed binding adversary** receives a random commitment key +and tries to open a commitment to two different messages. -/ +structure KeyedCommitmentScheme.BindingAdversary (C : KeyedCommitmentScheme) where + /-- Given a commitment key, produce a double-opening -/ + forge : (n : ℕ) → C.CommitKey n → + C.Commitment n × C.Message n × C.Opening n × C.Message n × C.Opening n + +/-- The **keyed binding game**: the key is sampled uniformly and given +to the adversary. Advantage = `E_ck[1[A double-opens]]`. -/ +noncomputable def KeyedCommitmentScheme.BindingGame (C : KeyedCommitmentScheme) + [∀ n, DecidableEq (C.Message n)] : + SecurityGame (KeyedCommitmentScheme.BindingAdversary C) where + advantage A n := + letI := C.commitKeyFintype n; letI := C.commitKeyNonempty n + Cslib.Probability.uniformExpect (C.CommitKey n) (fun ck => + let (com, m₁, o₁, m₂, o₂) := A.forge n ck + Cslib.Probability.boolToReal + (decide (m₁ ≠ m₂) && + C.verify n ck com m₁ o₁ && + C.verify n ck com m₂ o₂)) + +/-- A keyed commitment scheme is **(computationally) binding** if the +keyed binding game is secure against all adversaries. -/ +def KeyedCommitmentScheme.Binding (C : KeyedCommitmentScheme) + [∀ n, DecidableEq (C.Message n)] : Prop := + C.BindingGame.Secure + +/-- A keyed commitment scheme is **binding against** a class of +adversaries. -/ +def KeyedCommitmentScheme.BindingAgainst (C : KeyedCommitmentScheme) + [∀ n, DecidableEq (C.Message n)] + (Admissible : KeyedCommitmentScheme.BindingAdversary C → Prop) : Prop := + C.BindingGame.SecureAgainst Admissible + +end diff --git a/Cslib/Cryptography/Primitives/Encryption.lean b/Cslib/Cryptography/Primitives/Encryption.lean new file mode 100644 index 000000000..fa9a4562b --- /dev/null +++ b/Cslib/Cryptography/Primitives/Encryption.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.OracleInteraction +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Encryption Schemes and Security Notions + +This file defines **symmetric** and **public-key encryption schemes** +and their standard game-based security notions: + +- **IND-CPA** (indistinguishability under chosen-plaintext attack) +- **IND-CCA** (indistinguishability under chosen-ciphertext attack) +- **Semantic security** (simulation-based) + +## Main Definitions + +* `EncryptionScheme` — a symmetric encryption scheme (KeyGen, Enc, Dec) +* `PKEncryptionScheme` — a public-key encryption scheme +* `IND_CPA` — the IND-CPA security game +* `IND_CCA` — the IND-CCA security game +* `Correctness` — decryption recovers the plaintext + +## Design Notes + +We parameterize encryption schemes by abstract types for keys, +plaintexts, ciphertexts, and randomness. The security parameter `n : ℕ` +determines the key generation, and all algorithms are indexed by `n`. + +Adversaries are modeled with `OracleInteraction` for the encryption +oracle (which is randomized and game-managed) and plain functions for +the decryption oracle (which is deterministic). The advantage +is `|Pr[correct guess] - 1/2|`. + +## References + +* [S. Goldwasser, S. Micali, *Probabilistic Encryption*][GoldwasserM1984] +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- A **symmetric encryption scheme** consists of key generation, +encryption, and decryption algorithms, parameterized by the security +parameter. + +- `Key n` — the type of keys at security level `n` +- `Plaintext n` — the type of plaintexts +- `Ciphertext n` — the type of ciphertexts +- `Randomness n` — the type of encryption randomness +-/ +structure EncryptionScheme where + /-- Key type at security level n -/ + Key : ℕ → Type + /-- Plaintext type at security level n -/ + Plaintext : ℕ → Type + /-- Ciphertext type at security level n -/ + Ciphertext : ℕ → Type + /-- Randomness type for encryption -/ + Randomness : ℕ → Type + /-- Key type is finite (for sampling) -/ + keyFintype : ∀ n, Fintype (Key n) + /-- Key type is nonempty -/ + keyNonempty : ∀ n, Nonempty (Key n) + /-- Randomness type is finite (for sampling) -/ + randomnessFintype : ∀ n, Fintype (Randomness n) + /-- Randomness type is nonempty -/ + randomnessNonempty : ∀ n, Nonempty (Randomness n) + /-- Deterministic encryption given key, plaintext, and randomness -/ + encrypt : (n : ℕ) → Key n → Plaintext n → Randomness n → Ciphertext n + /-- Deterministic decryption -/ + decrypt : (n : ℕ) → Key n → Ciphertext n → Option (Plaintext n) + +/-- A **public-key encryption scheme** has separate public and secret +keys. Key generation produces a pair; encryption uses the public key; +decryption uses the secret key. -/ +structure PKEncryptionScheme where + /-- Public key type -/ + PublicKey : ℕ → Type + /-- Secret key type -/ + SecretKey : ℕ → Type + /-- Plaintext type -/ + Plaintext : ℕ → Type + /-- Ciphertext type -/ + Ciphertext : ℕ → Type + /-- Randomness for encryption -/ + Randomness : ℕ → Type + /-- Key generation randomness type -/ + KeyGenRandomness : ℕ → Type + /-- Key generation randomness is finite (for sampling) -/ + keyGenRandomnessFintype : ∀ n, Fintype (KeyGenRandomness n) + /-- Key generation randomness is nonempty -/ + keyGenRandomnessNonempty : ∀ n, Nonempty (KeyGenRandomness n) + /-- Randomness type is finite (for sampling) -/ + randomnessFintype : ∀ n, Fintype (Randomness n) + /-- Randomness type is nonempty -/ + randomnessNonempty : ∀ n, Nonempty (Randomness n) + /-- Key generation: produces a correlated (pk, sk) pair from randomness -/ + keyGen : (n : ℕ) → KeyGenRandomness n → PublicKey n × SecretKey n + /-- Encrypt with the public key -/ + encrypt : (n : ℕ) → PublicKey n → Plaintext n → Randomness n → Ciphertext n + /-- Decrypt with the secret key -/ + decrypt : (n : ℕ) → SecretKey n → Ciphertext n → Option (Plaintext n) + +/-! ### Correctness -/ + +/-- An encryption scheme is **correct** if decryption always recovers +the plaintext. -/ +def EncryptionScheme.Correct (E : EncryptionScheme) : Prop := + ∀ (n : ℕ) (k : E.Key n) (m : E.Plaintext n) (r : E.Randomness n), + E.decrypt n k (E.encrypt n k m r) = some m + +/-- A public-key encryption scheme is **correct** if decryption with +the matching secret key always recovers the plaintext, for any key +pair produced by `keyGen`. -/ +def PKEncryptionScheme.Correct (E : PKEncryptionScheme) : Prop := + ∀ (n : ℕ) (kgr : E.KeyGenRandomness n) (m : E.Plaintext n) + (r : E.Randomness n), + let (pk, sk) := E.keyGen n kgr + E.decrypt n sk (E.encrypt n pk m r) = some m + +/-! ### IND-CPA Security -/ + +/-- An **IND-CPA adversary** for a symmetric encryption scheme. + +The adversary operates in two phases, both with oracle access to +encryption via `OracleInteraction`: +1. `choose` — query the encryption oracle, then produce two challenge + messages `(m₀, m₁)` and some state `σ` +2. `guess` — given the challenge ciphertext and state, query the + encryption oracle, then guess which message was encrypted + +The adversary never controls the encryption randomness — the game +supplies fresh randomness for each oracle query. -/ +structure IND_CPA_Adversary (E : EncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Upper bound on encryption queries in Phase 1 -/ + numQueries1 : ℕ → ℕ + /-- Upper bound on encryption queries in Phase 2 -/ + numQueries2 : ℕ → ℕ + /-- Phase 1: query encryption oracle, then choose two challenge messages -/ + choose : (n : ℕ) → + OracleInteraction (E.Plaintext n) (E.Ciphertext n) + (E.Plaintext n × E.Plaintext n × State n) + /-- Phase 2: given challenge ciphertext and state, query encryption + oracle, then guess which message was encrypted -/ + guess : (n : ℕ) → E.Ciphertext n → State n → + OracleInteraction (E.Plaintext n) (E.Ciphertext n) Bool + +/-- The **IND-CPA security game** for a symmetric encryption scheme. + +The coin space is +`Key n × (Fin q1 → Randomness n) × Randomness n × (Fin q2 → Randomness n) × Bool`. +The game pre-samples randomness for each oracle query slot. +On fuel exhaustion (`none` from `.run`), return `0` for the game body +(adversary defaults to losing). -/ +noncomputable def IND_CPA_Game (E : EncryptionScheme) : + SecurityGame (IND_CPA_Adversary E) where + advantage A n := + let q1 := A.numQueries1 n + let q2 := A.numQueries2 n + letI := E.keyFintype n; letI := E.keyNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect + (E.Key n × (Fin q1 → E.Randomness n) × E.Randomness n × + (Fin q2 → E.Randomness n) × Bool) + (fun ⟨k, rs1, r_ch, rs2, b⟩ => + let encOracle1 : Fin q1 → E.Plaintext n → E.Ciphertext n := + fun i m => E.encrypt n k m (rs1 i) + match (A.choose n).run q1 encOracle1 with + | none => 0 + | some (_, m₀, m₁, σ) => + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n k challenge r_ch + let encOracle2 : Fin q2 → E.Plaintext n → E.Ciphertext n := + fun i m => E.encrypt n k m (rs2 i) + match (A.guess n ct σ).run q2 encOracle2 with + | none => 0 + | some (_, b') => + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-! ### IND-CCA Security -/ + +/-- An **IND-CCA adversary** has access to both an encryption oracle +(via `OracleInteraction`, game-managed randomness) and a decryption +oracle (passed as a plain function, since decryption is deterministic). + +Phase 1 and Phase 2 both have oracle access. In Phase 2, the +decryption oracle refuses to decrypt the challenge ciphertext. -/ +structure IND_CCA_Adversary (E : EncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Upper bound on encryption queries in Phase 1 -/ + numQueries1 : ℕ → ℕ + /-- Upper bound on encryption queries in Phase 2 -/ + numQueries2 : ℕ → ℕ + /-- Phase 1: choose messages with encryption oracle and decryption + oracle access -/ + choose : (n : ℕ) → + (E.Ciphertext n → Option (E.Plaintext n)) → + OracleInteraction (E.Plaintext n) (E.Ciphertext n) + (E.Plaintext n × E.Plaintext n × State n) + /-- Phase 2: guess with encryption oracle and restricted decryption + oracle (cannot query challenge ct) -/ + guess : (n : ℕ) → E.Ciphertext n → State n → + (E.Ciphertext n → Option (E.Plaintext n)) → + OracleInteraction (E.Plaintext n) (E.Ciphertext n) Bool + +/-- The **IND-CCA security game** for a symmetric encryption scheme. + +In Phase 1, the adversary receives encryption and decryption oracles and +produces two challenge messages. In Phase 2, the adversary receives the +challenge ciphertext and a restricted decryption oracle that refuses to +decrypt the challenge ciphertext. + +On fuel exhaustion (`none` from `.run`), return `0` for the game body. -/ +noncomputable def IND_CCA_Game (E : EncryptionScheme) + [∀ n, DecidableEq (E.Ciphertext n)] : + SecurityGame (IND_CCA_Adversary E) where + advantage A n := + let q1 := A.numQueries1 n + let q2 := A.numQueries2 n + letI := E.keyFintype n; letI := E.keyNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect + (E.Key n × (Fin q1 → E.Randomness n) × E.Randomness n × + (Fin q2 → E.Randomness n) × Bool) + (fun ⟨k, rs1, r_ch, rs2, b⟩ => + let encOracle1 : Fin q1 → E.Plaintext n → E.Ciphertext n := + fun i m => E.encrypt n k m (rs1 i) + let decOracle := E.decrypt n k + match (A.choose n decOracle).run q1 encOracle1 with + | none => 0 + | some (_, m₀, m₁, σ) => + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n k challenge r_ch + let decOracle' : E.Ciphertext n → Option (E.Plaintext n) := + fun c => if c = ct then none else E.decrypt n k c + let encOracle2 : Fin q2 → E.Plaintext n → E.Ciphertext n := + fun i m => E.encrypt n k m (rs2 i) + match (A.guess n ct σ decOracle').run q2 encOracle2 with + | none => 0 + | some (_, b') => + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-- A symmetric encryption scheme is **IND-CCA secure** if the IND-CCA game +is secure against all adversaries. -/ +def IND_CCA (E : EncryptionScheme) [∀ n, DecidableEq (E.Ciphertext n)] : Prop := + (IND_CCA_Game E).Secure + +/-! ### Relationships between security notions -/ + +/-- Every IND-CPA adversary can be embedded into the IND-CCA setting +by ignoring the decryption oracle. -/ +def IND_CPA_to_CCA (E : EncryptionScheme) (A : IND_CPA_Adversary E) : + IND_CCA_Adversary E where + State := A.State + numQueries1 := A.numQueries1 + numQueries2 := A.numQueries2 + choose n _decOracle := + A.choose n + guess n ct σ _decOracle := + A.guess n ct σ + +/-- Every IND-CCA adversary can be turned into an IND-CPA adversary +by replacing the decryption oracle with one that always returns `none`. + +This witnesses the fact that IND-CPA security is a weaker notion than +IND-CCA security. -/ +def IND_CCA_to_CPA (E : EncryptionScheme) (A : IND_CCA_Adversary E) : + IND_CPA_Adversary E where + State := A.State + numQueries1 := A.numQueries1 + numQueries2 := A.numQueries2 + choose n := + A.choose n (fun _ => none) + guess n ct σ := + A.guess n ct σ (fun _ => none) + +/-! ### PKE Security -/ + +/-- A **PKE IND-CPA adversary** for a public-key encryption scheme. + +The adversary receives the public key and can encrypt on its own, so +no encryption oracle is needed (standard definition, KL Def 12.7). -/ +structure PKE_IND_CPA_Adversary (E : PKEncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Phase 1: given public key, choose two challenge messages -/ + choose : (n : ℕ) → E.PublicKey n → E.Plaintext n × E.Plaintext n × State n + /-- Phase 2: given challenge ciphertext and state, guess which + message was encrypted -/ + guess : (n : ℕ) → E.Ciphertext n → State n → Bool + +/-- The **PKE IND-CPA security game** for a public-key encryption scheme. + +The coin space is `KeyGenRandomness n × Randomness n × Bool`. -/ +noncomputable def PKE_IND_CPA_Game (E : PKEncryptionScheme) : + SecurityGame (PKE_IND_CPA_Adversary E) where + advantage A n := + letI := E.keyGenRandomnessFintype n; letI := E.keyGenRandomnessNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect + (E.KeyGenRandomness n × E.Randomness n × Bool) + (fun ⟨kgr, r, b⟩ => + let (pk, _sk) := E.keyGen n kgr + let (m₀, m₁, σ) := A.choose n pk + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n pk challenge r + let b' := A.guess n ct σ + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-- A **PKE IND-CCA adversary** for a public-key encryption scheme. + +The adversary receives the public key (so can encrypt freely) and +a decryption oracle (passed as a plain function). In Phase 2, the +decryption oracle refuses to decrypt the challenge ciphertext. -/ +structure PKE_IND_CCA_Adversary (E : PKEncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Phase 1: given public key and decryption oracle, choose two + challenge messages -/ + choose : (n : ℕ) → E.PublicKey n → + (E.Ciphertext n → Option (E.Plaintext n)) → + E.Plaintext n × E.Plaintext n × State n + /-- Phase 2: given challenge ciphertext, state, and restricted + decryption oracle, guess which message was encrypted -/ + guess : (n : ℕ) → E.Ciphertext n → State n → + (E.Ciphertext n → Option (E.Plaintext n)) → Bool + +/-- The **PKE IND-CCA security game** for a public-key encryption scheme. + +The coin space is `KeyGenRandomness n × Randomness n × Bool`. -/ +noncomputable def PKE_IND_CCA_Game (E : PKEncryptionScheme) + [∀ n, DecidableEq (E.Ciphertext n)] : + SecurityGame (PKE_IND_CCA_Adversary E) where + advantage A n := + letI := E.keyGenRandomnessFintype n; letI := E.keyGenRandomnessNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect + (E.KeyGenRandomness n × E.Randomness n × Bool) + (fun ⟨kgr, r, b⟩ => + let (pk, sk) := E.keyGen n kgr + let decOracle := E.decrypt n sk + let (m₀, m₁, σ) := A.choose n pk decOracle + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n pk challenge r + let decOracle' : E.Ciphertext n → Option (E.Plaintext n) := + fun c => if c = ct then none else E.decrypt n sk c + let b' := A.guess n ct σ decOracle' + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +end diff --git a/Cslib/Cryptography/Primitives/HashFunction.lean b/Cslib/Cryptography/Primitives/HashFunction.lean new file mode 100644 index 000000000..e68645a8a --- /dev/null +++ b/Cslib/Cryptography/Primitives/HashFunction.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Cryptographic Hash Functions + +This file defines **collision-resistant hash function families** and +their security notions. + +## Main Definitions + +* `HashFamily` — a keyed hash function family +* `HashFamily.CollisionResistant` — collision resistance +* `HashFamily.SecondPreimageResistant` — second preimage resistance + +## Design Notes + +We follow the standard keyed hash function model where a public key +(hash function description) is sampled and given to the adversary. +The adversary wins if it finds a collision. + +## References + +* [I. Damgård, *Collision Free Hash Functions and Public Key + Signature Schemes*][Damgard1987] +* [P. Rogaway, T. Shrimpton, *Cryptographic Hash-Function + Basics*][RogawayS2004] +-/ + +/-- A **keyed hash function family** parameterized by security level. + +At each security level `n`, a key selects a specific hash function +from the family. -/ +structure HashFamily where + /-- Key (hash function description) type -/ + Key : ℕ → Type + /-- Input (preimage) type -/ + Input : ℕ → Type + /-- Output (digest) type -/ + Output : ℕ → Type + /-- Key type is finite (for sampling) -/ + keyFintype : ∀ n, Fintype (Key n) + /-- Key type is nonempty -/ + keyNonempty : ∀ n, Nonempty (Key n) + /-- The hash function -/ + hash : (n : ℕ) → Key n → Input n → Output n + +/-! ### Collision Resistance -/ + +/-- A **collision-finding adversary** attempts to find two distinct +inputs that hash to the same output under a given key. -/ +structure HashFamily.CollisionAdversary (H : HashFamily) where + /-- Given a key, find two inputs. The adversary wins if they are + distinct and hash to the same value. -/ + findCollision : (n : ℕ) → H.Key n → H.Input n × H.Input n + +/-- The **collision resistance game**: the adversary wins if it finds +two distinct inputs `(x₁, x₂)` with `H(k, x₁) = H(k, x₂)`. + +The advantage is `E_k[1[A finds collision under key k]]`. -/ +noncomputable def HashFamily.CollisionGame (H : HashFamily) + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] : + SecurityGame (HashFamily.CollisionAdversary H) where + advantage A n := + letI := H.keyFintype n; letI := H.keyNonempty n + Cslib.Probability.uniformExpect (H.Key n) (fun k => + let (x₁, x₂) := A.findCollision n k + Cslib.Probability.boolToReal + (decide (x₁ ≠ x₂) && decide (H.hash n k x₁ = H.hash n k x₂))) + +/-- A hash family is **collision resistant** if the collision game +is secure against all adversaries. -/ +def HashFamily.CollisionResistant (H : HashFamily) + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] : Prop := + H.CollisionGame.Secure + +/-- A hash family is **collision resistant against** a class of +adversaries. -/ +def HashFamily.CollisionResistantAgainst (H : HashFamily) + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] + (Admissible : HashFamily.CollisionAdversary H → Prop) : Prop := + H.CollisionGame.SecureAgainst Admissible + +/-! ### Second Preimage Resistance -/ + +/-- A **second-preimage adversary** is given a key and an input `x₁`, +and must find a different input `x₂` with the same hash value. -/ +structure HashFamily.SecondPreimageAdversary (H : HashFamily) where + /-- Given a key and an input, find another input with the same hash -/ + findSecondPreimage : (n : ℕ) → H.Key n → H.Input n → H.Input n + +/-- The **second preimage resistance game**: the adversary is given a +random key `k` and a random input `x₁`, and must find `x₂ ≠ x₁` with +`H(k, x₁) = H(k, x₂)`. + +The advantage is `E_{k,x₁}[1[x₁ ≠ x₂ ∧ H(k,x₁) = H(k,x₂)]]`. -/ +noncomputable def HashFamily.SecondPreimageGame (H : HashFamily) + [∀ n, Fintype (H.Input n)] [∀ n, Nonempty (H.Input n)] + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] : + SecurityGame (HashFamily.SecondPreimageAdversary H) where + advantage A n := + letI := H.keyFintype n; letI := H.keyNonempty n + Cslib.Probability.uniformExpect (H.Key n × H.Input n) (fun ⟨k, x₁⟩ => + let x₂ := A.findSecondPreimage n k x₁ + Cslib.Probability.boolToReal + (decide (x₁ ≠ x₂) && decide (H.hash n k x₁ = H.hash n k x₂))) + +/-- A hash family is **second preimage resistant** if the second preimage +game is secure against all adversaries. -/ +def HashFamily.SecondPreimageResistant (H : HashFamily) + [∀ n, Fintype (H.Input n)] [∀ n, Nonempty (H.Input n)] + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] : Prop := + H.SecondPreimageGame.Secure + +/-- A hash family is **second preimage resistant against** a class of +adversaries. -/ +def HashFamily.SecondPreimageResistantAgainst (H : HashFamily) + [∀ n, Fintype (H.Input n)] [∀ n, Nonempty (H.Input n)] + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] + (Admissible : HashFamily.SecondPreimageAdversary H → Prop) : Prop := + H.SecondPreimageGame.SecureAgainst Admissible + +/-! ### Collision Resistance implies Second Preimage Resistance -/ + +open Cslib.Probability in +/-- **Collision resistance implies second preimage resistance.** + +Given a second-preimage adversary `A`, we construct a collision-finding +adversary `B` such that `B(k) = (x₁*(k), A(k, x₁*(k)))` where +`x₁*(k)` is the input that maximizes `A`'s success probability for +key `k`. + +By the averaging principle (`uniformExpect_le_exists`), the CR +advantage of `B` is at least the SPR advantage of `A`. -/ +theorem HashFamily.collisionResistant_imp_secondPreimageResistant + (H : HashFamily) + [∀ n, Fintype (H.Input n)] [∀ n, Nonempty (H.Input n)] + [∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] + (hCR : H.CollisionResistant) : + H.SecondPreimageResistant := by + intro A + -- SPR indicator function + let ind (n : ℕ) (k : H.Key n) (x₁ : H.Input n) : ℝ := + boolToReal (decide (x₁ ≠ A.findSecondPreimage n k x₁) && + decide (H.hash n k x₁ = H.hash n k (A.findSecondPreimage n k x₁))) + -- For each (n, k), averaging gives us the best x₁ + have h_avg : ∀ n (k : H.Key n), ∃ x₁ : H.Input n, + uniformExpect (H.Input n) (ind n k) ≤ ind n k x₁ := + fun n k => uniformExpect_le_exists (H.Input n) (ind n k) + -- Build collision adversary: for each (n,k), use the best x₁ + let B : HashFamily.CollisionAdversary H := + ⟨fun n k => + let x₁ := (h_avg n k).choose + (x₁, A.findSecondPreimage n k x₁)⟩ + -- CR gives negligibility of B's advantage + apply Negligible.mono (hCR B) + refine ⟨0, fun n _ => ?_⟩ + letI := H.keyFintype n; letI := H.keyNonempty n + -- Both advantages are nonneg + have h_spr_nonneg : 0 ≤ H.SecondPreimageGame.advantage A n := by + simp only [SecondPreimageGame] + exact uniformExpect_nonneg _ fun _ => boolToReal_nonneg _ + have h_cr_nonneg : 0 ≤ H.CollisionGame.advantage B n := by + simp only [CollisionGame] + exact uniformExpect_nonneg _ fun _ => boolToReal_nonneg _ + rw [abs_of_nonneg h_spr_nonneg, abs_of_nonneg h_cr_nonneg] + -- SPR adv = E_{k,x₁}[ind] = E_k[E_{x₁}[ind]] ≤ E_k[ind(k,x₁*(k))] = CR adv + simp only [SecondPreimageGame, CollisionGame] + rw [uniformExpect_prod] + -- Pointwise monotonicity + unfold uniformExpect + apply Finset.sum_le_sum + intro k _ + apply mul_le_mul_of_nonneg_left _ ENNReal.toReal_nonneg + -- B.findCollision unfolds to (x₁_best, A(k, x₁_best)) + change uniformExpect (H.Input n) (ind n k) ≤ + ind n k (h_avg n k).choose + exact (h_avg n k).choose_spec + +end diff --git a/Cslib/Cryptography/Primitives/MAC.lean b/Cslib/Cryptography/Primitives/MAC.lean new file mode 100644 index 000000000..ede47629a --- /dev/null +++ b/Cslib/Cryptography/Primitives/MAC.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.OracleInteraction +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Message Authentication Codes + +A **message authentication code (MAC)** allows a party to produce a +short tag on a message such that anyone sharing the secret key can +verify the tag, but no one without the key can forge a valid tag on +a new message. + +## Main Definitions + +* `MACScheme` — a MAC scheme (Tag, Verify) +* `MACScheme.EUF_CMA_Adversary` — existential unforgeability adversary +* `MACScheme.EUF_CMA_Game` — the EUF-CMA security game +* `MACScheme.EUF_CMA_Secure` — security predicate + +## Design Notes + +The adversary adaptively queries a tagging oracle via +`OracleInteraction` and must forge a valid tag on a message it +never queried. The game logs all queries and checks freshness. + +The EUF-CMA game is a **search game** (baseline 0, not 1/2). + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014], §4.3 +* [M. Bellare, J. Kilian, P. Rogaway, *The Security of the Cipher + Block Chaining Message Authentication Code*][BKR2000] +-/ + +/-- A **message authentication code scheme** parameterized by the +security parameter. + +- `Key n` — the type of secret keys at security level `n` +- `Message n` — the type of messages +- `Tag n` — the type of authentication tags +-/ +structure MACScheme where + /-- Key type at security level n -/ + Key : ℕ → Type + /-- Message type -/ + Message : ℕ → Type + /-- Tag type -/ + Tag : ℕ → Type + /-- Key type is finite (for sampling) -/ + keyFintype : ∀ n, Fintype (Key n) + /-- Key type is nonempty -/ + keyNonempty : ∀ n, Nonempty (Key n) + /-- The tagging function -/ + tag : (n : ℕ) → Key n → Message n → Tag n + /-- The verification function -/ + verify : (n : ℕ) → Key n → Message n → Tag n → Bool + +/-! ### Correctness -/ + +/-- A MAC scheme is **correct** if verification always accepts honestly +generated tags. -/ +def MACScheme.Correct (M : MACScheme) : Prop := + ∀ (n : ℕ) (k : M.Key n) (m : M.Message n), + M.verify n k m (M.tag n k m) = true + +/-! ### EUF-CMA Security -/ + +/-- An **EUF-CMA adversary** for a MAC scheme models adaptive +chosen-message attack via `OracleInteraction`. + +The adversary interacts with a tagging oracle by issuing queries of +type `M.Message n` and receiving responses of type `M.Tag n`. After +the interaction, the adversary outputs a forgery attempt +`(message, tag)`. The game logs all queries and checks freshness — +the adversary never self-reports which messages it queried. + +- `numQueries n` — an upper bound on the number of tagging queries + at security parameter `n` (used as fuel for `OracleInteraction.run`) +- `interact n` — the adaptive oracle interaction producing a forgery + attempt -/ +structure MACScheme.EUF_CMA_Adversary (M : MACScheme) where + /-- Upper bound on the number of tagging queries -/ + numQueries : ℕ → ℕ + /-- The adaptive oracle interaction: query the tagging oracle and + produce a forgery attempt `(message, tag)` -/ + interact : (n : ℕ) → + OracleInteraction (M.Message n) (M.Tag n) + (M.Message n × M.Tag n) + +/-- The **EUF-CMA security game** for a MAC scheme. + +The game samples a key `k` and runs the adversary's oracle +interaction with oracle `fun _i m => M.tag n k m` (MACs are +deterministic, so the query index is unused). The game logs all +queries and checks: +1. The forgery message was not among the queried messages +2. The forged tag verifies under the key + +The advantage is `E_k[1[interaction succeeds ∧ forgery valid ∧ fresh]]`. +This is a **search game** with baseline 0. -/ +noncomputable def MACScheme.EUF_CMA_Game (M : MACScheme) + [∀ n, DecidableEq (M.Message n)] : + SecurityGame (MACScheme.EUF_CMA_Adversary M) where + advantage A n := + let q := A.numQueries n + letI := M.keyFintype n; letI := M.keyNonempty n + Cslib.Probability.uniformExpect (M.Key n) (fun k => + let oracle : Fin q → M.Message n → M.Tag n := + fun _i m => M.tag n k m + match (A.interact n).run q oracle with + | none => 0 + | some (queries, m_forge, t_forge) => + Cslib.Probability.boolToReal + (M.verify n k m_forge t_forge && !(queries.contains m_forge))) + +/-- A MAC scheme is **EUF-CMA secure** if the EUF-CMA game is secure +against all adversaries. -/ +def MACScheme.EUF_CMA_Secure (M : MACScheme) + [∀ n, DecidableEq (M.Message n)] : Prop := + M.EUF_CMA_Game.Secure + +/-- A MAC scheme is **EUF-CMA secure against** a class of adversaries. -/ +def MACScheme.EUF_CMA_SecureAgainst (M : MACScheme) + [∀ n, DecidableEq (M.Message n)] + (Admissible : MACScheme.EUF_CMA_Adversary M → Prop) : Prop := + M.EUF_CMA_Game.SecureAgainst Admissible + +end diff --git a/Cslib/Cryptography/Primitives/OneWayFunction.lean b/Cslib/Cryptography/Primitives/OneWayFunction.lean new file mode 100644 index 000000000..a33b876ac --- /dev/null +++ b/Cslib/Cryptography/Primitives/OneWayFunction.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# One-Way Functions + +This file defines **one-way functions (OWFs)** — the minimal +cryptographic assumption from which most of modern cryptography can +be built. + +A function is one-way if it is: +1. **Efficiently computable** — can be evaluated in polynomial time +2. **Hard to invert** — no efficient algorithm can find a preimage + with non-negligible probability + +## Main Definitions + +* `OWF` — a one-way function family +* `OWF.Secure` — information-theoretic security (all adversaries) +* `OWF.SecureAgainst` — computational security (efficient adversaries only) +* `OWP` — a one-way permutation (bijective OWF) + +## Design Notes + +We model one-way functions as families indexed by the security parameter, +following the standard asymptotic treatment. The inversion game is a +search game where the adversary's advantage is `Pr[A inverts f on +random input]`. + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +* [S. Goldwasser, S. Micali, *Probabilistic Encryption*][GoldwasserM1984] +-/ + +/-- A **one-way function family** indexed by the security parameter. + +At each security level `n`, `f n` maps `Domain n` to `Range n`. +The function should be hard to invert (captured by `Secure` / +`SecureAgainst`). -/ +structure OWF where + /-- Input domain at security level n -/ + Domain : ℕ → Type + /-- Output range at security level n -/ + Range : ℕ → Type + /-- Domain is finite (for sampling) -/ + domainFintype : ∀ n, Fintype (Domain n) + /-- Domain is nonempty (for sampling) -/ + domainNonempty : ∀ n, Nonempty (Domain n) + /-- Range has decidable equality (for checking inversion) -/ + rangeDecEq : ∀ n, DecidableEq (Range n) + /-- The one-way function -/ + f : (n : ℕ) → Domain n → Range n + +/-- An **inversion adversary** for a one-way function: given the security +parameter and a value `y` in the range, attempts to find `x` such that +`f(x) = y`. -/ +structure OWF.InversionAdversary (F : OWF) where + /-- The inversion algorithm: given n and y = f(x), find some x'. -/ + invert : (n : ℕ) → F.Range n → F.Domain n + +/-- A one-way function is **secure** if for every inversion adversary, +the probability of successful inversion is negligible. + +The advantage is `Pr_{x ← Domain n}[f(A.invert(f(x))) = f(x)]`, computed +as a uniform expectation over the domain using the coin-passing style. -/ +noncomputable def OWF.InversionGame (F : OWF) : SecurityGame (OWF.InversionAdversary F) := + letI (n : ℕ) := F.domainFintype n + letI (n : ℕ) := F.domainNonempty n + letI (n : ℕ) := F.rangeDecEq n + SecurityGame.ofCoinGame F.Domain + (fun A n x => Cslib.Probability.boolToReal (decide (F.f n (A.invert n (F.f n x)) = F.f n x))) + +/-- A one-way function is **(information-theoretically) secure** if the +inversion game is secure against all adversaries. -/ +def OWF.Secure (F : OWF) : Prop := F.InversionGame.Secure + +/-- A one-way function is **computationally secure** against a class of +adversaries defined by `Admissible`. The standard instantiation uses +poly-time adversaries. -/ +def OWF.SecureAgainst (F : OWF) + (Admissible : OWF.InversionAdversary F → Prop) : Prop := + F.InversionGame.SecureAgainst Admissible + +/-- A **one-way permutation** is a one-way function that is a bijection +at every security level. -/ +structure OWP extends OWF where + /-- The function is a bijection at every security level -/ + bij : ∀ n, Function.Bijective (toOWF.f n) + +end + +/-! ### Basic properties -/ + +/-- A one-way permutation is a one-way function. -/ +def OWP.toSecure (P : OWP) (h : P.toOWF.Secure) : P.toOWF.Secure := h + +/-- Information-theoretic security implies computational security +against any class of adversaries. -/ +theorem OWF.Secure.toSecureAgainst {F : OWF} (h : F.Secure) + (Admissible : OWF.InversionAdversary F → Prop) : + F.SecureAgainst Admissible := by + intro A _ + exact h A diff --git a/Cslib/Cryptography/Primitives/PRF.lean b/Cslib/Cryptography/Primitives/PRF.lean new file mode 100644 index 000000000..2a29ae909 --- /dev/null +++ b/Cslib/Cryptography/Primitives/PRF.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Pseudorandom Functions + +A **pseudorandom function (PRF)** is a keyed function family that is +computationally indistinguishable from a truly random function when +the key is chosen at random. + +PRFs are central to symmetric-key cryptography: they are used to +construct encryption schemes, MACs, and other primitives. The +GGM construction builds a PRF from any pseudorandom generator. + +## Main Definitions + +* `PRF` — a pseudorandom function family +* `PRF.Secure` — information-theoretic security +* `PRF.SecureAgainst` — computational security against efficient adversaries +* `PRP` — a pseudorandom permutation (bijective PRF) + +## Design Notes + +We model PRFs as keyed function families `f : Key n → Input n → Output n`. +Security says that no efficient oracle adversary can distinguish +`f(k, ·)` (for random `k`) from a truly random function. + +## References + +* [O. Goldreich, S. Goldwasser, S. Micali, *How to Construct Random + Functions*][GGM1986] +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- A **pseudorandom function family** indexed by the security parameter. + +At each security level `n`, `eval n k x` evaluates the PRF on key `k` +and input `x`. -/ +structure PRF where + /-- Key type at security level n -/ + Key : ℕ → Type + /-- Input type -/ + Input : ℕ → Type + /-- Output type -/ + Output : ℕ → Type + /-- Key type is finite (for sampling) -/ + keyFintype : ∀ n, Fintype (Key n) + /-- Key type is nonempty (for sampling) -/ + keyNonempty : ∀ n, Nonempty (Key n) + /-- Function space `Input n → Output n` is finite (for sampling random functions) -/ + funFintype : ∀ n, Fintype (Input n → Output n) + /-- Function space is nonempty -/ + funNonempty : ∀ n, Nonempty (Input n → Output n) + /-- The keyed function -/ + eval : (n : ℕ) → Key n → Input n → Output n + +/-- A **PRF adversary** has oracle access to either the PRF (keyed with +a random key) or a truly random function, and must distinguish between +the two cases. + +The adversary makes a sequence of queries and then outputs a decision +bit. We model the oracle as a function from inputs to outputs. -/ +structure PRF.OracleAdversary (F : PRF) where + /-- Given oracle access, produce a decision -/ + run : (n : ℕ) → (F.Input n → F.Output n) → Bool + +/-- The **PRF security game**: the adversary's advantage is +$$\left|\Pr_{k}[A^{f_k}=1] - \Pr_{\mathit{rf}}[A^{\mathit{rf}}=1]\right|$$ +where `k` is a uniform random key and `rf` is a uniform random function. -/ +noncomputable def PRF.SecurityGame (F : PRF) : + SecurityGame (PRF.OracleAdversary F) where + advantage A n := + letI := F.keyFintype n; letI := F.keyNonempty n + letI := F.funFintype n; letI := F.funNonempty n + |Cslib.Probability.uniformExpect (F.Key n) + (fun k => Cslib.Probability.boolToReal (A.run n (F.eval n k))) + - Cslib.Probability.uniformExpect (F.Input n → F.Output n) + (fun rf => Cslib.Probability.boolToReal (A.run n rf))| + +/-- A PRF is **(information-theoretically) secure** if its security game +is secure against all adversaries. -/ +def PRF.Secure (F : PRF) : Prop := F.SecurityGame.Secure + +/-- A PRF is **computationally secure** against a class of adversaries +defined by `Admissible`. -/ +def PRF.SecureAgainst (F : PRF) + (Admissible : PRF.OracleAdversary F → Prop) : Prop := + F.SecurityGame.SecureAgainst Admissible + +/-- A **pseudorandom permutation (PRP)** is a PRF where each keyed +instance is a bijection. PRPs model block ciphers. -/ +structure PRP extends PRF where + /-- Each keyed instance is a bijection -/ + bij : ∀ (n : ℕ) (k : toPRF.Key n), + Function.Bijective (toPRF.eval n k) + +end diff --git a/Cslib/Cryptography/Primitives/PRG.lean b/Cslib/Cryptography/Primitives/PRG.lean new file mode 100644 index 000000000..2cc15c819 --- /dev/null +++ b/Cslib/Cryptography/Primitives/PRG.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Pseudorandom Generators + +A **pseudorandom generator (PRG)** is a deterministic function that +stretches a short random seed into a longer string that is +computationally indistinguishable from a truly random string. + +PRGs are one of the most fundamental primitives in cryptography. +Their existence is equivalent to the existence of one-way functions +(Håstad, Impagliazzo, Levin, Luby 1999). + +## Main Definitions + +* `PRG` — a pseudorandom generator family +* `PRG.Secure` — information-theoretic security +* `PRG.SecureAgainst` — computational security against efficient adversaries + +## Design Notes + +We model PRGs as families of functions indexed by the security parameter, +mapping `Seed n` to `Output n`. Security says that the output ensemble +(over random seeds) is computationally indistinguishable from the +uniform ensemble over `Output n`. + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +* [HILL, *A Pseudorandom Generator from any One-Way Function*][HILL1999] +-/ + +/-- A **pseudorandom generator family** indexed by the security parameter. + +At each security level `n`, `stretch n` maps a short seed to a longer +output. The output must be indistinguishable from uniform. -/ +structure PRG where + /-- Seed type at security level n -/ + Seed : ℕ → Type + /-- Output type at security level n -/ + Output : ℕ → Type + /-- Seed type is finite (for sampling) -/ + seedFintype : ∀ n, Fintype (Seed n) + /-- Seed type is nonempty (for sampling) -/ + seedNonempty : ∀ n, Nonempty (Seed n) + /-- Output type is finite (for sampling) -/ + outputFintype : ∀ n, Fintype (Output n) + /-- Output type is nonempty (for sampling) -/ + outputNonempty : ∀ n, Nonempty (Output n) + /-- The stretching function -/ + stretch : (n : ℕ) → Seed n → Output n + /-- The output type is strictly larger than the seed type (expansion) -/ + expansion : ∀ n, Fintype.card (Seed n) < Fintype.card (Output n) + +/-- A PRG distinguisher observes a string and tries to determine +whether it was generated by the PRG or is truly random. -/ +structure PRG.DistinguishingAdversary (G : PRG) where + /-- Given the security parameter and an output string, decide + whether it came from the PRG. -/ + distinguish : (n : ℕ) → G.Output n → Bool + +/-- The **PRG security game**: the advantage of an adversary is +$$\left|\Pr_{s}[A(G(s))=1] - \Pr_{r}[A(r)=1]\right|$$ +where `s` is uniform over seeds and `r` is uniform over outputs. -/ +noncomputable def PRG.SecurityGame (G : PRG) : + SecurityGame (PRG.DistinguishingAdversary G) where + advantage A n := + letI := G.seedFintype n; letI := G.seedNonempty n + letI := G.outputFintype n; letI := G.outputNonempty n + |Cslib.Probability.uniformExpect (G.Seed n) + (fun s => Cslib.Probability.boolToReal (A.distinguish n (G.stretch n s))) + - Cslib.Probability.uniformExpect (G.Output n) + (fun r => Cslib.Probability.boolToReal (A.distinguish n r))| + +/-- A PRG is **(information-theoretically) secure** if its security game +is secure against all adversaries. -/ +def PRG.Secure (G : PRG) : Prop := G.SecurityGame.Secure + +/-- A PRG is **computationally secure** against a class of adversaries +defined by `Admissible`. -/ +def PRG.SecureAgainst (G : PRG) + (Admissible : PRG.DistinguishingAdversary G → Prop) : Prop := + G.SecurityGame.SecureAgainst Admissible + +end diff --git a/Cslib/Cryptography/Primitives/Signature.lean b/Cslib/Cryptography/Primitives/Signature.lean new file mode 100644 index 000000000..d7f85a438 --- /dev/null +++ b/Cslib/Cryptography/Primitives/Signature.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.OracleInteraction +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Digital Signature Schemes + +A **digital signature scheme** allows a signer to produce a signature +on a message that can be verified by anyone with the signer's public +key, but cannot be forged without the secret key. + +## Main Definitions + +* `SignatureScheme` — a digital signature scheme (KeyGen, Sign, Verify) +* `EUF_CMA` — existential unforgeability under chosen-message attack + +## Design Notes + +We model signature schemes with abstract types for keys, messages, +signatures, and randomness. The security notion EUF-CMA says that +no efficient adversary, even after seeing signatures on chosen messages, +can produce a valid signature on a new message. + +## References + +* [S. Goldwasser, S. Micali, R. Rivest, *A Digital Signature Scheme + Secure Against Adaptive Chosen-Message Attacks*][GMR1988] +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- A **digital signature scheme** parameterized by the security parameter. + +- `PublicKey n` — verification key +- `SecretKey n` — signing key +- `Message n` — message type +- `Signature n` — signature type +-/ +structure SignatureScheme where + /-- Public (verification) key type -/ + PublicKey : ℕ → Type + /-- Secret (signing) key type -/ + SecretKey : ℕ → Type + /-- Message type -/ + Message : ℕ → Type + /-- Signature type -/ + Signature : ℕ → Type + /-- Randomness for signing -/ + Randomness : ℕ → Type + /-- Public key type is finite (for sampling) -/ + publicKeyFintype : ∀ n, Fintype (PublicKey n) + /-- Secret key type is finite (for sampling) -/ + secretKeyFintype : ∀ n, Fintype (SecretKey n) + /-- Key types are nonempty -/ + publicKeyNonempty : ∀ n, Nonempty (PublicKey n) + secretKeyNonempty : ∀ n, Nonempty (SecretKey n) + /-- Signing randomness is finite (for sampling) -/ + randomnessFintype : ∀ n, Fintype (Randomness n) + /-- Signing randomness is nonempty -/ + randomnessNonempty : ∀ n, Nonempty (Randomness n) + /-- Key generation randomness type -/ + KeyGenRandomness : ℕ → Type + /-- Key generation randomness is finite (for sampling) -/ + keyGenRandomnessFintype : ∀ n, Fintype (KeyGenRandomness n) + /-- Key generation randomness is nonempty -/ + keyGenRandomnessNonempty : ∀ n, Nonempty (KeyGenRandomness n) + /-- Key generation: produces a correlated (pk, sk) pair from randomness -/ + keyGen : (n : ℕ) → KeyGenRandomness n → PublicKey n × SecretKey n + /-- Sign a message with the secret key -/ + sign : (n : ℕ) → SecretKey n → Message n → Randomness n → + Signature n + /-- Verify a signature with the public key -/ + verify : (n : ℕ) → PublicKey n → Message n → Signature n → Bool + +/-! ### Correctness -/ + +/-- A signature scheme is **correct** if honestly generated signatures +always verify for any key pair produced by `keyGen`. -/ +def SignatureScheme.Correct (S : SignatureScheme) : Prop := + ∀ (n : ℕ) (kgr : S.KeyGenRandomness n) (m : S.Message n) (r : S.Randomness n), + let (pk, sk) := S.keyGen n kgr + S.verify n pk m (S.sign n sk m r) = true + +/-! ### EUF-CMA Security -/ + +/-- An **EUF-CMA adversary** for a signature scheme models adaptive +chosen-message attack via `OracleInteraction`. + +The adversary receives the public key and interacts with a signing +oracle by issuing queries of type `S.Message n` and receiving +responses of type `S.Signature n`. The adversary never controls the +signing randomness — the game supplies it. After the interaction, +the adversary outputs a forgery attempt `(message, signature)`. + +- `numQueries n` — an upper bound on the number of signing queries + at security parameter `n` (used as fuel for `OracleInteraction.run`) +- `interact n pk` — the adaptive oracle interaction producing a + forgery attempt -/ +structure EUF_CMA_Adversary (S : SignatureScheme) where + /-- Upper bound on the number of signing queries -/ + numQueries : ℕ → ℕ + /-- The adaptive oracle interaction: given a public key, query the + signing oracle and produce a forgery attempt `(message, signature)` -/ + interact : (n : ℕ) → S.PublicKey n → + OracleInteraction (S.Message n) (S.Signature n) + (S.Message n × S.Signature n) + +/-- The **EUF-CMA security game** for a signature scheme. + +The game samples key generation randomness `kgr` and signing randomness +`rs : Fin q → S.Randomness n` (one per query slot), then derives the +key pair `(pk, sk) = S.keyGen n kgr`. The signing oracle is +`fun i m => S.sign n sk m (rs i)` — the adversary never touches the +randomness. The game runs the interaction, logs all queries, and checks: +1. The forgery message was not among the queried messages +2. The forged signature verifies under the public key + +The advantage is +`E_{kgr,rs}[1[interaction succeeds ∧ forgery valid ∧ fresh]]`. -/ +noncomputable def SignatureScheme.EUF_CMA_Game (S : SignatureScheme) + [∀ n, DecidableEq (S.Message n)] : + SecurityGame (EUF_CMA_Adversary S) where + advantage A n := + let q := A.numQueries n + letI := S.keyGenRandomnessFintype n; letI := S.keyGenRandomnessNonempty n + letI := S.randomnessFintype n; letI := S.randomnessNonempty n + Cslib.Probability.uniformExpect + (S.KeyGenRandomness n × (Fin q → S.Randomness n)) + (fun ⟨kgr, rs⟩ => + let (pk, sk) := S.keyGen n kgr + let oracle : Fin q → S.Message n → S.Signature n := + fun i m => S.sign n sk m (rs i) + match (A.interact n pk).run q oracle with + | none => 0 + | some (queries, m, σ) => + Cslib.Probability.boolToReal + (S.verify n pk m σ && !(queries.contains m))) + +/-- A signature scheme is **EUF-CMA secure** if the EUF-CMA game +is secure against all adversaries. -/ +def SignatureScheme.EUF_CMA (S : SignatureScheme) + [∀ n, DecidableEq (S.Message n)] : Prop := + S.EUF_CMA_Game.Secure + +/-- A signature scheme is **EUF-CMA secure against** a class of +adversaries. -/ +def SignatureScheme.EUF_CMA_Against (S : SignatureScheme) + [∀ n, DecidableEq (S.Message n)] + (Admissible : EUF_CMA_Adversary S → Prop) : Prop := + S.EUF_CMA_Game.SecureAgainst Admissible + +end diff --git a/Cslib/Cryptography/Protocols/Combinators.lean b/Cslib/Cryptography/Protocols/Combinators.lean new file mode 100644 index 000000000..155e5694d --- /dev/null +++ b/Cslib/Cryptography/Protocols/Combinators.lean @@ -0,0 +1,412 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Protocols.SigmaProtocol + +@[expose] public section + +/-! +# AND and OR Combinators for Sigma Protocols + +Sigma protocols can be combined to prove compound statements: + +- **AND**: given protocols for `R₀` and `R₁`, construct a protocol + for `R₀ ∧ R₁` (the prover knows witnesses for both) +- **OR**: given protocols for `R₀` and `R₁`, construct a protocol + for `R₀ ∨ R₁` (the prover knows a witness for at least one) + +## Main Definitions + +* `SigmaProtocol.AND` — the AND combinator +* `SigmaProtocol.AND.specialSoundness` — AND preserves special soundness +* `SigmaProtocol.OR` — the OR combinator with challenge splitting +* `SigmaProtocol.OR.specialSoundness` — OR preserves special soundness +* `SigmaProtocol.OR.specialHVZK` — OR preserves special HVZK + +## References + +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, §19.7 +* [R. Cramer, I. Damgård, B. Schoenmakers, *Proofs of Partial + Knowledge*][CDS1994] +-/ + +private theorem ne_of_cast_ne {α β : Type} (h : α = β) {a b : α} + (hne : a ≠ b) : h ▸ a ≠ h ▸ b := by subst h; exact hne + +/-! ### AND Combinator -/ + +/-- The **AND relation**: `(w₀, w₁)` is a witness for `(y₀, y₁)` +when `w₀` witnesses `y₀` in `R₀` and `w₁` witnesses `y₁` in `R₁`. -/ +def EffectiveRelation.AND (R₀ R₁ : EffectiveRelation) : + EffectiveRelation where + Witness n := R₀.Witness n × R₁.Witness n + Statement n := R₀.Statement n × R₁.Statement n + relation n w y := R₀.relation n w.1 y.1 ∧ R₁.relation n w.2 y.2 + +/-- The **AND combinator** for Sigma protocols: run both protocols +in parallel with the same challenge. + +Given protocols `P₀` for `R₀` and `P₁` for `R₁` sharing the same +challenge type, the combined protocol for `R₀ ∧ R₁`: +- Commitment: `(t₀, t₁)` +- Challenge: `c` (same challenge sent to both) +- Response: `(z₀, z₁)` +- Verify: both sub-protocols accept -/ +noncomputable def SigmaProtocol.AND + {R₀ R₁ : EffectiveRelation} + (P₀ : SigmaProtocol R₀) (P₁ : SigmaProtocol R₁) + -- Shared challenge type + (hChallenge : ∀ n, P₀.Challenge n = P₁.Challenge n) : + SigmaProtocol (R₀.AND R₁) where + Commitment n := P₀.Commitment n × P₁.Commitment n + Challenge := P₀.Challenge + Response n := P₀.Response n × P₁.Response n + ProverRandomness n := P₀.ProverRandomness n × P₁.ProverRandomness n + commitmentFintype := fun n => inferInstance + commitmentNonempty := fun n => inferInstance + commitmentDecEq := fun n => inferInstance + challengeFintype := P₀.challengeFintype + challengeNonempty := P₀.challengeNonempty + challengeDecEq := P₀.challengeDecEq + responseFintype := fun n => inferInstance + responseNonempty := fun n => inferInstance + proverRandomnessFintype := fun n => inferInstance + proverRandomnessNonempty := fun n => inferInstance + commit n w y r := + (P₀.commit n w.1 y.1 r.1, P₁.commit n w.2 y.2 r.2) + respond n w y r c := + (P₀.respond n w.1 y.1 r.1 c, + P₁.respond n w.2 y.2 r.2 (hChallenge n ▸ c)) + verify n y t c z := + P₀.verify n y.1 t.1 c z.1 && + P₁.verify n y.2 t.2 (hChallenge n ▸ c) z.2 + completeness n w y r c hrel := by + simp only [Bool.and_eq_true] + exact ⟨P₀.completeness n w.1 y.1 r.1 c hrel.1, + P₁.completeness n w.2 y.2 r.2 _ hrel.2⟩ + +/-- The AND combinator **preserves special soundness**: if both +sub-protocols have special soundness, so does the AND protocol. +The extractor runs both sub-extractors independently. -/ +noncomputable def SigmaProtocol.AND.specialSoundness + {R₀ R₁ : EffectiveRelation} + {P₀ : SigmaProtocol R₀} {P₁ : SigmaProtocol R₁} + {hChallenge : ∀ n, P₀.Challenge n = P₁.Challenge n} + (ss₀ : P₀.SpecialSoundness) (ss₁ : P₁.SpecialSoundness) : + (SigmaProtocol.AND P₀ P₁ hChallenge).SpecialSoundness where + extract n y t c z c' z' := + (ss₀.extract n y.1 t.1 c z.1 c' z'.1, + ss₁.extract n y.2 t.2 (hChallenge n ▸ c) z.2 + (hChallenge n ▸ c') z'.2) + soundness n y t c z c' z' hne hv1 hv2 := by + simp only [SigmaProtocol.AND, Bool.and_eq_true] at hv1 hv2 + constructor + · exact ss₀.soundness n y.1 t.1 c z.1 c' z'.1 hne hv1.1 hv2.1 + · exact ss₁.soundness n y.2 t.2 _ z.2 _ z'.2 + (ne_of_cast_ne (hChallenge n) hne) hv1.2 hv2.2 + +/-! ### OR Combinator -/ + +/-- The **OR relation**: `w` is a witness for `(y₀, y₁)` when +`w` witnesses `y₀` in `R₀` or `y₁` in `R₁`. The witness is +tagged with `Sum` to indicate which side it proves. -/ +def EffectiveRelation.OR (R₀ R₁ : EffectiveRelation) : + EffectiveRelation where + Witness n := R₀.Witness n ⊕ R₁.Witness n + Statement n := R₀.Statement n × R₁.Statement n + relation n w y := + match w with + | .inl w₀ => R₀.relation n w₀ y.1 + | .inr w₁ => R₁.relation n w₁ y.2 + +/-- The **OR combinator** for Sigma protocols. The prover knows a +witness for one side and simulates the other using the HVZK +simulator. + +Challenge splitting: the overall challenge `c` is split as +`c = c₀ + c₁`. The prover chooses the simulated side's challenge +and derives the honest side's challenge after receiving `c`. + +The prover randomness includes randomness for both sub-protocols, +a simulated challenge, and simulator randomness for both sides. +Depending on which witness the prover holds, the appropriate +components are used. -/ +noncomputable def SigmaProtocol.OR + {R₀ R₁ : EffectiveRelation} + (P₀ : SigmaProtocol R₀) (P₁ : SigmaProtocol R₁) + [∀ n, AddCommGroup (P₀.Challenge n)] + [∀ n, DecidableEq (P₀.Challenge n)] + (hvzk₀ : P₀.SpecialHVZK) (hvzk₁ : P₁.SpecialHVZK) + -- Challenges must be the same type for splitting + (challengeEq : ∀ n, P₀.Challenge n = P₁.Challenge n) : + SigmaProtocol (R₀.OR R₁) where + Commitment n := P₀.Commitment n × P₁.Commitment n + Challenge := P₀.Challenge + Response n := P₀.Response n × P₁.Response n × + P₀.Challenge n -- c₀ is included so verifier can reconstruct c₁ + -- Prover randomness: both protocols' randomness + simulated challenge + both simulator randomness + ProverRandomness n := + P₀.ProverRandomness n × P₁.ProverRandomness n × + P₀.Challenge n × + hvzk₀.SimRandomness n × hvzk₁.SimRandomness n + commitmentFintype := fun n => inferInstance + commitmentNonempty := fun n => inferInstance + commitmentDecEq := fun n => inferInstance + challengeFintype := P₀.challengeFintype + challengeNonempty := P₀.challengeNonempty + challengeDecEq := inferInstance + responseFintype := fun n => inferInstance + responseNonempty := fun n => inferInstance + proverRandomnessFintype := fun n => by + haveI := hvzk₀.simRandomnessFintype n + haveI := hvzk₁.simRandomnessFintype n + exact inferInstance + proverRandomnessNonempty := fun n => by + haveI := hvzk₀.simRandomnessNonempty n + haveI := hvzk₁.simRandomnessNonempty n + exact inferInstance + commit n w y r := + let (r₀, r₁, simC, s₀, s₁) := r + match w with + | .inl w₀ => + -- Know w₀: commit honestly to P₀, simulate P₁ + let t₀ := P₀.commit n w₀ y.1 r₀ + let (t₁, _) := hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁ + (t₀, t₁) + | .inr w₁ => + -- Know w₁: simulate P₀, commit honestly to P₁ + let (t₀, _) := hvzk₀.simulate n y.1 simC s₀ + let t₁ := P₁.commit n w₁ y.2 r₁ + (t₀, t₁) + respond n w y r c := + let (r₀, r₁, simC, s₀, s₁) := r + match w with + | .inl w₀ => + -- c₀ = c - simC, simC is the P₁ simulated challenge + let c₀ := c - simC + let z₀ := P₀.respond n w₀ y.1 r₀ c₀ + let (_, z₁) := hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁ + (z₀, z₁, c₀) + | .inr w₁ => + -- c₁ = c - simC, simC is the P₀ simulated challenge + let c₁ := c - simC + let z₁ := P₁.respond n w₁ y.2 r₁ (challengeEq n ▸ c₁) + let (_, z₀) := hvzk₀.simulate n y.1 simC s₀ + (z₀, z₁, simC) + verify n y t c z := + let (z₀, z₁, c₀) := z + let c₁ := c - c₀ + P₀.verify n y.1 t.1 c₀ z₀ && P₁.verify n y.2 t.2 (challengeEq n ▸ c₁) z₁ + completeness n w y r c hrel := by + simp only [Bool.and_eq_true] + obtain ⟨r₀, r₁, simC, s₀, s₁⟩ := r + match w, hrel with + | .inl w₀, hrel₀ => + constructor + · -- P₀: honest execution with c₀ = c - simC + exact P₀.completeness n w₀ y.1 r₀ (c - simC) hrel₀ + · -- P₁: simulated, always accepting by sim_accepting + have hsim := hvzk₁.sim_accepting n y.2 (challengeEq n ▸ simC) s₁ + -- c₁ = c - c₀ = c - (c - simC) = simC + have : c - (c - simC) = simC := by abel + rw [this] + exact hsim + | .inr w₁, hrel₁ => + constructor + · -- P₀: simulated, always accepting + exact hvzk₀.sim_accepting n y.1 simC s₀ + · -- P₁: honest execution with c₁ = c - simC + exact P₁.completeness n w₁ y.2 r₁ _ hrel₁ + +/-- The OR combinator **preserves special soundness** (CDS94): +from two accepting conversations `(t, c, z)` and `(t, c', z')` with the +same commitment but different challenges, extract a witness for at least +one side of the OR relation. + +**Extractor**: case split on whether the P₀ sub-challenges `c₀` and `c₀'` differ. +- If `c₀ ≠ c₀'`: extract from P₀ +- If `c₀ = c₀'`: then `c₁ ≠ c₁'` (since `c ≠ c'` and `c₀ = c₀'`), extract from P₁ -/ +noncomputable def SigmaProtocol.OR.specialSoundness + {R₀ R₁ : EffectiveRelation} + {P₀ : SigmaProtocol R₀} {P₁ : SigmaProtocol R₁} + [∀ n, AddCommGroup (P₀.Challenge n)] + [∀ n, DecidableEq (P₀.Challenge n)] + {hvzk₀ : P₀.SpecialHVZK} {hvzk₁ : P₁.SpecialHVZK} + {challengeEq : ∀ n, P₀.Challenge n = P₁.Challenge n} + (ss₀ : P₀.SpecialSoundness) (ss₁ : P₁.SpecialSoundness) : + (SigmaProtocol.OR P₀ P₁ hvzk₀ hvzk₁ challengeEq).SpecialSoundness where + extract n y t c z c' z' := by + let ch : P₀.Challenge n := c + let ch' : P₀.Challenge n := c' + let c₀ := z.2.2 + let c₀' := z'.2.2 + exact if _ : c₀ = c₀' then + .inr (ss₁.extract n y.2 t.2 + (challengeEq n ▸ (ch - c₀)) z.2.1 + (challengeEq n ▸ (ch' - c₀')) z'.2.1) + else + .inl (ss₀.extract n y.1 t.1 c₀ z.1 c₀' z'.1) + soundness n y t c z c' z' hne hv1 hv2 := by + simp only [SigmaProtocol.OR, Bool.and_eq_true] at hv1 hv2 + simp only + split + case isTrue h => + -- c₀ = c₀', so c₁ ≠ c₁' + simp only [EffectiveRelation.OR] + apply ss₁.soundness + · apply ne_of_cast_ne (challengeEq n) + rw [← h] + intro heq + exact hne (by + have := congr_arg (· + z.2.2) heq + simp only [sub_add_cancel] at this + exact this) + · exact hv1.2 + · exact hv2.2 + case isFalse h => + simp only [EffectiveRelation.OR] + exact ss₀.soundness n y.1 t.1 _ z.1 _ z'.1 h hv1.1 hv2.1 + +/-- The OR combinator **preserves special HVZK** (CDS94): +given HVZK simulators for both sub-protocols, construct an HVZK +simulator for the OR protocol. + +The OR simulator runs both sub-protocol simulators with a random +challenge split `c₀ + c₁ = c`, without needing any witness. -/ +noncomputable def SigmaProtocol.OR.specialHVZK + {R₀ R₁ : EffectiveRelation} + {P₀ : SigmaProtocol R₀} {P₁ : SigmaProtocol R₁} + [∀ n, AddCommGroup (P₀.Challenge n)] + [∀ n, DecidableEq (P₀.Challenge n)] + (hvzk₀ : P₀.SpecialHVZK) (hvzk₁ : P₁.SpecialHVZK) + (challengeEq : ∀ n, P₀.Challenge n = P₁.Challenge n) : + (SigmaProtocol.OR P₀ P₁ hvzk₀ hvzk₁ challengeEq).SpecialHVZK where + SimRandomness n := hvzk₀.SimRandomness n × hvzk₁.SimRandomness n × P₀.Challenge n + simRandomnessFintype n := by + haveI := hvzk₀.simRandomnessFintype n + haveI := hvzk₁.simRandomnessFintype n + exact inferInstance + simRandomnessNonempty n := by + haveI := hvzk₀.simRandomnessNonempty n + haveI := hvzk₁.simRandomnessNonempty n + exact inferInstance + simulate n y c s := + (((hvzk₀.simulate n y.1 s.2.2 s.1).1, + (hvzk₁.simulate n y.2 + (challengeEq n ▸ (@id (P₀.Challenge n) c - s.2.2)) s.2.1).1), + ((hvzk₀.simulate n y.1 s.2.2 s.1).2, + (hvzk₁.simulate n y.2 + (challengeEq n ▸ (@id (P₀.Challenge n) c - s.2.2)) s.2.1).2, + s.2.2)) + sim_accepting n y c s := by + simp only [SigmaProtocol.OR] + simp only [Bool.and_eq_true] + exact ⟨hvzk₀.sim_accepting n y.1 s.2.2 s.1, + hvzk₁.sim_accepting n y.2 _ s.2.1⟩ + sim_distribution n w y c hrel f := by + open Cslib.Probability in + match w, hrel with + | .inl w₀, hrel₀ => + letI := hvzk₀.simRandomnessFintype n + letI := hvzk₁.simRandomnessFintype n + letI := hvzk₀.simRandomnessNonempty n + letI := hvzk₁.simRandomnessNonempty n + dsimp only [SigmaProtocol.OR] + -- Step 1: Factor out unused r₁ (P₁.ProverRandomness) and s₀ (hvzk₀.SimRandomness) + -- Provide g explicitly to bypass higher-order matching + let ch : P₀.Challenge n := c + have step1 := uniformExpect_prod5_ignore_bd + (B := P₁.ProverRandomness n) (D := hvzk₀.SimRandomness n) + (fun a simC s₁ => + f ((P₀.commit n w₀ y.1 a, + (hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁).1), + (P₀.respond n w₀ y.1 a (ch - simC), + (hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁).2, + ch - simC))) + erw [step1] + -- Now: E_{(r₀, simC, s₁)}[body] = E_{(s₀', s₁', c₀)}[body'] + -- Step 2: Decompose both sides into individual expectations + rw [uniformExpect_prod] + simp_rw [uniformExpect_prod] + -- Step 3: Swap order on LHS so r₀ is innermost + rw [uniformExpect_comm] + simp_rw [uniformExpect_comm (P₀.ProverRandomness n)] + -- LHS: E_{simC}[E_{s₁}[E_{r₀}[body(r₀,simC,s₁)]]] + -- Step 4: Apply sim_distribution to inner E_{r₀} + conv_lhs => + arg 2; ext simC + arg 2; ext s₁ + erw [hvzk₀.sim_distribution n w₀ y.1 (ch - simC) hrel₀ + (fun pair => + f ((pair.1, (hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁).1), + (pair.2, (hvzk₁.simulate n y.2 (challengeEq n ▸ simC) s₁).2, + ch - simC)))] + -- Step 5: Reorder expectations to match RHS + -- LHS: E_{simC}[E_{s₁}[E_{s₀'}[...]]] + -- Need: E_{s₀'}[E_{s₁}[E_{simC}[...]]] + rw [uniformExpect_comm] + simp_rw [uniformExpect_comm (P₀.Challenge n)] + rw [uniformExpect_comm] + -- Step 6: Drill down to inner expectation + congr 1; ext s₀'; congr 1; ext s₁' + -- Goal: E_{simC}[body_lhs(simC)] = E_{c₀}[body_rhs(c₀)] + -- Step 7: Reindex c₀ ↦ ch - c₀ on RHS + let σ : P₀.Challenge n ≃ P₀.Challenge n := + { toFun := fun x => ch - x + invFun := fun x => ch - x + left_inv := fun x => by simp [sub_sub_cancel] + right_inv := fun x => by simp [sub_sub_cancel] } + rw [← uniformExpect_equiv _ _ σ] + -- Goal: E_{simC}[body_lhs(simC)] = E_{c₀}[body_rhs(ch - c₀)] + congr 1; ext simC + -- Body equality: need c - (ch - simC) = simC, ch - simC = ch - simC + simp only [σ, Equiv.coe_fn_mk, sub_sub_cancel, id]; rfl + | .inr w₁, hrel₁ => + letI := hvzk₀.simRandomnessFintype n + letI := hvzk₁.simRandomnessFintype n + letI := hvzk₀.simRandomnessNonempty n + letI := hvzk₁.simRandomnessNonempty n + dsimp only [SigmaProtocol.OR] + -- Step 1: Factor out unused r₀ (P₀.ProverRandomness) and s₁ (hvzk₁.SimRandomness) + let ch : P₀.Challenge n := c + have step1 := uniformExpect_prod5_ignore_ae + (A := P₀.ProverRandomness n) (E := hvzk₁.SimRandomness n) + (fun r₁ simC s₀ => + f (((hvzk₀.simulate n y.1 simC s₀).1, + P₁.commit n w₁ y.2 r₁), + ((hvzk₀.simulate n y.1 simC s₀).2, + P₁.respond n w₁ y.2 r₁ (challengeEq n ▸ (ch - simC)), + simC))) + erw [step1] + -- Now: E_{(r₁, simC, s₀)}[body] = E_{(s₀', s₁', c₀)}[body'] + -- Step 2: Decompose both sides into individual expectations + rw [uniformExpect_prod] + simp_rw [uniformExpect_prod] + -- Step 3: Swap order on LHS so r₁ is innermost + rw [uniformExpect_comm] + simp_rw [uniformExpect_comm (P₁.ProverRandomness n)] + -- LHS: E_{simC}[E_{s₀}[E_{r₁}[body(r₁, simC, s₀)]]] + -- Step 4: Apply hvzk₁.sim_distribution to inner E_{r₁} + conv_lhs => + arg 2; ext simC + arg 2; ext s₀ + erw [hvzk₁.sim_distribution n w₁ y.2 + (challengeEq n ▸ (ch - simC)) hrel₁ + (fun pair => + f (((hvzk₀.simulate n y.1 simC s₀).1, pair.1), + ((hvzk₀.simulate n y.1 simC s₀).2, pair.2, + simC)))] + -- LHS: E_{simC}[E_{s₀}[E_{s₁'}[...]]] + -- Step 5: Reorder to match RHS: E_{s₀'}[E_{s₁'}[E_{c₀}[...]]] + rw [uniformExpect_comm] + simp_rw [uniformExpect_comm (P₀.Challenge n)] + -- Now: E_{s₀}[E_{s₁'}[E_{simC}[...]]] = E_{s₀'}[E_{s₁'}[E_{c₀}[...]]] + -- Step 6: Bodies are equal pointwise + congr 1 + +end diff --git a/Cslib/Cryptography/Protocols/FiatShamir.lean b/Cslib/Cryptography/Protocols/FiatShamir.lean new file mode 100644 index 000000000..d27fac224 --- /dev/null +++ b/Cslib/Cryptography/Protocols/FiatShamir.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Protocols.SigmaProtocol +public import Cslib.Cryptography.Primitives.Signature + +@[expose] public section + +/-! +# The Fiat-Shamir Transform + +The **Fiat-Shamir transform** converts any Sigma protocol into a +(non-interactive) signature scheme by replacing the verifier's random +challenge with the output of a hash function applied to the message +and the commitment. + +## Main Definitions + +* `FiatShamirSignature` — generic construction of a signature scheme + from a Sigma protocol and a hash function +* `FiatShamirSignature.correct` — correctness follows from protocol + completeness + +## Design Notes + +The transform is parameterized by: +- A Sigma protocol `P` for a relation `R` +- A hash function `H : Message → Commitment → Challenge` +- Key generation data (witness/statement types with finiteness) + +In the random oracle model, the Fiat-Shamir transform preserves +the security of the underlying Sigma protocol: special soundness +implies unforgeability. + +## References + +* [A. Fiat, A. Shamir, *How to Prove Yourself*][FiatShamir1986] +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, §19.6.1 +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- The **Fiat-Shamir signature scheme** constructed from a Sigma +protocol by deriving the challenge from a hash of the message and +commitment. + +- **Key generation**: the secret key is a witness, the public key + is the corresponding statement +- **Sign**: run the prover with `c = H(m, t)` where `t` is the + commitment +- **Verify**: compute `c = H(m, t)`, check the Sigma protocol + verifier accepts -/ +noncomputable def FiatShamirSignature + {R : EffectiveRelation} + (P : SigmaProtocol R) + (Message : ℕ → Type) + [∀ n, DecidableEq (Message n)] + (H : ∀ n, Message n → P.Commitment n → P.Challenge n) + [∀ n, Fintype (R.Witness n)] + [∀ n, Nonempty (R.Witness n)] + [∀ n, Fintype (R.Statement n)] + [∀ n, Nonempty (R.Statement n)] + (kg : R.WithKeyGen) : + SignatureScheme where + PublicKey := R.Statement + SecretKey := R.Witness + Message := Message + Signature n := P.Commitment n × P.Response n + Randomness := P.ProverRandomness + publicKeyFintype := inferInstance + secretKeyFintype := inferInstance + publicKeyNonempty := inferInstance + secretKeyNonempty := inferInstance + randomnessFintype := P.proverRandomnessFintype + randomnessNonempty := P.proverRandomnessNonempty + KeyGenRandomness := R.Witness + keyGenRandomnessFintype := inferInstance + keyGenRandomnessNonempty := inferInstance + keyGen n w := (kg.keyOf n w, w) + sign n w m r := + let y := kg.keyOf n w + let t := P.commit n w y r + let c := H n m t + let z := P.respond n w y r c + (t, z) + verify n y m sig := + let (t, z) := sig + let c := H n m t + P.verify n y t c z + +/-- The Fiat-Shamir signature scheme is **correct** when the key +generation function maps witnesses to statements satisfying the +relation. + +This follows directly from the completeness of the underlying +Sigma protocol. -/ +theorem FiatShamirSignature.correct + {R : EffectiveRelation} + (P : SigmaProtocol R) + (Message : ℕ → Type) + [∀ n, DecidableEq (Message n)] + (H : ∀ n, Message n → P.Commitment n → P.Challenge n) + [∀ n, Fintype (R.Witness n)] + [∀ n, Nonempty (R.Witness n)] + [∀ n, Fintype (R.Statement n)] + [∀ n, Nonempty (R.Statement n)] + (kg : R.WithKeyGen) : + (FiatShamirSignature P Message H kg).Correct := by + intro n w m r + simp only [FiatShamirSignature] + exact P.completeness n _ _ r _ (kg.keyOf_valid n w) + +end diff --git a/Cslib/Cryptography/Protocols/Schnorr.lean b/Cslib/Cryptography/Protocols/Schnorr.lean new file mode 100644 index 000000000..7474fb654 --- /dev/null +++ b/Cslib/Cryptography/Protocols/Schnorr.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Assumptions.DiscreteLog +public import Cslib.Cryptography.Protocols.FiatShamir +public import Cslib.Cryptography.Protocols.SigmaProtocol + +@[expose] public section + +/-! +# Schnorr's Identification Protocol and Signature Scheme + +Schnorr's protocol is the canonical Sigma protocol for proving +knowledge of a discrete logarithm. Given a cyclic group `G` of +prime order `q` with generator `g`, the prover demonstrates knowledge +of `α` such that `g^α = u` without revealing `α`. + +## Main Definitions + +* `SchnorrRelation` — the DL relation `R = { (α, u) : g^α = u }` +* `SchnorrProtocol` — Schnorr's Sigma protocol for `SchnorrRelation` +* `schnorrSpecialSoundness` — proof of special soundness +* `schnorrSpecialHVZK` — proof of special HVZK +* `SchnorrSignature` — the Schnorr signature scheme (Fiat-Shamir + applied to the Schnorr protocol) + +## Protocol Description + +- **Commit**: Prover samples `α_t ← ZMod q`, sends `u_t = g^α_t` +- **Challenge**: Verifier sends `c ← ZMod q` +- **Respond**: Prover sends `α_z = α_t + α · c` +- **Verify**: Check `g^α_z = u_t · u^c` + +## References + +* [C.-P. Schnorr, *Efficient Signature Generation by Smart Cards*][Schnorr1991] +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, §19.1–19.2 +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014] +-/ + +/-- The **discrete logarithm relation**: `(α, u) ∈ R` iff `g^α = u`. +This is the NP relation underlying Schnorr's protocol. -/ +@[reducible] def SchnorrRelation (C : CyclicGroupFamily) : EffectiveRelation where + Witness n := ZMod (C.order n) + Statement n := C.Group n + relation n α u := C.gpow n α = u + +/-- Key generation for the Schnorr relation: `keyOf α = g^α`. -/ +def SchnorrRelation.keyGen (C : CyclicGroupFamily) : + (SchnorrRelation C).WithKeyGen where + keyOf n α := C.gpow n α + keyOf_valid _ _ := rfl + +/-- **Schnorr's Sigma protocol** for the DL relation. + +- Commitment: `u_t = g^α_t` for random `α_t` +- Challenge: `c ∈ ZMod q` +- Response: `α_z = α_t + α · c` +- Verify: `g^α_z = u_t · u^c` + +The verification equation uses `y ^ (ZMod.val c)` for the group +exponentiation `u^c`, which is well-defined since the group has +order dividing `q`. -/ +noncomputable def schnorr_commitUniform (C : CyclicGroupFamily) (n : ℕ) + [Fintype (ZMod (C.order n))] [Nonempty (ZMod (C.order n))] + [Fintype (C.Group n)] [Nonempty (C.Group n)] + (f : C.Group n → ℝ) : + Cslib.Probability.uniformExpect (ZMod (C.order n)) (fun r => f (C.gpow n r)) = + Cslib.Probability.uniformExpect (C.Group n) f := + Cslib.Probability.uniformExpect_congr + (Equiv.ofBijective (C.gpow n) ⟨C.gpow_injective n, C.gpow_surjective n⟩) f + +@[reducible] noncomputable def SchnorrProtocol (C : CyclicGroupFamily) : + SigmaProtocol (SchnorrRelation C) where + Commitment n := C.Group n + Challenge n := ZMod (C.order n) + Response n := ZMod (C.order n) + ProverRandomness n := ZMod (C.order n) + commitmentFintype := C.fintypeInst + commitmentNonempty := C.nonemptyInst + commitmentDecEq := C.decEqInst + challengeFintype := fun n => CyclicGroupFamily.zmodFintype C n + challengeNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + challengeDecEq := fun n => CyclicGroupFamily.zmodDecEq C n + responseFintype := fun n => CyclicGroupFamily.zmodFintype C n + responseNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + proverRandomnessFintype := fun n => CyclicGroupFamily.zmodFintype C n + proverRandomnessNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + commit n _w _y α_t := C.gpow n α_t + respond n w _y α_t c := α_t + w * c + verify n y u_t c α_z := decide (C.gpow n α_z = u_t * y ^ (ZMod.val c)) + completeness n w y r c hrel := by + simp only [decide_eq_true_eq] + -- hrel : C.gpow n w = y (the DL relation) + change C.gpow n w = y at hrel + rw [C.gpow_add, ← hrel, C.gpow_mul' n w c] + +/-- **Special soundness** for the Schnorr protocol: from two accepting +conversations `(u_t, c, α_z)` and `(u_t, c', α_z')` with `c ≠ c'`, +the extractor computes `α = (α_z - α_z') / (c - c')`. -/ +noncomputable def schnorrSpecialSoundness (C : CyclicGroupFamily) : + (SchnorrProtocol C).SpecialSoundness where + extract n _y _u_t c α_z c' α_z' := (α_z - α_z') * (c - c')⁻¹ + soundness n y u_t c α_z c' α_z' hne hv1 hv2 := by + haveI : Fact (Nat.Prime (C.order n)) := ⟨C.order_prime n⟩ + -- hv1 : gpow α_z = u_t * y ^ val(c) + -- hv2 : gpow α_z' = u_t * y ^ val(c') + simp only [decide_eq_true_eq] at hv1 hv2 + -- We need: gpow ((α_z - α_z') * (c - c')⁻¹) = y + change C.gpow n ((α_z - α_z') * (c - c')⁻¹) = y + -- Let β = dlog y, then y = gpow β + set β := C.dlog n y + have hβ : C.gpow n β = y := C.gpow_dlog n y + -- Let δ = dlog u_t + set δ := C.dlog n u_t + have hδ : C.gpow n δ = u_t := C.gpow_dlog n u_t + -- Rewrite verification equations + rw [← hβ, ← C.gpow_mul' n β c] at hv1 + rw [← hβ, ← C.gpow_mul' n β c'] at hv2 + rw [← hδ, ← C.gpow_add] at hv1 hv2 + -- By injectivity: α_z = δ + β * c and α_z' = δ + β * c' + have inj1 := C.gpow_injective n hv1 + have inj2 := C.gpow_injective n hv2 + -- So α_z - α_z' = β * (c - c') + have hdiff : α_z - α_z' = β * (c - c') := by + rw [inj1, inj2]; ring + -- Therefore (α_z - α_z') * (c - c')⁻¹ = β + suffices h : (α_z - α_z') * (c - c')⁻¹ = β by rw [h]; exact hβ + rw [hdiff] + -- β * (c - c') * (c - c')⁻¹ = β in ZMod (C.order n) + rw [mul_assoc] + have hcc : (c - c' : ZMod (C.order n)) * (c - c')⁻¹ = 1 := by + rw [ZMod.mul_inv_eq_gcd] + have hprime := C.order_prime n + have hne_zmod : (c - c' : ZMod (C.order n)) ≠ 0 := sub_ne_zero.mpr hne + have hval_ne : (c - c' : ZMod (C.order n)).val ≠ 0 := + (ZMod.val_ne_zero _).mpr hne_zmod + have hval_lt : (c - c' : ZMod (C.order n)).val < C.order n := + ZMod.val_lt _ + have hcop : Nat.Coprime (c - c' : ZMod (C.order n)).val (C.order n) := + ((Nat.Prime.coprime_iff_not_dvd hprime).mpr + (fun hdvd => hval_ne (Nat.eq_zero_of_dvd_of_lt hdvd hval_lt))).symm + simp [hcop.gcd_eq_one] + rw [hcc, mul_one] + +/-- **Special HVZK** for the Schnorr protocol: the simulator samples +`α_z ← ZMod q` and sets `u_t = g^α_z · u^(-c)`, producing a +transcript `(u_t, c, α_z)` that is accepting and has the same +distribution as a real transcript. -/ +noncomputable def schnorrSpecialHVZK (C : CyclicGroupFamily) : + (SchnorrProtocol C).SpecialHVZK where + SimRandomness n := ZMod (C.order n) + simRandomnessFintype := fun n => CyclicGroupFamily.zmodFintype C n + simRandomnessNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + simulate n y c α_z := + let u_t := C.gpow n α_z * (y ^ (ZMod.val c))⁻¹ + (u_t, α_z) + sim_accepting n y c α_z := by + simp only [decide_eq_true_eq] + -- Need: gpow α_z = (gpow α_z * (y ^ val c)⁻¹) * y ^ val c + rw [inv_mul_cancel_right] + sim_distribution n w y c hrel f := by + -- Real: E_{α_t}[f(gpow α_t, α_t + w * c)] + -- Sim: E_{α_z}[f(gpow α_z * (y ^ val c)⁻¹, α_z)] + -- The map α_t ↦ α_t + w * c is a bijection on ZMod q, + -- so α_z := α_t + w * c is uniform when α_t is uniform. + change C.gpow n w = y at hrel + -- Reindex: α_t ↦ α_z = α_t + w * c (bijection on ZMod q) + let σ : ZMod (C.order n) ≃ ZMod (C.order n) := + { toFun := fun α_t => α_t + w * c + invFun := fun α_z => α_z - w * c + left_inv := fun α_t => by ring + right_inv := fun α_z => by ring } + -- After reindexing by σ, the real distribution becomes: + -- E_{α_z}[f(gpow(α_z - w*c), α_z)] + -- which equals the simulated distribution since + -- gpow(α_z - w*c) = gpow α_z * (y ^ val c)⁻¹ + -- Both sides are uniform averages over ZMod q. + -- We show the functions agree pointwise after reindexing + -- by σ : α_t ↦ α_t + w*c. + -- The key: f(gpow α_t, α_t + w*c) = f(gpow(σ⁻¹(σ α_t)), σ(α_t)) + -- After summing over α_t vs α_z = σ(α_t), both give the same sum. + simp only [Cslib.Probability.uniformExpect_eq] + congr 1 + apply Finset.sum_equiv σ (by simp) (fun α_t _ => by + simp only [σ, Equiv.coe_fn_mk] + congr 1 + apply Prod.ext + · -- gpow(α_t + w*c) * (y ^ val c)⁻¹ = gpow α_t + rw [show (C.gpow n (α_t + w * c) * (y ^ ZMod.val c)⁻¹, α_t + w * c).1 = + C.gpow n (α_t + w * c) * (y ^ ZMod.val c)⁻¹ from rfl, + show (C.gpow n α_t, α_t + w * c).1 = C.gpow n α_t from rfl, + C.gpow_add, C.gpow_mul' n w c, hrel, mul_inv_cancel_right] + · -- α_t + w * c = σ(α_t) + rfl) + +/-- Schnorr has `1/|G|`-unpredictable commitments (since `g^r` is uniform). -/ +theorem schnorr_unpredictable (C : CyclicGroupFamily) : + (SchnorrProtocol C).UnpredictableCommitments + (fun n => 1 / Fintype.card (C.Group n)) := by + intro n _w _y t₀ _hw + have h := schnorr_commitUniform C n (fun t => if t = t₀ then 1 else 0) + simp only [] at h + rw [h] + simp only [Cslib.Probability.uniformExpect_eq, Finset.sum_ite_eq', + Finset.mem_univ, ite_true] + ring_nf + exact le_refl _ + +/-- The **Schnorr signature scheme**: the Fiat-Shamir transform +applied to the Schnorr protocol. + +- **Key generation**: sample `α ← ZMod q`, set `pk = g^α`, `sk = α` +- **Sign**: sample `α_t ← ZMod q`, compute `u_t = g^α_t`, + `c = H(m, u_t)`, `α_z = α_t + α · c`, output `(u_t, α_z)` +- **Verify**: compute `c = H(m, u_t)`, check `g^α_z = u_t · pk^c` -/ +noncomputable def SchnorrSignature (C : CyclicGroupFamily) + (Message : ℕ → Type) + [∀ n, DecidableEq (Message n)] + (H : ∀ n, Message n → C.Group n → ZMod (C.order n)) : + SignatureScheme where + PublicKey n := C.Group n + SecretKey n := ZMod (C.order n) + Message := Message + Signature n := C.Group n × ZMod (C.order n) + Randomness n := ZMod (C.order n) + publicKeyFintype := C.fintypeInst + secretKeyFintype := fun n => CyclicGroupFamily.zmodFintype C n + publicKeyNonempty := C.nonemptyInst + secretKeyNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + randomnessFintype := fun n => CyclicGroupFamily.zmodFintype C n + randomnessNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + KeyGenRandomness n := ZMod (C.order n) + keyGenRandomnessFintype := fun n => CyclicGroupFamily.zmodFintype C n + keyGenRandomnessNonempty := fun n => CyclicGroupFamily.zmodNonempty C n + keyGen n α := (C.gpow n α, α) + sign n sk m α_t := + let u_t := C.gpow n α_t + let c := H n m u_t + let α_z := α_t + sk * c + (u_t, α_z) + verify n pk m sig := + let (u_t, α_z) := sig + let c := H n m u_t + decide (C.gpow n α_z = u_t * pk ^ (ZMod.val c)) + +/-- The Schnorr signature scheme is **correct**: honestly generated +signatures always verify. + +This follows directly from the completeness of the Schnorr protocol +(the verification equation `g^(α_t + α·c) = g^α_t · (g^α)^c`). -/ +theorem SchnorrSignature.correct (C : CyclicGroupFamily) + (Message : ℕ → Type) [∀ n, DecidableEq (Message n)] + (H : ∀ n, Message n → C.Group n → ZMod (C.order n)) : + (SchnorrSignature C Message H).Correct := by + intro n α m r + simp only [SchnorrSignature, decide_eq_true_eq] + rw [C.gpow_add, C.gpow_mul' n α _] + +/-- The direct `SchnorrSignature` equals the `FiatShamirSignature` +transform applied to the Schnorr Sigma protocol with `keyOf = gpow`. -/ +theorem SchnorrSignature_eq_FiatShamir (C : CyclicGroupFamily) + (Message : ℕ → Type) [∀ n, DecidableEq (Message n)] + (H : ∀ n, Message n → C.Group n → ZMod (C.order n)) : + SchnorrSignature C Message H = + FiatShamirSignature (SchnorrProtocol C) Message H (SchnorrRelation.keyGen C) := by + rfl + +end diff --git a/Cslib/Cryptography/Protocols/SigmaProtocol.lean b/Cslib/Cryptography/Protocols/SigmaProtocol.lean new file mode 100644 index 000000000..e6218dc25 --- /dev/null +++ b/Cslib/Cryptography/Protocols/SigmaProtocol.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Foundations.SecurityGame + +@[expose] public section + +/-! +# Sigma Protocols + +A **Sigma protocol** (Σ-protocol) is a three-move interactive proof +system between a prover and a verifier. The prover sends a commitment, +the verifier responds with a random challenge, and the prover sends +a response. The verifier then accepts or rejects. + +Sigma protocols are the key abstraction for honest-verifier +zero-knowledge proofs and form the basis for Schnorr signatures, +the Fiat-Shamir heuristic, and many advanced protocols. + +## Main Definitions + +* `EffectiveRelation` — a relation between witnesses and statements +* `SigmaProtocol` — a three-move proof system for an `EffectiveRelation` +* `SigmaProtocol.SpecialSoundness` — from two accepting conversations + with the same commitment but different challenges, one can extract + a witness (Def 19.4 in Boneh-Shoup) +* `SigmaProtocol.SpecialHVZK` — a simulator can produce transcripts + indistinguishable from real conversations (Def 19.5 in Boneh-Shoup) + +## References + +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, Ch. 19 +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +-/ + +/-- An **effective relation** between witnesses and statements, indexed +by the security parameter. This captures the NP relation underlying +a proof system: `relation n w y` means `w` is a valid witness for +statement `y` at security level `n`. -/ +structure EffectiveRelation where + /-- Witness type at security level `n` -/ + Witness : ℕ → Type + /-- Statement type at security level `n` -/ + Statement : ℕ → Type + /-- The relation: `relation n w y` holds when `w` is a valid + witness for statement `y` -/ + relation : ∀ n, Witness n → Statement n → Prop + +/-- A **key generation** for an effective relation bundles a key +derivation function (`keyOf`) that maps a witness (secret key) to +its canonical statement (public key), together with a proof that +the derived statement always satisfies the relation. + +Not every relation admits a natural key generation — for example, +OR relations receive both statements externally. Use this wrapper +when the relation supports key derivation (e.g., discrete log). -/ +structure EffectiveRelation.WithKeyGen (R : EffectiveRelation) where + /-- Key derivation: maps a witness (secret key) to its canonical + statement (public key) -/ + keyOf : ∀ n, R.Witness n → R.Statement n + /-- The derived statement always satisfies the relation -/ + keyOf_valid : ∀ n w, R.relation n w (keyOf n w) + +/-- A **Sigma protocol** for an effective relation `R`. The protocol +is a three-move proof of knowledge: + +1. **Commit**: The prover sends a commitment `t` +2. **Challenge**: The verifier sends a random challenge `c` +3. **Respond**: The prover sends a response `z` +4. **Verify**: The verifier accepts or rejects based on `(y, t, c, z)` -/ +structure SigmaProtocol (R : EffectiveRelation) where + /-- Commitment type -/ + Commitment : ℕ → Type + /-- Challenge type -/ + Challenge : ℕ → Type + /-- Response type -/ + Response : ℕ → Type + /-- Prover's randomness type -/ + ProverRandomness : ℕ → Type + /-- Commitments form a finite type -/ + commitmentFintype : ∀ n, Fintype (Commitment n) + /-- Commitments are nonempty -/ + commitmentNonempty : ∀ n, Nonempty (Commitment n) + /-- Commitments have decidable equality -/ + commitmentDecEq : ∀ n, DecidableEq (Commitment n) + /-- Challenges form a finite type -/ + challengeFintype : ∀ n, Fintype (Challenge n) + /-- Challenges are nonempty -/ + challengeNonempty : ∀ n, Nonempty (Challenge n) + /-- Challenges have decidable equality -/ + challengeDecEq : ∀ n, DecidableEq (Challenge n) + /-- Responses form a finite type -/ + responseFintype : ∀ n, Fintype (Response n) + /-- Responses are nonempty -/ + responseNonempty : ∀ n, Nonempty (Response n) + /-- Prover randomness forms a finite type -/ + proverRandomnessFintype : ∀ n, Fintype (ProverRandomness n) + /-- Prover randomness is nonempty -/ + proverRandomnessNonempty : ∀ n, Nonempty (ProverRandomness n) + /-- Prover's commitment function: given witness, statement, and + randomness, produce a commitment -/ + commit : ∀ n, R.Witness n → R.Statement n → + ProverRandomness n → Commitment n + /-- Prover's response function: given witness, statement, + randomness, and challenge, produce a response -/ + respond : ∀ n, R.Witness n → R.Statement n → + ProverRandomness n → Challenge n → Response n + /-- Verifier's decision function: given statement, commitment, + challenge, and response, accept or reject -/ + verify : ∀ n, R.Statement n → Commitment n → + Challenge n → Response n → Bool + /-- **Completeness**: an honest prover with a valid witness is + always accepted. For any `(w, y) ∈ R`, any randomness `r`, and + any challenge `c`, the honest transcript is accepted. -/ + completeness : ∀ n (w : R.Witness n) (y : R.Statement n) + (r : ProverRandomness n) (c : Challenge n), + R.relation n w y → + verify n y (commit n w y r) c (respond n w y r c) = true + +attribute [instance] SigmaProtocol.commitmentFintype + SigmaProtocol.commitmentNonempty SigmaProtocol.commitmentDecEq + SigmaProtocol.challengeFintype SigmaProtocol.challengeNonempty + SigmaProtocol.challengeDecEq SigmaProtocol.responseFintype + SigmaProtocol.responseNonempty + SigmaProtocol.proverRandomnessFintype + SigmaProtocol.proverRandomnessNonempty + +/-- **δ-unpredictable commitments** (Def 19.7, Boneh-Shoup): for any +valid witness-statement pair and any target commitment `t₀`, the +probability over prover randomness that `commit` produces `t₀` is `≤ δ(n)`. -/ +def SigmaProtocol.UnpredictableCommitments {R : EffectiveRelation} + (P : SigmaProtocol R) (δ : ℕ → ℝ) : Prop := + ∀ n (w : R.Witness n) (y : R.Statement n) (t₀ : P.Commitment n), + R.relation n w y → + Cslib.Probability.uniformExpect (P.ProverRandomness n) + (fun r => if P.commit n w y r = t₀ then (1 : ℝ) else 0) ≤ δ n + +/-- **Special soundness** (Def 19.4 in Boneh-Shoup): from two +accepting conversations `(t, c, z)` and `(t, c', z')` sharing the +same commitment `t` but with distinct challenges `c ≠ c'`, an +extractor can recover a valid witness. -/ +structure SigmaProtocol.SpecialSoundness {R : EffectiveRelation} + (P : SigmaProtocol R) where + /-- The witness extractor -/ + extract : ∀ n, R.Statement n → P.Commitment n → + P.Challenge n → P.Response n → + P.Challenge n → P.Response n → R.Witness n + /-- If both conversations accept and challenges differ, the + extracted witness satisfies the relation -/ + soundness : ∀ n (y : R.Statement n) (t : P.Commitment n) + (c : P.Challenge n) (z : P.Response n) + (c' : P.Challenge n) (z' : P.Response n), + c ≠ c' → + P.verify n y t c z = true → + P.verify n y t c' z' = true → + R.relation n (extract n y t c z c' z') y + +/-- **Special honest-verifier zero-knowledge** (Def 19.5 in +Boneh-Shoup): there exists a simulator that, given a statement `y` +and a challenge `c`, produces a commitment-response pair `(t, z)` +such that `(t, c, z)` is accepting and has the same distribution +as a real transcript. -/ +structure SigmaProtocol.SpecialHVZK {R : EffectiveRelation} + (P : SigmaProtocol R) where + /-- Simulator randomness type -/ + SimRandomness : ℕ → Type + /-- Simulator randomness is finite -/ + simRandomnessFintype : ∀ n, Fintype (SimRandomness n) + /-- Simulator randomness is nonempty -/ + simRandomnessNonempty : ∀ n, Nonempty (SimRandomness n) + /-- The simulator: given statement and challenge, produce + commitment and response -/ + simulate : ∀ n, R.Statement n → P.Challenge n → + SimRandomness n → P.Commitment n × P.Response n + /-- Simulated transcripts are always accepting -/ + sim_accepting : ∀ n (y : R.Statement n) (c : P.Challenge n) + (s : SimRandomness n), + let (t, z) := simulate n y c s + P.verify n y t c z = true + /-- The simulated distribution equals the real distribution: + for any `(w, y) ∈ R` and any function `f` on transcripts, + `E_r[f(commit(w,y,r), respond(w,y,r,c))] + = E_s[f(simulate(y,c,s))]`. + + This captures that the two distributions are identical. -/ + sim_distribution : ∀ n (w : R.Witness n) (y : R.Statement n) + (c : P.Challenge n), + R.relation n w y → + ∀ (f : P.Commitment n × P.Response n → ℝ), + Cslib.Probability.uniformExpect (P.ProverRandomness n) + (fun r => f (P.commit n w y r, P.respond n w y r c)) = + Cslib.Probability.uniformExpect (SimRandomness n) + (fun s => f (simulate n y c s)) + +end diff --git a/Cslib/Cryptography/Reductions/FiatShamirROM.lean b/Cslib/Cryptography/Reductions/FiatShamirROM.lean new file mode 100644 index 000000000..991bcb9e5 --- /dev/null +++ b/Cslib/Cryptography/Reductions/FiatShamirROM.lean @@ -0,0 +1,3107 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Probability.ForkingLemma +public import Cslib.Cryptography.Foundations.RandomOracle + +@[expose] public section + +/-! +# Fiat-Shamir ROM Security Reduction + +The central security theorem for Fiat-Shamir signatures: if the +underlying Sigma protocol has **special soundness** and **special +HVZK**, and the relation is hard, then the Fiat-Shamir signature +scheme is **EUF-CMA secure** in the **random oracle model**. + +## Main Results + +* `fiatShamir_ROM_bound` — concrete security bound: + `ROM-EUF-CMA advantage ≤ √(q · Adv_R + q/|Ch|) + q² · δ` +* `fiatShamirReduction` — the relation solver constructed from the + EUF-CMA adversary via the forking lemma and special soundness +* `fiatShamir_ROM_secure` — asymptotic security: negligible advantage + under computational hardness of the relation (`SecureAgainst`), + super-polynomial challenge space, negligible `δ`-unpredictable + commitments, and polynomial query bound + +## Proof Architecture (Boneh-Shoup §19.6) + +The reduction proceeds through a chain of game hops: + +### Game-hop chain: ROM → LazyROM → MapGame_Real → MapGame1_HVZK + +1. **ROM → LazyROM** (`rom_eq_lazy_rom`): The real ROM game samples + `Fin q → (Msg × Commitment → Challenge)` (per-step random functions). + By `uniformExpect_eval_at_point`, evaluating a random function at a + point is equivalent to sampling a uniform value directly. This + gives exact equality with the lazy-sampling game that uses + `Fin q → Challenge` as its randomness. + +2. **LazyROM → MapGame_Real** (`lazy_le_mapGame_real`): The lazy ROM + oracle checks the association-list map before using its fresh + challenge `ch_i` at signing steps. MapGame_Real always uses `ch_i` + and inserts into the map without checking. The two games differ + only when a signing query hits a key already in the map, which + requires a commitment collision. By the union bound over + `≤ q²` pairs, the gap is at most `q² · δ` + (`lazyCommitReuse_bound`, via `lazyPairCommitReuse_pair_bound`). + +3. **MapGame_Real → MapGame1_HVZK** (`mapGame_real_eq_mapGame1_hvzk`): + The real prover `(commit, respond)` and the HVZK simulator produce + the same marginal distribution at each step (by `sim_distribution`). + The `runWithState_uniformExpect_oracle_eq` lemma lifts this per-step + equivalence to the full interaction, giving exact equality. + +### Combining the game hops + +`rom_eq_mapGame1_hvzk_bound` assembles the chain: + `ROM.adv ≤ MapGame1_HVZK.adv + q² · δ` + +### Forking step: MapGame1_HVZK → relation advantage + +In MapGame1_HVZK, the signing oracle uses the HVZK simulator and +does **not** use the witness. The forking lemma (`forking_lemma`) +applied to the adversary's interaction yields the quadratic bound: + `acc²/q ≤ frk + acc/|Ch|` + +When forking succeeds, two accepting transcripts with different +challenges at the same forgery index yield a witness via special +soundness (`forkExtraction_le_advR_map`). Thus `frk ≤ Adv_R(B)`. + +Inverting the quadratic gives: + `acc ≤ √(q · Adv_R(B) + q/|Ch|)` + +This is `mapGame1_hvzk_forking_bound`. + +### Infrastructure lemmas + +The file also develops infrastructure for reasoning about stateful +oracle interactions: + +* `run_uniformExpect_oracle_eq` / `runWithState_uniformExpect_oracle_eq`: + per-step marginal equivalence lifts to full interaction expected values +* `queryAtWithState` / `stateBeforeWithState`: access the `k`-th query + and the state just before it, enabling prefix-independence arguments +* `queryAtWithState_eq_of_prefix`: changing the oracle at indices `≥ k` + does not affect the `k`-th query +* `mapGameRealOracle_finalMap_lookup`: traces the forgery key through + the association list to establish which challenge the final map binds +* `lazy_run_stmt_eq_mapGame_real_run_stmt_of_no_reuse`: conditioned on + no commitment reuse, the lazy and MapGame_Real runs are identical +* `runWithState_eq_of_oracle_agree_on_trace`: two oracles that agree + on the actual trace produce the same `runWithState` result + +## References + +* Boneh-Shoup, *A Graduate Course in Applied Cryptography*, §19.6 +* [M. Bellare, G. Neven, *Multi-Signatures in the Plain Public-Key Model + and a General Forking Lemma*][BellareNeven2006] +-/ + +open Cslib.Probability + +/-- If two oracle families, parameterized by per-step randomness types +`S₁` and `S₂`, produce the same marginal distribution at each step +(for all queries and all test functions), then the expected value of +any function of the `run` result is the same. + +This is the key tool for proving that swapping per-step randomness +(e.g., real prover randomness ↔ simulator randomness in HVZK) +preserves the interaction's expected outcome. The proof is by +induction on `fuel`: at each step, we factor the expectation into +the head component (which we swap using `h_marginal`) and the tail +(which we swap using the inductive hypothesis). -/ +private theorem run_uniformExpect_oracle_eq + {Q R A : Type} {S₁ S₂ : Type} + [Fintype S₁] [Nonempty S₁] [Fintype S₂] [Nonempty S₂] + (fuel : ℕ) + (interaction : OracleInteraction Q R A) + (oracle₁ : Fin fuel → S₁ → Q → R) + (oracle₂ : Fin fuel → S₂ → Q → R) + (h_marginal : ∀ (i : Fin fuel) (q : Q) (g : R → ℝ), + uniformExpect S₁ (fun s => g (oracle₁ i s q)) = + uniformExpect S₂ (fun s => g (oracle₂ i s q))) + (f : Option (List Q × A) → ℝ) : + uniformExpect (Fin fuel → S₁) + (fun ss => f (interaction.run fuel (fun i => oracle₁ i (ss i)))) = + uniformExpect (Fin fuel → S₂) + (fun ss => f (interaction.run fuel (fun i => oracle₂ i (ss i)))) := by + induction fuel generalizing interaction f with + | zero => + -- Fin 0 → S is a singleton; run at fuel 0 doesn't use the oracle. + cases interaction with + | done a => + -- run (.done a) 0 _ = some ([], a) + change uniformExpect _ (fun _ => f (some ([], a))) = + uniformExpect _ (fun _ => f (some ([], a))) + rw [uniformExpect_const, uniformExpect_const] + | query q k => + -- run (.query q k) 0 _ = none + change uniformExpect _ (fun _ => f none) = + uniformExpect _ (fun _ => f none) + rw [uniformExpect_const, uniformExpect_const] + | succ n ih => + cases interaction with + | done a => + change uniformExpect _ (fun _ => f (some ([], a))) = + uniformExpect _ (fun _ => f (some ([], a))) + rw [uniformExpect_const, uniformExpect_const] + | query q k => + -- Shifted oracles for the IH + let shifted₁ : Fin n → S₁ → Q → R := + fun j => oracle₁ ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + let shifted₂ : Fin n → S₂ → Q → R := + fun j => oracle₂ ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + have h_shifted : ∀ (j : Fin n) (q' : Q) (g : R → ℝ), + uniformExpect S₁ (fun s => g (shifted₁ j s q')) = + uniformExpect S₂ (fun s => g (shifted₂ j s q')) := + fun j => h_marginal ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + -- Post-processing: wraps result with q :: prefix + let postF : Option (List Q × A) → ℝ := fun result => + f (match result with | none => none | some (qs, a) => some (q :: qs, a)) + -- Step 1: Convert Fin(n+1) → S to S × (Fin n → S) using Fin.consEquiv, + -- then factor with uniformExpect_prod. + -- LHS conversion + have lhs_conv : + uniformExpect (Fin (n + 1) → S₁) + (fun ss => f (OracleInteraction.run (.query q k) (n + 1) + (fun i => oracle₁ i (ss i)))) = + uniformExpect S₁ (fun s₀ => + uniformExpect (Fin n → S₁) (fun ss' => + postF ((k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ q)).run n + (fun j => shifted₁ j (ss' j))))) := by + rw [show (fun ss : Fin (n + 1) → S₁ => + f (OracleInteraction.run (.query q k) (n + 1) + (fun i => oracle₁ i (ss i)))) = + ((fun p : S₁ × (Fin n → S₁) => + postF ((k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ p.1 q)).run n + (fun j => shifted₁ j (p.2 j)))) ∘ + (Fin.consEquiv (fun _ : Fin (n + 1) => S₁)).symm) from by + funext ss; rfl + , uniformExpect_congr, uniformExpect_prod] + -- RHS conversion + have rhs_conv : + uniformExpect (Fin (n + 1) → S₂) + (fun ss => f (OracleInteraction.run (.query q k) (n + 1) + (fun i => oracle₂ i (ss i)))) = + uniformExpect S₂ (fun s₀ => + uniformExpect (Fin n → S₂) (fun ss' => + postF ((k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s₀ q)).run n + (fun j => shifted₂ j (ss' j))))) := by + rw [show (fun ss : Fin (n + 1) → S₂ => + f (OracleInteraction.run (.query q k) (n + 1) + (fun i => oracle₂ i (ss i)))) = + ((fun p : S₂ × (Fin n → S₂) => + postF ((k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ p.1 q)).run n + (fun j => shifted₂ j (p.2 j)))) ∘ + (Fin.consEquiv (fun _ : Fin (n + 1) => S₂)).symm) from by + funext ss; rfl + , uniformExpect_congr, uniformExpect_prod] + rw [lhs_conv, rhs_conv] + -- Step 2: Apply IH to rewrite inner expectation + -- For each s₀, the inner expectation over Fin n → S₁ equals Fin n → S₂ + conv_lhs => + arg 2; ext s₀ + rw [ih (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ q)) shifted₁ shifted₂ + h_shifted postF] + -- Step 3: Apply h_marginal for the outer expectation + -- Goal: E_{s₀:S₁}[G(oracle₁ 0 s₀ q)] = E_{s₀:S₂}[G(oracle₂ 0 s₀ q)] + exact h_marginal ⟨0, Nat.zero_lt_succ n⟩ q + (fun r => uniformExpect (Fin n → S₂) (fun ss' => + postF ((k r).run n (fun j => shifted₂ j (ss' j))))) + +/-- Stateful version of `run_uniformExpect_oracle_eq`. If two oracle +families, parameterized by per-step randomness types `S₁` and `S₂` and +threading state of type `State`, produce the same marginal distribution +at each step (for all states, queries, and test functions), then the +expected value of any function of the `runWithState` result is the same. + +The proof mirrors `run_uniformExpect_oracle_eq` by induction on `fuel`. -/ +private theorem runWithState_uniformExpect_oracle_eq + {Q R A State : Type} {S₁ S₂ : Type} + [Fintype S₁] [Nonempty S₁] [Fintype S₂] [Nonempty S₂] + (fuel : ℕ) + (interaction : OracleInteraction Q R A) + (oracle₁ : Fin fuel → S₁ → State → Q → (R × State)) + (oracle₂ : Fin fuel → S₂ → State → Q → (R × State)) + (h_marginal : ∀ (i : Fin fuel) (st : State) (q : Q) + (g : R × State → ℝ), + uniformExpect S₁ (fun s => g (oracle₁ i s st q)) = + uniformExpect S₂ (fun s => g (oracle₂ i s st q))) + (initState : State) + (f : Option (List Q × A × State) → ℝ) : + uniformExpect (Fin fuel → S₁) + (fun ss => f (interaction.runWithState fuel + (fun i st q => oracle₁ i (ss i) st q) initState)) = + uniformExpect (Fin fuel → S₂) + (fun ss => f (interaction.runWithState fuel + (fun i st q => oracle₂ i (ss i) st q) initState)) := by + induction fuel generalizing interaction initState f with + | zero => + cases interaction with + | done a => + change uniformExpect _ (fun _ => f (some ([], a, initState))) = + uniformExpect _ (fun _ => f (some ([], a, initState))) + rw [uniformExpect_const, uniformExpect_const] + | query q k => + change uniformExpect _ (fun _ => f none) = + uniformExpect _ (fun _ => f none) + rw [uniformExpect_const, uniformExpect_const] + | succ n ih => + cases interaction with + | done a => + change uniformExpect _ (fun _ => f (some ([], a, initState))) = + uniformExpect _ (fun _ => f (some ([], a, initState))) + rw [uniformExpect_const, uniformExpect_const] + | query q k => + -- Shifted oracles for the IH + let shifted₁ : Fin n → S₁ → State → Q → (R × State) := + fun j => oracle₁ ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + let shifted₂ : Fin n → S₂ → State → Q → (R × State) := + fun j => oracle₂ ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + have h_shifted : ∀ (j : Fin n) (st : State) (q' : Q) + (g : R × State → ℝ), + uniformExpect S₁ (fun s => g (shifted₁ j s st q')) = + uniformExpect S₂ (fun s => g (shifted₂ j s st q')) := + fun j => h_marginal ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ + -- Post-processing: wraps result with q :: prefix + let postF : Option (List Q × A × State) → ℝ := fun result => + f (match result with + | none => none + | some (qs, a, sf) => some (q :: qs, a, sf)) + -- Step 1: Factor Fin(n+1) → S into S × (Fin n → S) via Fin.consEquiv + -- LHS conversion + have lhs_conv : + uniformExpect (Fin (n + 1) → S₁) + (fun ss => f (OracleInteraction.runWithState (.query q k) (n + 1) + (fun i st q' => oracle₁ i (ss i) st q') initState)) = + uniformExpect S₁ (fun s₀ => + uniformExpect (Fin n → S₁) (fun ss' => + postF ((k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).1).runWithState n + (fun j st q' => shifted₁ j (ss' j) st q') + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).2))) := by + rw [show (fun ss : Fin (n + 1) → S₁ => + f (OracleInteraction.runWithState (.query q k) (n + 1) + (fun i st q' => oracle₁ i (ss i) st q') initState)) = + ((fun p : S₁ × (Fin n → S₁) => + postF ((k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ p.1 initState q).1).runWithState n + (fun j st q' => shifted₁ j (p.2 j) st q') + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ p.1 initState q).2)) ∘ + (Fin.consEquiv (fun _ : Fin (n + 1) => S₁)).symm) from by + funext ss; rfl + , uniformExpect_congr, uniformExpect_prod] + -- RHS conversion + have rhs_conv : + uniformExpect (Fin (n + 1) → S₂) + (fun ss => f (OracleInteraction.runWithState (.query q k) (n + 1) + (fun i st q' => oracle₂ i (ss i) st q') initState)) = + uniformExpect S₂ (fun s₀ => + uniformExpect (Fin n → S₂) (fun ss' => + postF ((k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).1).runWithState n + (fun j st q' => shifted₂ j (ss' j) st q') + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).2))) := by + rw [show (fun ss : Fin (n + 1) → S₂ => + f (OracleInteraction.runWithState (.query q k) (n + 1) + (fun i st q' => oracle₂ i (ss i) st q') initState)) = + ((fun p : S₂ × (Fin n → S₂) => + postF ((k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ p.1 initState q).1).runWithState n + (fun j st q' => shifted₂ j (p.2 j) st q') + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ p.1 initState q).2)) ∘ + (Fin.consEquiv (fun _ : Fin (n + 1) => S₂)).symm) from by + funext ss; rfl + , uniformExpect_congr, uniformExpect_prod] + rw [lhs_conv, rhs_conv] + -- Step 2: Apply IH to rewrite inner expectation + conv_lhs => + arg 2; ext s₀ + rw [ih (k (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).1) + shifted₁ shifted₂ h_shifted + (oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s₀ initState q).2 + postF] + -- Step 3: Apply h_marginal for the outer expectation + exact h_marginal ⟨0, Nat.zero_lt_succ n⟩ initState q + (fun p => uniformExpect (Fin n → S₂) (fun ss' => + postF ((k p.1).runWithState n + (fun j st q' => shifted₂ j (ss' j) st q') p.2))) + +/-- **Evaluate-at-point under a uniform random function**: +`E_{H : X → Y}[g(H x₀)] = E_{y : Y}[g(y)]`. -/ +private theorem uniformExpect_eval_at_point + {X Y : Type*} [Fintype X] [Nonempty X] [DecidableEq X] + [Fintype Y] [Nonempty Y] + (x₀ : X) (g : Y → ℝ) : + uniformExpect (X → Y) (fun H => g (H x₀)) = + uniformExpect Y g := by + let e := Equiv.funSplitAt x₀ Y + have h_comp : + (fun H : X → Y => g (H x₀)) = + (fun p : Y × ({x : X // x ≠ x₀} → Y) => g p.1) ∘ e := by + funext H + simp [e, Equiv.funSplitAt, Equiv.piSplitAt] + rw [h_comp, uniformExpect_congr] + exact uniformExpect_prod_ignore_snd g + +/-- For a single pair `(i, j)` of distinct indices, the probability (over +uniform prover randomness) that the signing commitments collide is `≤ δ`. +This adapts `uniformExpect_collision_pair` to the `UnpredictableCommitments` +setting: we split `rs` at coordinate `j` via `Equiv.funSplitAt`, fix the +remaining coordinates (which determines the target `t₀ = commit(w, y, rs i)`), +and apply the unpredictability bound. -/ +private theorem uniformExpect_commit_collision_pair {R : EffectiveRelation} + (P : SigmaProtocol R) + (kg : R.WithKeyGen) + (n : ℕ) (q : ℕ) (w : R.Witness n) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) + [inst_ft : Fintype (P.ProverRandomness n)] + [inst_ne : Nonempty (P.ProverRandomness n)] + (i j : Fin q) (hij : i ≠ j) : + uniformExpect (Fin q → P.ProverRandomness n) + (fun rs => if P.commit n w (kg.keyOf n w) (rs i) = + P.commit n w (kg.keyOf n w) (rs j) then (1 : ℝ) else 0) ≤ δ n := by + -- Align instances with the protocol's canonical instances so h_unpred applies + have h_ft : inst_ft = P.proverRandomnessFintype n := Subsingleton.elim _ _ + have h_ne : inst_ne = P.proverRandomnessNonempty n := Subsingleton.elim _ _ + subst h_ft; subst h_ne + -- Split at coordinate j: (Fin q → PR) ≃ PR × ({k // k ≠ j} → PR) + -- Flip equality direction so it matches UnpredictableCommitments (commit(rj) = t₀) + have h_comp : (fun rs : Fin q → P.ProverRandomness n => + if P.commit n w (kg.keyOf n w) (rs i) = + P.commit n w (kg.keyOf n w) (rs j) then (1 : ℝ) else 0) = + (fun p : P.ProverRandomness n × ({k : Fin q // k ≠ j} → P.ProverRandomness n) => + if P.commit n w (kg.keyOf n w) p.1 = + P.commit n w (kg.keyOf n w) (p.2 ⟨i, hij⟩) then 1 else 0) ∘ + Equiv.funSplitAt j (P.ProverRandomness n) := by + ext rs; simp [Equiv.funSplitAt, Equiv.piSplitAt, eq_comm] + rw [h_comp, uniformExpect_congr] + haveI : Nonempty ({k : Fin q // k ≠ j} → P.ProverRandomness n) := + ⟨fun _ => (P.proverRandomnessNonempty n).some⟩ + rw [uniformExpect_prod, uniformExpect_comm] + -- E_{rest}[E_{rj}[1{commit(rj) = commit(rest[i])}]] ≤ δ + have h_bound : ∀ rest : {k : Fin q // k ≠ j} → P.ProverRandomness n, + uniformExpect (P.ProverRandomness n) (fun rj => + if P.commit n w (kg.keyOf n w) rj = + P.commit n w (kg.keyOf n w) (rest ⟨i, hij⟩) then 1 else 0) ≤ δ n := + fun rest => h_unpred n w (kg.keyOf n w) + (P.commit n w (kg.keyOf n w) (rest ⟨i, hij⟩)) (kg.keyOf_valid n w) + exact le_trans (uniformExpect_mono _ h_bound) (le_of_eq (uniformExpect_const _ _)) + +/-- The probability that any two signing commitments collide, over uniform +witness and prover randomness, is at most `q² · δ`. + +This is the generalized birthday bound for `δ`-unpredictable commitments: +union bound over `≤ q²` pairs, each contributing `≤ δ` by +`uniformExpect_commit_collision_pair`. -/ +private theorem commitment_collision_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + uniformExpect (R.Witness n × (Fin (A.numQueries n) → P.ProverRandomness n)) + (fun ⟨w, rs⟩ => if ∃ (i j : Fin (A.numQueries n)), i.val < j.val ∧ + P.commit n w (kg.keyOf n w) (rs i) = P.commit n w (kg.keyOf n w) (rs j) + then 1 else 0) ≤ (A.numQueries n : ℝ) ^ 2 * δ n := by + let q := A.numQueries n + letI := P.proverRandomnessFintype n + letI := P.proverRandomnessNonempty n + -- Factor: E_{w,rs}[f(w,rs)] = E_w[E_rs[f(w,rs)]] + rw [uniformExpect_prod] + -- Per-w bound: E_rs[collision_indicator(w,rs)] ≤ q²·δ + -- Step 1: Union bound — indicator of ∃ ≤ sum of indicators over pairs + have h_union : ∀ (w : R.Witness n) (rs : Fin q → P.ProverRandomness n), + (if ∃ (i j : Fin q), i.val < j.val ∧ + P.commit n w (kg.keyOf n w) (rs i) = P.commit n w (kg.keyOf n w) (rs j) + then (1 : ℝ) else 0) ≤ + ∑ p : Fin q × Fin q, + if p.1.val < p.2.val ∧ + P.commit n w (kg.keyOf n w) (rs p.1) = P.commit n w (kg.keyOf n w) (rs p.2) + then 1 else 0 := by + intro w rs + split + · next h => + obtain ⟨i, j, hij, heq⟩ := h + let f : Fin q × Fin q → ℝ := fun p => + if p.1.val < p.2.val ∧ + P.commit n w (kg.keyOf n w) (rs p.1) = + P.commit n w (kg.keyOf n w) (rs p.2) then 1 else 0 + have hf_nonneg : ∀ p ∈ Finset.univ, (0 : ℝ) ≤ f p := + fun p _ => ite_nonneg zero_le_one (le_refl 0) + have h_single := Finset.single_le_sum hf_nonneg (Finset.mem_univ (i, j)) + have hfi : f (i, j) = 1 := if_pos ⟨hij, heq⟩ + linarith + · exact Finset.sum_nonneg fun p _ => + show (0 : ℝ) ≤ _ from ite_nonneg zero_le_one (le_refl 0) + -- Step 2: Per-pair bound ≤ δ + have h_pair_bound : ∀ (w : R.Witness n) (p : Fin q × Fin q), + uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if p.1.val < p.2.val ∧ + P.commit n w (kg.keyOf n w) (rs p.1) = P.commit n w (kg.keyOf n w) (rs p.2) + then (1 : ℝ) else 0) ≤ δ n := by + intro w ⟨i, j⟩ + by_cases hij : i.val < j.val + · simp only [hij, true_and] + exact uniformExpect_commit_collision_pair P kg n q w δ + h_unpred i j (Fin.ne_of_lt hij) + · have : (fun rs : Fin q → P.ProverRandomness n => + if i.val < j.val ∧ + P.commit n w (kg.keyOf n w) (rs i) = P.commit n w (kg.keyOf n w) (rs j) + then (1 : ℝ) else 0) = fun _ => 0 := by + ext rs; simp [hij] + rw [this, uniformExpect_const] + exact le_trans (le_refl 0) (le_trans + (uniformExpect_nonneg _ fun _ => ite_nonneg zero_le_one (le_refl 0)) + (h_unpred n w (kg.keyOf n w) + (P.commit n w (kg.keyOf n w) (‹Nonempty (P.ProverRandomness n)›.some)) + (kg.keyOf_valid n w))) + -- Step 3: Assemble + have h_per_w : ∀ w : R.Witness n, + uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if ∃ (i j : Fin q), i.val < j.val ∧ + P.commit n w (kg.keyOf n w) (rs i) = P.commit n w (kg.keyOf n w) (rs j) + then (1 : ℝ) else 0) ≤ (q : ℝ) ^ 2 * δ n := by + intro w + calc uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if ∃ (i j : Fin q), i.val < j.val ∧ + P.commit n w (kg.keyOf n w) (rs i) = P.commit n w (kg.keyOf n w) (rs j) + then (1 : ℝ) else 0) + ≤ uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + ∑ p : Fin q × Fin q, + if p.1.val < p.2.val ∧ + P.commit n w (kg.keyOf n w) (rs p.1) = P.commit n w (kg.keyOf n w) (rs p.2) + then 1 else 0) := + uniformExpect_mono _ (h_union w) + _ = ∑ p : Fin q × Fin q, uniformExpect (Fin q → P.ProverRandomness n) + (fun rs => if p.1.val < p.2.val ∧ + P.commit n w (kg.keyOf n w) (rs p.1) = P.commit n w (kg.keyOf n w) (rs p.2) + then 1 else 0) := + uniformExpect_finset_sum _ + _ ≤ ∑ _p : Fin q × Fin q, δ n := + Finset.sum_le_sum (fun p _ => h_pair_bound w p) + _ = (Fintype.card (Fin q × Fin q) : ℝ) * δ n := by + simp [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + _ ≤ (q : ℝ) ^ 2 * δ n := by + simp [Fintype.card_prod, Fintype.card_fin]; ring_nf; exact le_refl _ + exact le_trans (uniformExpect_mono _ h_per_w) (le_of_eq (uniformExpect_const _ _)) + +/-! ## Map-Based Intermediate Games (Boneh-Shoup §19.6) + +The following definitions implement the Map-based game hop chain: +- **MapGame0** ≡ ROM (via lazy sampling) +- **MapGame1** differs from MapGame0 only in that signing always uses fresh + `ch_i` (ignoring Map). Gap bounded by commitment collision probability. +- **MapGame1_HVZK** replaces real prover with HVZK simulator. Same advantage + as MapGame1 by `sim_distribution`. + +The forking lemma is applied to MapGame1_HVZK. -/ + +/-- Map state type: association list from `(Msg × Commitment)` to `Challenge`. -/ +private abbrev MapState {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) (n : ℕ) := + List ((Msg n × P.Commitment n) × P.Challenge n) + +/-- Oracle for MapGame_Real: signing uses the real prover (commit/respond) +with per-query challenge `ch_i`, and inserts into Map. Hash oracle checks +Map for consistency. This is the intermediate game between ROM and +MapGame1_HVZK. -/ +private noncomputable def mapGameRealOracle {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (ch : Fin q → P.Challenge n) : + Fin q → MapState P Msg n → + (Msg n ⊕ (Msg n × P.Commitment n)) → + (((P.Commitment n × P.Response n) ⊕ P.Challenge n) × MapState P Msg n) := + fun i map qry => + letI := P.commitmentDecEq n + match qry with + | .inl m => + let t := P.commit n w y (rs i) + let z := P.respond n w y (rs i) (ch i) + (.inl (t, z), ((m, t), ch i) :: map) + | .inr (m, t) => + match assocLookup (m, t) map with + | some c => (.inr c, map) + | none => (.inr (ch i), ((m, t), ch i) :: map) + +/-- Execute MapGame_Real: run the adversary with the Map-based real oracle, +then post-process to extract forgery and check verification. -/ +private noncomputable def mapGame_real_run_stmt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) : + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + let q := A.numQueries n + letI := P.commitmentDecEq n + match (A.interact n y).runWithState q + (mapGameRealOracle P Msg n q w y rs ch) [] with + | none => none + | some (queries, (mf, tf, zf), _) => + let j := queries.findIdx (fun x => decide (x = .inr (mf, tf))) + if hj : j < q then + if j < queries.length then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + if P.verify n y tf (ch ⟨j, hj⟩) zf && !(signMsgs.contains mf) then + some (⟨j, hj⟩, (mf, tf, zf)) + else + none + else + none + else + none + +/-- Wrap `mapGame_real_run_stmt` for the `forkAcceptProb` framework. -/ +private noncomputable def mapGame_real_run {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : + (R.Witness n × (Fin (A.numQueries n) → P.ProverRandomness n)) → + (Fin (A.numQueries n) → P.Challenge n) → + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + fun ⟨w, rs⟩ ch => + mapGame_real_run_stmt P Msg A n w (kg.keyOf n w) rs ch + +/-- **MapGame_Real advantage**: acceptance probability of the Map-based +real-prover game in the forking framework. -/ +private noncomputable def mapGame_real_advantage {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : ℝ := + let q := A.numQueries n + letI := P.proverRandomnessFintype n + letI := P.proverRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + forkAcceptProb + (R.Witness n × (Fin q → P.ProverRandomness n)) + (P.Challenge n) q + (mapGame_real_run P Msg kg A n) + +/-- Oracle for LazyROM (= MapGame0 in Boneh-Shoup §19.6): like +`mapGameRealOracle` but checks the Map at signing steps before using +`ch_i`. When the key `(m, commit(w,y,rs_i))` is already cached, uses +the cached challenge for consistency (faithfully simulating a random +function). When the key is fresh, behaves identically to +`mapGameRealOracle`. -/ +private noncomputable def lazyRomOracle {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (ch : Fin q → P.Challenge n) : + Fin q → MapState P Msg n → + (Msg n ⊕ (Msg n × P.Commitment n)) → + (((P.Commitment n × P.Response n) ⊕ P.Challenge n) × MapState P Msg n) := + fun i map qry => + letI := P.commitmentDecEq n + match qry with + | .inl m => + let t := P.commit n w y (rs i) + match assocLookup (m, t) map with + | some c => (.inl (t, P.respond n w y (rs i) c), map) + | none => (.inl (t, P.respond n w y (rs i) (ch i)), + ((m, t), ch i) :: map) + | .inr (m, t) => + match assocLookup (m, t) map with + | some c => (.inr c, map) + | none => (.inr (ch i), ((m, t), ch i) :: map) + +/-- LazyROM oracle variant where each step receives a random function +`Hᵢ : Msg × Comm → Ch` and uses `Hᵢ(key)` when the key is fresh. +Map lookups still enforce consistency on repeated keys. -/ +private noncomputable def lazyRomHOracle {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) : + Fin q → (Msg n × P.Commitment n → P.Challenge n) → + MapState P Msg n → + (Msg n ⊕ (Msg n × P.Commitment n)) → + (((P.Commitment n × P.Response n) ⊕ P.Challenge n) × MapState P Msg n) := + fun i H map qry => + letI := P.commitmentDecEq n + match qry with + | .inl m => + let t := P.commit n w y (rs i) + match assocLookup (m, t) map with + | some c => (.inl (t, P.respond n w y (rs i) c), map) + | none => + let c := H (m, t) + (.inl (t, P.respond n w y (rs i) c), ((m, t), c) :: map) + | .inr (m, t) => + match assocLookup (m, t) map with + | some c => (.inr c, map) + | none => + let c := H (m, t) + (.inr c, ((m, t), c) :: map) + +/-- One-step marginal equivalence: +sampling a fresh value via `Hᵢ(key)` (uniform random function) matches +sampling a fresh uniform challenge directly. -/ +private theorem lazyRomHOracle_marginal_eq {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (i : Fin q) (map : MapState P Msg n) + (qry : Msg n ⊕ (Msg n × P.Commitment n)) + (g : (((P.Commitment n × P.Response n) ⊕ P.Challenge n) × + MapState P Msg n) → ℝ) : + uniformExpect (Msg n × P.Commitment n → P.Challenge n) + (fun H => g (lazyRomHOracle P Msg n q w y rs i H map qry)) = + uniformExpect (P.Challenge n) + (fun c => g (lazyRomOracle P Msg n q w y rs (fun _ => c) i map qry)) := by + letI := P.commitmentDecEq n + cases qry with + | inl m => + let t := P.commit n w y (rs i) + cases h_lookup : assocLookup (m, t) map with + | some c0 => + simpa [lazyRomHOracle, lazyRomOracle, t, h_lookup] using + (show uniformExpect (Msg n × P.Commitment n → P.Challenge n) + (fun _ => g (.inl (t, P.respond n w y (rs i) c0), map)) = + uniformExpect (P.Challenge n) + (fun _ => g (.inl (t, P.respond n w y (rs i) c0), map)) from by + rw [uniformExpect_const, uniformExpect_const]) + | none => + let g' : P.Challenge n → ℝ := fun c => + g (.inl (t, P.respond n w y (rs i) c), ((m, t), c) :: map) + have h_eval := + uniformExpect_eval_at_point (x₀ := (m, t)) (g := g') + simpa [lazyRomHOracle, lazyRomOracle, t, h_lookup, g'] using h_eval + | inr mt => + rcases mt with ⟨m, t⟩ + cases h_lookup : assocLookup (m, t) map with + | some c0 => + simpa [lazyRomHOracle, lazyRomOracle, h_lookup] using + (show uniformExpect (Msg n × P.Commitment n → P.Challenge n) + (fun _ => g (.inr c0, map)) = + uniformExpect (P.Challenge n) + (fun _ => g (.inr c0, map)) from by + rw [uniformExpect_const, uniformExpect_const]) + | none => + let g' : P.Challenge n → ℝ := fun c => g (.inr c, ((m, t), c) :: map) + have h_eval := + uniformExpect_eval_at_point (x₀ := (m, t)) (g := g') + simpa [lazyRomHOracle, lazyRomOracle, h_lookup, g'] using h_eval + +/-- Run-level oracle swap for LazyROM: +replacing per-step random functions `Hᵢ` with per-step uniform challenges +preserves the expected value of any post-processing of `runWithState`. -/ +private theorem lazyRomH_runWithState_uniform_eq {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + (n : ℕ) (q : ℕ) + (interaction : OracleInteraction + (Msg n ⊕ (Msg n × P.Commitment n)) + ((P.Commitment n × P.Response n) ⊕ P.Challenge n) + (Msg n × P.Commitment n × P.Response n)) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (f : Option + (List (Msg n ⊕ (Msg n × P.Commitment n)) × + (Msg n × P.Commitment n × P.Response n) × + MapState P Msg n) → ℝ) : + uniformExpect (Fin q → (Msg n × P.Commitment n → P.Challenge n)) + (fun Hs => + f (interaction.runWithState q + (fun i st qry => lazyRomHOracle P Msg n q w y rs i (Hs i) st qry) [])) = + uniformExpect (Fin q → P.Challenge n) + (fun ch => + f (interaction.runWithState q + (lazyRomOracle P Msg n q w y rs ch) [])) := by + have h_oracle_lazy : + ∀ (ch : Fin q → P.Challenge n), + lazyRomOracle P Msg n q w y rs ch = + fun i st qry => (fun i s st qry => + lazyRomOracle P Msg n q w y rs (fun _ => s) i st qry) i (ch i) st qry := by + intro ch + funext i st qry + rfl + conv_rhs => + arg 2 + ext ch + rw [h_oracle_lazy ch] + dsimp only [] + exact runWithState_uniformExpect_oracle_eq q interaction + (fun i s => lazyRomHOracle P Msg n q w y rs i s) + (fun i s => lazyRomOracle P Msg n q w y rs (fun _ => s) i) + (by + intro i st qry g + exact lazyRomHOracle_marginal_eq P Msg n q w y rs i st qry g) + [] f + +/-- Execute LazyROM: run the adversary with the lazy ROM oracle, +then post-process to extract forgery and check verification. +Mirrors `mapGame_real_run_stmt` exactly, substituting `lazyRomOracle` +for `mapGameRealOracle`. -/ +private noncomputable def lazyRom_run_stmt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) : + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + let q := A.numQueries n + letI := P.commitmentDecEq n + match (A.interact n y).runWithState q + (lazyRomOracle P Msg n q w y rs ch) [] with + | none => none + | some (queries, (mf, tf, zf), finalMap) => + let j := queries.findIdx (fun x => decide (x = .inr (mf, tf))) + if hj : j < q then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + match assocLookup (mf, tf) finalMap with + | some c => + if P.verify n y tf c zf && !(signMsgs.contains mf) then + some (⟨j, hj⟩, (mf, tf, zf)) + else + none + | none => none + else + none + +/-- Wrap `lazyRom_run_stmt` for the `forkAcceptProb` framework. -/ +private noncomputable def lazyRom_run {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : + (R.Witness n × (Fin (A.numQueries n) → P.ProverRandomness n)) → + (Fin (A.numQueries n) → P.Challenge n) → + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + fun ⟨w, rs⟩ ch => + lazyRom_run_stmt P Msg A n w (kg.keyOf n w) rs ch + +/-- **LazyROM advantage**: acceptance probability of the lazy ROM game +in the forking framework. -/ +private noncomputable def lazyRom_advantage {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : ℝ := + let q := A.numQueries n + letI := P.proverRandomnessFintype n + letI := P.proverRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + forkAcceptProb + (R.Witness n × (Fin q → P.ProverRandomness n)) + (P.Challenge n) q + (lazyRom_run P Msg kg A n) + +/-- Oracle for MapGame1_HVZK: signing uses HVZK simulator, always uses +`ch_i`, and inserts into Map. Hash oracle checks Map for consistency. -/ +private noncomputable def mapGame1HvzkOracle {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (hvzk : P.SpecialHVZK) (n : ℕ) (q : ℕ) + (y : R.Statement n) + (sr : Fin q → hvzk.SimRandomness n) + (ch : Fin q → P.Challenge n) : + Fin q → MapState P Msg n → + (Msg n ⊕ (Msg n × P.Commitment n)) → + (((P.Commitment n × P.Response n) ⊕ P.Challenge n) × MapState P Msg n) := + fun i map qry => + letI := P.commitmentDecEq n + match qry with + | .inl m => + let (t, z) := hvzk.simulate n y (ch i) (sr i) + (.inl (t, z), ((m, t), ch i) :: map) + | .inr (m, t) => + match assocLookup (m, t) map with + | some c => (.inr c, map) + | none => (.inr (ch i), ((m, t), ch i) :: map) + +/-- Execute MapGame1_HVZK: run the adversary with the Map-based HVZK oracle, +then post-process to extract forgery and check verification. -/ +private noncomputable def mapGame1_hvzk_run_stmt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (y : R.Statement n) + (sr : Fin (A.numQueries n) → hvzk.SimRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) : + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + let q := A.numQueries n + letI := P.commitmentDecEq n + match (A.interact n y).runWithState q + (mapGame1HvzkOracle P Msg hvzk n q y sr ch) [] with + | none => none + | some (queries, (mf, tf, zf), _) => + let j := queries.findIdx (fun x => decide (x = .inr (mf, tf))) + if hj : j < q then + if j < queries.length then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + if P.verify n y tf (ch ⟨j, hj⟩) zf && !(signMsgs.contains mf) then + some (⟨j, hj⟩, (mf, tf, zf)) + else + none + else + none + else + none + +/-- Wrap `mapGame1_hvzk_run_stmt` for the `forkAcceptProb` framework. -/ +private noncomputable def mapGame1_hvzk_run {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (kg : R.WithKeyGen) + (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : + (R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n)) → + (Fin (A.numQueries n) → P.Challenge n) → + Option (Fin (A.numQueries n) × (Msg n × P.Commitment n × P.Response n)) := + fun ⟨w, sr⟩ ch => + mapGame1_hvzk_run_stmt P Msg hvzk A n (kg.keyOf n w) sr ch + +/-- **MapGame1_HVZK advantage**: acceptance probability of the Map-based +HVZK game in the forking framework. -/ +private noncomputable def mapGame1_hvzk_advantage {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : ℝ := + let q := A.numQueries n + letI := hvzk.simRandomnessFintype n + letI := hvzk.simRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + forkAcceptProb + (R.Witness n × (Fin q → hvzk.SimRandomness n)) + (P.Challenge n) q + (mapGame1_hvzk_run P Msg kg hvzk A n) + +/-- If two `forkAcceptProb` computations with different coin types produce +the same expected payoff for every challenge assignment, they are equal. -/ +private theorem forkAcceptProb_coins_eq + {α : Type} {C₁ C₂ R : Type} + [Fintype C₁] [Nonempty C₁] [Fintype C₂] [Nonempty C₂] + [Fintype R] [Nonempty R] (q : ℕ) + (run₁ : C₁ → (Fin q → R) → Option (Fin q × α)) + (run₂ : C₂ → (Fin q → R) → Option (Fin q × α)) + (h : ∀ (ch : Fin q → R) (f : Option (Fin q × α) → ℝ), + uniformExpect C₁ (fun c => f (run₁ c ch)) = + uniformExpect C₂ (fun c => f (run₂ c ch))) : + forkAcceptProb C₁ R q run₁ = forkAcceptProb C₂ R q run₂ := by + simp only [forkAcceptProb] + conv_lhs => rw [uniformExpect_prod, uniformExpect_comm] + conv_rhs => rw [uniformExpect_prod, uniformExpect_comm] + congr 1; ext ch + exact h ch (fun o => match o with | none => 0 | some _ => 1) + +/-- **HVZK switch**: the MapGame_Real advantage equals the MapGame1_HVZK +advantage. The real prover `(commit, respond)` produces the same marginal +distribution as the HVZK simulator at each step (by `sim_distribution`), +so the overall interaction's expected payoff is preserved. -/ +private theorem mapGame_real_eq_mapGame1_hvzk {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : + mapGame_real_advantage P Msg kg A n = + mapGame1_hvzk_advantage P Msg kg hvzk A n := by + set q := A.numQueries n with hq + letI := P.proverRandomnessFintype n + letI := P.proverRandomnessNonempty n + letI := hvzk.simRandomnessFintype n + letI := hvzk.simRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + simp only [mapGame_real_advantage, mapGame1_hvzk_advantage] + apply forkAcceptProb_coins_eq + intro ch f_payoff + simp only [mapGame_real_run, mapGame1_hvzk_run] + rw [uniformExpect_prod, uniformExpect_prod] + congr 1; ext w; dsimp only [] + -- For fixed w and ch, show the inner expectations over per-step randomness are equal + set y := kg.keyOf n w + -- Post-processing function applied after runWithState (same in both games) + let pp : Option (List (Msg n ⊕ (Msg n × P.Commitment n)) × + (Msg n × P.Commitment n × P.Response n) × MapState P Msg n) → + Option (Fin q × (Msg n × P.Commitment n × P.Response n)) := + fun result => + letI := P.commitmentDecEq n + match result with + | none => none + | some (queries, (mf, tf, zf), _) => + let j := queries.findIdx (fun x => decide (x = Sum.inr (mf, tf))) + if hj : j < q then + if j < queries.length then + let signMsgs := queries.filterMap (fun q => match q with + | Sum.inl m => some m | Sum.inr _ => none) + if P.verify n y tf (ch ⟨j, hj⟩) zf && !(signMsgs.contains mf) then + some (⟨j, hj⟩, (mf, tf, zf)) + else none + else none + else none + -- Factoring: run_stmt = pp ∘ runWithState ∘ oracle + have h_run_real : ∀ rs, + mapGame_real_run_stmt P Msg A n w y rs ch = + pp ((A.interact n y).runWithState q (mapGameRealOracle P Msg n q w y rs ch) []) := by + intro rs; rfl + have h_run_hvzk : ∀ sr, + mapGame1_hvzk_run_stmt P Msg hvzk A n y sr ch = + pp ((A.interact n y).runWithState q (mapGame1HvzkOracle P Msg hvzk n q y sr ch) []) := by + intro sr; rfl + -- Oracle factoring: oracle(rs)(i) = oracle₁(i)(rs i) where oracle₁ doesn't depend on rs + have h_oracle_real : ∀ (rs : Fin q → P.ProverRandomness n), + mapGameRealOracle P Msg n q w y rs ch = + fun i st qry => (fun i s st qry => + mapGameRealOracle P Msg n q w y (fun _ => s) ch i st qry) i (rs i) st qry := by + intro rs; funext i st qry; rfl + have h_oracle_hvzk : ∀ (sr : Fin q → hvzk.SimRandomness n), + mapGame1HvzkOracle P Msg hvzk n q y sr ch = + fun i st qry => (fun i s st qry => + mapGame1HvzkOracle P Msg hvzk n q y (fun _ => s) ch i st qry) i (sr i) st qry := by + intro sr; funext i st qry; rfl + conv_lhs => arg 2; ext rs; rw [h_run_real, h_oracle_real]; dsimp only [] + conv_rhs => arg 2; ext sr; rw [h_run_hvzk, h_oracle_hvzk]; dsimp only [] + -- Normalize Fin (A.numQueries n) to Fin q for unification + change uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + f_payoff (pp ((A.interact n y).runWithState q + (fun i st qry => mapGameRealOracle P Msg n q w y (fun _ => rs i) ch i st qry) []))) = + uniformExpect (Fin q → hvzk.SimRandomness n) (fun sr => + f_payoff (pp ((A.interact n y).runWithState q + (fun i st qry => mapGame1HvzkOracle P Msg hvzk n q y (fun _ => sr i) ch i st qry) []))) + -- Apply the stateful oracle swap lemma + exact runWithState_uniformExpect_oracle_eq q (A.interact n y) + (fun i s => mapGameRealOracle P Msg n q w y (fun _ => s) ch i) + (fun i s => mapGame1HvzkOracle P Msg hvzk n q y (fun _ => s) ch i) + (by + intro i st qry g + cases qry with + | inr mt => + -- Hash query: result is independent of per-step randomness s + simp only [mapGameRealOracle, mapGame1HvzkOracle] + rw [uniformExpect_const, uniformExpect_const] + | inl m => + -- Sign query: real prover ↔ HVZK simulator by sim_distribution + simp only [mapGameRealOracle, mapGame1HvzkOracle] + exact hvzk.sim_distribution n w y (ch i) (kg.keyOf_valid n w) + (fun ⟨t, z⟩ => g (Sum.inl (t, z), ((m, t), ch i) :: st))) + [] (fun result => f_payoff (pp result)) + +/-- Return the `idx`-th query issued by a stateful interaction, if it exists, +without requiring the whole `runWithState` call to terminate successfully. + +This is useful for prefix-dependence arguments: `queryAtWithState ... idx` +only depends on oracle indices `< idx + 1`. -/ +private def queryAtWithState {Q R A S : Type} + : (interaction : OracleInteraction Q R A) → + (fuel : Nat) → + (oracle : Fin fuel → S → Q → R × S) → + (initState : S) → + (idx : Nat) → + Option Q + | .done _, _, _, _, _ => none + | .query _ _, 0, _, _, _ => none + | .query q k, fuel + 1, oracle, s, idx => + match idx with + | 0 => some q + | idx + 1 => + let (response, s') := oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q + let shiftedOracle : Fin fuel → S → Q → R × S := + fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + queryAtWithState (k response) fuel shiftedOracle s' idx + +/-- State just before processing query `idx` (if that query exists), for a +stateful interaction run with fixed fuel and oracle. -/ +private def stateBeforeWithState {Q R A S : Type} + : (interaction : OracleInteraction Q R A) → + (fuel : Nat) → + (oracle : Fin fuel → S → Q → R × S) → + (initState : S) → + (idx : Nat) → + Option S + | .done _, _, _, s, 0 => some s + | .done _, _, _, _, _ + 1 => none + | .query _ _, 0, _, s, 0 => some s + | .query _ _, 0, _, _, _ + 1 => none + | .query _ _, _fuel + 1, _, s, 0 => some s + | .query q k, fuel + 1, oracle, s, idx + 1 => + let (response, s') := oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q + let shiftedOracle : Fin fuel → S → Q → R × S := + fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + stateBeforeWithState (k response) fuel shiftedOracle s' idx + +/-- `queryAtWithState` depends only on the oracle prefix `≤ idx`. -/ +private theorem queryAtWithState_eq_of_prefix + {Q R A S : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) + (oracle₁ oracle₂ : Fin fuel → S → Q → R × S) + (s : S) + (idx : Nat) + (h_agree : ∀ (i : Fin fuel), i.val < idx → oracle₁ i = oracle₂ i) : + queryAtWithState interaction fuel oracle₁ s idx = + queryAtWithState interaction fuel oracle₂ s idx := by + induction idx generalizing interaction fuel oracle₁ oracle₂ s with + | zero => + cases interaction with + | done a => + cases fuel <;> rfl + | query q k => + cases fuel <;> rfl + | succ idx ih => + cases interaction with + | done a => + cases fuel <;> rfl + | query q k => + cases fuel with + | zero => + rfl + | succ fuel => + simp only [queryAtWithState] + have h0 : oracle₁ ⟨0, Nat.zero_lt_succ fuel⟩ s q = + oracle₂ ⟨0, Nat.zero_lt_succ fuel⟩ s q := by + exact congrFun (congrFun + (h_agree ⟨0, Nat.zero_lt_succ fuel⟩ (Nat.zero_lt_succ _)) s) q + let shifted₁ : Fin fuel → S → Q → R × S := + fun i => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + let shifted₂ : Fin fuel → S → Q → R × S := + fun i => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ + have h_shift : ∀ (i : Fin fuel), i.val < idx → shifted₁ i = shifted₂ i := by + intro i hi + exact h_agree ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩ (Nat.succ_lt_succ hi) + have h_tail := ih + (k (oracle₁ ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + fuel shifted₁ shifted₂ + (oracle₁ ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 + h_shift + have h_rhs : + queryAtWithState + (k (oracle₁ ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + fuel shifted₂ + (oracle₁ ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 idx = + queryAtWithState + (k (oracle₂ ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + fuel shifted₂ + (oracle₂ ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 idx := + congrArg + (fun p : R × S => queryAtWithState (k p.1) fuel shifted₂ p.2 idx) h0 + exact (by + simpa [shifted₁, shifted₂] using h_tail.trans h_rhs) + +/-- If `assocLookup key map = some v`, then the pair `(key, v)` occurs in +the association list. -/ +private lemma assocLookup_some_mem {α β : Type} [DecidableEq α] + (key : α) (map : List (α × β)) (v : β) + (h : assocLookup key map = some v) : + (key, v) ∈ map := by + induction map with + | nil => + simp [assocLookup] at h + | cons kv rest ih => + rcases kv with ⟨k, v'⟩ + by_cases hk : k = key + · subst hk + have hv : v' = v := by + simpa [assocLookup] using h + subst hv + exact List.mem_cons.mpr (Or.inl rfl) + · have hrest : assocLookup key rest = some v := by + simpa [assocLookup, hk] using h + exact List.mem_cons.mpr (Or.inr (ih hrest)) + +/-- The `idx`-th query in the LazyROM interaction. -/ +private noncomputable def lazyQueryAt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (idx : Nat) : + Option (Msg n ⊕ (Msg n × P.Commitment n)) := + queryAtWithState (A.interact n y) (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w y rs ch) [] idx + +/-- LazyROM map state just before query index `idx` (if that query exists). -/ +private noncomputable def lazyMapBefore {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (idx : Nat) : + Option (MapState P Msg n) := + stateBeforeWithState (A.interact n y) (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w y rs ch) [] idx + +/-- Prefix-independence for `lazyQueryAt`: changing prover randomness at +indices `≥ idx` does not change the `idx`-th query. -/ +private theorem lazyQueryAt_eq_of_rs_prefix {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs₁ rs₂ : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (idx : Nat) + (h_prefix : ∀ i : Fin (A.numQueries n), i.val < idx → rs₁ i = rs₂ i) : + lazyQueryAt P Msg A n w y rs₁ ch idx = + lazyQueryAt P Msg A n w y rs₂ ch idx := by + apply queryAtWithState_eq_of_prefix (interaction := A.interact n y) + intro i hi + funext st qry + cases qry with + | inr mt => + simp [lazyRomOracle] + | inl m => + simp [lazyRomOracle, h_prefix i hi] + +/-- Commitment inserted into the LazyROM map at query index `i`, if any. + +At a signing query this is `commit(w, y, rs i)`, while at a hash query it is +the queried commitment. -/ +private noncomputable def lazyInsertedCommitAt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (i : Fin (A.numQueries n)) : + Option (P.Commitment n) := + match lazyQueryAt P Msg A n w y rs ch i.val with + | some (.inl _) => some (P.commit n w y (rs i)) + | some (.inr (_, t)) => some t + | none => none + +/-- Pair event at `(i,j)`: the `j`-th query is a signing query and its +commitment matches a commitment already inserted at index `i < j`. -/ +private noncomputable def lazyPairCommitReuse {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (i j : Fin (A.numQueries n)) : Bool := + match lazyInsertedCommitAt P Msg A n w y rs ch i, + lazyQueryAt P Msg A n w y rs ch j.val with + | some ti, some (.inl _) => + decide (ti = P.commit n w y (rs j)) + | _, _ => false + +/-- If two prover-randomness vectors agree on indices `< j`, then for any +`i < j` they induce the same inserted commitment at index `i`. -/ +private theorem lazyInsertedCommitAt_eq_of_rs_prefix_lt {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs₁ rs₂ : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (i j : Fin (A.numQueries n)) + (hij : i.val < j.val) + (h_prefix : ∀ k : Fin (A.numQueries n), k.val < j.val → rs₁ k = rs₂ k) : + lazyInsertedCommitAt P Msg A n w y rs₁ ch i = + lazyInsertedCommitAt P Msg A n w y rs₂ ch i := by + unfold lazyInsertedCommitAt + have hq : lazyQueryAt P Msg A n w y rs₁ ch i.val = + lazyQueryAt P Msg A n w y rs₂ ch i.val := by + apply lazyQueryAt_eq_of_rs_prefix + intro k hk + exact h_prefix k (lt_trans hk hij) + rw [hq] + simp [h_prefix i hij] + +/-- Per-pair bound: for `i < j`, the probability that LazyROM has a +commitment reuse at `(i,j)` is at most `δ`. -/ +private theorem lazyPairCommitReuse_pair_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) + (i j : Fin (A.numQueries n)) + (hij : i.val < j.val) : + uniformExpect + ((R.Witness n × (Fin (A.numQueries n) → P.ProverRandomness n)) × + (Fin (A.numQueries n) → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j then (1 : ℝ) else 0) + ≤ δ n := by + classical + let q := A.numQueries n + -- Reorder expectations as E_w E_ch E_rs + have h_reorder : + uniformExpect ((R.Witness n × (Fin q → P.ProverRandomness n)) × + (Fin q → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j then (1 : ℝ) else 0) = + uniformExpect (R.Witness n) (fun w => + uniformExpect (Fin q → P.Challenge n) (fun ch => + uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + then (1 : ℝ) else 0))) := by + rw [uniformExpect_prod, uniformExpect_prod] + congr 1 + ext w + exact uniformExpect_comm + (Fin q → P.ProverRandomness n) (Fin q → P.Challenge n) + (fun rs ch => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j then (1 : ℝ) else 0) + rw [h_reorder] + -- Inner bound for fixed (w, ch) + have h_inner : ∀ (w : R.Witness n) (ch : Fin q → P.Challenge n), + uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j then (1 : ℝ) else 0) + ≤ δ n := by + intro w ch + let y := kg.keyOf n w + let e := Equiv.funSplitAt j (P.ProverRandomness n) + let g : (Fin (A.numQueries n) → P.ProverRandomness n) → ℝ := fun rs => + if lazyPairCommitReuse P Msg A n w y rs ch i j then (1 : ℝ) else 0 + have h_split : + uniformExpect (Fin (A.numQueries n) → P.ProverRandomness n) g = + uniformExpect + (P.ProverRandomness n × ({k : Fin (A.numQueries n) // k ≠ j} → P.ProverRandomness n)) + (fun p => g (e.symm p)) := by + have h_tmp := uniformExpect_congr e + (fun p : P.ProverRandomness n × + ({k : Fin (A.numQueries n) // k ≠ j} → P.ProverRandomness n) => + g (e.symm p)) + have h_left : ((fun p : P.ProverRandomness n × + ({k : Fin (A.numQueries n) // k ≠ j} → P.ProverRandomness n) => + g (e.symm p)) ∘ e) = g := by + funext rs + exact congrArg g (e.left_inv rs) + simpa [h_left] using h_tmp + rw [h_split, uniformExpect_prod] + rw [uniformExpect_comm] + -- For each fixed `rest`, the only remaining randomness is `rj` + have h_rest : + ∀ rest : {k : Fin (A.numQueries n) // k ≠ j} → P.ProverRandomness n, + uniformExpect (P.ProverRandomness n) (fun rj => + g (e.symm (rj, rest))) ≤ δ n := by + intro rest + let r0 : P.ProverRandomness n := (P.proverRandomnessNonempty n).some + let rs0 : Fin (A.numQueries n) → P.ProverRandomness n := e.symm (r0, rest) + have h_prefix_of_rj : + ∀ (rj : P.ProverRandomness n) (k : Fin (A.numQueries n)), k.val < j.val → + (e.symm (rj, rest)) k = rs0 k := by + intro rj k hk + have hk_ne : k ≠ j := Fin.ne_of_lt hk + have h_left : (e.symm (rj, rest)) k = rest ⟨k, hk_ne⟩ := by + simp [e, Equiv.funSplitAt, Equiv.piSplitAt, hk_ne] + have h_right : rs0 k = rest ⟨k, hk_ne⟩ := by + simp [rs0, e, Equiv.funSplitAt, Equiv.piSplitAt, hk_ne] + exact h_left.trans h_right.symm + have hδ_nonneg : 0 ≤ δ n := by + have htmp := h_unpred n w y (P.commit n w y r0) (kg.keyOf_valid n w) + exact le_trans (uniformExpect_nonneg _ (fun _ => by split <;> norm_num)) htmp + cases h_ins0 : lazyInsertedCommitAt P Msg A n w y rs0 ch i with + | none => + have h_point : ∀ rj : P.ProverRandomness n, g (e.symm (rj, rest)) = 0 := by + intro rj + have h_ins_rj : + lazyInsertedCommitAt P Msg A n w y (e.symm (rj, rest)) ch i = + lazyInsertedCommitAt P Msg A n w y rs0 ch i := by + apply lazyInsertedCommitAt_eq_of_rs_prefix_lt P Msg A n w y + (e.symm (rj, rest)) rs0 ch i j hij + intro k hk + exact h_prefix_of_rj rj k hk + unfold g lazyPairCommitReuse + rw [h_ins_rj, h_ins0] + simp + rw [show (fun rj => g (e.symm (rj, rest))) = fun _ => (0 : ℝ) from by + funext rj; exact h_point rj, + uniformExpect_const] + exact hδ_nonneg + | some ti => + cases h_qj0 : lazyQueryAt P Msg A n w y rs0 ch j.val with + | none => + have h_point : ∀ rj : P.ProverRandomness n, g (e.symm (rj, rest)) = 0 := by + intro rj + have h_ins_rj : + lazyInsertedCommitAt P Msg A n w y (e.symm (rj, rest)) ch i = + lazyInsertedCommitAt P Msg A n w y rs0 ch i := by + apply lazyInsertedCommitAt_eq_of_rs_prefix_lt P Msg A n w y + (e.symm (rj, rest)) rs0 ch i j hij + intro k hk + exact h_prefix_of_rj rj k hk + have h_qj_rj : + lazyQueryAt P Msg A n w y (e.symm (rj, rest)) ch j.val = + lazyQueryAt P Msg A n w y rs0 ch j.val := by + apply lazyQueryAt_eq_of_rs_prefix P Msg A n w y + (e.symm (rj, rest)) rs0 ch j.val + intro k hk + exact h_prefix_of_rj rj k hk + unfold g lazyPairCommitReuse + rw [h_ins_rj, h_qj_rj, h_qj0] + simp + rw [show (fun rj => g (e.symm (rj, rest))) = fun _ => (0 : ℝ) from by + funext rj; exact h_point rj, + uniformExpect_const] + exact hδ_nonneg + | some qj => + cases qj with + | inr mt => + have h_point : ∀ rj : P.ProverRandomness n, g (e.symm (rj, rest)) = 0 := by + intro rj + have h_ins_rj : + lazyInsertedCommitAt P Msg A n w y (e.symm (rj, rest)) ch i = + lazyInsertedCommitAt P Msg A n w y rs0 ch i := by + apply lazyInsertedCommitAt_eq_of_rs_prefix_lt P Msg A n w y + (e.symm (rj, rest)) rs0 ch i j hij + intro k hk + exact h_prefix_of_rj rj k hk + have h_qj_rj : + lazyQueryAt P Msg A n w y (e.symm (rj, rest)) ch j.val = + lazyQueryAt P Msg A n w y rs0 ch j.val := by + apply lazyQueryAt_eq_of_rs_prefix P Msg A n w y + (e.symm (rj, rest)) rs0 ch j.val + intro k hk + exact h_prefix_of_rj rj k hk + unfold g lazyPairCommitReuse + rw [h_ins_rj, h_qj_rj, h_qj0] + simp + rw [show (fun rj => g (e.symm (rj, rest))) = fun _ => (0 : ℝ) from by + funext rj; exact h_point rj, + uniformExpect_const] + exact hδ_nonneg + | inl mj => + have h_point : ∀ rj : P.ProverRandomness n, + g (e.symm (rj, rest)) = + (if ti = P.commit n w y rj then (1 : ℝ) else 0) := by + intro rj + have h_ins_rj : + lazyInsertedCommitAt P Msg A n w y (e.symm (rj, rest)) ch i = + lazyInsertedCommitAt P Msg A n w y rs0 ch i := by + apply lazyInsertedCommitAt_eq_of_rs_prefix_lt P Msg A n w y + (e.symm (rj, rest)) rs0 ch i j hij + intro k hk + exact h_prefix_of_rj rj k hk + have h_qj_rj : + lazyQueryAt P Msg A n w y (e.symm (rj, rest)) ch j.val = + lazyQueryAt P Msg A n w y rs0 ch j.val := by + apply lazyQueryAt_eq_of_rs_prefix P Msg A n w y + (e.symm (rj, rest)) rs0 ch j.val + intro k hk + exact h_prefix_of_rj rj k hk + unfold g lazyPairCommitReuse + rw [h_ins_rj, h_qj_rj, h_ins0, h_qj0] + have h_jcoord : (e.symm (rj, rest)) j = rj := by + simp [e, Equiv.funSplitAt, Equiv.piSplitAt] + rw [h_jcoord] + simp [decide_eq_true_eq] + rw [show (fun rj => g (e.symm (rj, rest))) = + (fun rj => if ti = P.commit n w y rj then (1 : ℝ) else 0) from by + funext rj; exact h_point rj] + simpa [eq_comm] using h_unpred n w y ti (kg.keyOf_valid n w) + exact le_trans (uniformExpect_mono _ h_rest) (le_of_eq (uniformExpect_const _ _)) + have h_inner_w : ∀ w : R.Witness n, + uniformExpect (Fin q → P.Challenge n) (fun ch => + uniformExpect (Fin q → P.ProverRandomness n) (fun rs => + if lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j then (1 : ℝ) else 0)) + ≤ δ n := by + intro w + exact le_trans (uniformExpect_mono _ (h_inner w)) (le_of_eq (uniformExpect_const _ _)) + exact le_trans (uniformExpect_mono _ h_inner_w) (le_of_eq (uniformExpect_const _ _)) + +/-- Union bound over all pairs `(i,j)`: probability of any LazyROM commitment +reuse event is at most `q² · δ`. -/ +private theorem lazyCommitReuse_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + uniformExpect + ((R.Witness n × (Fin (A.numQueries n) → P.ProverRandomness n)) × + (Fin (A.numQueries n) → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if ∃ (i j : Fin (A.numQueries n)), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + then (1 : ℝ) else 0) + ≤ (A.numQueries n : ℝ) ^ 2 * δ n := by + classical + let q := A.numQueries n + have h_union : ∀ (w : R.Witness n) (rs : Fin q → P.ProverRandomness n) + (ch : Fin q → P.Challenge n), + (if ∃ (i j : Fin q), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + then (1 : ℝ) else 0) ≤ + ∑ p : Fin q × Fin q, + if p.1.val < p.2.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch p.1 p.2 + then 1 else 0 := by + intro w rs ch + split + · rename_i h + obtain ⟨i, j, hij, hpair⟩ := h + have h_nonneg : ∀ p ∈ (Finset.univ : Finset (Fin q × Fin q)), + (0 : ℝ) ≤ + (if p.1.val < p.2.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch p.1 p.2 + then 1 else 0) := + fun p _ => ite_nonneg zero_le_one (le_refl 0) + have h_single := Finset.single_le_sum h_nonneg (Finset.mem_univ (i, j)) + have h_ij : + (if (i : Fin q).val < j.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + then (1 : ℝ) else 0) = 1 := if_pos ⟨hij, hpair⟩ + linarith + · rename_i hfalse + exact Finset.sum_nonneg fun p _ => ite_nonneg zero_le_one (le_refl 0) + have h_pair : ∀ (p : Fin q × Fin q), + uniformExpect + ((R.Witness n × (Fin q → P.ProverRandomness n)) × (Fin q → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if p.1.val < p.2.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch p.1 p.2 + then (1 : ℝ) else 0) ≤ δ n := by + intro p + rcases p with ⟨i, j⟩ + by_cases hij : i.val < j.val + · have := lazyPairCommitReuse_pair_bound P Msg kg A n δ h_unpred i j hij + exact le_trans + (uniformExpect_mono _ (fun ⟨⟨w, rs⟩, ch⟩ => by + by_cases hpair : lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + · simp [hij, hpair] + · simp [hij, hpair])) + this + · have h_zero : + (fun x : + (R.Witness n × (Fin q → P.ProverRandomness n)) × (Fin q → P.Challenge n) => + if i.val < j.val ∧ + lazyPairCommitReuse P Msg A n x.1.1 (kg.keyOf n x.1.1) x.1.2 x.2 i j + then (1 : ℝ) else 0) = fun _ => 0 := by + funext x + simp [hij] + rw [h_zero, uniformExpect_const] + have hδ_nonneg : 0 ≤ δ n := by + let r0 : P.ProverRandomness n := (P.proverRandomnessNonempty n).some + have htmp := h_unpred n (Classical.arbitrary (R.Witness n)) + (kg.keyOf n (Classical.arbitrary (R.Witness n))) + (P.commit n (Classical.arbitrary (R.Witness n)) + (kg.keyOf n (Classical.arbitrary (R.Witness n))) r0) + (kg.keyOf_valid n (Classical.arbitrary (R.Witness n))) + exact le_trans (uniformExpect_nonneg _ (fun _ => by split <;> norm_num)) htmp + exact hδ_nonneg + calc uniformExpect + ((R.Witness n × (Fin q → P.ProverRandomness n)) × (Fin q → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if ∃ (i j : Fin q), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j + then (1 : ℝ) else 0) + ≤ uniformExpect + ((R.Witness n × (Fin q → P.ProverRandomness n)) × (Fin q → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + ∑ p : Fin q × Fin q, + if p.1.val < p.2.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch p.1 p.2 + then 1 else 0) := + uniformExpect_mono _ (fun ⟨⟨w, rs⟩, ch⟩ => h_union w rs ch) + _ = ∑ p : Fin q × Fin q, + uniformExpect + ((R.Witness n × (Fin q → P.ProverRandomness n)) × (Fin q → P.Challenge n)) + (fun ⟨⟨w, rs⟩, ch⟩ => + if p.1.val < p.2.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch p.1 p.2 + then 1 else 0) := + uniformExpect_finset_sum _ + _ ≤ ∑ _p : Fin q × Fin q, δ n := + Finset.sum_le_sum (fun p _ => h_pair p) + _ = (Fintype.card (Fin q × Fin q) : ℝ) * δ n := by + simp [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + _ ≤ (q : ℝ) ^ 2 * δ n := by + simp [Fintype.card_prod, Fintype.card_fin]; ring_nf; exact le_refl _ + +/-- Single-step lookup persistence for `mapGameRealOracle`: if `(mf, tf)` is +already in the map and the query is not a signing query for `mf`, the lookup +is preserved. -/ +private theorem mapGameRealOracle_lookup_persist {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (ch : Fin q → P.Challenge n) + (i : Fin q) (map : MapState P Msg n) + (mf : Msg n) (tf : P.Commitment n) (v : P.Challenge n) + (qry : Msg n ⊕ (Msg n × P.Commitment n)) + (h_lookup : assocLookup (mf, tf) map = some v) + (h_not_sign_mf : ∀ m, qry = .inl m → m ≠ mf) : + assocLookup (mf, tf) (mapGameRealOracle P Msg n q w y rs ch i map qry).2 = some v := by + letI := P.commitmentDecEq n + cases qry with + | inl m => + simp only [mapGameRealOracle] + have hne : m ≠ mf := h_not_sign_mf m rfl + simp only [assocLookup] + rw [if_neg (fun h => hne (Prod.mk.inj h).1)] + exact h_lookup + | inr mt => + simp only [mapGameRealOracle] + cases hlk : assocLookup (mt.1, mt.2) map with + | some c => exact h_lookup + | none => + simp only [assocLookup] + have hne : ¬ ((mt.1, mt.2) = (mf, tf)) := by + intro heq; rw [Prod.mk.injEq] at heq; rw [heq.1, heq.2] at hlk + simp [hlk] at h_lookup + rw [if_neg hne] + exact h_lookup + +/-- The query log produced by `runWithState` has length at most `fuel`. -/ +private theorem runWithState_length_le {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (queries : List Q) (a : A) (sf : S), + interaction.runWithState fuel oracle s = some (queries, a, sf) → + queries.length ≤ fuel := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => + intro oracle s queries a sf h + cases interaction with + | done _ => + change some ([], _, _) = some (queries, a, sf) at h + obtain ⟨rfl, _, _⟩ := Prod.mk.inj (Option.some.inj h) + simp + | query _ _ => exact absurd h nofun + | succ n ih => + intro oracle s queries a sf h + cases interaction with + | done _ => + change some ([], _, _) = some (queries, a, sf) at h + obtain ⟨rfl, _, _⟩ := Prod.mk.inj (Option.some.inj h) + simp + | query q k => + simp only [OracleInteraction.runWithState] at h + split at h + · exact absurd h nofun + · have hinj := Option.some.inj h + obtain ⟨rfl, rfl, rfl⟩ := Prod.mk.inj hinj + simp only [List.length_cons] + exact Nat.succ_le_succ (ih _ _ _ _ _ _ (by assumption)) + +/-- `runWithState` final state equals `stateBeforeWithState` at `queries.length`. -/ +private theorem runWithState_finalState_eq_stateBeforeWithState {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (queries : List Q) (a : A) (sf : S), + interaction.runWithState fuel oracle s = some (queries, a, sf) → + stateBeforeWithState interaction fuel oracle s queries.length = some sf := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => + intro oracle s queries a sf h + cases interaction with + | done a' => + simp only [OracleInteraction.runWithState, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, _, rfl⟩ := h; simp [stateBeforeWithState] + | query _ _ => + simp only [OracleInteraction.runWithState] at h; contradiction + | succ fuel ih => + intro oracle s queries a sf h + cases interaction with + | done a' => + simp only [OracleInteraction.runWithState, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, _, rfl⟩ := h; simp [stateBeforeWithState] + | query q k => + simp only [OracleInteraction.runWithState] at h + split at h + · simp at h + · next qs' a' hrec => + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + simp only [stateBeforeWithState, List.length_cons] + exact ih _ _ _ _ _ _ hrec + +/-- `runWithState` query list entries match `queryAtWithState`. -/ +private theorem runWithState_query_eq_queryAtWithState {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (queries : List Q) (a : A) (sf : S), + interaction.runWithState fuel oracle s = some (queries, a, sf) → + ∀ (idx : Nat) (hlt : idx < queries.length), + queryAtWithState interaction fuel oracle s idx = some (queries.get ⟨idx, hlt⟩) := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => + intro oracle s queries a sf h + cases interaction with + | done a' => + simp only [OracleInteraction.runWithState, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, _, _⟩ := h + intro idx hlt; simp at hlt + | query _ _ => + simp only [OracleInteraction.runWithState] at h; contradiction + | succ fuel ih => + intro oracle s queries a sf h + cases interaction with + | done a' => + simp only [OracleInteraction.runWithState, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, _, _⟩ := h + intro idx hlt; simp at hlt + | query q k => + simp only [OracleInteraction.runWithState] at h + split at h + · simp at h + · next qs' a' hrec => + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + intro idx hlt + cases idx with + | zero => simp [queryAtWithState] + | succ idx' => + simp only [queryAtWithState, List.get_cons_succ] + exact ih _ _ _ _ _ _ hrec idx' (by simpa [List.length_cons] using hlt) + +/-- At index 0, `stateBeforeWithState` always returns the initial state. -/ +private theorem stateBeforeWithState_at_zero {Q R A S : Type} + (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) : + stateBeforeWithState interaction fuel oracle s 0 = some s := by + cases interaction with + | done _ => rfl + | query _ _ => cases fuel <;> rfl + +/-- If `stateBeforeWithState` at `idx+1` is `some`, then so are the state and +query at `idx`, and they compose via the oracle. -/ +private theorem stateBeforeWithState_pred {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (idx : Nat) (hidx : idx < fuel) (st' : S), + stateBeforeWithState interaction fuel oracle s (idx + 1) = some st' → + ∃ (st : S) (qry : Q), + stateBeforeWithState interaction fuel oracle s idx = some st ∧ + queryAtWithState interaction fuel oracle s idx = some qry ∧ + st' = (oracle ⟨idx, hidx⟩ st qry).2 := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => intro _ _ _ _ hidx; omega + | succ fuel ih => + intro oracle s idx hidx st' h_step + cases interaction with + | done a => + cases idx with + | zero => simp [stateBeforeWithState] at h_step + | succ _ => simp [stateBeforeWithState] at h_step + | query q k => + cases idx with + | zero => + simp only [stateBeforeWithState] at h_step + have h0 := stateBeforeWithState_at_zero + (k (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) fuel + (fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 + rw [h0] at h_step + exact ⟨s, q, rfl, rfl, (Option.some.inj h_step).symm⟩ + | succ idx' => + simp only [stateBeforeWithState] at h_step + have ih_result := ih (k (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + (fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 + idx' (by omega) st' h_step + obtain ⟨st, qry, h_st, h_qry, h_eq⟩ := ih_result + simp only [stateBeforeWithState, queryAtWithState] + exact ⟨st, qry, h_st, h_qry, h_eq⟩ + +/-- The state at step `idx + 1` is obtained by applying the oracle at step `idx` +to the state and query at step `idx`. -/ +private theorem stateBeforeWithState_step {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (idx : Nat) (hidx : idx < fuel) (st : S) (qry : Q), + stateBeforeWithState interaction fuel oracle s idx = some st → + queryAtWithState interaction fuel oracle s idx = some qry → + stateBeforeWithState interaction fuel oracle s (idx + 1) = + some (oracle ⟨idx, hidx⟩ st qry).2 := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => intro _ _ _ _ hidx; omega + | succ fuel ih => + intro oracle s idx hidx st qry h_st h_qry + cases interaction with + | done a => + cases idx with + | zero => simp [queryAtWithState] at h_qry + | succ _ => simp [stateBeforeWithState] at h_st + | query q k => + cases idx with + | zero => + simp only [stateBeforeWithState, Option.some.injEq] at h_st + simp only [queryAtWithState, Option.some.injEq] at h_qry + subst h_st; subst h_qry + simp only [stateBeforeWithState] + cases (k (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) with + | done a => cases fuel <;> simp [stateBeforeWithState] + | query _ _ => cases fuel <;> simp [stateBeforeWithState] + | succ idx' => + simp only [stateBeforeWithState] at h_st ⊢ + simp only [queryAtWithState] at h_qry + exact ih (k (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + (fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 + idx' (by omega) st qry h_st h_qry + +/-- Single-step preservation: `mapGameRealOracle` preserves +`assocLookup key st = none` when the query doesn't insert `key`. -/ +private theorem mapGameReal_step_preserves_none {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (n : ℕ) (q : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin q → P.ProverRandomness n) + (ch : Fin q → P.Challenge n) + (i : Fin q) (st : MapState P Msg n) + (qry : Msg n ⊕ (Msg n × P.Commitment n)) + (key : Msg n × P.Commitment n) + (h_none : assocLookup key st = none) + (h_not_hash : qry ≠ Sum.inr key) + (h_not_sign : ∀ m, qry = Sum.inl m → m ≠ key.1) : + assocLookup key (mapGameRealOracle P Msg n q w y rs ch i st qry).2 = none := by + letI := P.commitmentDecEq n + cases qry with + | inl m => + simp only [mapGameRealOracle, assocLookup] + have hne : m ≠ key.1 := h_not_sign m rfl + rw [if_neg (fun h => hne (Prod.mk.inj h).1)] + exact h_none + | inr mt => + simp only [mapGameRealOracle] + cases hlk : assocLookup mt st with + | some c => exact h_none + | none => + simp only [assocLookup] + have hne : mt ≠ key := fun h => h_not_hash (congrArg Sum.inr h) + rw [if_neg hne] + exact h_none + +/-- In the mapGameRealOracle execution, if the forged message was never signed +and the first hash query for the forgery key is at index `j`, then the final +map associates the forgery key with `ch j`. -/ +private theorem mapGameRealOracle_finalMap_lookup {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (queries : List (Msg n ⊕ (Msg n × P.Commitment n))) + (mf : Msg n) (tf : P.Commitment n) (zf : P.Response n) + (finalMap : MapState P Msg n) + (h_result : (A.interact n y).runWithState (A.numQueries n) + (mapGameRealOracle P Msg n (A.numQueries n) w y rs ch) [] = + some (queries, (mf, tf, zf), finalMap)) + (hj : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n) + (hj_in : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < queries.length) + (h_not_signed : (List.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) queries).contains mf = false) : + assocLookup (mf, tf) finalMap = + some (ch ⟨List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries, hj⟩) := by + set j := List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries with j_def + set oracle := mapGameRealOracle P Msg n (A.numQueries n) w y rs ch + have h_final := runWithState_finalState_eq_stateBeforeWithState _ _ _ _ _ _ _ h_result + have h_query := runWithState_query_eq_queryAtWithState _ _ _ _ _ _ _ h_result + letI := P.commitmentDecEq n + have h_len_le := runWithState_length_le _ _ _ _ _ _ _ h_result + -- Sub-claim: no signing query has message mf + have h_not_sign_any : ∀ (i : Nat) (hi : i < queries.length) (m : Msg n), + queries.get ⟨i, hi⟩ = .inl m → m ≠ mf := by + intro i hi m hqi hmf; rw [hmf] at hqi + have hmem : Sum.inl mf ∈ queries := by rw [← hqi]; exact List.getElem_mem hi + have hfm : mf ∈ queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) := + List.mem_filterMap.mpr ⟨.inl mf, hmem, rfl⟩ + have h_ct := List.contains_iff_mem.mpr hfm + rw [h_ct] at h_not_signed + exact Bool.noConfusion h_not_signed + -- Sub-claim: before step j, no hash query matches (mf, tf) + have h_not_hash_before : ∀ (i : Nat), i < j → + ∀ (hi : i < queries.length), queries.get ⟨i, hi⟩ ≠ .inr (mf, tf) := by + intro i hi_lt_j hi hqi + exact absurd hqi (by + have := List.not_of_lt_findIdx (j_def ▸ hi_lt_j) + simpa using this) + -- Main proof by forward induction + suffices ∀ (k : Nat) (hk : k ≤ queries.length), + ∃ st, stateBeforeWithState (A.interact n y) (A.numQueries n) oracle [] k = some st ∧ + (k ≤ j → assocLookup (mf, tf) st = none) ∧ + (j < k → assocLookup (mf, tf) st = some (ch ⟨j, hj⟩)) by + obtain ⟨st, h_st, _, h_after⟩ := this queries.length le_rfl + rw [h_final] at h_st; cases h_st + exact h_after (by omega) + intro k + induction k with + | zero => + intro _ + exact ⟨[], stateBeforeWithState_at_zero _ _ _ _, fun _ => rfl, fun h => absurd h (by omega)⟩ + | succ k' ih => + intro hk + obtain ⟨st_prev, h_prev, h_none_if, h_some_if⟩ := ih (by omega) + have hk'_fuel : k' < A.numQueries n := by omega + -- Get query at step k' + have hk'_len : k' < queries.length := by omega + have h_qk : queryAtWithState (A.interact n y) (A.numQueries n) oracle [] k' = + some (queries.get ⟨k', hk'_len⟩) := h_query k' hk'_len + -- Step forward + have h_step := stateBeforeWithState_step _ _ _ _ k' hk'_fuel st_prev + (queries.get ⟨k', hk'_len⟩) h_prev h_qk + set st_next := (oracle ⟨k', hk'_fuel⟩ st_prev (queries.get ⟨k', hk'_len⟩)).2 + refine ⟨st_next, h_step, fun hle => ?_, fun hlt => ?_⟩ + · -- k'+1 ≤ j, so k' < j: lookup stays none + have h_prev_none := h_none_if (by omega) + exact mapGameReal_step_preserves_none P Msg n (A.numQueries n) w y rs ch + ⟨k', hk'_fuel⟩ st_prev (queries.get ⟨k', hk'_len⟩) (mf, tf) h_prev_none + (h_not_hash_before k' (by omega) hk'_len) + (fun m hm => h_not_sign_any k' hk'_len m hm) + · -- j < k'+1, so j ≤ k' + by_cases hjk : j = k' + · -- k' = j: this is the insertion step + subst hjk + have h_prev_none := h_none_if le_rfl + -- Query at step j is .inr (mf, tf) + have h_qj_eq : queries.get ⟨j, hk'_len⟩ = .inr (mf, tf) := by + have := List.findIdx_getElem (w := hj_in) + simp only [decide_eq_true_eq] at this; exact this + -- Oracle inserts (mf, tf) since assocLookup is none + change assocLookup (mf, tf) st_next = some (ch ⟨j, hj⟩) + simp only [st_next, oracle, h_qj_eq, mapGameRealOracle, h_prev_none, assocLookup] + simp + · -- k' > j: lookup persists from previous step + have h_prev_some := h_some_if (by omega) + change assocLookup (mf, tf) st_next = some (ch ⟨j, hj⟩) + exact mapGameRealOracle_lookup_persist P Msg n (A.numQueries n) w y rs ch + ⟨k', hk'_fuel⟩ st_prev mf tf (ch ⟨j, hj⟩) (queries.get ⟨k', hk'_len⟩) + h_prev_some (fun m hm => h_not_sign_any k' hk'_len m hm) + +/-- Entries in a stateful interaction's state came from the initial state +or were inserted by an oracle step. -/ +private theorem stateBeforeWithState_mem_source {Q R A : Type} {S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle : Fin fuel → S → Q → R × S) + (s : S) (idx : Nat) (st : S) + (P : S → Prop), + P s → + (∀ (j : Fin fuel) (sj : S) (qj : Q), P sj → P (oracle j sj qj).2) → + stateBeforeWithState interaction fuel oracle s idx = some st → + P st := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => + intro oracle s idx st P hP _ h_st + cases interaction with + | done _ => cases idx with + | zero => + simp only [stateBeforeWithState, Option.some.injEq] at h_st + subst h_st; exact hP + | succ _ => + simp only [stateBeforeWithState] at h_st + contradiction + | query _ _ => cases idx with + | zero => + simp only [stateBeforeWithState, Option.some.injEq] at h_st + subst h_st; exact hP + | succ _ => + simp only [stateBeforeWithState] at h_st + contradiction + | succ fuel ih => + intro oracle s idx st P hP hOracle h_st + cases interaction with + | done a => + cases idx with + | zero => + simp only [stateBeforeWithState, Option.some.injEq] at h_st + subst h_st; exact hP + | succ _ => + simp only [stateBeforeWithState] at h_st + contradiction + | query q k => + cases idx with + | zero => + simp only [stateBeforeWithState, Option.some.injEq] at h_st + subst h_st; exact hP + | succ idx' => + simp only [stateBeforeWithState] at h_st + exact ih (k (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).1) + (fun i => oracle ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle ⟨0, Nat.zero_lt_succ fuel⟩ s q).2 idx' st P + (hOracle ⟨0, Nat.zero_lt_succ fuel⟩ s q hP) + (fun j sj qj hPsj => hOracle ⟨j.val + 1, Nat.succ_lt_succ j.isLt⟩ sj qj hPsj) + h_st + +/-- Every entry in the lazy-oracle map at step `idx` has its commitment +component witnessed by `lazyInsertedCommitAt` at some earlier step. -/ +private theorem lazyMap_entry_commit_source {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (idx : Nat) (hidx : idx < A.numQueries n) + (st : MapState P Msg n) + (key : Msg n × P.Commitment n) (v : P.Challenge n) + (h_st : lazyMapBefore P Msg A n w y rs ch idx = some st) + (h_mem : (key, v) ∈ st) : + ∃ (i : Fin (A.numQueries n)), i.val < idx ∧ + lazyInsertedCommitAt P Msg A n w y rs ch i = some key.2 := by + induction idx generalizing st key v with + | zero => + unfold lazyMapBefore at h_st + rw [stateBeforeWithState_at_zero] at h_st + cases h_st; simp at h_mem + | succ k ih => + have hk : k < A.numQueries n := Nat.lt_of_succ_lt hidx + unfold lazyMapBefore at h_st + obtain ⟨map_k, qry_k, h_map_k, h_qry_k, h_eq⟩ := + stateBeforeWithState_pred _ _ _ _ k hk st h_st + rw [h_eq] at h_mem + letI := P.commitmentDecEq n + cases qry_k with + | inl m => + simp only [lazyRomOracle] at h_mem + cases hlookup : assocLookup (m, P.commit n w y (rs ⟨k, hk⟩)) map_k with + | some c => + simp only [hlookup] at h_mem + obtain ⟨i, hi_lt, hi⟩ := + ih hk map_k key v (by unfold lazyMapBefore; exact h_map_k) h_mem + exact ⟨i, by omega, hi⟩ + | none => + simp only [hlookup] at h_mem + cases h_mem with + | head => + refine ⟨⟨k, hk⟩, by change k < k + 1; omega, ?_⟩ + unfold lazyInsertedCommitAt lazyQueryAt + rw [h_qry_k] + | tail _ h_tail => + obtain ⟨i, hi_lt, hi⟩ := + ih hk map_k key v (by unfold lazyMapBefore; exact h_map_k) h_tail + exact ⟨i, by omega, hi⟩ + | inr mt => + simp only [lazyRomOracle] at h_mem + cases hlookup : assocLookup (mt.1, mt.2) map_k with + | some c => + simp only [hlookup] at h_mem + obtain ⟨i, hi_lt, hi⟩ := + ih hk map_k key v (by unfold lazyMapBefore; exact h_map_k) h_mem + exact ⟨i, by omega, hi⟩ + | none => + simp only [hlookup] at h_mem + cases h_mem with + | head => + refine ⟨⟨k, hk⟩, by change k < k + 1; omega, ?_⟩ + unfold lazyInsertedCommitAt lazyQueryAt + rw [h_qry_k] + | tail _ h_tail => + obtain ⟨i, hi_lt, hi⟩ := + ih hk map_k key v (by unfold lazyMapBefore; exact h_map_k) h_tail + exact ⟨i, by omega, hi⟩ + +/-- If a signing query at step `k` finds its commitment already in the map, +then a pair-reuse event exists. -/ +private theorem map_lookup_implies_pairReuse {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + (k : Nat) (hk : k < A.numQueries n) + (st : MapState P Msg n) + (m : Msg n) (c : P.Challenge n) + (h_st : lazyMapBefore P Msg A n w y rs ch k = some st) + (h_qry : lazyQueryAt P Msg A n w y rs ch k = some (Sum.inl m)) + (h_lookup : assocLookup (m, P.commit n w y (rs ⟨k, hk⟩)) st = some c) : + ∃ (i j : Fin (A.numQueries n)), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w y rs ch i j = true := by + have h_mem := assocLookup_some_mem _ _ _ h_lookup + obtain ⟨i, hi_lt, hi_commit⟩ := lazyMap_entry_commit_source P Msg A n w y rs ch + k hk st (m, P.commit n w y (rs ⟨k, hk⟩)) c h_st h_mem + refine ⟨i, ⟨k, hk⟩, hi_lt, ?_⟩ + unfold lazyPairCommitReuse + rw [hi_commit, show (⟨k, hk⟩ : Fin (A.numQueries n)).val = k from rfl, h_qry] + simp + +/-- If two oracles agree at every step on the `(state, query)` encountered +during execution with `oracle₁`, then `runWithState` produces the same result. -/ +private theorem runWithState_eq_of_oracle_agree_on_trace {Q R A S : Type} + : ∀ (interaction : OracleInteraction Q R A) + (fuel : Nat) (oracle₁ oracle₂ : Fin fuel → S → Q → R × S) + (s : S), + (∀ (k : Nat) (hk : k < fuel) (st : S) (q : Q), + stateBeforeWithState interaction fuel oracle₁ s k = some st → + queryAtWithState interaction fuel oracle₁ s k = some q → + oracle₁ ⟨k, hk⟩ st q = oracle₂ ⟨k, hk⟩ st q) → + interaction.runWithState fuel oracle₁ s = + interaction.runWithState fuel oracle₂ s := by + intro interaction fuel + induction fuel generalizing interaction with + | zero => intro _ _ _ _; cases interaction <;> rfl + | succ n ih => + intro oracle₁ oracle₂ s h + cases interaction with + | done => rfl + | query q k => + simp only [OracleInteraction.runWithState] + have h0 : oracle₁ ⟨0, Nat.zero_lt_succ n⟩ s q = + oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q := + h 0 (Nat.zero_lt_succ n) s q rfl rfl + rw [h0] + have h_ih := ih (k (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).1) + (fun (i : Fin n) => oracle₁ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (fun (i : Fin n) => oracle₂ ⟨i.val + 1, Nat.succ_lt_succ i.isLt⟩) + (oracle₂ ⟨0, Nat.zero_lt_succ n⟩ s q).2 + (fun k' hk' st' q' h_state h_query => by + have := h (k' + 1) (by omega) st' q' + (by simp only [stateBeforeWithState]; rw [h0]; exact h_state) + (by simp only [queryAtWithState]; rw [h0]; exact h_query) + exact this) + rw [h_ih] + +/-- If no pair-reuse event occurs, LazyROM and MapGame_Real produce the same +run statement for fixed coins. -/ +private theorem lazy_run_stmt_eq_mapGame_real_run_stmt_of_no_reuse {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (w : R.Witness n) (y : R.Statement n) + (rs : Fin (A.numQueries n) → P.ProverRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) : + (¬ ∃ (i j : Fin (A.numQueries n)), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w y rs ch i j = true) → + lazyRom_run_stmt P Msg A n w y rs ch = + mapGame_real_run_stmt P Msg A n w y rs ch := by + intro h_no_reuse + let q := A.numQueries n + letI := P.commitmentDecEq n + -- Step 1: Show the runWithState calls agree + have h_run_eq : (A.interact n y).runWithState q + (lazyRomOracle P Msg n q w y rs ch) [] = + (A.interact n y).runWithState q + (mapGameRealOracle P Msg n q w y rs ch) [] := by + apply runWithState_eq_of_oracle_agree_on_trace + intro k hk st qry h_st h_qry + cases qry with + | inr mt => + simp [lazyRomOracle, mapGameRealOracle] + | inl m => + unfold lazyRomOracle mapGameRealOracle + simp only + cases h_lookup : assocLookup (m, P.commit n w y (rs ⟨k, hk⟩)) st with + | none => rfl + | some c => + exfalso + exact h_no_reuse (map_lookup_implies_pairReuse P Msg A n w y rs ch + k hk st m c h_st h_qry h_lookup) + -- Step 2: Use the equality to simplify + simp only [lazyRom_run_stmt, mapGame_real_run_stmt] + have h_rw : (A.interact n y).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w y rs ch) [] = + (A.interact n y).runWithState (A.numQueries n) + (mapGameRealOracle P Msg n (A.numQueries n) w y rs ch) [] := h_run_eq + rw [h_rw] + cases h_result : (A.interact n y).runWithState (A.numQueries n) + (mapGameRealOracle P Msg n (A.numQueries n) w y rs ch) [] with + | none => rfl + | some val => + obtain ⟨queries, ⟨mf, tf, zf⟩, finalMap⟩ := val + simp only + split + next hj => + -- Split on whether j < queries.length (hash was actually queried) + by_cases hj_in : + List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < queries.length + · -- Hash WAS queried: use mapGameRealOracle_finalMap_lookup + simp only [hj_in, ↓reduceIte] + set signMsgs := List.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) queries + cases h_signed : signMsgs.contains mf with + | true => + simp only [Bool.not_true, Bool.and_false, Bool.false_eq_true, ↓reduceIte] + cases assocLookup (mf, tf) finalMap <;> rfl + | false => + have h_lookup := mapGameRealOracle_finalMap_lookup P Msg A n w y rs ch + queries mf tf zf finalMap h_result hj hj_in h_signed + simp only [h_lookup] + · -- Hash was NOT queried: both sides are none + simp only [hj_in, ↓reduceIte] + -- LHS: match assocLookup ... with | some c => ... | none => none = none + set signMsgs := List.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) queries + cases h_signed : signMsgs.contains mf with + | true => + simp only [Bool.not_true, Bool.and_false, Bool.false_eq_true, ↓reduceIte] + cases assocLookup (mf, tf) finalMap <;> rfl + | false => + have h_no_hash : Sum.inr (mf, tf) ∉ queries := by + intro hmem + apply hj_in + rw [List.findIdx_lt_length] + refine ⟨Sum.inr (mf, tf), hmem, ?_⟩ + dsimp + exact of_decide_eq_self_eq_true _ + have h_none : assocLookup (mf, tf) finalMap = none := by + set oracle := mapGameRealOracle P Msg n (A.numQueries n) w y rs ch + have h_final := runWithState_finalState_eq_stateBeforeWithState _ _ _ _ _ _ _ h_result + have h_query_at := runWithState_query_eq_queryAtWithState _ _ _ _ _ _ _ h_result + have h_len_le := runWithState_length_le _ _ _ _ _ _ _ h_result + -- No signing query has message mf + have h_not_sign_mf : ∀ (i : Nat) (hi : i < queries.length) (m : Msg n), + queries.get ⟨i, hi⟩ = .inl m → m ≠ mf := by + intro i hi m hqi hmf; rw [hmf] at hqi + have hmem : Sum.inl mf ∈ queries := by rw [← hqi]; exact List.getElem_mem hi + have hfm : mf ∈ signMsgs := List.mem_filterMap.mpr ⟨.inl mf, hmem, rfl⟩ + have h_ct := List.contains_iff_mem.mpr hfm + rw [h_ct] at h_signed + exact Bool.noConfusion h_signed + -- Forward induction: assocLookup stays none at every step + suffices ∀ k (hk : k ≤ queries.length), + ∃ st, stateBeforeWithState (A.interact n y) (A.numQueries n) + oracle [] k = some st ∧ + assocLookup (mf, tf) st = none by + obtain ⟨st, h_st, h_ans⟩ := this queries.length le_rfl + rw [h_final] at h_st; cases h_st; exact h_ans + intro k + induction k with + | zero => + intro _ + exact ⟨[], stateBeforeWithState_at_zero _ _ _ _, rfl⟩ + | succ k' ih => + intro hk + obtain ⟨st_prev, h_prev, h_prev_none⟩ := ih (by omega) + have hk'_fuel : k' < A.numQueries n := by omega + have hk'_len : k' < queries.length := by omega + have h_qk := h_query_at k' hk'_len + have h_step := stateBeforeWithState_step _ _ _ _ k' hk'_fuel st_prev + (queries.get ⟨k', hk'_len⟩) h_prev h_qk + refine ⟨_, h_step, ?_⟩ + exact mapGameReal_step_preserves_none P Msg n (A.numQueries n) w y rs ch + ⟨k', hk'_fuel⟩ st_prev (queries.get ⟨k', hk'_len⟩) (mf, tf) h_prev_none + (by intro h_eq; exact h_no_hash (by rw [← h_eq]; exact List.getElem_mem hk'_len)) + (fun m hm => h_not_sign_mf k' hk'_len m hm) + simp [h_none] + next hj => + rfl + +/-- `uniformExpect` does not depend on the particular `Fintype`/`Nonempty` +instances chosen for the sampling type. -/ +private theorem uniformExpect_inst_irrel {α : Type*} + [instF₀ : Fintype α] [instN₀ : Nonempty α] (f : α → ℝ) + (instF : Fintype α) (instN : Nonempty α) : + @uniformExpect α instF₀ instN₀ f = @uniformExpect α instF instN f := by + cases Subsingleton.elim instF₀ instF + cases Subsingleton.elim instN₀ instN + rfl + +/-- **Lazy sampling**: the ROM EUF-CMA advantage equals the LazyROM +advantage. The ROM game samples a full random function +`H : Msg × Comm → Ch` and evaluates it at ≤ q adaptively-chosen points. +By the lazy sampling principle, evaluating a uniform random function at +fresh points yields independent uniform values, which is exactly what +the per-query challenges `ch_i` provide. Cached values in the Map ensure +consistency on repeated queries, faithfully reproducing `H`. + +**Proof approach (future work):** Induction on `fuel` using +`Equiv.piSplitAt` to decompose the function space +`(X → Y) ≃ Y × ({x' // x' ≠ x₀} → Y)` at each query point. Requires: +- `uniformExpect_eval_at_point`: `E_{H:X→Y}[f(H(x))] = E_{y:Y}[f(y)]` +- Bridge between `run` (used by ROM) and `runWithState` (used by LazyROM) +- Strengthened IH tracking Map consistency with the random function -/ +private theorem rom_eq_lazy_rom {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) : + (ROM_EUF_CMA_Game P Msg kg).advantage A n = + lazyRom_advantage P Msg kg A n := by + simp only [ROM_EUF_CMA_Game, romCmaWinCondition, + List.contains_eq_mem, List.mem_filterMap, + Sum.exists, Option.some.injEq, exists_eq_right, reduceCtorEq, and_false, + exists_const, or_false, lazyRom_advantage, forkAcceptProb, + lazyRom_run, lazyRom_run_stmt, Bool.and_eq_true, Bool.not_eq_eq_eq_not, + Bool.not_true, decide_eq_false_iff_not] + conv_lhs => rw [uniformExpect_prod] + conv_rhs => rw [uniformExpect_prod] + congr 1 + ext wrs + rcases wrs with ⟨w, rs⟩ + let runPayoff : Option (List (Msg n ⊕ (Msg n × P.Commitment n)) × + (Msg n × P.Commitment n × P.Response n) × MapState P Msg n) → ℝ := + fun result => + letI := P.commitmentDecEq n + match result with + | none => 0 + | some (queries, (mf, tf, zf), finalMap) => + let j := queries.findIdx (fun x => decide (x = .inr (mf, tf))) + if hj : j < A.numQueries n then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + match assocLookup (mf, tf) finalMap with + | some c => boolToReal (P.verify n (kg.keyOf n w) tf c zf && !decide (mf ∈ signMsgs)) + | none => 0 + else 0 + have h_swap := + lazyRomH_runWithState_uniform_eq (P := P) (Msg := Msg) + n (A.numQueries n) (A.interact n (kg.keyOf n w)) w (kg.keyOf n w) rs + runPayoff + let rhsNested : (Fin (A.numQueries n) → P.Challenge n) → ℝ := fun ch => + match + (match + (A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs ch) [] with + | none => (none : Option (Fin (A.numQueries n) × + (Msg n × P.Commitment n × P.Response n))) + | some (queries, (mf, tf, zf), finalMap) => + if hj : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n then + match assocLookup (mf, tf) finalMap with + | some c => + if P.verify n (kg.keyOf n w) tf c zf && + !(List.filterMap (fun q : Msg n ⊕ (Msg n × P.Commitment n) => match q with + | Sum.inl m => some m + | Sum.inr _ => none) queries).contains mf then + some + (⟨List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries, hj⟩, + (mf, tf, zf)) + else none + | none => none + else (none : Option (Fin (A.numQueries n) × + (Msg n × P.Commitment n × P.Response n)))) + with + | none => 0 + | some _ => 1 + have h_rhs_fun : + (fun ch => + runPayoff ((A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs ch) [])) = + rhsNested := by + funext ch + let result := + (A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs ch) [] + cases h_result : result with + | none => + simp [rhsNested, runPayoff, boolToReal, result, h_result] + | some triple => + rcases triple with ⟨queries, forg, finalMap⟩ + rcases forg with ⟨mf, tf, zf⟩ + by_cases hj : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n + · cases h_lookup : assocLookup (mf, tf) finalMap with + | none => + simp [rhsNested, runPayoff, boolToReal, result, h_result, hj, h_lookup] + | some c => + have h_contains : + (List.filterMap (fun q => match q with + | Sum.inl m => some m + | Sum.inr _ => none) queries).contains mf = + decide (mf ∈ List.filterMap (fun q => match q with + | Sum.inl m => some m + | Sum.inr _ => none) queries) := by + simp + by_cases hverify : + (P.verify n (kg.keyOf n w) tf c zf && + !decide + (mf ∈ + List.filterMap + (fun q => + match q with + | Sum.inl m => some m + | Sum.inr _ => none) + queries)) = true + · simp [rhsNested, runPayoff, boolToReal, result, h_result, hj, h_lookup, + hverify] + · simp [rhsNested, runPayoff, boolToReal, result, h_result, hj, h_lookup, + hverify] + · simp [rhsNested, runPayoff, boolToReal, result, h_result, hj] + have h_main : + uniformExpect (Fin (A.numQueries n) → (Msg n × P.Commitment n → P.Challenge n)) + (fun Hs => + runPayoff + ((A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (fun i st qry => + lazyRomHOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs i (Hs i) st qry) [])) = + uniformExpect (Fin (A.numQueries n) → P.Challenge n) rhsNested := by + calc + uniformExpect (Fin (A.numQueries n) → (Msg n × P.Commitment n → P.Challenge n)) + (fun Hs => + runPayoff + ((A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (fun i st qry => + lazyRomHOracle P Msg n (A.numQueries n) + w (kg.keyOf n w) rs i (Hs i) st qry) [])) = + uniformExpect (Fin (A.numQueries n) → P.Challenge n) + (fun ch => + runPayoff ((A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs ch) [])) := by + simpa [runPayoff, boolToReal, lazyRomHOracle] using h_swap + _ = uniformExpect (Fin (A.numQueries n) → P.Challenge n) rhsNested := by + rw [h_rhs_fun] + let goalRhs : (Fin (A.numQueries n) → P.Challenge n) → ℝ := fun b => + match + match + (A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs b) [] with + | none => (none : Option (Fin (A.numQueries n) × + (Msg n × P.Commitment n × P.Response n))) + | some (queries, (mf, tf, zf), finalMap) => + if h : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n then + match assocLookup (mf, tf) finalMap with + | some c => + if P.verify n (kg.keyOf n w) tf c zf && + !(List.filterMap (fun q : Msg n ⊕ (Msg n × P.Commitment n) => match q with + | Sum.inl m => some m + | Sum.inr _ => none) queries).contains mf then + some + (⟨List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries, h⟩, + (mf, tf, zf)) + else none + | none => none + else (none : Option (Fin (A.numQueries n) × + (Msg n × P.Commitment n × P.Response n))) + with + | none => 0 + | some _ => 1 + have h_rhs_nested_eq_goal : rhsNested = goalRhs := by + funext b + let result := + (A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs b) [] + cases h_result : result with + | none => + simp [rhsNested, goalRhs, result, h_result] + | some triple => + rcases triple with ⟨queries, forg, finalMap⟩ + rcases forg with ⟨mf, tf, zf⟩ + by_cases hj : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n + · cases h_lookup : assocLookup (mf, tf) finalMap with + | none => + simp [rhsNested, goalRhs, result, h_result, hj, h_lookup] + | some c => + by_cases hcond : + (P.verify n (kg.keyOf n w) tf c zf && + !(List.filterMap + (fun q => + match q with + | Sum.inl m => some m + | Sum.inr _ => none) + queries).contains + mf) = true + · simp [rhsNested, goalRhs, result, h_result, hj, h_lookup] + · simp [rhsNested, goalRhs, result, h_result, hj, h_lookup] + · simp [rhsNested, goalRhs, result, h_result, hj] + conv_lhs => + arg 2 + ext Hs + simp [runPayoff, boolToReal, lazyRomHOracle] + refine h_main.trans ?_ + rw [h_rhs_nested_eq_goal] + apply congrArg (uniformExpect (Fin (A.numQueries n) → P.Challenge n)) + funext b + let result := + (A.interact n (kg.keyOf n w)).runWithState (A.numQueries n) + (lazyRomOracle P Msg n (A.numQueries n) w (kg.keyOf n w) rs b) [] + cases h_result : result with + | none => + simp [goalRhs, result, h_result] + | some triple => + rcases triple with ⟨queries, forg, finalMap⟩ + rcases forg with ⟨mf, tf, zf⟩ + by_cases hj : List.findIdx (fun x => decide (x = Sum.inr (mf, tf))) queries < A.numQueries n + · cases h_lookup : assocLookup (mf, tf) finalMap with + | none => + simp [goalRhs, result, h_result, hj, h_lookup] + | some c => + by_cases hcond : + (P.verify n (kg.keyOf n w) tf c zf && + !(List.filterMap + (fun q => + match q with + | Sum.inl m => some m + | Sum.inr _ => none) + queries).contains + mf) = true + · simp only [goalRhs, result, h_result, hj, h_lookup, List.contains_eq_mem, + List.mem_filterMap, Sum.exists, Option.some.injEq, exists_eq_right, + reduceCtorEq, and_false, exists_const, or_false, Bool.and_eq_true, + Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not] + conv_lhs => + rw [dif_pos (show True by trivial)] + rw [if_pos hcond] + simp + conv_rhs => + rw [dif_pos (show True by trivial)] + rw [if_pos hcond] + simp + · simp only [goalRhs, result, h_result, hj, h_lookup, List.contains_eq_mem, + List.mem_filterMap, Sum.exists, Option.some.injEq, exists_eq_right, + reduceCtorEq, and_false, exists_const, or_false, Bool.and_eq_true, + Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not] + conv_lhs => + rw [dif_pos (show True by trivial)] + rw [if_neg hcond] + simp + conv_rhs => + rw [dif_pos (show True by trivial)] + rw [if_neg hcond] + simp + · simp [goalRhs, result, h_result, hj] + +/-- **LazyROM ≤ MapGame_Real + q²δ**: the game hop from lazy ROM to +MapGame_Real. The two games use the same coin type +`(W × (Fin q → PR)) × (Fin q → Ch)` and identical post-processing. +Their oracles differ only at signing steps where the key +`(m, commit(w,y,rs_i))` is already in the Map: + +- `lazyRomOracle` uses the cached challenge (simulating a consistent + random function) +- `mapGameRealOracle` always uses the fresh `ch_i` + +When no such collision occurs, both oracles are identical at every step, +producing the same interaction and hence the same indicator value. + +The collision probability is bounded by `q² · δ`: +- **Signing-signing**: commitment collision between `rs_i` and `rs_j`, + bounded by `uniformExpect_commit_collision_pair` / `δ` per pair +- **Hash-signing**: adversary predicting `commit(w,y,rs_i)` before step + `i`, bounded by `UnpredictableCommitments` since `rs_i` is independent + of the adversary's queries before step `i` + +Total: ≤ `q(q-1)/2` pairs × `δ` each ≤ `q² · δ`. -/ +private theorem lazy_le_mapGame_real {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + lazyRom_advantage P Msg kg A n ≤ + mapGame_real_advantage P Msg kg A n + + (A.numQueries n : ℝ) ^ 2 * δ n := by + classical + let q := A.numQueries n + letI := P.proverRandomnessFintype n + letI := P.proverRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + let Ω := (R.Witness n × (Fin q → P.ProverRandomness n)) × + (Fin q → P.Challenge n) + let fL : Ω → ℝ := fun ⟨⟨w, rs⟩, ch⟩ => + match lazyRom_run_stmt P Msg A n w (kg.keyOf n w) rs ch with + | none => 0 + | some _ => 1 + let fM : Ω → ℝ := fun ⟨⟨w, rs⟩, ch⟩ => + match mapGame_real_run_stmt P Msg A n w (kg.keyOf n w) rs ch with + | none => 0 + | some _ => 1 + let bad : Ω → Prop := fun ⟨⟨w, rs⟩, ch⟩ => + ∃ (i j : Fin q), i.val < j.val ∧ + lazyPairCommitReuse P Msg A n w (kg.keyOf n w) rs ch i j = true + have h_agree : ∀ ω : Ω, ¬ bad ω → fL ω = fM ω := by + intro ⟨⟨w, rs⟩, ch⟩ hnb + dsimp [fL, fM, bad] at hnb ⊢ + rw [lazy_run_stmt_eq_mapGame_real_run_stmt_of_no_reuse + P Msg A n w (kg.keyOf n w) rs ch hnb] + have h_fL_nn : ∀ ω : Ω, 0 ≤ fL ω := by + intro ⟨⟨w, rs⟩, ch⟩ + dsimp [fL] + split <;> norm_num + have h_fL_le : ∀ ω : Ω, fL ω ≤ 1 := by + intro ⟨⟨w, rs⟩, ch⟩ + dsimp [fL] + split <;> norm_num + have h_fM_nn : ∀ ω : Ω, 0 ≤ fM ω := by + intro ⟨⟨w, rs⟩, ch⟩ + dsimp [fM] + split <;> norm_num + have h_fM_le : ∀ ω : Ω, fM ω ≤ 1 := by + intro ⟨⟨w, rs⟩, ch⟩ + dsimp [fM] + split <;> norm_num + have h_hop := uniformExpect_game_hop Ω fL fM bad h_agree + h_fL_nn h_fL_le h_fM_nn h_fM_le + have h_bad_bound : + uniformExpect Ω (fun ω => if bad ω then (1 : ℝ) else 0) ≤ + (q : ℝ) ^ 2 * δ n := by + simpa [Ω, bad] using + lazyCommitReuse_bound P Msg kg A n δ h_unpred + have h_sub : + uniformExpect Ω fL - uniformExpect Ω fM ≤ + uniformExpect Ω (fun ω => if bad ω then (1 : ℝ) else 0) := by + exact le_trans (le_abs_self _) h_hop + have h_lin : + uniformExpect Ω fL ≤ + uniformExpect Ω fM + + uniformExpect Ω (fun ω => if bad ω then (1 : ℝ) else 0) := by + linarith [h_sub] + have h_main : + uniformExpect Ω fL ≤ uniformExpect Ω fM + (q : ℝ) ^ 2 * δ n := by + exact le_trans h_lin (by linarith [h_bad_bound]) + have h_advL : lazyRom_advantage P Msg kg A n = uniformExpect Ω fL := by + unfold lazyRom_advantage forkAcceptProb lazyRom_run + congr!; rename_i x; obtain ⟨⟨w, rs⟩, ch⟩ := x + dsimp [fL]; split <;> simp_all + have h_advM : mapGame_real_advantage P Msg kg A n = uniformExpect Ω fM := by + unfold mapGame_real_advantage forkAcceptProb mapGame_real_run + congr!; rename_i x; obtain ⟨⟨w, rs⟩, ch⟩ := x + dsimp [fM]; split <;> simp_all + rw [h_advL, h_advM]; exact h_main + +/-- **ROM ≤ MapGame_Real + q²δ**: the ROM advantage is at most the +MapGame_Real advantage plus a commitment collision term `q² · δ`. + +Proved by combining: +- `rom_eq_lazy_rom`: ROM advantage = LazyROM advantage (lazy sampling) +- `lazy_le_mapGame_real`: LazyROM ≤ MapGame_Real + q²δ (game hop) -/ +private theorem rom_le_mapGame_real {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + (ROM_EUF_CMA_Game P Msg kg).advantage A n ≤ + mapGame_real_advantage P Msg kg A n + + (A.numQueries n : ℝ) ^ 2 * δ n := by + have h1 := rom_eq_lazy_rom P Msg kg A n + have h2 := lazy_le_mapGame_real P Msg kg A n δ h_unpred + linarith + +/-- **ROM game hop bound**: combines `rom_le_mapGame_real` (lazy sampling + +collision bound) with `mapGame_real_eq_mapGame1_hvzk` (HVZK switch). -/ +private theorem rom_eq_mapGame1_hvzk_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + (kg : R.WithKeyGen) + (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + (ROM_EUF_CMA_Game P Msg kg).advantage A n ≤ + mapGame1_hvzk_advantage P Msg kg hvzk A n + + (A.numQueries n : ℝ) ^ 2 * δ n := by + have h1 := rom_le_mapGame_real P Msg kg A n δ h_unpred + have h2 := mapGame_real_eq_mapGame1_hvzk P Msg kg hvzk A n + linarith + +/-- When `mapGame1_hvzk_run_stmt` succeeds, extract the underlying +`runWithState` result and key properties. -/ +private lemma mapGame1_hvzk_run_stmt_data {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) [∀ n, DecidableEq (Msg n)] + (hvzk : P.SpecialHVZK) (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (y : R.Statement n) (sr : Fin (A.numQueries n) → hvzk.SimRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + {j : Fin (A.numQueries n)} {mf : Msg n} {tf : P.Commitment n} + {zf : P.Response n} + (h : mapGame1_hvzk_run_stmt P Msg hvzk A n y sr ch = + some (j, (mf, tf, zf))) : + ∃ queries finalMap, + (A.interact n y).runWithState (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch) [] = + some (queries, (mf, tf, zf), finalMap) ∧ + j.val ≤ queries.length ∧ + (∀ (hlt : j.val < queries.length), queries[j.val] = .inr (mf, tf)) := by + letI := P.commitmentDecEq n + have h_def : mapGame1_hvzk_run_stmt P Msg hvzk A n y sr ch = + match (A.interact n y).runWithState (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch) [] with + | none => none + | some (queries, (mf', tf', zf'), _) => + let jv := queries.findIdx (fun x => decide (x = .inr (mf', tf'))) + if hj : jv < A.numQueries n then + if jv < queries.length then + let signMsgs := queries.filterMap (fun q => match q with + | .inl m => some m | .inr _ => none) + if P.verify n y tf' (ch ⟨jv, hj⟩) zf' && !(signMsgs.contains mf') then + some (⟨jv, hj⟩, (mf', tf', zf')) + else none + else none + else none := by rfl + rw [h_def] at h + generalize h_run : (A.interact n y).runWithState (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch) [] = result at h + rcases result with _ | ⟨queries, ⟨mf', tf', zf'⟩, finalMap⟩ + · exact absurd h nofun + · dsimp only [] at h + split at h + · split at h + · split at h + · have hinj := Option.some.inj h + have hj_eq := (Prod.mk.inj hinj).1 + have hrest := (Prod.mk.inj hinj).2 + have hmf : mf' = mf := (Prod.mk.inj hrest).1 + have hrest2 := (Prod.mk.inj hrest).2 + have htf_eq : tf' = tf := (Prod.mk.inj hrest2).1 + have hzf : zf' = zf := (Prod.mk.inj hrest2).2 + refine ⟨queries, finalMap, ?_, ?_, ?_⟩ + · rw [← hmf, ← htf_eq, ← hzf] + · have hj_val : queries.findIdx (fun x => decide (x = .inr (mf', tf'))) = j.val := + congrArg Fin.val hj_eq + rw [← hj_val]; exact List.findIdx_le_length + · intro hlt + rw [← hmf, ← htf_eq] + have hj_val : queries.findIdx (fun x => decide (x = .inr (mf', tf'))) = j.val := + congrArg Fin.val hj_eq + have hlt' : queries.findIdx (fun x => decide (x = .inr (mf', tf'))) < queries.length := + hj_val ▸ hlt + have h_beq := List.findIdx_getElem (w := hlt') + have h_at := of_decide_eq_true h_beq + simp only [hj_val] at h_at; exact h_at + · exact absurd h nofun + · exact absurd h nofun + · exact absurd h nofun + +/-- When `mapGame1_hvzk_run_stmt` succeeds, verification passed. -/ +private lemma mapGame1_hvzk_run_stmt_verify {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) [∀ n, DecidableEq (Msg n)] + (hvzk : P.SpecialHVZK) (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + (y : R.Statement n) (sr : Fin (A.numQueries n) → hvzk.SimRandomness n) + (ch : Fin (A.numQueries n) → P.Challenge n) + {j : Fin (A.numQueries n)} {mf : Msg n} {tf : P.Commitment n} + {zf : P.Response n} + (h : mapGame1_hvzk_run_stmt P Msg hvzk A n y sr ch = + some (j, (mf, tf, zf))) : + P.verify n y tf (ch j) zf = true := by + simp only [mapGame1_hvzk_run_stmt] at h + split at h + · exact absurd h nofun + · split at h + · split at h + · split at h + · have hinj := Option.some.inj h + have hj_eq : _ = j := congrArg Prod.fst hinj + have hmf := congrArg Prod.fst (congrArg Prod.snd hinj) + have htf := congrArg Prod.fst (congrArg Prod.snd (congrArg Prod.snd hinj)) + have hzf := congrArg Prod.snd (congrArg Prod.snd (congrArg Prod.snd hinj)) + subst hmf; subst htf; subst hzf; rw [← hj_eq] + simp_all + · exact absurd h nofun + · exact absurd h nofun + · exact absurd h nofun + +/-- **Fork extraction (Map-based)**: when forking succeeds, special +soundness extracts a valid witness. -/ +private theorem forkExtraction_le_advR_map {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] + (kg : R.WithKeyGen) + (ss : P.SpecialSoundness) (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) (n : ℕ) + [Fintype (hvzk.SimRandomness n)] [Nonempty (hvzk.SimRandomness n)] + [Fintype (P.Challenge n)] [Nonempty (P.Challenge n)] + [DecidableEq (P.Challenge n)] : + ∃ find_n : R.Statement n → R.Witness n, + forkProb + (R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n)) + (P.Challenge n) (A.numQueries n) + (mapGame1_hvzk_run P Msg kg hvzk A n) ≤ + uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w)))) := by + set q := A.numQueries n + have fork_sound : ∀ (y : R.Statement n) (sr : Fin q → hvzk.SimRandomness n) + (ch₁ ch₂ : Fin q → P.Challenge n) + {j : Fin q} {mf₁ mf₂ : Msg n} {tf₁ tf₂ : P.Commitment n} + {zf₁ zf₂ : P.Response n}, + mapGame1_hvzk_run_stmt P Msg hvzk A n y sr ch₁ = some (j, (mf₁, tf₁, zf₁)) → + mapGame1_hvzk_run_stmt P Msg hvzk A n y sr + (fun i => if i.val < j.val then ch₁ i else ch₂ i) = + some (j, (mf₂, tf₂, zf₂)) → + ch₁ j ≠ ch₂ j → + R.relation n (ss.extract n y tf₁ (ch₁ j) zf₁ (ch₂ j) zf₂) y := by + intro y sr ch₁ ch₂ j mf₁ mf₂ tf₁ tf₂ zf₁ zf₂ h₁ h₂ h_neq + have hv₁ := mapGame1_hvzk_run_stmt_verify P Msg hvzk A n y sr ch₁ h₁ + have hv₂ := mapGame1_hvzk_run_stmt_verify P Msg hvzk A n y sr + (fun i => if i.val < j.val then ch₁ i else ch₂ i) h₂ + have h_ch_at_j : (fun i : Fin (A.numQueries n) => + if i.val < j.val then ch₁ i else ch₂ i) j = ch₂ j := + if_neg (Nat.lt_irrefl _) + rw [h_ch_at_j] at hv₂ + have htf : tf₁ = tf₂ := by + obtain ⟨queries₁, _, hrun₁, hle₁, hget₁⟩ := + mapGame1_hvzk_run_stmt_data P Msg hvzk A n y sr ch₁ h₁ + set ch_fork : Fin (A.numQueries n) → P.Challenge n := + fun i => if i.val < j.val then ch₁ i else ch₂ i + obtain ⟨queries₂, _, hrun₂, hle₂, hget₂⟩ := + mapGame1_hvzk_run_stmt_data P Msg hvzk A n y sr ch_fork h₂ + have h_oracle_agree : ∀ (i : Fin (A.numQueries n)), i.val < j.val → + mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch₁ i = + mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch_fork i := by + intro i hi + have h_ch_eq : ch_fork i = ch₁ i := if_pos hi + funext map qry + unfold mapGame1HvzkOracle + rw [h_ch_eq] + by_cases hjlt : j.val < queries₁.length + · have hjlt₂ : j.val < queries₂.length := + OracleInteraction.runWithState_prefix_implies_length + (A.interact n y) (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch₁) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch_fork) + [] j.val h_oracle_agree hrun₁ hrun₂ hjlt + have hq_eq : queries₁[j.val] = queries₂[j.val] := + OracleInteraction.runWithState_prefix_query_eq + (A.interact n y) (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch₁) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch_fork) + [] j.val h_oracle_agree hrun₁ hrun₂ hjlt hjlt₂ + have hq₁ : queries₁[j.val] = .inr (mf₁, tf₁) := hget₁ hjlt + have hq₂ : queries₂[j.val] = .inr (mf₂, tf₂) := hget₂ hjlt₂ + have := hq₁.symm.trans (hq_eq.trans hq₂) + exact (Prod.mk.inj (Sum.inr.inj this)).2 + · have h_agree_all : ∀ (i : Fin (A.numQueries n)), + i.val < queries₁.length → + mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch₁ i = + mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch_fork i := by + intro i hi + exact h_oracle_agree i (lt_of_lt_of_le hi (Nat.le_of_not_lt hjlt)) + have hrun₂' := + OracleInteraction.runWithState_det_prefix + (A.interact n y) (A.numQueries n) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch₁) + (mapGame1HvzkOracle P Msg hvzk n (A.numQueries n) y sr ch_fork) + [] hrun₁ h_agree_all + rw [hrun₂'] at hrun₂ + have hinj := Option.some.inj hrun₂ + have hrest := (Prod.mk.inj hinj).2 + have hforg := (Prod.mk.inj hrest).1 + exact (Prod.mk.inj (Prod.mk.inj hforg).2).1 + rw [← htf] at hv₂ + exact ss.soundness n y tf₁ (ch₁ j) zf₁ (ch₂ j) zf₂ h_neq hv₁ hv₂ + let find_n : R.Statement n → R.Witness n := fun y => + Classical.epsilon (fun w' => R.relation n w' y) + refine ⟨find_n, ?_⟩ + have h_mono : forkProb + (R.Witness n × (Fin q → hvzk.SimRandomness n)) + (P.Challenge n) q + (mapGame1_hvzk_run P Msg kg hvzk A n) ≤ + uniformExpect ((R.Witness n × (Fin q → hvzk.SimRandomness n)) × + (Fin q → P.Challenge n) × (Fin q → P.Challenge n)) + (fun p => boolToReal + (decide (R.relation n (find_n (kg.keyOf n p.1.1)) + (kg.keyOf n p.1.1)))) := by + unfold forkProb uniformExpect + apply Finset.sum_le_sum + intro ⟨⟨w, sr⟩, ch₁, ch₂⟩ _ + apply mul_le_mul_of_nonneg_left _ ENNReal.toReal_nonneg + dsimp only [mapGame1_hvzk_run] + rcases h_run₁ : mapGame1_hvzk_run_stmt P Msg hvzk A n (kg.keyOf n w) sr ch₁ + with _ | ⟨j, mf₁, tf₁, zf₁⟩ + · exact boolToReal_nonneg _ + · dsimp only [] + rcases h_run₂ : mapGame1_hvzk_run_stmt P Msg hvzk A n (kg.keyOf n w) sr + (fun i => if i.val < j.val then ch₁ i else ch₂ i) + with _ | ⟨j', mf₂, tf₂, zf₂⟩ + · exact boolToReal_nonneg _ + · dsimp only [] + have h_if : (if (j : ℕ) < (j : ℕ) then ch₁ j else ch₂ j) = ch₂ j := + if_neg (Nat.lt_irrefl _) + simp only [h_if] + by_cases h_cond : j = j' ∧ ch₁ j ≠ ch₂ j + · obtain ⟨hjj', h_neq⟩ := h_cond; subst hjj' + have h_rel := fork_sound (kg.keyOf n w) sr ch₁ ch₂ h_run₁ h_run₂ h_neq + have h_eps := Classical.epsilon_spec + (p := fun w' => R.relation n w' (kg.keyOf n w)) ⟨_, h_rel⟩ + have h_rel_find : R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w) := h_eps + have lhs_eq : boolToReal (decide (j = j ∧ ch₁ j ≠ ch₂ j)) = 1 := by + simp [boolToReal, h_neq] + have rhs_eq : boolToReal + (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w))) = 1 := by + simp [boolToReal, h_rel_find] + linarith + · have lhs_eq : boolToReal (decide (j = j' ∧ ch₁ j ≠ ch₂ j)) = 0 := by + simp [boolToReal, h_cond] + linarith [boolToReal_nonneg + (decide (R.relation n (find_n (kg.keyOf n w)) + (kg.keyOf n w)))] + have h_eq : uniformExpect ((R.Witness n × (Fin q → hvzk.SimRandomness n)) × + (Fin q → P.Challenge n) × (Fin q → P.Challenge n)) + (fun p => boolToReal (decide (R.relation n (find_n (kg.keyOf n p.1.1)) (kg.keyOf n p.1.1)))) = + uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w)))) := by + trans uniformExpect (R.Witness n × (Fin q → hvzk.SimRandomness n)) + (fun (x : R.Witness n × (Fin q → hvzk.SimRandomness n)) => + boolToReal (decide (R.relation n (find_n (kg.keyOf n x.1)) (kg.keyOf n x.1)))) + · exact uniformExpect_prod_ignore_snd + (fun (x : R.Witness n × (Fin q → hvzk.SimRandomness n)) => + boolToReal (decide (R.relation n (find_n (kg.keyOf n x.1)) (kg.keyOf n x.1)))) + · exact uniformExpect_prod_ignore_snd + (fun w => boolToReal (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w)))) + linarith + +/-- **Forking reduction for MapGame1_HVZK.** -/ +private theorem mapGame1_hvzk_forking_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] + (kg : R.WithKeyGen) + (ss : P.SpecialSoundness) (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) : + ∃ B : RelationSolver R, ∀ n, + mapGame1_hvzk_advantage P Msg kg hvzk A n ≤ + Real.sqrt ((A.numQueries n : ℝ) * + (RelationGame R kg).advantage B n + + (A.numQueries n : ℝ) / + Fintype.card (P.Challenge n)) := by + suffices per_n : ∀ n, ∃ find_n : R.Statement n → R.Witness n, + mapGame1_hvzk_advantage P Msg kg hvzk A n ≤ + Real.sqrt ((A.numQueries n : ℝ) * + uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w)))) + + (A.numQueries n : ℝ) / Fintype.card (P.Challenge n)) by + exact ⟨⟨fun n => (per_n n).choose⟩, fun n => (per_n n).choose_spec⟩ + intro n + letI := hvzk.simRandomnessFintype n + letI := hvzk.simRandomnessNonempty n + letI := P.challengeFintype n + letI := P.challengeNonempty n + letI := P.challengeDecEq n + by_cases hq : A.numQueries n = 0 + · refine ⟨fun _ => Classical.arbitrary _, ?_⟩ + have h_adv_le : mapGame1_hvzk_advantage P Msg kg hvzk A n ≤ 0 := by + change forkAcceptProb _ _ _ _ ≤ 0 + have h_nn := forkAcceptProb_nonneg + (R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n)) + (P.Challenge n) (A.numQueries n) + (mapGame1_hvzk_run P Msg kg hvzk A n) + suffices h : forkAcceptProb + (R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n)) + (P.Challenge n) (A.numQueries n) + (mapGame1_hvzk_run P Msg kg hvzk A n) ≤ 0 from h + unfold forkAcceptProb + trans uniformExpect + ((R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n)) × + (Fin (A.numQueries n) → P.Challenge n)) + (fun _ => (0 : ℝ)) + · apply uniformExpect_mono + intro ⟨⟨w, sr⟩, ch⟩; dsimp only [] + cases h_run : mapGame1_hvzk_run P Msg kg hvzk A n ⟨w, sr⟩ ch with + | none => norm_num + | some p => exact absurd p.1.isLt (by omega) + · exact le_of_eq (uniformExpect_const _ 0) + linarith [Real.sqrt_nonneg ((A.numQueries n : ℝ) * + uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n + ((fun _ => Classical.arbitrary _) (kg.keyOf n w)) (kg.keyOf n w)))) + + (A.numQueries n : ℝ) / Fintype.card (P.Challenge n))] + · have hq_pos : 0 < A.numQueries n := by omega + let Coins := R.Witness n × (Fin (A.numQueries n) → hvzk.SimRandomness n) + let run := mapGame1_hvzk_run P Msg kg hvzk A n + have h_fork := forking_lemma Coins (P.Challenge n) (A.numQueries n) run hq_pos + obtain ⟨find_n, h_extract⟩ := forkExtraction_le_advR_map P Msg kg ss hvzk A n + have h_rearrange : + forkAcceptProb Coins (P.Challenge n) (A.numQueries n) run ^ 2 / + (A.numQueries n : ℝ) ≤ + uniformExpect (R.Witness n) (fun w => + boolToReal (decide (R.relation n (find_n (kg.keyOf n w)) (kg.keyOf n w)))) + + forkAcceptProb Coins (P.Challenge n) (A.numQueries n) run / + Fintype.card (P.Challenge n) := by + linarith + have h_acc_nn := forkAcceptProb_nonneg Coins (P.Challenge n) (A.numQueries n) run + have h_acc_le1 := forkAcceptProb_le_one Coins (P.Challenge n) (A.numQueries n) run + have h_Ch_pos : (0 : ℝ) < Fintype.card (P.Challenge n) := + Nat.cast_pos.mpr Fintype.card_pos + refine ⟨find_n, ?_⟩ + change forkAcceptProb Coins (P.Challenge n) (A.numQueries n) run ≤ _ + exact quadratic_sqrt_bound h_acc_nn h_acc_le1 + (Nat.cast_pos.mpr hq_pos) h_Ch_pos h_rearrange + + +/-- **Concrete security bound for Fiat-Shamir in the ROM.** + +If the Sigma protocol has special soundness, special HVZK, and +`δ`-unpredictable commitments (Def 19.7, Boneh-Shoup), there exists +a relation solver whose advantage, combined with the forking overhead, +bounds the ROM EUF-CMA advantage: + +$$\mathrm{Adv}_{\mathrm{ROM\text{-}EUF\text{-}CMA}}(A, n) + \le \sqrt{q \cdot \mathrm{Adv}_R(B, n) + q / |\mathcal{C}|} + + q^2 \cdot \delta$$ + +where `q` is the total query bound and `|𝒞|` is the challenge space size. + +**Proof** (Boneh-Shoup §19.6.1, Theorem 19.16): +1. *Game hop* (`rom_eq_mapGame1_hvzk_bound`): ROM → MapGame1_HVZK. + Gap bounded by `q² · δ` via lazy sampling + collision bound + HVZK. +2. *Forking* (`mapGame1_hvzk_forking_bound`): In MapGame1_HVZK, the + signing oracle doesn't use the witness. Forking lemma + special + soundness extraction yields `acc ≤ √(q · Adv_R + q/|Ch|)`. -/ +theorem fiatShamir_ROM_bound {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] + (kg : R.WithKeyGen) + (ss : P.SpecialSoundness) (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : + ∃ B : RelationSolver R, ∀ n, + (ROM_EUF_CMA_Game P Msg kg).advantage A n ≤ + Real.sqrt ((A.numQueries n : ℝ) * + (RelationGame R kg).advantage B n + + (A.numQueries n : ℝ) / + Fintype.card (P.Challenge n)) + + (A.numQueries n : ℝ) ^ 2 * δ n := by + obtain ⟨B, hB⟩ := mapGame1_hvzk_forking_bound P Msg kg ss hvzk A + exact ⟨B, fun n => by + have h_rom_le := rom_eq_mapGame1_hvzk_bound P Msg kg hvzk A n δ h_unpred + have h_fork := hB n + linarith⟩ + +/-- The **Fiat-Shamir reduction**: given a ROM EUF-CMA adversary `A`, +construct a relation solver via the forking lemma and special soundness +extraction. In a concrete implementation, `B` runs `A` as a subroutine; +if `A` is efficient, so is `B`. + +This is the adversary whose advantage appears in `fiatShamir_ROM_bound` +and `fiatShamir_ROM_secure` (Boneh-Shoup §19.6.1). -/ +noncomputable def fiatShamirReduction {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] + (kg : R.WithKeyGen) + (ss : P.SpecialSoundness) (hvzk : P.SpecialHVZK) + (A : ROM_EUF_CMA_Adversary P Msg) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) : RelationSolver R := + (fiatShamir_ROM_bound P Msg kg ss hvzk A δ h_unpred).choose + +/-- **Asymptotic security of Fiat-Shamir in the ROM.** + +If: +1. The Sigma protocol has special soundness and special HVZK +2. The underlying relation is hard against `Admissible` adversaries +3. The protocol has `δ`-unpredictable commitments for negligible `δ` +4. The challenge space grows super-polynomially +5. The adversary makes polynomially many queries +6. The Fiat-Shamir reduction `fiatShamirReduction P Msg kg ss hvzk A` + is in the `Admissible` class + +Then the ROM EUF-CMA advantage is negligible. + +This is the main theorem connecting Sigma protocols to practical +signatures in the random oracle model (Theorem 19.16, Boneh-Shoup). + +The `Admissible` predicate captures the class of adversaries against +which the relation is assumed hard (e.g., polynomial-time solvers). +The hypothesis `hAdm` asks that the reduction from `A` to a relation +solver lands in this class — in practice, the reduction runs `A` as +a subroutine, so if `A` is efficient the reduction is efficient too. -/ +theorem fiatShamir_ROM_secure {R : EffectiveRelation} + (P : SigmaProtocol R) (Msg : ℕ → Type) + [∀ n, DecidableEq (Msg n)] + [∀ n, Fintype (Msg n)] [∀ n, Nonempty (Msg n)] + [∀ n, Fintype (R.Witness n)] [∀ n, Nonempty (R.Witness n)] + [∀ n (w : R.Witness n) (y : R.Statement n), Decidable (R.relation n w y)] + (kg : R.WithKeyGen) + (ss : P.SpecialSoundness) (hvzk : P.SpecialHVZK) + {Admissible : RelationSolver R → Prop} + (hR : (RelationGame R kg).SecureAgainst Admissible) + (δ : ℕ → ℝ) + (h_unpred : P.UnpredictableCommitments δ) + (hDelta : Negligible δ) + (hChallenge : Negligible (fun n => 1 / (Fintype.card (P.Challenge n) : ℝ))) + (A : ROM_EUF_CMA_Adversary P Msg) + (hPoly : PolynomiallyBounded (fun n => (A.numQueries n : ℝ))) + (hAdm : Admissible (fiatShamirReduction P Msg kg ss hvzk A δ h_unpred)) : + Negligible (fun n => (ROM_EUF_CMA_Game P Msg kg).advantage A n) := by + -- B is the reduction; hB is the concrete bound from fiatShamir_ROM_bound + let B := fiatShamirReduction P Msg kg ss hvzk A δ h_unpred + have hB := (fiatShamir_ROM_bound P Msg kg ss hvzk A δ h_unpred).choose_spec + -- Component 1: q · Adv_R(B, ·) is negligible + have h_qAdv : Negligible (fun n => + (A.numQueries n : ℝ) * (RelationGame R kg).advantage B n) := + ((hR B hAdm).mul_polyBounded hPoly).mono ⟨0, fun n _ => + le_of_eq (congr_arg abs (mul_comm _ _))⟩ + -- Component 2: q / |Ch| is negligible + have h_qCh : Negligible (fun n => + (A.numQueries n : ℝ) / (Fintype.card (P.Challenge n) : ℝ)) := + (hChallenge.mul_polyBounded hPoly).mono ⟨0, fun n _ => + le_of_eq (congr_arg abs (by ring))⟩ + -- Component 3: √(q · Adv_R + q/|Ch|) is negligible + have h_sum_nn : ∀ n, 0 ≤ (A.numQueries n : ℝ) * + (RelationGame R kg).advantage B n + + (A.numQueries n : ℝ) / (Fintype.card (P.Challenge n) : ℝ) := + fun n => add_nonneg + (mul_nonneg (Nat.cast_nonneg _) + (uniformExpect_nonneg _ fun _ => boolToReal_nonneg _)) + (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) + have h_sqrt := (h_qAdv.add h_qCh).sqrt_nonneg h_sum_nn + -- Component 4: q² · δ is negligible + have h_q2Delta : Negligible (fun n => + (A.numQueries n : ℝ) ^ 2 * δ n) := + (hDelta.mul_polyBounded hPoly.sq).mono ⟨0, fun n _ => + le_of_eq (congr_arg abs (by ring))⟩ + -- Full bound is negligible + have h_bound := h_sqrt.add h_q2Delta + -- Transfer to advantage via concrete bound + exact h_bound.mono ⟨0, fun n _ => by + have h_adv_nn : 0 ≤ (ROM_EUF_CMA_Game P Msg kg).advantage A n := by + unfold ROM_EUF_CMA_Game romCmaWinCondition romCmaOracle + apply uniformExpect_nonneg + intro ⟨⟨_, _⟩, _⟩ + dsimp only + generalize h_run : (A.interact _ _).runWithState _ _ [] = result + cases result with + | none => exact le_refl 0 + | some val => + rcases val with ⟨queries, ⟨mf, tf, zf⟩, finalMap⟩ + dsimp + split + · split + · exact boolToReal_nonneg _ + · exact le_refl 0 + · exact le_refl 0 + rw [abs_of_nonneg h_adv_nn] + exact le_trans (hB n) (le_abs_self _)⟩ + +end diff --git a/Cslib/Cryptography/Reductions/HashToCommitment.lean b/Cslib/Cryptography/Reductions/HashToCommitment.lean new file mode 100644 index 000000000..868ae0d23 --- /dev/null +++ b/Cslib/Cryptography/Reductions/HashToCommitment.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Primitives.HashFunction +public import Cslib.Cryptography.Primitives.Commitment + +@[expose] public section + +/-! +# Hash Function → Keyed Commitment Scheme Reduction + +This file constructs a keyed commitment scheme from any keyed hash +function family and proves that collision resistance of the hash +function implies the binding property of the commitment scheme. + +## Construction + +Given a hash family `H`, the keyed commitment scheme is: +- `CommitKey n = H.Key n` (hash function key, sampled by challenger) +- `commit(ck, m) = (H(ck, m), m)` — commitment is the hash +- `verify(ck, c, m, _) = (H(ck, m) == c)` — verify by re-hashing + +## Main Results + +* `HashFamily.toKeyedCommitmentScheme` — the construction +* `HashFamily.toKeyedCommitmentScheme_correct` — correctness +* `HashFamily.collisionResistant_imp_keyedBinding` — CR → Binding + +## Key insight + +The binding game advantage equals the collision game advantage by +construction — a binding adversary that opens a commitment to two +different messages directly yields a collision. + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +-/ + +open Cslib.Probability + +/-- The hash-based keyed commitment scheme: `commit(ck, m) = (H(ck, m), m)`. + +The hash key `ck` is the commitment key, sampled by the challenger and +given to both the committer and verifier. -/ +def HashFamily.toKeyedCommitmentScheme (H : HashFamily) + [∀ n, DecidableEq (H.Output n)] + : KeyedCommitmentScheme where + CommitKey := H.Key + Message := H.Input + Commitment := H.Output + Opening := H.Input + Randomness := fun _ => Unit + commitKeyFintype := H.keyFintype + commitKeyNonempty := H.keyNonempty + randomnessFintype := fun _ => inferInstance + randomnessNonempty := fun _ => inferInstance + commit n ck m _ := (H.hash n ck m, m) + verify n ck c m _opening := decide (H.hash n ck m = c) + +/-- The hash-based keyed commitment scheme is correct. -/ +theorem HashFamily.toKeyedCommitmentScheme_correct (H : HashFamily) + [∀ n, DecidableEq (H.Output n)] : + H.toKeyedCommitmentScheme.Correct := by + intro n ck m r + simp [toKeyedCommitmentScheme] + +/-- **Collision resistance implies keyed binding** for the hash-based +commitment scheme. + +A keyed binding adversary receives a random key `ck` and produces +`(c, m₁, o₁, m₂, o₂)` with `m₁ ≠ m₂` and both verify. Since +verification checks `H(ck, m) = c`, both messages hash to the same +value — directly yielding a collision for key `ck`. -/ +theorem HashFamily.collisionResistant_imp_keyedBinding (H : HashFamily) + [instDI : ∀ n, DecidableEq (H.Input n)] + [∀ n, DecidableEq (H.Output n)] : + H.CollisionResistant → + (@KeyedCommitmentScheme.Binding H.toKeyedCommitmentScheme instDI) := by + intro hCR A + -- Build a collision-finding adversary from the binding adversary + let B : HashFamily.CollisionAdversary H := + ⟨fun n k => + let (_, m₁, _, m₂, _) := A.forge n k + (m₁, m₂)⟩ + apply Negligible.mono (hCR B) + refine ⟨0, fun n _ => ?_⟩ + letI := H.keyFintype n; letI := H.keyNonempty n + -- Show: binding advantage ≤ |collision advantage| + -- Both advantages are expectations over H.Key n + simp only [KeyedCommitmentScheme.BindingGame, HashFamily.CollisionGame, + toKeyedCommitmentScheme] + rw [abs_of_nonneg (uniformExpect_nonneg _ fun _ => boolToReal_nonneg _), + abs_of_nonneg (uniformExpect_nonneg _ fun _ => boolToReal_nonneg _)] + -- Pointwise: binding indicator ≤ collision indicator + unfold uniformExpect + apply Finset.sum_le_sum + intro k _ + apply mul_le_mul_of_nonneg_left _ ENNReal.toReal_nonneg + -- For each k: if binding succeeds, then collision succeeds + -- binding indicator: m₁ ≠ m₂ ∧ H(k,m₁)=c ∧ H(k,m₂)=c + -- collision indicator: m₁ ≠ m₂ ∧ H(k,m₁) = H(k,m₂) + simp only [B, boolToReal, Bool.and_eq_true, decide_eq_true_eq] + split + · rename_i hbind + split + · norm_num + · rename_i hcoll; exfalso; apply hcoll + exact ⟨hbind.1.1, hbind.1.2.trans hbind.2.symm⟩ + · split <;> norm_num + +end diff --git a/Cslib/Cryptography/Reductions/PRFtoEncryption.lean b/Cslib/Cryptography/Reductions/PRFtoEncryption.lean new file mode 100644 index 000000000..1154e23cf --- /dev/null +++ b/Cslib/Cryptography/Reductions/PRFtoEncryption.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Primitives.PRF +public import Cslib.Cryptography.Primitives.Encryption + +@[expose] public section + +/-! +# PRF → IND-CPA Encryption Security Reduction + +This file constructs an IND-CPA secure encryption scheme from any +pseudorandom function (PRF) and proves that PRF security implies +IND-CPA security of the resulting scheme. + +## Construction + +Given a PRF `F : Key n → Input n → Output n`, we define: +- `Enc(k, m; r) = (r, F(k, r) + m)` +- `Dec(k, (r, c)) = c - F(k, r)` + +The `AddCommGroup` structure on the output type abstracts XOR (or any +group operation making `· + m` a bijection). + +## Main Results + +* `PRF.toEncryptionScheme` — the construction +* `PRF.toEncryptionScheme_correct` — correctness +* `PRF.toEncryptionScheme_reduction_bound` — reduction bound with explicit gap +* `PRF.toEncryptionScheme_secure'` — PRF security + negligible gap ⟹ IND-CPA security +* `PRF.toEncryptionScheme_secureAgainst` — security against admissible adversaries + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014], §3.6 +-/ + +open Cslib.Probability + +/-- The standard PRF-based encryption scheme: `Enc(k, m; r) = (r, F(k,r) + m)`. + +The type aliases below make the construction transparent for reductions. -/ +noncomputable def PRF.toEncryptionScheme (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + : EncryptionScheme where + Key := F.Key + Plaintext := F.Output + Ciphertext := fun n => F.Input n × F.Output n + Randomness := F.Input + keyFintype := F.keyFintype + keyNonempty := F.keyNonempty + randomnessFintype := inferInstance + randomnessNonempty := inferInstance + encrypt n k m r := (r, F.eval n k r + m) + decrypt n k ct := some (ct.2 - F.eval n k ct.1) + +/-- `toEncryptionScheme.Ciphertext n` is `F.Input n × F.Output n`. -/ +@[simp] theorem PRF.toEncryptionScheme_Ciphertext (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (n : ℕ) : F.toEncryptionScheme.Ciphertext n = (F.Input n × F.Output n) := rfl + +/-- `toEncryptionScheme.Plaintext n` is `F.Output n`. -/ +@[simp] theorem PRF.toEncryptionScheme_Plaintext (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (n : ℕ) : F.toEncryptionScheme.Plaintext n = F.Output n := rfl + +/-- `toEncryptionScheme.Randomness n` is `F.Input n`. -/ +@[simp] theorem PRF.toEncryptionScheme_Randomness (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (n : ℕ) : F.toEncryptionScheme.Randomness n = F.Input n := rfl + +/-- The PRF-based encryption scheme is correct: decryption recovers +the plaintext. -/ +theorem PRF.toEncryptionScheme_correct (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + : F.toEncryptionScheme.Correct := by + intro n k m r + simp [toEncryptionScheme] + +/-- Simulate the IND-CPA game body with a given oracle function. + +Given `oracle : F.Input n → F.Output n` (either `F(k,·)` or a random +function), encryption randomness slots `rs1`, `rs2`, challenge +randomness `r₀`, and challenge bit `b₀`, run the adversary's oracle +interaction and compute whether the adversary guesses correctly. + +Returns `0` on fuel exhaustion. -/ +noncomputable def PRF.simulateBody (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (A : IND_CPA_Adversary F.toEncryptionScheme) + (n : ℕ) (r₀ : F.Input n) (b₀ : Bool) + (oracle : F.Input n → F.Output n) + (rs1 : Fin (A.numQueries1 n) → F.Input n) + (rs2 : Fin (A.numQueries2 n) → F.Input n) : ℝ := + let q1 := A.numQueries1 n + let q2 := A.numQueries2 n + let encOracle1 : Fin q1 → F.Output n → F.Input n × F.Output n := + fun i m => (rs1 i, oracle (rs1 i) + m) + match (A.choose n).run q1 encOracle1 with + | none => 0 + | some (_, m₀, m₁, σ) => + let challenge : F.Output n := if b₀ then m₁ else m₀ + let ct : F.Input n × F.Output n := (r₀, oracle r₀ + challenge) + let encOracle2 : Fin q2 → F.Output n → F.Input n × F.Output n := + fun i m => (rs2 i, oracle (rs2 i) + m) + match (A.guess n ct σ).run q2 encOracle2 with + | none => 0 + | some (_, b') => boolToReal (b' == b₀) + +/-- Construct a PRF adversary from an IND-CPA adversary at a specific +security parameter with specific randomness and challenge bit. + +At parameter `n₀`, the adversary simulates the IND-CPA game using +its oracle; at other parameters it returns `true`. -/ +noncomputable def PRF.mkPRFAdversaryAt (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (A : IND_CPA_Adversary F.toEncryptionScheme) + (n₀ : ℕ) (r₀ : F.Input n₀) (b₀ : Bool) + (rs1 : Fin (A.numQueries1 n₀) → F.Input n₀) + (rs2 : Fin (A.numQueries2 n₀) → F.Input n₀) : + PRF.OracleAdversary F where + run n oracle := + if h : n = n₀ then + let oracle' : F.Input n₀ → F.Output n₀ := + fun x => cast (congrArg F.Output h) + (oracle (cast (congrArg F.Input h.symm) x)) + let rs1' := rs1 + let rs2' := rs2 + (F.simulateBody A n₀ r₀ b₀ oracle' rs1' rs2' > 0) + else true + +/-- The IND-CPA advantage in the "ideal world" where the encryption +oracle uses a truly random function instead of the PRF. + +This measures how well the adversary can win the IND-CPA game when +the key-derived function is replaced by a uniformly random function. +For computationally bounded adversaries facing a one-time-pad-like +scheme this is zero, but for unbounded adversaries it may be +nonzero. -/ +noncomputable def IND_CPA_idealWorldGap (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (A : IND_CPA_Adversary F.toEncryptionScheme) (n : ℕ) : ℝ := + letI := F.funFintype n; letI := F.funNonempty n + |uniformExpect + (F.Input n × Bool × + (Fin (A.numQueries1 n) → F.Input n) × + (Fin (A.numQueries2 n) → F.Input n)) + (fun ⟨r, b, rs1, rs2⟩ => + uniformExpect (F.Input n → F.Output n) (fun rf => + F.simulateBody A n r b rf rs1 rs2)) + - 1/2| + +/-- **PRF → IND-CPA reduction bound.** + +For any IND-CPA adversary `A`, there exists a PRF adversary `B` such +that for all `n`: +$$\mathrm{IND\text{-}CPA~advantage}(A, n) + \le \mathrm{PRF~advantage}(B, n) + + \mathrm{idealWorldGap}(A, n)$$ + +The first term is negligible by PRF security; the second term captures +the residual advantage in the ideal world. -/ +theorem PRF.toEncryptionScheme_reduction_bound (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Nonempty (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (A : IND_CPA_Adversary F.toEncryptionScheme) : + ∃ (B : PRF.OracleAdversary F), + ∀ n, (IND_CPA_Game F.toEncryptionScheme).advantage A n ≤ + F.SecurityGame.advantage B n + + IND_CPA_idealWorldGap F A n := by + sorry + +/-- **PRF security + negligible ideal-world gap → IND-CPA security.** + +This is the standard PRF→IND-CPA theorem, correctly formulated with +an explicit gap hypothesis. The gap is negligible for computationally +bounded adversaries (one-time pad argument). -/ +theorem PRF.toEncryptionScheme_secure' (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Nonempty (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (hF : F.Secure) + (A : IND_CPA_Adversary F.toEncryptionScheme) + (hGap : Negligible (IND_CPA_idealWorldGap F A)) : + Negligible (fun n => + (IND_CPA_Game F.toEncryptionScheme).advantage A n) := by + obtain ⟨B, hB⟩ := F.toEncryptionScheme_reduction_bound A + apply Negligible.mono (Negligible.add (hF B) hGap) + refine ⟨0, fun n _ => ?_⟩ + have h1 : 0 ≤ (IND_CPA_Game F.toEncryptionScheme).advantage A n := by + simp only [IND_CPA_Game]; exact abs_nonneg _ + have h2 : 0 ≤ F.SecurityGame.advantage B n := by + simp only [PRF.SecurityGame]; exact abs_nonneg _ + have h3 : 0 ≤ IND_CPA_idealWorldGap F A n := abs_nonneg _ + rw [abs_of_nonneg h1, abs_of_nonneg (by linarith)] + exact hB n + +/-- **PRF security + negligible gap for all admissible adversaries +→ IND-CPA security against that class.** -/ +theorem PRF.toEncryptionScheme_secureAgainst (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Nonempty (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (hF : F.Secure) + (Admissible : + IND_CPA_Adversary F.toEncryptionScheme → Prop) + (hGap : ∀ A, Admissible A → + Negligible (IND_CPA_idealWorldGap F A)) : + (IND_CPA_Game F.toEncryptionScheme).SecureAgainst + Admissible := by + intro A hA + exact F.toEncryptionScheme_secure' hF A (hGap A hA) + +end diff --git a/Cslib/Cryptography/Reductions/PRFtoMAC.lean b/Cslib/Cryptography/Reductions/PRFtoMAC.lean new file mode 100644 index 000000000..298ceb21a --- /dev/null +++ b/Cslib/Cryptography/Reductions/PRFtoMAC.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Primitives.PRF +public import Cslib.Cryptography.Primitives.MAC + +@[expose] public section + +/-! +# PRF → MAC Security Reduction + +This file constructs an EUF-CMA secure MAC from any pseudorandom +function (PRF) and proves the security reduction. + +## Construction + +Given a PRF `F : Key n → Input n → Output n`, we define: +- `tag(k, m) = F(k, m)` +- `verify(k, m, t) = (F(k, m) == t)` + +## Main Results + +* `PRF.toMACScheme` — the construction +* `PRF.toMACScheme_correct` — correctness +* `PRF.toMACScheme_reduction_bound` — EUF-CMA advantage ≤ PRF advantage + ideal gap +* `PRF.toMACScheme_secure` — PRF security + negligible ideal gap → EUF-CMA security + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014], §4.3 +-/ + +open Cslib.Probability + +/-- The standard PRF-based MAC: `tag(k, m) = F(k, m)`. -/ +@[reducible] def PRF.toMACScheme (F : PRF) [∀ n, DecidableEq (F.Output n)] : + MACScheme where + Key := F.Key + Message := F.Input + Tag := F.Output + keyFintype := F.keyFintype + keyNonempty := F.keyNonempty + tag n k m := F.eval n k m + verify n k m t := decide (F.eval n k m = t) + +/-- The PRF-based MAC is correct: verification accepts honestly +generated tags. -/ +theorem PRF.toMACScheme_correct (F : PRF) + [∀ n, DecidableEq (F.Output n)] : + F.toMACScheme.Correct := by + intro n k m + simp + +/-- Simulate the EUF-CMA game body with a given oracle function. + +Given `oracle : F.Input n → F.Output n` (either `F(k,·)` or a random +function), run the adversary's oracle interaction and compute the +forgery success indicator. Returns `0` on fuel exhaustion, or +`boolToReal` of the success indicator otherwise. + +This returns `ℝ` to match the game body directly, enabling +definitional equality in the reduction proof. -/ +noncomputable def PRF.simulateMACBody (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) + (n : ℕ) (oracle : F.Input n → F.Output n) : ℝ := + let q := A.numQueries n + match (A.interact n).run q (fun _i m => oracle m) with + | none => 0 + | some (queries, m_forge, t_forge) => + boolToReal (decide (oracle m_forge = t_forge) && !(queries.contains m_forge)) + +/-- Construct a PRF adversary from a MAC forger. + +The PRF adversary simulates the MAC game using its oracle and outputs +`true` (claiming the oracle is the PRF) iff the forgery verifies. -/ +noncomputable def PRF.mkPRFAdversaryFromMAC (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) : + PRF.OracleAdversary F where + run n oracle := + let q := A.numQueries n + match (A.interact n).run q (fun _i m => oracle m) with + | none => false + | some (queries, m_forge, t_forge) => + decide (oracle m_forge = t_forge) && !(queries.contains m_forge) + +/-- The simulate body equals `boolToReal` of the PRF adversary's output. -/ +private theorem PRF.simulateMACBody_eq (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) + (n : ℕ) (oracle : F.Input n → F.Output n) : + F.simulateMACBody A n oracle = + boolToReal ((F.mkPRFAdversaryFromMAC A).run n oracle) := by + simp only [simulateMACBody, mkPRFAdversaryFromMAC] + split + · rfl + · rfl + +/-- The simulate body is nonnegative. -/ +private theorem PRF.simulateMACBody_nonneg (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) + (n : ℕ) (oracle : F.Input n → F.Output n) : + 0 ≤ F.simulateMACBody A n oracle := by + simp only [simulateMACBody] + split + · exact le_refl (0 : ℝ) + · exact boolToReal_nonneg _ + +/-- The ideal-world forgery probability: the adversary's success rate +when the tagging oracle is a truly random function. -/ +noncomputable def PRF.EUF_CMA_idealWorldGap (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) (n : ℕ) : ℝ := + letI := F.funFintype n; letI := F.funNonempty n + uniformExpect (F.Input n → F.Output n) (fun rf => + F.simulateMACBody A n rf) + +/-- **PRF → EUF-CMA reduction bound.** + +For any EUF-CMA adversary `A`, the PRF distinguisher `mkPRFAdversaryFromMAC` +satisfies: +$$\mathrm{EUF\text{-}CMA~advantage}(A, n) + \le \mathrm{PRF~advantage}(B, n) + + \mathrm{idealWorldGap}(A, n)$$ +-/ +theorem PRF.toMACScheme_reduction_bound (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [instDI : ∀ n, DecidableEq (F.Input n)] + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) : + ∀ n, (@MACScheme.EUF_CMA_Game F.toMACScheme instDI).advantage A n ≤ + F.SecurityGame.advantage (F.mkPRFAdversaryFromMAC A) n + + F.EUF_CMA_idealWorldGap A n := by + intro n + letI := F.keyFintype n; letI := F.keyNonempty n + letI := F.funFintype n; letI := F.funNonempty n + -- Step 1: Express MAC advantage using simulateMACBody + have h_mac_eq : + (@MACScheme.EUF_CMA_Game F.toMACScheme instDI).advantage A n = + uniformExpect (F.Key n) (fun k => + F.simulateMACBody A n (F.eval n k)) := by + simp only [MACScheme.EUF_CMA_Game, simulateMACBody] + congr 1; ext k; split <;> simp_all + -- Step 2: The PRF advantage of our adversary + have h_eq : ∀ oracle : F.Input n → F.Output n, + boolToReal ((F.mkPRFAdversaryFromMAC A).run n oracle) = + F.simulateMACBody A n oracle := + fun oracle => (F.simulateMACBody_eq A n oracle).symm + have h_prf_eq : F.SecurityGame.advantage (F.mkPRFAdversaryFromMAC A) n = + |uniformExpect (F.Key n) (fun k => + F.simulateMACBody A n (F.eval n k)) - + uniformExpect (F.Input n → F.Output n) (fun rf => + F.simulateMACBody A n rf)| := by + simp only [PRF.SecurityGame, h_eq] + -- Step 3: real = (real - ideal) + ideal ≤ |real - ideal| + ideal + rw [h_mac_eq, h_prf_eq] + unfold EUF_CMA_idealWorldGap + set real := uniformExpect (F.Key n) (fun k => + F.simulateMACBody A n (F.eval n k)) + set ideal := uniformExpect (F.Input n → F.Output n) (fun rf => + F.simulateMACBody A n rf) + linarith [le_abs_self (real - ideal)] + +/-- **PRF security + negligible ideal-world gap → EUF-CMA security.** -/ +theorem PRF.toMACScheme_secure (F : PRF) + [∀ n, DecidableEq (F.Output n)] + [instDI : ∀ n, DecidableEq (F.Input n)] + (hF : F.Secure) + (A : MACScheme.EUF_CMA_Adversary F.toMACScheme) + (hGap : Negligible (F.EUF_CMA_idealWorldGap A)) : + Negligible (fun n => + (@MACScheme.EUF_CMA_Game F.toMACScheme instDI).advantage A n) := by + let B := F.mkPRFAdversaryFromMAC A + apply Negligible.mono (Negligible.add (hF B) hGap) + refine ⟨0, fun n _ => ?_⟩ + letI := F.keyFintype n; letI := F.keyNonempty n + letI := F.funFintype n; letI := F.funNonempty n + have h1 : 0 ≤ (@MACScheme.EUF_CMA_Game F.toMACScheme instDI).advantage A n := by + simp only [MACScheme.EUF_CMA_Game] + apply uniformExpect_nonneg + intro k + split + · exact le_refl 0 + · exact boolToReal_nonneg _ + have h2 : 0 ≤ F.SecurityGame.advantage B n := abs_nonneg _ + have h3 : 0 ≤ F.EUF_CMA_idealWorldGap A n := + uniformExpect_nonneg _ fun rf => F.simulateMACBody_nonneg A n rf + rw [abs_of_nonneg h1, abs_of_nonneg (by linarith)] + exact F.toMACScheme_reduction_bound A n + +end diff --git a/Cslib/Cryptography/Reductions/PRGtoEncryption.lean b/Cslib/Cryptography/Reductions/PRGtoEncryption.lean new file mode 100644 index 000000000..413b5a2f6 --- /dev/null +++ b/Cslib/Cryptography/Reductions/PRGtoEncryption.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Cryptography.Primitives.PRG +public import Cslib.Cryptography.Primitives.Encryption + +@[expose] public section + +/-! +# PRG → IND-CPA Encryption Security Reduction + +This file constructs an IND-CPA secure stream cipher from any +pseudorandom generator (PRG) and proves that PRG security implies +IND-CPA security of the resulting scheme. + +## Construction + +Given a PRG `G : Seed n → Output n` with an `AddCommGroup` on +the output type (abstracting XOR), we define: +- `Enc(k, m; ()) = G(k) + m` +- `Dec(k, c) = c - G(k)` + +## Main Results + +* `PRG.toEncryptionScheme` — the construction +* `PRG.toEncryptionScheme_correct` — correctness +* `PRG.toEncryptionScheme_secure` — PRG security → IND-CPA security + +## References + +* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2014], §3.3 +-/ + +open Cslib.Probability + +/-- The standard PRG-based stream cipher: `Enc(k, m) = G(k) + m`. -/ +noncomputable def PRG.toEncryptionScheme (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + : EncryptionScheme where + Key := G.Seed + Plaintext := G.Output + Ciphertext := G.Output + Randomness := fun _ => Unit + keyFintype := G.seedFintype + keyNonempty := G.seedNonempty + randomnessFintype := fun _ => inferInstance + randomnessNonempty := fun _ => inferInstance + encrypt n k m _ := G.stretch n k + m + decrypt n k c := some (c - G.stretch n k) + +/-- The PRG-based stream cipher is correct. -/ +theorem PRG.toEncryptionScheme_correct (G : PRG) + [∀ n, AddCommGroup (G.Output n)] : + G.toEncryptionScheme.Correct := by + intro n k m r + simp [toEncryptionScheme, add_sub_cancel_left] + +/-- Simulate the IND-CPA game body with a given string `y` and bit `b`. + +Since the stream cipher has `Randomness = Unit`, the encryption oracle +is `fun m => y + m` regardless of the per-query randomness. The +adversary's `OracleInteraction` is run against this oracle. Returns `0` +on fuel exhaustion (adversary defaults to losing). -/ +noncomputable def PRG.simulateStreamBody (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (A : IND_CPA_Adversary G.toEncryptionScheme) + (n : ℕ) (b : Bool) (y : G.Output n) : ℝ := + let q1 := A.numQueries1 n + let q2 := A.numQueries2 n + let oracle1 : Fin q1 → G.Output n → G.Output n := + fun _ m => y + m + match (A.choose n).run q1 oracle1 with + | none => 0 + | some (_, m₀, m₁, σ) => + let challenge : G.Output n := if b then m₁ else m₀ + let ct : G.Output n := y + challenge + let oracle2 : Fin q2 → G.Output n → G.Output n := + fun _ m => y + m + match (A.guess n ct σ).run q2 oracle2 with + | none => 0 + | some (_, b') => boolToReal (b' == b) + +/-- Construct a PRG distinguisher from an IND-CPA adversary. -/ +noncomputable def PRG.mkPRGAdversary (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (A : IND_CPA_Adversary G.toEncryptionScheme) + (b₀ : Bool) : + PRG.DistinguishingAdversary G where + distinguish n y := + let q1 := A.numQueries1 n + let q2 := A.numQueries2 n + let oracle1 : Fin q1 → G.Output n → G.Output n := + fun _ m => y + m + match (A.choose n).run q1 oracle1 with + | none => false + | some (_, m₀, m₁, σ) => + let challenge : G.Output n := if b₀ then m₁ else m₀ + let ct : G.Output n := y + challenge + let oracle2 : Fin q2 → G.Output n → G.Output n := + fun _ m => y + m + match (A.guess n ct σ).run q2 oracle2 with + | none => false + | some (_, b') => b' == b₀ + +/-- The ideal-world gap for the PRG→IND-CPA reduction. -/ +noncomputable def PRG.IND_CPA_idealWorldGap (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (A : IND_CPA_Adversary G.toEncryptionScheme) + (n : ℕ) : ℝ := + letI := G.outputFintype n; letI := G.outputNonempty n + |uniformExpect Bool (fun b => + uniformExpect (G.Output n) (fun y => + G.simulateStreamBody A n b y)) + - 1/2| + +/-- **PRG → IND-CPA reduction bound.** -/ +theorem PRG.toEncryptionScheme_reduction_bound (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (A : IND_CPA_Adversary G.toEncryptionScheme) : + ∃ (B : PRG.DistinguishingAdversary G), + ∀ n, (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ + G.SecurityGame.advantage B n + + G.IND_CPA_idealWorldGap A n := by + sorry + +/-- **PRG security → IND-CPA security** for the stream cipher, +given that the ideal-world gap is negligible. -/ +theorem PRG.toEncryptionScheme_secure (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (hG : G.Secure) + (A : IND_CPA_Adversary G.toEncryptionScheme) + (hGap : Negligible (G.IND_CPA_idealWorldGap A)) : + Negligible (fun n => + (IND_CPA_Game G.toEncryptionScheme).advantage A n) := by + obtain ⟨B, hB⟩ := G.toEncryptionScheme_reduction_bound A + apply Negligible.mono (Negligible.add (hG B) hGap) + refine ⟨0, fun n _ => ?_⟩ + have h1 : 0 ≤ (IND_CPA_Game G.toEncryptionScheme).advantage A n := by + simp only [IND_CPA_Game]; exact abs_nonneg _ + have h2 : 0 ≤ G.SecurityGame.advantage B n := abs_nonneg _ + have h3 : 0 ≤ G.IND_CPA_idealWorldGap A n := abs_nonneg _ + rw [abs_of_nonneg h1, abs_of_nonneg (by linarith)] + exact hB n + +end diff --git a/Cslib/Probability/Discrete.lean b/Cslib/Probability/Discrete.lean new file mode 100644 index 000000000..a0fa14090 --- /dev/null +++ b/Cslib/Probability/Discrete.lean @@ -0,0 +1,501 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Init +public import Mathlib.Probability.ProbabilityMassFunction.Basic +public import Mathlib.Probability.Distributions.Uniform + +@[expose] public section + +/-! +# Discrete Probability Helpers + +This file provides lightweight probability helpers on top of Mathlib's `PMF`, +staying in `ℝ` (not `ℝ≥0∞`). The main definitions support the coin-passing +style used throughout the cryptographic security games. + +## Main Definitions + +* `boolToReal` — indicator function `Bool → ℝ` +* `uniformExpect` — expected value of `f(c)` when `c` is sampled uniformly +* `uniformProb` — probability of an event under the uniform distribution + +## Design Notes + +We work in `ℝ` rather than `ℝ≥0∞` to avoid coercion complications in game +definitions. The `ENNReal.toReal` conversion from `PMF.uniformOfFintype` is +safe on finite types since the masses are `1 / |α|`, which is finite. + +## References + +* [O. Goldreich, *Foundations of Cryptography, Vol. 1*][Goldreich2001] +-/ + +namespace Cslib.Probability + +/-- Convert a `Bool` to `ℝ`: `true ↦ 1`, `false ↦ 0`. -/ +def boolToReal (b : Bool) : ℝ := if b then 1 else 0 + +theorem boolToReal_nonneg (b : Bool) : 0 ≤ boolToReal b := by + simp [boolToReal]; split <;> norm_num + +theorem boolToReal_le_one (b : Bool) : boolToReal b ≤ 1 := by + simp [boolToReal]; split <;> norm_num + +/-- Expected value of `f(c)` when `c` is sampled uniformly from a `Fintype`. + +This is `∑ a, (1 / |α|) * f(a)`, i.e., the average of `f` over all elements. -/ +noncomputable def uniformExpect (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) : ℝ := + ∑ a : α, (PMF.uniformOfFintype α a).toReal * f a + +/-- `uniformExpect` equals `(1 / |α|) * ∑ a, f(a)`. -/ +theorem uniformExpect_eq (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) : + uniformExpect α f = (1 / Fintype.card α) * ∑ a : α, f a := by + unfold uniformExpect + simp only [PMF.uniformOfFintype_apply, ENNReal.toReal_inv, ENNReal.toReal_natCast, one_div] + rw [Finset.mul_sum] + +/-- If `f ≥ 0` pointwise then `uniformExpect α f ≥ 0`. -/ +theorem uniformExpect_nonneg (α : Type*) [Fintype α] [Nonempty α] + {f : α → ℝ} (hf : ∀ a, 0 ≤ f a) : + 0 ≤ uniformExpect α f := by + unfold uniformExpect + exact Finset.sum_nonneg fun a _ => + mul_nonneg (ENNReal.toReal_nonneg) (hf a) + +/-- `uniformExpect` of a constant function equals the constant. -/ +theorem uniformExpect_const (α : Type*) [Fintype α] [Nonempty α] + (c : ℝ) : uniformExpect α (fun _ => c) = c := by + rw [uniformExpect_eq] + simp [Finset.sum_const, Finset.card_univ] + +/-- Probability of a decidable event under the uniform distribution. -/ +noncomputable def uniformProb (α : Type*) [Fintype α] [Nonempty α] + (p : α → Prop) [DecidablePred p] : ℝ := + uniformExpect α (fun a => if p a then 1 else 0) + +/-- `uniformProb α p ≤ 1`. -/ +theorem uniformProb_le_one (α : Type*) [Fintype α] [Nonempty α] + (p : α → Prop) [DecidablePred p] : + uniformProb α p ≤ 1 := by + unfold uniformProb + rw [uniformExpect_eq] + have hcard_pos : (0 : ℝ) < Fintype.card α := Nat.cast_pos.mpr Fintype.card_pos + have hcard_ne : (Fintype.card α : ℝ) ≠ 0 := ne_of_gt hcard_pos + rw [div_mul_eq_mul_div, one_mul] + rw [div_le_one hcard_pos] + calc ∑ a : α, (if p a then (1 : ℝ) else 0) + ≤ ∑ _a : α, (1 : ℝ) := + Finset.sum_le_sum fun a _ => by split <;> norm_num + _ = Fintype.card α := by simp [Finset.sum_const, Finset.card_univ] + +/-- `uniformProb α p ≥ 0`. -/ +theorem uniformProb_nonneg (α : Type*) [Fintype α] [Nonempty α] + (p : α → Prop) [DecidablePred p] : + 0 ≤ uniformProb α p := + uniformExpect_nonneg α fun a => by split <;> norm_num + +/-- `uniformExpect` is additive: `E[f + g] = E[f] + E[g]`. -/ +theorem uniformExpect_add (α : Type*) [Fintype α] [Nonempty α] + (f g : α → ℝ) : + uniformExpect α (fun a => f a + g a) = + uniformExpect α f + uniformExpect α g := by + simp only [uniformExpect_eq] + rw [← mul_add, Finset.sum_add_distrib] + +/-- `uniformExpect` distributes over subtraction: `E[f - g] = E[f] - E[g]`. -/ +theorem uniformExpect_sub (α : Type*) [Fintype α] [Nonempty α] + (f g : α → ℝ) : + uniformExpect α (fun a => f a - g a) = + uniformExpect α f - uniformExpect α g := by + simp only [uniformExpect_eq] + rw [← mul_sub, Finset.sum_sub_distrib] + +/-- `uniformExpect` scales: `E[c * f] = c * E[f]`. -/ +theorem uniformExpect_smul (α : Type*) [Fintype α] [Nonempty α] + (c : ℝ) (f : α → ℝ) : + uniformExpect α (fun a => c * f a) = c * uniformExpect α f := by + simp only [uniformExpect_eq, ← Finset.mul_sum] + ring + +/-- Jensen's inequality for absolute value: `|E[f]| ≤ E[|f|]`. -/ +theorem uniformExpect_abs_le (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) : + |uniformExpect α f| ≤ uniformExpect α (fun a => |f a|) := by + simp only [uniformExpect_eq] + rw [abs_mul, abs_of_nonneg (by positivity : (0 : ℝ) ≤ 1 / Fintype.card α)] + exact mul_le_mul_of_nonneg_left (Finset.abs_sum_le_sum_abs _ _) (by positivity) + +/-- Fubini for `uniformExpect`: `E_{(a,b)}[f] = E_a[E_b[f(a,b)]]`. -/ +theorem uniformExpect_prod (α β : Type*) [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (f : α × β → ℝ) : + uniformExpect (α × β) f = + uniformExpect α (fun a => uniformExpect β (fun b => f (a, b))) := by + simp only [uniformExpect_eq, Fintype.card_prod, Nat.cast_mul] + rw [Fintype.sum_prod_type f] + have hα : (Fintype.card α : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (Fintype.card_ne_zero) + have hβ : (Fintype.card β : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (Fintype.card_ne_zero) + rw [show (1 : ℝ) / (↑(Fintype.card α) * ↑(Fintype.card β)) = + (1 / ↑(Fintype.card α)) * (1 / ↑(Fintype.card β)) from by ring] + rw [mul_assoc, Finset.mul_sum] + +/-- Invariance of `uniformExpect` under an equivalence (bijection): +`E[f ∘ σ] = E[f]` for any `σ : α ≃ α`. -/ +theorem uniformExpect_equiv (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) (σ : α ≃ α) : + uniformExpect α (fun a => f (σ a)) = uniformExpect α f := by + simp only [uniformExpect_eq] + congr 1 + exact Finset.sum_equiv σ (by simp) (by simp) + +/-- Averaging/pigeonhole: `uniformExpect α f ≤ f a` for some `a`. + +If the average of `f` exceeds every value, we get a contradiction +since the average of values all strictly below the average is +strictly below the average. -/ +theorem uniformExpect_le_exists (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) : ∃ a, uniformExpect α f ≤ f a := by + by_contra h + push_neg at h + have hcard_pos : (0 : ℝ) < Fintype.card α := Nat.cast_pos.mpr Fintype.card_pos + have hsum_lt : ∑ a : α, f a < ∑ _a : α, uniformExpect α f := + Finset.sum_lt_sum (fun a _ => le_of_lt (h a)) + ⟨(‹Nonempty α›).some, Finset.mem_univ _, h _⟩ + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] at hsum_lt + have key : (Fintype.card α : ℝ) * uniformExpect α f = ∑ a : α, f a := by + rw [uniformExpect_eq]; field_simp + linarith + +/-- Fubini for `uniformExpect`: swapping the order of expectation. + +Both sides equal `(1/(|α|*|β|)) * ∑ a, ∑ b, f a b`. -/ +theorem uniformExpect_comm (α β : Type*) [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (f : α → β → ℝ) : + uniformExpect α (fun a => uniformExpect β (fun b => f a b)) = + uniformExpect β (fun b => uniformExpect α (fun a => f a b)) := by + simp only [uniformExpect_eq] + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + congr 1; ext b; congr 1; ext a; ring + +/-- If a function on a product doesn't depend on the second component, +the expectation reduces to the marginal over the first component. -/ +theorem uniformExpect_prod_ignore_snd {α β : Type*} [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (g : α → ℝ) : + uniformExpect (α × β) (fun p => g p.1) = uniformExpect α g := by + rw [uniformExpect_prod] + congr 1; ext a; exact uniformExpect_const β (g a) + +/-- If a function on a product doesn't depend on the first component, +the expectation reduces to the marginal over the second component. -/ +theorem uniformExpect_prod_ignore_fst {α β : Type*} [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (g : β → ℝ) : + uniformExpect (α × β) (fun p => g p.2) = uniformExpect β g := by + rw [uniformExpect_prod] + exact uniformExpect_const α (uniformExpect β g) + +/-- Factor out unused components from a product expectation. Given a 5-tuple +`A × B × C × D × E`, if the function only uses the `A`, `C`, and `E` components, +the expectation equals the expectation over `A × C × E`. -/ +theorem uniformExpect_prod5_ignore_bd {A B C D E : Type*} + [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] + [Fintype C] [Nonempty C] [Fintype D] [Nonempty D] [Fintype E] [Nonempty E] + (g : A → C → E → ℝ) : + uniformExpect (A × B × C × D × E) + (fun r => g r.1 r.2.2.1 r.2.2.2.2) = + uniformExpect (A × C × E) + (fun r => g r.1 r.2.1 r.2.2) := by + simp only [uniformExpect_eq, Fintype.card_prod, Nat.cast_mul] + simp_rw [Fintype.sum_prod_type] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hB : (Fintype.card B : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + have hD : (Fintype.card D : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + field_simp + simp_rw [← Finset.mul_sum] + ring + +/-- Factor out unused components from a product expectation. Given a 5-tuple +`A × B × C × D × E`, if the function only uses the `B`, `C`, and `D` components, +the expectation equals the expectation over `B × C × D`. -/ +theorem uniformExpect_prod5_ignore_ae {A B C D E : Type*} + [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] + [Fintype C] [Nonempty C] [Fintype D] [Nonempty D] [Fintype E] [Nonempty E] + (g : B → C → D → ℝ) : + uniformExpect (A × B × C × D × E) + (fun r => g r.2.1 r.2.2.1 r.2.2.2.1) = + uniformExpect (B × C × D) + (fun r => g r.1 r.2.1 r.2.2) := by + simp only [uniformExpect_eq, Fintype.card_prod, Nat.cast_mul] + simp_rw [Fintype.sum_prod_type] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hA : (Fintype.card A : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + have hE : (Fintype.card E : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + field_simp + simp_rw [← Finset.mul_sum] + -- Unlike `ignore_bd`, `field_simp` already leaves the goal in normal form here + +/-- Monotonicity of `uniformExpect`: if `f ≤ g` pointwise then `E[f] ≤ E[g]`. -/ +theorem uniformExpect_mono (α : Type*) [Fintype α] [Nonempty α] + {f g : α → ℝ} (hle : ∀ a, f a ≤ g a) : + uniformExpect α f ≤ uniformExpect α g := by + unfold uniformExpect + exact Finset.sum_le_sum fun a _ => + mul_le_mul_of_nonneg_left (hle a) ENNReal.toReal_nonneg + +/-- Jensen's inequality for squares: `E[f]² ≤ E[f²]`. + +Follows from the variance identity: `E[(f - μ)²] ≥ 0` implies +`E[f²] - μ² ≥ 0` where `μ = E[f]`. -/ +theorem uniformExpect_sq_le (α : Type*) [Fintype α] [Nonempty α] + (f : α → ℝ) : + (uniformExpect α f) ^ 2 ≤ uniformExpect α (fun a => f a ^ 2) := by + set μ := uniformExpect α f + suffices h : 0 ≤ uniformExpect α (fun a => f a ^ 2) - μ ^ 2 by linarith + have key : uniformExpect α (fun a => (f a - μ) ^ 2) = + uniformExpect α (fun a => f a ^ 2) - μ ^ 2 := by + trans uniformExpect α (fun a => f a ^ 2 + (-2 * μ * f a + μ ^ 2)) + · congr 1; ext a; ring + rw [uniformExpect_add, uniformExpect_add, uniformExpect_smul, uniformExpect_const] + ring + linarith [uniformExpect_nonneg α (fun a => sq_nonneg (f a - μ))] + +/-- Transport `uniformExpect` along a type equivalence `α ≃ β`: +`E[f ∘ e] over α = E[f] over β`. -/ +theorem uniformExpect_congr {α β : Type*} [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (e : α ≃ β) (f : β → ℝ) : + uniformExpect α (f ∘ e) = uniformExpect β f := by + simp only [uniformExpect_eq, Fintype.card_congr e] + congr 1 + exact Finset.sum_equiv e (by simp) (by simp) + +/-- Pull a finite sum out of `uniformExpect`: +`E[∑ j, f j a] = ∑ j, E[f j a]`. -/ +theorem uniformExpect_finsum {α : Type*} [Fintype α] [Nonempty α] + {n : ℕ} (f : Fin n → α → ℝ) : + uniformExpect α (fun a => ∑ j : Fin n, f j a) = + ∑ j : Fin n, uniformExpect α (f j) := by + simp only [uniformExpect_eq, Finset.mul_sum] + rw [Finset.sum_comm] + +/-- Independence of factors in product expectations: +`E_{(a,b)}[f(a) * g(b)] = E[f] * E[g]`. -/ +theorem uniformExpect_prod_mul {α β : Type*} [Fintype α] [Nonempty α] + [Fintype β] [Nonempty β] (f : α → ℝ) (g : β → ℝ) : + uniformExpect (α × β) (fun p => f p.1 * g p.2) = + uniformExpect α f * uniformExpect β g := by + rw [uniformExpect_prod] + have : ∀ a : α, uniformExpect β (fun b => f a * g b) = + f a * uniformExpect β g := + fun a => uniformExpect_smul β (f a) g + simp_rw [this] + rw [show (fun a => f a * uniformExpect β g) = + (fun a => uniformExpect β g * f a) from by ext; ring, + uniformExpect_smul]; ring + +/-- If `acc²/q ≤ ε + acc/C` (with `0 ≤ acc ≤ 1`, `q > 0`, `C > 0`) +then `acc ≤ √(q * ε + q / C)`. + +This is the algebraic step that inverts the forking lemma bound. -/ +theorem quadratic_sqrt_bound {acc q ε C : ℝ} + (h_nn : 0 ≤ acc) (h_le1 : acc ≤ 1) (hq : 0 < q) (hC : 0 < C) + (h : acc ^ 2 / q ≤ ε + acc / C) : + acc ≤ Real.sqrt (q * ε + q / C) := by + -- From h: acc² ≤ q * ε + q * acc / C + have h1 : acc ^ 2 ≤ q * ε + q * (acc / C) := by + have h_mul := mul_le_mul_of_nonneg_right h (le_of_lt hq) + have h_cancel : acc ^ 2 / q * q = acc ^ 2 := div_mul_cancel₀ _ (ne_of_gt hq) + linarith [show (ε + acc / C) * q = q * ε + q * (acc / C) from by ring] + -- From acc ≤ 1: q * acc / C ≤ q / C + have h2 : q * (acc / C) ≤ q / C := by + have h_le : acc / C ≤ 1 / C := div_le_div_of_nonneg_right h_le1 (le_of_lt hC) + have h_mul : q * (acc / C) ≤ q * (1 / C) := mul_le_mul_of_nonneg_left h_le (le_of_lt hq) + linarith [show q * (1 / C) = q / C from by ring] + -- So acc² ≤ q * ε + q / C + have h3 : acc ^ 2 ≤ q * ε + q / C := by linarith + -- acc = √(acc²) ≤ √(q * ε + q / C) by monotonicity of sqrt + calc acc = Real.sqrt (acc ^ 2) := by + rw [Real.sqrt_sq h_nn] + _ ≤ Real.sqrt (q * ε + q / C) := by + exact Real.sqrt_le_sqrt h3 + +/-- **Fundamental lemma of game hopping**: if two `[0,1]`-valued functions +agree except on a "bad" event, the difference of their expectations is +bounded by the probability of the bad event. + +This is the key tool for bounding the gap in game-hopping proofs: +when transitioning from Game 0 to Game 1, the adversary's advantage +changes by at most the probability that the "bad" distinguishing +event occurs. -/ +theorem uniformExpect_game_hop (α : Type*) [Fintype α] [Nonempty α] + (f₀ f₁ : α → ℝ) (bad : α → Prop) [DecidablePred bad] + (h_agree : ∀ a, ¬bad a → f₀ a = f₁ a) + (h0_nn : ∀ a, 0 ≤ f₀ a) (h0_le : ∀ a, f₀ a ≤ 1) + (h1_nn : ∀ a, 0 ≤ f₁ a) (h1_le : ∀ a, f₁ a ≤ 1) : + |uniformExpect α f₀ - uniformExpect α f₁| ≤ + uniformExpect α (fun a => if bad a then 1 else 0) := by + -- |E[f₀] - E[f₁]| = |E[f₀ - f₁]| ≤ E[|f₀ - f₁|] ≤ E[1{bad}] + rw [← uniformExpect_sub] + refine le_trans (uniformExpect_abs_le α _) ?_ + apply uniformExpect_mono + intro a + by_cases h : bad a + · -- bad a: |f₀ a - f₁ a| ≤ 1 + simp only [h, ite_true] + rw [abs_le]; exact ⟨by linarith [h0_nn a, h1_le a], + by linarith [h0_le a, h1_nn a]⟩ + · -- ¬bad a: f₀ a = f₁ a, so |f₀ a - f₁ a| = 0 + simp only [h, ite_false] + rw [h_agree a h, sub_self, abs_zero] + +/-- Factor out unused components from a product expectation. Given a 5-tuple +`A × B × C × D × E`, if the function only uses the `A`, `B`, and `C` components, +the expectation equals the expectation over `A × B × C`. -/ +theorem uniformExpect_prod5_ignore_de {A B C D E : Type*} + [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] + [Fintype C] [Nonempty C] [Fintype D] [Nonempty D] [Fintype E] [Nonempty E] + (g : A → B → C → ℝ) : + uniformExpect (A × B × C × D × E) + (fun r => g r.1 r.2.1 r.2.2.1) = + uniformExpect (A × B × C) + (fun r => g r.1 r.2.1 r.2.2) := by + simp only [uniformExpect_eq, Fintype.card_prod, Nat.cast_mul] + simp_rw [Fintype.sum_prod_type] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hD : (Fintype.card D : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + have hE : (Fintype.card E : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + field_simp + simp_rw [← Finset.mul_sum] + +/-- Factor out unused components from a product expectation. Given a 5-tuple +`A × B × C × D × E`, if the function only uses the `A`, `D`, and `E` components, +the expectation equals the expectation over `A × D × E`. -/ +theorem uniformExpect_prod5_ignore_bc {A B C D E : Type*} + [Fintype A] [Nonempty A] [Fintype B] [Nonempty B] + [Fintype C] [Nonempty C] [Fintype D] [Nonempty D] [Fintype E] [Nonempty E] + (g : A → D → E → ℝ) : + uniformExpect (A × B × C × D × E) + (fun r => g r.1 r.2.2.2.1 r.2.2.2.2) = + uniformExpect (A × D × E) + (fun r => g r.1 r.2.1 r.2.2) := by + simp only [uniformExpect_eq, Fintype.card_prod, Nat.cast_mul] + simp_rw [Fintype.sum_prod_type] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hB : (Fintype.card B : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + have hC : (Fintype.card C : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr Fintype.card_ne_zero + field_simp + simp_rw [← Finset.mul_sum] + +/-- Union bound for indicators: `1{∃ i, P i a} ≤ ∑ i, 1{P i a}`. -/ +theorem indicator_exists_le_sum {α : Type*} {n : ℕ} + (P : Fin n → α → Prop) [∀ i, DecidablePred (P i)] (a : α) : + (if ∃ i, P i a then (1 : ℝ) else 0) ≤ ∑ i : Fin n, (if P i a then 1 else 0) := by + by_cases h : ∃ i, P i a + · simp only [h, ite_true] + obtain ⟨i, hi⟩ := h + have h_nonneg : ∀ j : Fin n, j ∈ Finset.univ → + 0 ≤ (if P j a then (1 : ℝ) else 0) := + fun j _ => ite_nonneg zero_le_one (le_refl 0) + have h_le := Finset.single_le_sum h_nonneg (Finset.mem_univ i) + simp only [hi, ite_true] at h_le + exact h_le + · simp only [h, ite_false] + exact Finset.sum_nonneg fun j _ => ite_nonneg zero_le_one (le_refl 0) + +/-- Pull a `Finset.univ` sum out of `uniformExpect`: +`E[∑ s ∈ univ, f s a] = ∑ s ∈ univ, E[f s a]`. -/ +theorem uniformExpect_finset_sum {α S : Type*} [Fintype α] [Nonempty α] [Fintype S] + (f : S → α → ℝ) : + uniformExpect α (fun a => ∑ s : S, f s a) = + ∑ s : S, uniformExpect α (f s) := by + unfold uniformExpect + simp_rw [Finset.mul_sum] + exact Finset.sum_comm + +/-- For a uniform pair of coordinates from `Fin q → T`, the collision +probability is `1/|T|`. -/ +theorem uniformExpect_collision_pair {T : Type*} [Fintype T] [Nonempty T] [DecidableEq T] + {q : ℕ} (i j : Fin q) (hij : i ≠ j) : + uniformExpect (Fin q → T) + (fun ts => if ts i = ts j then (1 : ℝ) else 0) = + 1 / Fintype.card T := by + -- Split at coordinate i: (Fin q → T) ≃ T × ({k // k ≠ i} → T) + -- After splitting, ts i = p.1 and ts j = p.2 ⟨j, Ne.symm hij⟩ + have h_comp : (fun ts : Fin q → T => if ts i = ts j then (1 : ℝ) else 0) = + (fun p : T × ({k : Fin q // k ≠ i} → T) => + if p.1 = p.2 ⟨j, Ne.symm hij⟩ then 1 else 0) ∘ Equiv.funSplitAt i T := by + ext ts; simp [Equiv.funSplitAt, Equiv.piSplitAt] + rw [h_comp, uniformExpect_congr] + haveI : Nonempty ({k : Fin q // k ≠ i} → T) := ⟨fun _ => ‹Nonempty T›.some⟩ + rw [uniformExpect_prod] + -- Goal: E_{ti}[E_{rest}[1{ti = rest ⟨j, ...⟩}]] = 1/|T| + -- Swap to E_{rest}[E_{ti}[1{ti = rest ⟨j, ...⟩}]] so the inner is over T + rw [uniformExpect_comm] + -- Now: E_{rest}[E_{ti}[1{ti = rest ⟨j, ...⟩}]] = 1/|T| + -- For any c, E_{ti}[1{ti = c}] = 1/|T| + have h_inner : ∀ c : T, + uniformExpect T (fun ti => if ti = c then (1 : ℝ) else 0) = + 1 / Fintype.card T := by + intro c + rw [uniformExpect_eq, Finset.sum_ite_eq', if_pos (Finset.mem_univ c)] + simp [one_div] + simp_rw [h_inner, uniformExpect_const] + +/-- **Birthday bound**: for `q` uniform i.i.d. samples from a set of size `|T|`, +the probability that any two collide is at most `q² / |T|`. -/ +theorem birthday_bound {T : Type*} [Fintype T] [Nonempty T] [DecidableEq T] (q : ℕ) : + uniformExpect (Fin q → T) + (fun ts => if ∃ (i j : Fin q), i < j ∧ ts i = ts j then (1 : ℝ) else 0) ≤ + (q : ℝ) ^ 2 / Fintype.card T := by + -- Step 1: Union bound — indicator of ∃ ≤ sum of indicators over pairs + have h_union : ∀ ts : Fin q → T, + (if ∃ (i j : Fin q), i < j ∧ ts i = ts j then (1 : ℝ) else 0) ≤ + ∑ p : Fin q × Fin q, + if p.1 < p.2 ∧ ts p.1 = ts p.2 then 1 else 0 := by + intro ts + split + · next h => + obtain ⟨i, j, hij, heq⟩ := h + have h_nonneg : ∀ p : Fin q × Fin q, p ∈ Finset.univ → + 0 ≤ (if p.1 < p.2 ∧ ts p.1 = ts p.2 then (1 : ℝ) else 0) := + fun p _ => ite_nonneg zero_le_one (le_refl 0) + have h_le := Finset.single_le_sum h_nonneg (Finset.mem_univ (i, j)) + simp only [hij, heq, and_self, ite_true] at h_le + exact h_le + · exact Finset.sum_nonneg fun p _ => ite_nonneg zero_le_one (le_refl 0) + -- Step 2: E[∑ pair, ...] = ∑ pair, E[...] by linearity, then bound each pair + calc uniformExpect (Fin q → T) + (fun ts => if ∃ (i j : Fin q), i < j ∧ ts i = ts j then (1 : ℝ) else 0) + ≤ uniformExpect (Fin q → T) + (fun ts => ∑ p : Fin q × Fin q, + if p.1 < p.2 ∧ ts p.1 = ts p.2 then 1 else 0) := + uniformExpect_mono _ h_union + _ = ∑ p : Fin q × Fin q, uniformExpect (Fin q → T) + (fun ts => if p.1 < p.2 ∧ ts p.1 = ts p.2 then 1 else 0) := + uniformExpect_finset_sum _ + _ ≤ ∑ _p : Fin q × Fin q, (1 / Fintype.card T : ℝ) := by + apply Finset.sum_le_sum; intro ⟨i, j⟩ _ + by_cases hij : i < j + · simp only [hij, true_and] + exact le_of_eq (uniformExpect_collision_pair i j (ne_of_lt hij)) + · -- When ¬(i < j), the indicator is always 0 + calc uniformExpect (Fin q → T) + (fun ts => if i < j ∧ ts i = ts j then (1 : ℝ) else 0) + = uniformExpect (Fin q → T) (fun _ => 0) := by + congr 1; ext ts; simp [hij] + _ = 0 := uniformExpect_const _ 0 + _ ≤ 1 / Fintype.card T := by positivity + _ = (Fintype.card (Fin q × Fin q) : ℝ) * (1 / Fintype.card T) := by + simp [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + _ ≤ (q : ℝ) ^ 2 / Fintype.card T := by + simp [Fintype.card_prod, Fintype.card_fin]; ring_nf; exact le_refl _ + +end Cslib.Probability + +end diff --git a/Cslib/Probability/ForkingLemma.lean b/Cslib/Probability/ForkingLemma.lean new file mode 100644 index 000000000..07d31602d --- /dev/null +++ b/Cslib/Probability/ForkingLemma.lean @@ -0,0 +1,525 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Cslib.Probability.Discrete + +@[expose] public section + +/-! +# The General Forking Lemma + +The **Forking Lemma** (Bellare-Neven 2006) is a general probabilistic tool +for extracting two accepting transcripts from a single algorithm by +replaying it with a modified random oracle. + +## Setup + +An algorithm takes random coins and a random oracle table `h : Fin q → R` +(q entries from a finite type R). It either fails or outputs a "fork index" +`j : Fin q` and some result. **Forking** means: run once with `h₁`, get +index `j`; build `h_fork` agreeing with `h₁` on indices `< j` but using +fresh randomness `h₂` on indices `≥ j`; run again with `h_fork`. + +## Main Definitions + +* `forkAcceptProb` — acceptance probability of a randomized oracle algorithm +* `forkProb` — probability that forking produces two runs with matching + fork index but differing oracle response at that index + +## Main Results + +* `forking_lemma` — the general forking lemma bound: + `forkProb ≥ acc²/q - acc/|R|` + +## References + +* [M. Bellare, G. Neven, *Multi-Signatures in the Plain Public-Key Model + and a General Forking Lemma*][BellareNeven2006] +* [D. Pointcheval, J. Stern, *Security Arguments for Digital Signatures + and Blind Signatures*][PointchevalStern2000] +-/ + +namespace Cslib.Probability + +/-- Acceptance probability of a randomized oracle algorithm. + +The algorithm takes random coins and a random oracle table +`h : Fin q → R` and either fails (`none`) or outputs a fork index +`j : Fin q` and some result. -/ +noncomputable def forkAcceptProb + {α : Type} (Coins R : Type) [Fintype Coins] [Nonempty Coins] + [Fintype R] [Nonempty R] (q : ℕ) + (run : Coins → (Fin q → R) → Option (Fin q × α)) : ℝ := + uniformExpect (Coins × (Fin q → R)) (fun ⟨c, h⟩ => + match run c h with | none => 0 | some _ => 1) + +/-- Forking success probability. + +Fork an algorithm: run once with `h₁` to get index `j`, build `h_fork` +agreeing with `h₁` on indices `< j` but using fresh `h₂` on indices +`≥ j`, run again. Forking succeeds if both runs output the same index +`j` and the oracle responses at `j` differ. -/ +noncomputable def forkProb + {α : Type} (Coins R : Type) [Fintype Coins] [Nonempty Coins] + [Fintype R] [Nonempty R] [DecidableEq R] (q : ℕ) + (run : Coins → (Fin q → R) → Option (Fin q × α)) : ℝ := + uniformExpect (Coins × (Fin q → R) × (Fin q → R)) + (fun ⟨c, h₁, h₂⟩ => + match run c h₁ with + | none => 0 + | some (j, _) => + let h_fork : Fin q → R := + fun i => if i.val < j.val then h₁ i else h₂ i + match run c h_fork with + | none => 0 + | some (j', _) => + boolToReal (decide (j = j' ∧ h₁ j ≠ h_fork j))) + +/-- `forkAcceptProb` is nonneg: it's the expected value of a {0,1}-valued function. -/ +theorem forkAcceptProb_nonneg + {α : Type} (Coins R : Type) [Fintype Coins] [Nonempty Coins] + [Fintype R] [Nonempty R] (q : ℕ) + (run : Coins → (Fin q → R) → Option (Fin q × α)) : + 0 ≤ forkAcceptProb Coins R q run := by + apply uniformExpect_nonneg + intro ⟨c, h⟩; dsimp only [] + split <;> norm_num + +/-- `forkAcceptProb` is at most 1: it's the expected value of a function bounded by 1. -/ +theorem forkAcceptProb_le_one + {α : Type} (Coins R : Type) [Fintype Coins] [Nonempty Coins] + [Fintype R] [Nonempty R] (q : ℕ) + (run : Coins → (Fin q → R) → Option (Fin q × α)) : + forkAcceptProb Coins R q run ≤ 1 := by + unfold forkAcceptProb + calc uniformExpect (Coins × (Fin q → R)) (fun ⟨c, h⟩ => + match run c h with | none => 0 | some _ => 1) + ≤ uniformExpect (Coins × (Fin q → R)) (fun _ => (1 : ℝ)) := by + apply uniformExpect_mono + intro ⟨c, h⟩; dsimp only [] + split <;> norm_num + _ = 1 := uniformExpect_const _ 1 + +/-- Acceptance probability for fixed coins `c`, averaged over oracle tables. -/ +private noncomputable def perCoinsAcc + {α : Type} {R : Type} [Fintype R] [Nonempty R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) : ℝ := + uniformExpect (Fin q → R) (fun h => + match run c h with | none => 0 | some _ => 1) + +/-- Acceptance probability for fixed coins `c` at a specific index `j`. -/ +private noncomputable def perIndexAcc + {α : Type} {R : Type} [Fintype R] [Nonempty R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (j : Fin q) : ℝ := + uniformExpect (Fin q → R) (fun h => + match run c h with | none => 0 | some (j', _) => if j' = j then 1 else 0) + +/-- The acceptance probability decomposes as a sum over indices: +`perCoinsAcc c = ∑_j perIndexAcc c j`. -/ +private theorem perCoinsAcc_eq_sum + {α : Type} {R : Type} [Fintype R] [Nonempty R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) : + perCoinsAcc run c = ∑ j : Fin q, perIndexAcc run c j := by + unfold perCoinsAcc perIndexAcc + rw [← uniformExpect_finsum] + congr 1; ext h + match hrun : run c h with + | none => simp [Finset.sum_const_zero] + | some (j', _) => + symm + simp only [eq_comm (a := j')] + rw [Finset.sum_ite_eq'] + simp + +/-- Per-coins fork probability: fork success probability for fixed coins `c`. -/ +private noncomputable def perCoinsFork + {α : Type} {R : Type} [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) : ℝ := + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + match run c h₁ with + | none => 0 + | some (j, _) => + let h_fork : Fin q → R := fun i => if i.val < j.val then h₁ i else h₂ i + match run c h_fork with + | none => 0 + | some (j', _) => + boolToReal (decide (j = j' ∧ h₁ j ≠ h_fork j))) + +/-- Per-index fork contribution: expected value of the indicator that the +first run gives index `j`, the second run (with merge at `j`) also gives +index `j`, and the oracle responses at `j` differ. -/ +private noncomputable def perIndexFork + {α : Type} {R : Type} [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (j : Fin q) : ℝ := + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + let acc₁ : ℝ := match run c h₁ with + | none => 0 + | some (j', _) => if j' = j then 1 else 0 + let h_fork : Fin q → R := fun i => if i.val < j.val then h₁ i else h₂ i + let acc₂ : ℝ := match run c h_fork with + | none => 0 + | some (j', _) => if j' = j then 1 else 0 + acc₁ * acc₂ * if h₁ j = h₂ j then 0 else 1) + +/-- The fork integrand decomposes as a sum of per-index contributions. -/ +private theorem perCoinsFork_eq_sum + {α : Type} {R : Type} [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) : + perCoinsFork run c = ∑ j : Fin q, perIndexFork run c j := by + simp only [perCoinsFork, perIndexFork, ← uniformExpect_finsum] + congr 1; ext ⟨h₁, h₂⟩ + dsimp only [] + rcases hrun : run c h₁ with _ | ⟨j, a⟩ + · -- When first run fails: both sides are 0 + simp + · -- When first run gives (j, a): sum collapses to j₀ = j + -- Simplify: j.val < j.val is false, so h_fork j = h₂ j + simp only [show ¬ (j.val < j.val) from Nat.lt_irrefl _, ite_false] + -- Collapse the sum using sum_eq_single: only the x = j term is nonzero + rw [Finset.sum_eq_single j] + · -- Main: show the j-th term equals the LHS + simp only [ite_true, one_mul] + -- Case split on the second run + rcases run c (fun i => if i.val < j.val then h₁ i else h₂ i) with _ | ⟨j', b⟩ + · simp + · by_cases h_jj' : j = j' + · subst h_jj' + simp only [true_and, ite_true] + by_cases h_eq : h₁ j = h₂ j + · simp [boolToReal, h_eq] + · simp [boolToReal, h_eq] + · have h_jj'2 : j' ≠ j := Ne.symm h_jj' + simp [boolToReal, h_jj', h_jj'2] + · -- All x ≠ j terms vanish + intro x _ hxj + simp [Ne.symm hxj] + · -- j ∈ univ (trivial) + intro h; exact absurd (Finset.mem_univ j) h + +/-- Collision bound: the probability that the first run gives index `j` AND +`h₁(j) = h₂(j)` is exactly `perIndexAcc(c,j) / |R|`. -/ +private theorem collision_bound + {α : Type} {R : Type} [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (j : Fin q) : + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0) * + if h₁ j = h₂ j then 1 else 0) = + perIndexAcc run c j / Fintype.card R := by + -- Fubini: separate h₁ and h₂ + rw [uniformExpect_prod] + -- For fixed h₁, factor out acc₁ (constant wrt h₂) + -- and show E_{h₂}[1{h₁(j) = h₂(j)}] = 1/|R| + have h_marginal : ∀ (r : R), + uniformExpect (Fin q → R) (fun h₂ => if r = h₂ j then (1 : ℝ) else 0) = + 1 / Fintype.card R := by + intro r + -- Use funSplitAt to decompose h₂ as (h₂(j), rest) + rw [show (fun h₂ : Fin q → R => if r = h₂ j then (1 : ℝ) else 0) = + (fun p : R × ({i : Fin q // i ≠ j} → R) => if r = p.1 then (1 : ℝ) else 0) ∘ + (Equiv.funSplitAt j R) from by ext h₂; simp [Equiv.funSplitAt], + uniformExpect_congr (Equiv.funSplitAt j R)] + -- Decompose as E_{rj}[E_{rest}[...]] and the inner is constant + rw [uniformExpect_prod] + -- Reduce (a, b).1 to a + conv_lhs => + arg 2; ext a + rw [show (fun b : {i : Fin q // i ≠ j} → R => if r = (a, b).1 then (1 : ℝ) else 0) = + (fun _ => if r = a then (1 : ℝ) else 0) from rfl] + rw [uniformExpect_const] + -- E_a[1{r = a}] = 1/|R| + rw [uniformExpect_eq] + simp only [eq_comm (a := r), Finset.sum_ite_eq', Finset.mem_univ, ite_true] + ring + -- Now simplify the inner expectation + conv_lhs => + arg 2; ext h₁ + rw [show (fun h₂ : Fin q → R => + (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0) * + if h₁ j = h₂ j then 1 else 0) = + (fun h₂ => (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0) * + ((fun h₂ : Fin q → R => if h₁ j = h₂ j then (1 : ℝ) else 0) h₂)) from rfl, + uniformExpect_smul, h_marginal] + -- E_{h₁}[acc₁ * (1/|R|)] = (1/|R|) * perIndexAcc + unfold perIndexAcc + rw [show (fun h₁ : Fin q → R => + (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0) * + (1 / ↑(Fintype.card R))) = + (fun h₁ => (1 / Fintype.card R : ℝ) * + (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0)) from by ext; ring, + uniformExpect_smul] + ring + +/-- Correlation bound: `E[1{first gives j} · 1{second gives j}] ≥ perIndexAcc(c,j)²`. +Uses oracle table split + independence + Jensen. -/ +private theorem correlation_bound + {α : Type} {R : Type} [Fintype R] [Nonempty R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (j : Fin q) : + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + (match run c h₁ with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0) * + (match run c (fun i => if i.val < j.val then h₁ i else h₂ i) with + | none => (0 : ℝ) + | some (j', _) => if j' = j then 1 else 0)) ≥ + perIndexAcc run c j ^ 2 := by + -- Abbreviation for the indicator function + let ind : (Fin q → R) → ℝ := fun h => + match run c h with | none => 0 | some (j', _) => if j' = j then 1 else 0 + -- Prefix/suffix split equiv + let P := {i : Fin q // i.val < j.val} + let S := {i : Fin q // ¬(i.val < j.val)} + let e := Equiv.piEquivPiSubtypeProd (fun i : Fin q => i.val < j.val) (fun _ => R) + -- β(p) = conditional expectation of ind given prefix p + let β : (P → R) → ℝ := fun p => + uniformExpect (S → R) (fun s => ind (e.symm (p, s))) + -- Step A: LHS = E_p[β(p)²] + -- Key merge identity: merge(e.symm(p₁,s₁), e.symm(p₂,s₂)) = e.symm(p₁,s₂) + have merge_eq : ∀ (p₁ : P → R) (s₁ : S → R) (p₂ : P → R) (s₂ : S → R), + (fun i : Fin q => if i.val < j.val then e.symm (p₁, s₁) i else e.symm (p₂, s₂) i) = + e.symm (p₁, s₂) := by + intro p₁ s₁ p₂ s₂; funext i + -- e.symm applies dite on i.val < j.val: choosing p or s component + -- The outer ite selects which e.symm to use + -- When i.val < j.val: outer selects e.symm(p₁,s₁), inner dite selects p₁ + -- When ¬(i.val < j.val): outer selects e.symm(p₂,s₂), inner dite selects s₂ + -- Both match e.symm(p₁,s₂): dite selects p₁ or s₂ + by_cases h : i.val < j.val + · -- i.val < j.val: both sides give p₁ ⟨i, h⟩ + simp only [h, ite_true] + show e.symm (p₁, s₁) i = e.symm (p₁, s₂) i + change (if h' : i.val < j.val then p₁ ⟨i, h'⟩ else s₁ ⟨i, h'⟩) = + (if h' : i.val < j.val then p₁ ⟨i, h'⟩ else s₂ ⟨i, h'⟩) + simp [h] + · -- ¬(i.val < j.val): both sides give s₂ ⟨i, h⟩ + simp only [h, ite_false] + show e.symm (p₂, s₂) i = e.symm (p₁, s₂) i + change (if h' : i.val < j.val then p₂ ⟨i, h'⟩ else s₂ ⟨i, h'⟩) = + (if h' : i.val < j.val then p₁ ⟨i, h'⟩ else s₂ ⟨i, h'⟩) + simp [h] + have lhs_eq : uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + ind h₁ * ind (fun i => if i.val < j.val then h₁ i else h₂ i)) = + uniformExpect (P → R) (fun p => β p ^ 2) := by + -- Sub-step 1: Change variables via Equiv.prodCongr e e + have cov : uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + ind h₁ * ind (fun i => if i.val < j.val then h₁ i else h₂ i)) = + uniformExpect (((P → R) × (S → R)) × ((P → R) × (S → R))) + (fun ⟨⟨p₁, s₁⟩, ⟨_, s₂⟩⟩ => ind (e.symm (p₁, s₁)) * ind (e.symm (p₁, s₂))) := by + -- Change variables via (Equiv.prodCongr e e).symm + rw [← uniformExpect_congr (Equiv.prodCongr e e).symm] + congr 1; ext ⟨⟨p₁, s₁⟩, ⟨p₂, s₂⟩⟩ + simp only [Function.comp_def, Equiv.prodCongr_symm, Equiv.prodCongr_apply, + Prod.map_fst, Prod.map_snd] + congr 1 + exact congr_arg ind (merge_eq p₁ s₁ p₂ s₂) + -- Sub-step 2: Integrate out p₂ + factor s₁,s₂ + collapse to β² + have factor : uniformExpect (((P → R) × (S → R)) × ((P → R) × (S → R))) + (fun ⟨⟨p₁, s₁⟩, ⟨_, s₂⟩⟩ => ind (e.symm (p₁, s₁)) * ind (e.symm (p₁, s₂))) = + uniformExpect (P → R) (fun p => β p ^ 2) := by + -- Convert to projection form for easier rewriting + change uniformExpect _ (fun (x : ((P → R) × (S → R)) × ((P → R) × (S → R))) => + ind (e.symm (x.1.1, x.1.2)) * ind (e.symm (x.1.1, x.2.2))) = _ + -- Fubini: split ((p₁,s₁),(p₂,s₂)) into outer (p₁,s₁) and inner (p₂,s₂) + rw [uniformExpect_prod] + -- Reduce (a,b).1 → a and (a,b).2 → b + dsimp only [] + -- Factor out ind(e⁻¹(a.1,a.2)) from inner (constant wrt b) + simp_rw [uniformExpect_smul] + -- Drop unused b.1: E_{(b₁,b₂)}[ind(e⁻¹(a.1,b₂))] = E_{s₂}[ind(e⁻¹(a.1,s₂))] + have h_drop : ∀ p₁ : P → R, + uniformExpect ((P → R) × (S → R)) (fun b => + ind (e.symm (p₁, b.2))) = β p₁ := by + intro p₁ + exact uniformExpect_prod_ignore_fst (fun s₂ => ind (e.symm (p₁, s₂))) + simp_rw [h_drop] + -- Now: E_{(p₁,s₁)}[ind(e⁻¹(p₁,s₁)) * β(p₁)] = E_p[β(p)²] + rw [uniformExpect_prod]; dsimp only [] + -- Commute and factor out β(p) (constant wrt s₁) + simp_rw [show ∀ (p : P → R) (s : S → R), + ind (e.symm (p, s)) * β p = β p * ind (e.symm (p, s)) from + fun _ _ => mul_comm _ _, uniformExpect_smul] + -- Now E_p[β(p) * β(p)] = E_p[β(p)²] + congr 1; ext p; ring + rw [cov, factor] + -- Step B: Jensen's inequality: E[β²] ≥ (E[β])² + have jensen := uniformExpect_sq_le (P → R) β + -- Step C: E[β] = perIndexAcc + have beta_eq : uniformExpect (P → R) β = perIndexAcc run c j := by + -- β(p) = E_s[ind(e.symm(p,s))], so E_p[β(p)] = E_{(p,s)}[ind(e.symm(p,s))] + change uniformExpect (P → R) (fun p => + uniformExpect (S → R) (fun s => ind (e.symm (p, s)))) = _ + -- Rewrite inner as composition to help Fubini match + rw [show (fun p : P → R => uniformExpect (S → R) (fun s => ind (e.symm (p, s)))) = + (fun p => uniformExpect (S → R) (fun s => (ind ∘ e.symm) (p, s))) from rfl, + ← uniformExpect_prod, + uniformExpect_congr e.symm] + rfl + -- Combine: LHS = E[β²] ≥ (E[β])² = perIndexAcc² + calc uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + ind h₁ * ind (fun i => if i.val < j.val then h₁ i else h₂ i)) + = uniformExpect (P → R) (fun p => β p ^ 2) := lhs_eq + _ ≥ (uniformExpect (P → R) β) ^ 2 := jensen + _ = perIndexAcc run c j ^ 2 := by rw [beta_eq] + +/-- Per-index bound: the fork contribution at index `j` is at least +`perIndexAcc(c,j)² - perIndexAcc(c,j)/|R|`. -/ +private theorem perIndexFork_ge + {α : Type} {R : Type} [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (j : Fin q) : + perIndexFork run c j ≥ perIndexAcc run c j ^ 2 - perIndexAcc run c j / Fintype.card R := by + -- perIndexFork = E[acc₁ · acc₂ · (1 - col)] + -- ≥ E[acc₁ · acc₂] - E[acc₁ · col] + -- ≥ perIndexAcc² - perIndexAcc/|R| + -- Step 1: Pointwise lower bound + -- perIndexFork integrand = acc₁ * acc₂ * notcol ≥ acc₁*acc₂ - acc₁*col + -- because acc₁*acc₂*notcol - (acc₁*acc₂ - acc₁*col) = acc₁*col*(1-acc₂) ≥ 0 + have h_lb : perIndexFork run c j ≥ + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + (match run c h₁ with | none => (0:ℝ) | some (j', _) => if j' = j then 1 else 0) * + (match run c (fun i => if i.val < j.val then h₁ i else h₂ i) with + | none => (0:ℝ) | some (j', _) => if j' = j then 1 else 0)) - + uniformExpect ((Fin q → R) × (Fin q → R)) (fun ⟨h₁, h₂⟩ => + (match run c h₁ with | none => (0:ℝ) | some (j', _) => if j' = j then 1 else 0) * + if h₁ j = h₂ j then 1 else 0) := by + unfold perIndexFork + rw [← uniformExpect_sub] + apply uniformExpect_mono + intro ⟨h₁, h₂⟩ + -- Case split on the first run + rcases hrun₁ : run c h₁ with _ | ⟨j₁, a₁⟩ + · -- acc₁ = 0: both sides 0 + simp [hrun₁] + · by_cases hj₁ : j₁ = j + · -- j₁ = j: acc₁ = 1 + subst hj₁ + simp only [hrun₁, ite_true, one_mul] + -- Case split on the second run + rcases hrun₂ : run c (fun i => if i.val < j₁.val then h₁ i else h₂ i) + with _ | ⟨j₂, a₂⟩ + · simp; split <;> simp + · by_cases hj₂ : j₂ = j₁ + · subst hj₂; simp; split <;> simp + · simp [hj₂]; split <;> simp + · -- j₁ ≠ j: acc₁ = 0 + simp [hrun₁, hj₁] + -- Step 2: Apply correlation and collision bounds + linarith [correlation_bound run c j, collision_bound run c j] + +/-- Per-coins fork bound: for fixed coins `c`, the fork probability is at least +`perCoinsAcc(c)²/q - perCoinsAcc(c)/|R|`. -/ +private theorem per_coins_fork_ge + {α : Type} (R : Type) [Fintype R] [Nonempty R] [DecidableEq R] {q : ℕ} + (run : Coins → (Fin q → R) → Option (Fin q × α)) (c : Coins) (hq : 0 < q) : + perCoinsFork run c ≥ + perCoinsAcc run c ^ 2 / q - perCoinsAcc run c / Fintype.card R := by + -- Decompose into per-index contributions + rw [perCoinsFork_eq_sum] + -- Each per-index contribution ≥ α_j² - α_j/|R| + have h_per_index : ∀ j : Fin q, + perIndexFork run c j ≥ + perIndexAcc run c j ^ 2 - perIndexAcc run c j / Fintype.card R := + fun j => perIndexFork_ge run c j + -- Sum the per-index bounds + have h_sum_ge : ∑ j : Fin q, perIndexFork run c j ≥ + ∑ j : Fin q, (perIndexAcc run c j ^ 2 - perIndexAcc run c j / Fintype.card R) := + Finset.sum_le_sum fun j _ => h_per_index j + -- Split the sum + have h_split : ∑ j : Fin q, + (perIndexAcc run c j ^ 2 - perIndexAcc run c j / Fintype.card R) = + ∑ j : Fin q, perIndexAcc run c j ^ 2 - + ∑ j : Fin q, (perIndexAcc run c j / Fintype.card R) := + Finset.sum_sub_distrib + (fun j => perIndexAcc run c j ^ 2) + (fun j => perIndexAcc run c j / Fintype.card R) + -- The sum of α_j/|R| = perCoinsAcc/|R| + have h_sum_div : ∑ j : Fin q, (perIndexAcc run c j / (Fintype.card R : ℝ)) = + perCoinsAcc run c / Fintype.card R := by + rw [← Finset.sum_div, ← perCoinsAcc_eq_sum] + -- Cauchy-Schwarz: ∑ α_j² ≥ (∑ α_j)²/q + have h_cauchy : ∑ j : Fin q, perIndexAcc run c j ^ 2 ≥ + perCoinsAcc run c ^ 2 / q := by + rw [perCoinsAcc_eq_sum run c] + have hq_pos : (0 : ℝ) < q := Nat.cast_pos.mpr hq + rw [ge_iff_le, div_le_iff₀ hq_pos] + have hcs := Finset.sum_mul_sq_le_sq_mul_sq Finset.univ + (fun j : Fin q => perIndexAcc run c j) (fun _ => (1 : ℝ)) + simp only [one_pow, mul_one, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul, mul_one] at hcs + linarith + linarith + +/-- **The General Forking Lemma** (Bellare-Neven 2006). + +If an algorithm accepts with probability `acc` and outputs a fork index +from `{0, ..., q-1}`, then forking succeeds with probability at least +`acc²/q - acc/|R|`. + +The bound comes from: +1. For fixed coins, the probability of accepting at index `j` is `α_j`. + Forking success for those coins ≥ `∑_j α_j · (α_j - 1/|R|)`. +2. By Cauchy-Schwarz: `∑_j α_j² ≥ (∑_j α_j)²/q`. +3. Average over coins using Jensen (`E[x²] ≥ E[x]²`). -/ +theorem forking_lemma + {α : Type} (Coins R : Type) [Fintype Coins] [Nonempty Coins] + [Fintype R] [Nonempty R] [DecidableEq R] (q : ℕ) + (run : Coins → (Fin q → R) → Option (Fin q × α)) + (hq : 0 < q) : + forkProb Coins R q run ≥ + (forkAcceptProb Coins R q run) ^ 2 / q - + (forkAcceptProb Coins R q run) / Fintype.card R := by + -- Step 1: Fubini — rewrite acc as E_c[perCoinsAcc c] + have acc_eq : forkAcceptProb Coins R q run = + uniformExpect Coins (fun c => perCoinsAcc run c) := by + unfold forkAcceptProb perCoinsAcc + rw [uniformExpect_prod] + -- Step 2: Fubini — rewrite forkProb as E_c[perCoinsFork c] + have fork_eq : forkProb Coins R q run = + uniformExpect Coins (fun c => perCoinsFork run c) := by + unfold forkProb perCoinsFork + rw [uniformExpect_prod] + -- Step 3: Per-coins bound — the heart of the proof + have per_coins : ∀ c : Coins, + perCoinsFork run c ≥ + perCoinsAcc run c ^ 2 / q - perCoinsAcc run c / Fintype.card R := + fun c => per_coins_fork_ge R run c hq + -- Step 4: Combine — Fubini + monotonicity + Jensen + rw [fork_eq, acc_eq] + calc uniformExpect Coins (fun c => perCoinsFork run c) + ≥ uniformExpect Coins (fun c => + perCoinsAcc run c ^ 2 / q - perCoinsAcc run c / Fintype.card R) := + uniformExpect_mono Coins per_coins + _ = uniformExpect Coins (fun c => perCoinsAcc run c ^ 2 / q) - + uniformExpect Coins (fun c => perCoinsAcc run c / Fintype.card R) := by + rw [uniformExpect_sub] + _ = uniformExpect Coins (fun c => perCoinsAcc run c ^ 2) / q - + uniformExpect Coins (fun c => perCoinsAcc run c) / Fintype.card R := by + rw [show (fun c => perCoinsAcc run c ^ 2 / (q : ℝ)) = + (fun c => (1 / q : ℝ) * perCoinsAcc run c ^ 2) from by ext; ring, + uniformExpect_smul, + show (fun c => perCoinsAcc run c / (Fintype.card R : ℝ)) = + (fun c => (1 / Fintype.card R : ℝ) * perCoinsAcc run c) from by ext; ring, + uniformExpect_smul] + ring + _ ≥ (uniformExpect Coins (fun c => perCoinsAcc run c)) ^ 2 / q - + uniformExpect Coins (fun c => perCoinsAcc run c) / Fintype.card R := by + have hj := uniformExpect_sq_le Coins (fun c => perCoinsAcc run c) + have hq_pos : (0 : ℝ) < q := Nat.cast_pos.mpr hq + linarith [div_le_div_of_nonneg_right hj (le_of_lt hq_pos)] + +end Cslib.Probability + +end diff --git a/CslibTests.lean b/CslibTests.lean index 73292aef3..79e09b564 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -1,6 +1,7 @@ module -- shake: keep-all public import CslibTests.Bisimulation +public import CslibTests.BooleanFormula public import CslibTests.CCS public import CslibTests.CLL public import CslibTests.DFA diff --git a/CslibTests/BooleanFormula.lean b/CslibTests/BooleanFormula.lean new file mode 100644 index 000000000..4a8d7792d --- /dev/null +++ b/CslibTests/BooleanFormula.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Cslib.Computability.Circuits.Formula.Std + +namespace CslibTests + +open Cslib.Circuits + +/-! Tests for Boolean formulas over the standard basis. -/ + +inductive TestVar where + | x | y | z + deriving DecidableEq + +def assignment : TestVar → Bool + | .x => true + | .y => false + | .z => true + +def x : Formula TestVar NCOp := .var .x +def y : Formula TestVar NCOp := .var .y +def z : Formula TestVar NCOp := .var .z + +/-! ### Evaluation tests -/ + +example : (Formula.and x y).eval assignment = some false := by + simp [x, y, assignment] + +example : (Formula.or x y).eval assignment = some true := by + simp [x, y, assignment] + +example : (Formula.not y).eval assignment = some true := by + simp [y, assignment] + +example : (Formula.not (Formula.or x z)).eval assignment = some false := by + simp [x, z, assignment] + +example : (Formula.and x (Formula.or y z)).eval assignment = some true := by + simp [x, y, z, assignment] + +/-! ### Double negation -/ + +example : (Formula.not (Formula.not x)).eval assignment = some true := by + simp [x, assignment] + +/-! ### Size tests -/ + +example : (Formula.and x y).size = 3 := by + simp [x, y, Formula.and] + +example : (Formula.not x).size = 2 := by + simp [x, Formula.not] + +example : (Formula.or (Formula.and x y) z).size = 5 := by + simp [x, y, z, Formula.and, Formula.or] + +/-! ### Depth tests -/ + +example : (Formula.and x y).depth = 1 := by + simp [x, y, Formula.and] + +example : (Formula.not x).depth = 1 := by + simp [x, Formula.not] + +example : (Formula.or (Formula.and x y) z).depth = 2 := by + simp [x, y, z, Formula.and, Formula.or] + +/-! ### De Morgan via theorem -/ + +example (v : TestVar → Bool) (a b : Formula TestVar NCOp) : + (Formula.not (Formula.and a b)).eval v = + (Formula.or (Formula.not a) (Formula.not b)).eval v := + Formula.deMorgan_and v a b + +end CslibTests diff --git a/CslibTests/GrindLint.lean b/CslibTests/GrindLint.lean index 67673a40b..bd228d699 100644 --- a/CslibTests/GrindLint.lean +++ b/CslibTests/GrindLint.lean @@ -27,6 +27,18 @@ open_scoped_all Cslib -/ #grind_lint skip Cslib.Bisimilarity.trans +#grind_lint skip Cslib.Circuits.Formula.deMorgan_and +#grind_lint skip Cslib.Circuits.Formula.deMorgan_or +#grind_lint skip Cslib.Circuits.Formula.depth_and +#grind_lint skip Cslib.Circuits.Formula.depth_not +#grind_lint skip Cslib.Circuits.Formula.depth_or +#grind_lint skip Cslib.Circuits.Formula.eval_and +#grind_lint skip Cslib.Circuits.Formula.eval_not +#grind_lint skip Cslib.Circuits.Formula.eval_not_not +#grind_lint skip Cslib.Circuits.Formula.eval_or +#grind_lint skip Cslib.Circuits.Formula.size_and +#grind_lint skip Cslib.Circuits.Formula.size_not +#grind_lint skip Cslib.Circuits.Formula.size_or #grind_lint skip Cslib.FLTS.toLTS_tr #grind_lint skip Cslib.FinFun.coe_fromFun_id #grind_lint skip Cslib.FinFun.fromFun_comm diff --git a/references.bib b/references.bib index 3ad80fe85..ae89b8a05 100644 --- a/references.bib +++ b/references.bib @@ -233,6 +233,15 @@ @incollection{ Thomas1990 year = {1990} } +@book{AroraB2009, + author = {Arora, Sanjeev and Barak, Boaz}, + title = {Computational Complexity: A Modern Approach}, + publisher = {Cambridge University Press}, + year = {2009}, + isbn = {978-0-521-42426-4}, + address = {Cambridge} +} + @book{ Cutland1980, author = {Cutland, Nigel J.}, title = {Computability: An Introduction to Recursive Function Theory}, @@ -254,3 +263,196 @@ @article{ ShepherdsonSturgis1963 publisher = {Association for Computing Machinery}, address = {New York, NY, USA} } + +@inproceedings{ BellareNeven2006, + author = {Bellare, Mihir and Neven, Gregory}, + title = {Multi-Signatures in the Plain Public-Key Model and a General Forking Lemma}, + booktitle = {Proceedings of the 13th ACM Conference on Computer and Communications Security}, + pages = {390--399}, + publisher = {ACM}, + year = {2006}, + doi = {10.1145/1180405.1180453} +} + +@inproceedings{ BellareR1993, + author = {Bellare, Mihir and Rogaway, Phillip}, + title = {Random Oracles are Practical: A Paradigm for Designing Efficient Protocols}, + booktitle = {Proceedings of the 1st ACM Conference on Computer and Communications Security}, + pages = {62--73}, + publisher = {ACM}, + year = {1993}, + doi = {10.1145/168588.168596} +} + +@inproceedings{ BellareR2006, + author = {Bellare, Mihir and Rogaway, Phillip}, + title = {The Security of Triple Encryption and a Framework for Code-Based Game-Playing Proofs}, + booktitle = {Advances in Cryptology -- EUROCRYPT 2006}, + series = {Lecture Notes in Computer Science}, + volume = {4004}, + pages = {409--426}, + publisher = {Springer}, + year = {2006}, + doi = {10.1007/11761679_25} +} + +@inproceedings{ BKR2000, + author = {Bellare, Mihir and Kilian, Joe and Rogaway, Phillip}, + title = {The Security of the Cipher Block Chaining Message Authentication Code}, + booktitle = {Journal of Computer and System Sciences}, + volume = {61}, + number = {3}, + pages = {362--399}, + year = {2000}, + doi = {10.1006/jcss.1999.1694} +} + +@inproceedings{ Blum1981, + author = {Blum, Manuel}, + title = {Coin Flipping by Telephone: A Protocol for Solving Impossible Problems}, + booktitle = {Advances in Cryptology: A Report on CRYPTO 81}, + pages = {11--15}, + year = {1981}, + publisher = {University of California, Santa Barbara} +} + +@inproceedings{ Damgard1987, + author = {Damg{\aa}rd, Ivan Bjerre}, + title = {Collision Free Hash Functions and Public Key Signature Schemes}, + booktitle = {Advances in Cryptology -- EUROCRYPT '87}, + series = {Lecture Notes in Computer Science}, + volume = {304}, + pages = {203--216}, + publisher = {Springer}, + year = {1988}, + doi = {10.1007/3-540-39118-5_19} +} + +@inproceedings{ GGM1986, + author = {Goldreich, Oded and Goldwasser, Shafi and Micali, Silvio}, + title = {How to Construct Random Functions}, + journal = {Journal of the ACM}, + volume = {33}, + number = {4}, + pages = {792--807}, + year = {1986}, + doi = {10.1145/6490.6503}, + publisher = {Association for Computing Machinery} +} + +@article{ GMR1988, + author = {Goldwasser, Shafi and Micali, Silvio and Rivest, Ronald L.}, + title = {A Digital Signature Scheme Secure Against Adaptive Chosen-Message Attacks}, + journal = {SIAM Journal on Computing}, + volume = {17}, + number = {2}, + pages = {281--308}, + year = {1988}, + doi = {10.1137/0217017} +} + +@inproceedings{ FiatShamir1986, + author = {Fiat, Amos and Shamir, Adi}, + title = {How to Prove Yourself: Practical Solutions to Identification and Signature Problems}, + booktitle = {Advances in Cryptology -- CRYPTO '86}, + series = {Lecture Notes in Computer Science}, + volume = {263}, + pages = {186--194}, + publisher = {Springer}, + year = {1987}, + doi = {10.1007/3-540-47721-7_12} +} + +@book{ Goldreich2001, + author = {Goldreich, Oded}, + title = {Foundations of Cryptography, Volume 1: Basic Tools}, + publisher = {Cambridge University Press}, + year = {2001}, + isbn = {978-0-521-79172-5}, + address = {Cambridge} +} + +@article{ GoldwasserM1984, + author = {Goldwasser, Shafi and Micali, Silvio}, + title = {Probabilistic Encryption}, + journal = {Journal of Computer and System Sciences}, + volume = {28}, + number = {2}, + pages = {270--299}, + year = {1984}, + doi = {10.1016/0022-0000(84)90070-9} +} + +@article{ HILL1999, + author = {H{\aa}stad, Johan and Impagliazzo, Russell and Levin, Leonid A. and Luby, Michael}, + title = {A Pseudorandom Generator from any One-Way Function}, + journal = {SIAM Journal on Computing}, + volume = {28}, + number = {4}, + pages = {1364--1396}, + year = {1999}, + doi = {10.1137/S0097539793244708} +} + +@book{ KatzLindell2014, + author = {Katz, Jonathan and Lindell, Yehuda}, + title = {Introduction to Modern Cryptography}, + edition = {2nd}, + publisher = {Chapman and Hall/CRC}, + year = {2014}, + isbn = {978-1-4665-7026-9} +} + +@inproceedings{ RogawayS2004, + author = {Rogaway, Phillip and Shrimpton, Thomas}, + title = {Cryptographic Hash-Function Basics: Definitions, Implications, and Separations for Preimage Resistance, Second-Preimage Resistance, and Collision Resistance}, + booktitle = {Fast Software Encryption -- FSE 2004}, + series = {Lecture Notes in Computer Science}, + volume = {3017}, + pages = {371--388}, + publisher = {Springer}, + year = {2004}, + doi = {10.1007/978-3-540-25937-4_24} +} + +@inproceedings{ PointchevalStern2000, + author = {Pointcheval, David and Stern, Jacques}, + title = {Security Arguments for Digital Signatures and Blind Signatures}, + journal = {Journal of Cryptology}, + volume = {13}, + number = {3}, + pages = {361--396}, + year = {2000}, + doi = {10.1007/s001450010003} +} + +@article{ Schnorr1991, + author = {Schnorr, Claus-Peter}, + title = {Efficient Signature Generation by Smart Cards}, + journal = {Journal of Cryptology}, + volume = {4}, + number = {3}, + pages = {161--174}, + year = {1991}, + doi = {10.1007/BF00196725} +} + +@inproceedings{ CDS1994, + author = {Cramer, Ronald and Damg{\aa}rd, Ivan and Schoenmakers, Berry}, + title = {Proofs of Partial Knowledge and Simplified Design of Witness Hiding Protocols}, + booktitle = {Advances in Cryptology --- {CRYPTO} '94}, + series = {Lecture Notes in Computer Science}, + volume = {839}, + pages = {174--187}, + publisher = {Springer}, + year = {1994}, + doi = {10.1007/3-540-48658-5_19} +} + +@article{ Shoup2004, + author = {Shoup, Victor}, + title = {Sequences of Games: A Tool for Taming Complexity in Security Proofs}, + howpublished = {Cryptology ePrint Archive, Report 2004/332}, + year = {2004}, + url = {https://eprint.iacr.org/2004/332} +}