From 20f3f0cd093cb256f9dd0c62df6842bd401a5c14 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Thu, 5 Mar 2026 22:57:17 -0500 Subject: [PATCH 01/10] refactor(Computability): improve SingleTapeTM composition API Move Symbol typeclass assumptions into SingleTapeTM fields, reducing repeated section-level assumptions. Add core transition lemmas: determinism of TransitionRelation, no_step_from_halt, and reachable_steps_le_halting_steps for bounding chain lengths to halting endpoints. Introduce monotoneEnvelope for running maxima, with proofs of monotonicity, pointwise bounds, and comparison with monotone upper bounds. Add TimeComputable.toMonotone and rewrite TimeComputable.comp to internalize monotonicity handling, removing the external monotonicity parameter from composition. Update PolyTimeComputable.comp accordingly. --- .../Machines/SingleTapeTuring/Basic.lean | 199 +++++++++++++----- 1 file changed, 147 insertions(+), 52 deletions(-) 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 From 439ab0b62b2a3b5e2110c8e285bdccf15db93fe8 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Thu, 5 Mar 2026 22:57:32 -0500 Subject: [PATCH 02/10] feat(Computability): add complexity classes P, NP, coNP, PSPACE and reductions Define the fundamental complexity classes using single-tape Turing machines, namespaced under Cslib.Complexity. Classes/Core.lean: shared language-level definitions Decides and Verifies. Classes/Time.lean: P, NP, CoNP, PNeNP, and foundational results P_subset_NP and NP_subset_CoNP_iff. Classes/Space.lean: OutputsWithinSpace, SpaceBoundedComputable, PSPACE, and P_subset_PSPACE (a TM running in time t uses at most t work cells). Reductions.lean: polynomial-time many-one reductions (PolyTimeReduces), NPHard, NPComplete, with reflexivity, transitivity, downward closure under P, and NPHard.p_eq_np. --- Cslib.lean | 2 + Cslib/Computability/Complexity/Classes.lean | 11 ++ .../Complexity/Classes/Core.lean | 50 +++++++ .../Complexity/Classes/Space.lean | 133 ++++++++++++++++++ .../Complexity/Classes/Time.lean | 103 ++++++++++++++ .../Computability/Complexity/Reductions.lean | 125 ++++++++++++++++ 6 files changed, 424 insertions(+) create mode 100644 Cslib/Computability/Complexity/Classes.lean create mode 100644 Cslib/Computability/Complexity/Classes/Core.lean create mode 100644 Cslib/Computability/Complexity/Classes/Space.lean create mode 100644 Cslib/Computability/Complexity/Classes/Time.lean create mode 100644 Cslib/Computability/Complexity/Reductions.lean diff --git a/Cslib.lean b/Cslib.lean index a9d5ffc3e..1bcab64d4 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -30,6 +30,8 @@ public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.Complexity.Classes +public import Cslib.Computability.Complexity.Reductions public import Cslib.Computability.URM.Basic public import Cslib.Computability.URM.Computable public import Cslib.Computability.URM.Defs 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/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 From 9d0d5f7ad87724e6feaa4ba9c5f25de33776e196 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:09:09 -0500 Subject: [PATCH 03/10] feat(Computability): add Boolean circuits, formulas, and circuit complexity hierarchy MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Introduces a circuit and formula framework for Boolean computation, along with the NC and AC circuit complexity hierarchies. ## Circuits and Formulas - `Basis`: typeclass for circuit operation sets with arity and evaluation - `Circuit`: DAG-based Boolean circuits with `eval`, `size`, `depth`, `mapOp` - `CircuitFamily`: indexed families for uniform complexity definitions - `Formula`: tree-structured formulas with standard basis (AND, OR, NOT) - Structural measures (`size`, `depth`, `leafCount`, `gateCount`) - Standard basis constructors and `deMorgan` normalization ## Circuit Complexity - `SizeDepth`: languages decidable by bounded-size, bounded-depth circuits - `NC k` / `AC k`: the standard circuit complexity hierarchies - `NC k ⊆ NC (k+1)`, `NC k ⊆ AC k`, `AC k ⊆ NC (k+1)` - `NonUniform.PSlashPoly`: non-uniform polynomial circuits (P/poly) - `PSPACE_class`: space complexity class definition ## References - [Arora, Barak — Computational Complexity: A Modern Approach][AroraB2009] --- Cslib.lean | 8 + Cslib/Computability/Circuits/Basis.lean | 136 +++++++ .../Computability/Circuits/Circuit/Basic.lean | 355 ++++++++++++++++++ .../Computability/Circuits/Formula/Basic.lean | 184 +++++++++ .../Circuits/Formula/Measures.lean | 128 +++++++ Cslib/Computability/Circuits/Formula/Std.lean | 183 +++++++++ .../Complexity/CircuitHierarchy.lean | 296 +++++++++++++++ .../Computability/Complexity/NonUniform.lean | 95 +++++ Cslib/Computability/Complexity/Space.lean | 16 + CslibTests.lean | 1 + CslibTests/BooleanFormula.lean | 79 ++++ CslibTests/GrindLint.lean | 12 + references.bib | 9 + 13 files changed, 1502 insertions(+) create mode 100644 Cslib/Computability/Circuits/Basis.lean create mode 100644 Cslib/Computability/Circuits/Circuit/Basic.lean create mode 100644 Cslib/Computability/Circuits/Formula/Basic.lean create mode 100644 Cslib/Computability/Circuits/Formula/Measures.lean create mode 100644 Cslib/Computability/Circuits/Formula/Std.lean create mode 100644 Cslib/Computability/Complexity/CircuitHierarchy.lean create mode 100644 Cslib/Computability/Complexity/NonUniform.lean create mode 100644 Cslib/Computability/Complexity/Space.lean create mode 100644 CslibTests/BooleanFormula.lean diff --git a/Cslib.lean b/Cslib.lean index 1bcab64d4..aeab715c2 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -22,6 +22,14 @@ 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.NonUniform +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 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/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/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/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..c10581123 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}, From 8c97d137e111aa21bffcab5c2d6f9df31d504382 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:09:57 -0500 Subject: [PATCH 04/10] feat(Probability): add discrete probability and General Forking Lemma MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Introduces foundational discrete probability theory and the General Forking Lemma of Bellare-Neven (2006). ## Discrete Probability - `uniformExpect`: expected value under the uniform distribution - `uniformProb`: probability of an event under the uniform distribution - Key lemmas: linearity, monotonicity, indicator sums, product sampling - `uniformExpect_eval_at_point`: evaluating a random function at a fixed point equals sampling a uniform value ## General Forking Lemma - `forking_lemma`: if an algorithm accepts with probability `acc`, then replaying with fresh randomness at a random fork point succeeds with probability `≥ acc²/q - acc/|H|` - Proved sorry-free from first principles ## References - [Bellare, Neven — Multi-Signatures and a General Forking Lemma][BellareNeven2006] - [Pointcheval, Stern — Security Arguments for Digital Signatures][PointchevalStern2000] --- Cslib.lean | 2 + Cslib/Probability/Discrete.lean | 501 ++++++++++++++++++++++++++ Cslib/Probability/ForkingLemma.lean | 525 ++++++++++++++++++++++++++++ references.bib | 21 ++ 4 files changed, 1049 insertions(+) create mode 100644 Cslib/Probability/Discrete.lean create mode 100644 Cslib/Probability/ForkingLemma.lean diff --git a/Cslib.lean b/Cslib.lean index aeab715c2..f084e53a5 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -108,3 +108,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/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/references.bib b/references.bib index c10581123..7d62f70df 100644 --- a/references.bib +++ b/references.bib @@ -263,3 +263,24 @@ @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{ 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} +} From 9060179679a4ee9c685b03a329fe20bef9d98a83 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:10:34 -0500 Subject: [PATCH 05/10] =?UTF-8?q?feat(Cryptography):=20add=20foundations?= =?UTF-8?q?=20=E2=80=94=20negligible=20functions,=20security=20games,=20in?= =?UTF-8?q?distinguishability?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Introduces the foundational framework for game-based cryptographic security definitions. ## Main Definitions - `Negligible` / `PolynomiallyBounded` / `Noticeable`: asymptotic notions - `SecurityGame`: abstract game-based security parameterized by adversary type - `SecurityReduction`: advantage-preserving adversary transformation - `Ensemble` / `PMFEnsemble`: probability distribution families - `CompIndistinguishable` / `StatIndistinguishable`: indistinguishability notions - `PolyTimeDistinguisher`: polynomial-time distinguisher formalization - `OracleInteraction`: stateful multi-query oracle interaction model - `RandomOracle` / `ROM_EUF_CMA_Game`: random oracle model definitions ## Main Results - Negligible closure: `zero`, `neg`, `add`, `mono`, `mul_polyBounded`, `sqrt_nonneg` - `SecurityReduction.secure_transfer`: reductions transfer security - Perfect ⇒ statistical ⇒ computational indistinguishability ## References - [Goldreich — Foundations of Cryptography, Vol. 1][Goldreich2001] - [Katz, Lindell — Introduction to Modern Cryptography][KatzLindell2014] - [Bellare, Rogaway — Random Oracles are Practical][BellareR1993] - [Bellare, Rogaway — Code-Based Game-Playing Proofs][BellareR2006] - [Shoup — Sequences of Games][Shoup2004] --- Cslib.lean | 6 + .../Foundations/Indistinguishability.lean | 278 +++++++++ .../Cryptography/Foundations/Negligible.lean | 265 +++++++++ .../Foundations/OracleInteraction.lean | 557 ++++++++++++++++++ .../Foundations/PolyTimeDistinguisher.lean | 111 ++++ .../Foundations/RandomOracle.lean | 219 +++++++ .../Foundations/SecurityGame.lean | 184 ++++++ references.bib | 48 ++ 8 files changed, 1668 insertions(+) create mode 100644 Cslib/Cryptography/Foundations/Indistinguishability.lean create mode 100644 Cslib/Cryptography/Foundations/Negligible.lean create mode 100644 Cslib/Cryptography/Foundations/OracleInteraction.lean create mode 100644 Cslib/Cryptography/Foundations/PolyTimeDistinguisher.lean create mode 100644 Cslib/Cryptography/Foundations/RandomOracle.lean create mode 100644 Cslib/Cryptography/Foundations/SecurityGame.lean diff --git a/Cslib.lean b/Cslib.lean index f084e53a5..03b9f62a1 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -46,6 +46,12 @@ 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.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.Foundations.Combinatorics.InfiniteGraphRamsey public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects 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/references.bib b/references.bib index 7d62f70df..3877c060a 100644 --- a/references.bib +++ b/references.bib @@ -264,6 +264,54 @@ @article{ ShepherdsonSturgis1963 address = {New York, NY, USA} } +@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} +} + +@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} +} + +@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} +} + +@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} +} + @inproceedings{ BellareNeven2006, author = {Bellare, Mihir and Neven, Gregory}, title = {Multi-Signatures in the Plain Public-Key Model and a General Forking Lemma}, From 0e78dbb2c967c87788c4ad27ea201bcbb608c60f Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:11:19 -0500 Subject: [PATCH 06/10] feat(Cryptography): add primitives and hardness assumptions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Defines standard cryptographic primitives and their game-based security notions, plus discrete logarithm hardness assumptions. ## Primitives - `EncryptionScheme` with `IND_CPA_Game` and `IND_CCA_Game` - `PRF` / `PRG` with distinguishing security games - `MACScheme` / `SignatureScheme` with `EUF_CMA_Game` - `OWF` with `InversionGame` - `HashFamily` with `CollisionGame` and `SecondPreimageGame` - `CommitmentScheme` with hiding and binding properties ## Hardness Assumptions - `CyclicGroupFamily`: parameterized cyclic group families - `DLog_Game`: discrete logarithm security game - `DLog_Secure`: DLog hardness assumption ## References - [Goldwasser, Micali — Probabilistic Encryption][GoldwasserM1984] - [GGM — How to Construct Random Functions][GGM1986] - [HILL — A PRG from any OWF][HILL1999] - [GMR — Digital Signatures Secure Against CMA][GMR1988] - [BKR — Security of CBC-MAC][BKR2000] - [Rogaway, Shrimpton — Hash-Function Basics][RogawayS2004] - [Damgård — Collision Free Hash Functions][Damgard1987] - [Blum — Coin Flipping by Telephone][Blum1981] --- Cslib.lean | 9 + .../Cryptography/Assumptions/DiscreteLog.lean | 190 +++++++++++++ Cslib/Cryptography/Primitives/Commitment.lean | 226 ++++++++++++++++ Cslib/Cryptography/Primitives/Encryption.lean | 254 ++++++++++++++++++ .../Cryptography/Primitives/HashFunction.lean | 196 ++++++++++++++ Cslib/Cryptography/Primitives/MAC.lean | 137 ++++++++++ .../Primitives/OneWayFunction.lean | 113 ++++++++ Cslib/Cryptography/Primitives/PRF.lean | 106 ++++++++ Cslib/Cryptography/Primitives/PRG.lean | 97 +++++++ Cslib/Cryptography/Primitives/Signature.lean | 160 +++++++++++ references.bib | 89 ++++++ 11 files changed, 1577 insertions(+) create mode 100644 Cslib/Cryptography/Assumptions/DiscreteLog.lean create mode 100644 Cslib/Cryptography/Primitives/Commitment.lean create mode 100644 Cslib/Cryptography/Primitives/Encryption.lean create mode 100644 Cslib/Cryptography/Primitives/HashFunction.lean create mode 100644 Cslib/Cryptography/Primitives/MAC.lean create mode 100644 Cslib/Cryptography/Primitives/OneWayFunction.lean create mode 100644 Cslib/Cryptography/Primitives/PRF.lean create mode 100644 Cslib/Cryptography/Primitives/PRG.lean create mode 100644 Cslib/Cryptography/Primitives/Signature.lean diff --git a/Cslib.lean b/Cslib.lean index 03b9f62a1..678bb724f 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -52,6 +52,15 @@ 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.Assumptions.DiscreteLog +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.Foundations.Combinatorics.InfiniteGraphRamsey public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects 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/Primitives/Commitment.lean b/Cslib/Cryptography/Primitives/Commitment.lean new file mode 100644 index 000000000..a2a0573db --- /dev/null +++ b/Cslib/Cryptography/Primitives/Commitment.lean @@ -0,0 +1,226 @@ +/- +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. -/ +structure CommitmentScheme.BindingAdversary (C : CommitmentScheme) where + /-- Given the security parameter, produce a commitment that can be + opened to two different messages. Returns (commitment, msg1, + opening1, msg2, opening2). -/ + forge : (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. -/ +def CommitmentScheme.BindingGame (C : CommitmentScheme) + [∀ n, DecidableEq (C.Message n)] : + SecurityGame (CommitmentScheme.BindingAdversary C) where + advantage A n := + let (com, m₁, o₁, m₂, o₂) := A.forge n + 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 + /-- Commit key type is finite (for sampling) -/ + commitKeyFintype : ∀ n, Fintype (CommitKey n) + /-- Commit key type is nonempty -/ + commitKeyNonempty : ∀ n, Nonempty (CommitKey n) + /-- Create a commitment given key and message -/ + commit : (n : ℕ) → CommitKey n → Message 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), + let (com, opening) := C.commit n ck m + C.verify n ck com m opening = true + +/-- 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..119b4ca4d --- /dev/null +++ b/Cslib/Cryptography/Primitives/Encryption.lean @@ -0,0 +1,254 @@ +/- +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 + +/-! +# 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 abstractly: an IND-CPA adversary produces two +challenge messages and then guesses which was encrypted. 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 + /-- 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. -/ +def PKEncryptionScheme.Correct (E : PKEncryptionScheme) + (keyPair : (n : ℕ) → E.PublicKey n × E.SecretKey n) : Prop := + ∀ (n : ℕ) (m : E.Plaintext n) (r : E.Randomness n), + let (pk, sk) := keyPair n + 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: +1. `choose` — given the security parameter, produce two challenge + messages `(m₀, m₁)` and some state `σ` +2. `guess` — given the challenge ciphertext and state, guess which + message was encrypted (returns `Bool`, `true` = guessed `m₁`) + +The adversary has access to an encryption oracle (modeled externally +by giving it the key in the `choose` phase for CPA). -/ +structure IND_CPA_Adversary (E : EncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Phase 1: choose two challenge messages -/ + choose : (n : ℕ) → (E.Plaintext n → E.Randomness n → E.Ciphertext n) → + E.Plaintext n × E.Plaintext n × State n + /-- Phase 2: guess which message was encrypted -/ + guess : (n : ℕ) → E.Ciphertext n → State n → Bool + +/-- The **IND-CPA advantage** of adversary `A` at security parameter `n`, +given a specific key `k`, randomness `r` for encryption, and a +challenge bit `b`: + +`Adv = |Pr[A guesses correctly] - 1/2|` + +Since we don't have a probability monad, we define the advantage as a +function of all the randomness, and security requires it to be negligible +over the choice of randomness. -/ +noncomputable def IND_CPA_Advantage (E : EncryptionScheme) (A : IND_CPA_Adversary E) + (n : ℕ) (k : E.Key n) (r : E.Randomness n) (b : Bool) : ℝ := + let oracle := E.encrypt n k + let (m₀, m₁, σ) := A.choose n (fun m r' => oracle m r') + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n k challenge r + let b' := A.guess n ct σ + if b' = b then 1 else 0 + +/-- The **IND-CPA security game** for a symmetric encryption scheme. + +The advantage is +$$\mathbb{E}_{k,r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2$$ +where `k` is a random key, `r` is random encryption coins, and `b` is a +random challenge bit. The coin space is `Key n × Randomness n × Bool`. -/ +noncomputable def IND_CPA_Game (E : EncryptionScheme) : + SecurityGame (IND_CPA_Adversary E) where + advantage A n := + letI := E.keyFintype n; letI := E.keyNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect (E.Key n × E.Randomness n × Bool) + (fun ⟨k, r, b⟩ => + let oracle := E.encrypt n k + let (m₀, m₁, σ) := A.choose n (fun m r' => oracle m r') + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n k challenge r + let b' := A.guess n ct σ + Cslib.Probability.boolToReal (b' == b)) + - 1 / 2| + +/-! ### IND-CCA Security -/ + +/-- An **IND-CCA adversary** has access to a decryption oracle in +addition to the encryption oracle, with the restriction that it cannot +query the decryption oracle on the challenge ciphertext. + +Phase 1 and Phase 2 both have oracle access. -/ +structure IND_CCA_Adversary (E : EncryptionScheme) where + /-- Adversary state type -/ + State : ℕ → Type + /-- Phase 1: choose messages with encryption and decryption oracle access -/ + choose : (n : ℕ) → + (E.Plaintext n → E.Randomness n → E.Ciphertext n) → -- enc oracle + (E.Ciphertext n → Option (E.Plaintext n)) → -- dec oracle + E.Plaintext n × E.Plaintext n × State n + /-- Phase 2: guess with oracle access (cannot query challenge ct) -/ + guess : (n : ℕ) → E.Ciphertext n → State n → + (E.Ciphertext n → Option (E.Plaintext n)) → -- dec oracle + Bool + +/-- The **IND-CCA security game** for a symmetric encryption scheme. + +The advantage is +$$\mathbb{E}_{k,r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2$$ +where `k` is a random key, `r` is random encryption coins, and `b` is a +random challenge bit. + +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. -/ +noncomputable def IND_CCA_Game (E : EncryptionScheme) + [∀ n, DecidableEq (E.Ciphertext n)] : + SecurityGame (IND_CCA_Adversary E) where + advantage A n := + letI := E.keyFintype n; letI := E.keyNonempty n + letI := E.randomnessFintype n; letI := E.randomnessNonempty n + |Cslib.Probability.uniformExpect (E.Key n × E.Randomness n × Bool) + (fun ⟨k, r, b⟩ => + let encOracle := E.encrypt n k + let decOracle := E.decrypt n k + let (m₀, m₁, σ) := A.choose n encOracle decOracle + let challenge := if b then m₁ else m₀ + let ct := E.encrypt n k challenge r + -- Restricted decryption oracle: refuses to decrypt the challenge ct + let decOracle' : E.Ciphertext n → Option (E.Plaintext n) := + fun c => if c = ct then none else E.decrypt n k c + let b' := A.guess n ct σ decOracle' + 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 + choose n encOracle _decOracle := + A.choose n encOracle + 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 + choose n encOracle := + A.choose n encOracle (fun _ => none) + guess n ct σ := + A.guess n ct σ (fun _ => none) + +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..28fb31943 --- /dev/null +++ b/Cslib/Cryptography/Primitives/PRG.lean @@ -0,0 +1,97 @@ +/- +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 is strictly longer than the seed (expansion) -/ + seedLength : ℕ → ℕ + outputLength : ℕ → ℕ + expansion : ∀ n, seedLength n < outputLength 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/references.bib b/references.bib index 3877c060a..c8303b840 100644 --- a/references.bib +++ b/references.bib @@ -264,6 +264,95 @@ @article{ ShepherdsonSturgis1963 address = {New York, NY, USA} } +@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} +} + +@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} +} + +@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{ BellareR1993, author = {Bellare, Mihir and Rogaway, Phillip}, title = {Random Oracles are Practical: A Paradigm for Designing Efficient Protocols}, From fcd05952a9bd53501e1aa10548210688dce9ee23 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:11:50 -0500 Subject: [PATCH 07/10] feat(Cryptography): add Sigma protocols with Schnorr and Fiat-Shamir MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Defines Sigma protocols and their security properties, with concrete instantiations for Schnorr identification and the Fiat-Shamir transform. ## Sigma Protocols - `SigmaProtocol`: three-move interactive proof structure - `SpecialSoundness` / `SpecialHVZK`: security properties - AND/OR combinators (`SigmaAnd`, `SigmaOr`) with security proofs ## Fiat-Shamir Transform - `FiatShamir.toSignatureScheme`: Sigma protocol → signature scheme - Deterministic challenge derivation from hash of (message, commitment) ## Schnorr Protocol - `SchnorrSigma`: Sigma protocol for discrete log relation - `SchnorrSignatureScheme`: Schnorr signatures via Fiat-Shamir - Special soundness and special HVZK proofs ## References - [Fiat, Shamir — How to Prove Yourself][FiatShamir1986] - [Schnorr — Efficient Signature Generation][Schnorr1991] - [Cramer, Damgård, Schoenmakers — Proofs of Partial Knowledge][CDS1994] --- Cslib.lean | 4 + Cslib/Cryptography/Protocols/Combinators.lean | 412 ++++++++++++++++++ Cslib/Cryptography/Protocols/FiatShamir.lean | 117 +++++ Cslib/Cryptography/Protocols/Schnorr.lean | 274 ++++++++++++ .../Cryptography/Protocols/SigmaProtocol.lean | 200 +++++++++ references.bib | 35 ++ 6 files changed, 1042 insertions(+) create mode 100644 Cslib/Cryptography/Protocols/Combinators.lean create mode 100644 Cslib/Cryptography/Protocols/FiatShamir.lean create mode 100644 Cslib/Cryptography/Protocols/Schnorr.lean create mode 100644 Cslib/Cryptography/Protocols/SigmaProtocol.lean diff --git a/Cslib.lean b/Cslib.lean index 678bb724f..c69667218 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -61,6 +61,10 @@ 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.Foundations.Combinatorics.InfiniteGraphRamsey public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects 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/references.bib b/references.bib index c8303b840..2aa68553e 100644 --- a/references.bib +++ b/references.bib @@ -411,6 +411,41 @@ @inproceedings{ BellareNeven2006 doi = {10.1145/1180405.1180453} } +@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} +} + +@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} +} + @inproceedings{ PointchevalStern2000, author = {Pointcheval, David and Stern, Jacques}, title = {Security Arguments for Digital Signatures and Blind Signatures}, From b750d37e61e50549a056384b9f702f8c3613e88a Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:12:19 -0500 Subject: [PATCH 08/10] feat(Cryptography): add security reductions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Proves concrete security reductions between cryptographic primitives and the Fiat-Shamir ROM security theorem. ## Primitive Reductions - `PRGtoEncryption`: PRG security ⇒ IND-CPA security of PRG-based encryption - `PRFtoEncryption`: PRF security ⇒ IND-CPA security of PRF-based encryption - `PRFtoMAC`: PRF security ⇒ EUF-CMA security of PRF-based MAC - `HashToCommitment`: collision resistance ⇒ binding of hash-based commitments ## Fiat-Shamir ROM Reduction (Boneh-Shoup §19.6) - `fiatShamir_ROM_bound`: concrete bound `ROM-EUF-CMA advantage ≤ √(q · Adv_R + q/|Ch|) + q² · δ` - `fiatShamirReduction`: relation solver from EUF-CMA adversary via forking lemma and special soundness - `fiatShamir_ROM_secure`: asymptotic EUF-CMA security under computational hardness, super-polynomial challenges, and negligible commitment unpredictability - Game-hop chain: ROM → LazyROM → MapGame_Real → MapGame1_HVZK with commitment-collision and HVZK-simulation arguments --- Cslib.lean | 5 + .../Reductions/FiatShamirROM.lean | 3107 +++++++++++++++++ .../Reductions/HashToCommitment.lean | 114 + .../Reductions/PRFtoEncryption.lean | 365 ++ Cslib/Cryptography/Reductions/PRFtoMAC.lean | 202 ++ .../Reductions/PRGtoEncryption.lean | 225 ++ 6 files changed, 4018 insertions(+) create mode 100644 Cslib/Cryptography/Reductions/FiatShamirROM.lean create mode 100644 Cslib/Cryptography/Reductions/HashToCommitment.lean create mode 100644 Cslib/Cryptography/Reductions/PRFtoEncryption.lean create mode 100644 Cslib/Cryptography/Reductions/PRFtoMAC.lean create mode 100644 Cslib/Cryptography/Reductions/PRGtoEncryption.lean diff --git a/Cslib.lean b/Cslib.lean index c69667218..dd185b625 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -65,6 +65,11 @@ 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 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..48ae77186 --- /dev/null +++ b/Cslib/Cryptography/Reductions/HashToCommitment.lean @@ -0,0 +1,114 @@ +/- +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 + commitKeyFintype := H.keyFintype + commitKeyNonempty := H.keyNonempty + 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 + 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..898119185 --- /dev/null +++ b/Cslib/Cryptography/Reductions/PRFtoEncryption.lean @@ -0,0 +1,365 @@ +/- +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] + +/-- Auxiliary: construct a PRF adversary from an IND-CPA adversary. + +Given families `r(n)` and `b(n)` specifying the encryption randomness +and challenge bit at each security parameter, the PRF adversary +simulates the IND-CPA game using its oracle (either `F(k, ·)` or a +random function). -/ +noncomputable def PRF.mkPRFAdversary (F : PRF) + [∀ n, AddCommGroup (F.Output n)] + [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] + (A : IND_CPA_Adversary F.toEncryptionScheme) + (r : (n : ℕ) → F.Input n) (b : ℕ → Bool) : + PRF.OracleAdversary F where + run n oracle := by + let E := F.toEncryptionScheme + let toPlain : F.Output n → E.Plaintext n := + cast (PRF.toEncryptionScheme_Plaintext F n).symm + let fromPlain : E.Plaintext n → F.Output n := + cast (PRF.toEncryptionScheme_Plaintext F n) + let toCipher : F.Input n × F.Output n → E.Ciphertext n := + cast (PRF.toEncryptionScheme_Ciphertext F n).symm + let encOracle : E.Plaintext n → E.Randomness n → E.Ciphertext n := + fun m r' => + toCipher (cast (PRF.toEncryptionScheme_Randomness F n) r', + oracle (cast (PRF.toEncryptionScheme_Randomness F n) r') + + fromPlain m) + let result := A.choose n encOracle + let m₀ := fromPlain result.1 + let m₁ := fromPlain result.2.1 + let σ := result.2.2 + let challenge : F.Output n := if b n then m₁ else m₀ + let ct := toCipher (r n, oracle (r n) + challenge) + exact (A.guess n ct σ) == (b n) + +/-- 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), randomness `r₀`, and challenge bit `b₀`, compute whether +the adversary guesses the challenge bit correctly. + +The definition mirrors the game body from `IND_CPA_Game` to ensure +definitional equality when the oracle is `F.eval n k`. -/ +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) : Bool := + let encOracle : F.Output n → F.Input n → F.Input n × F.Output n := + fun m r' => (r', oracle r' + m) + let result := A.choose n encOracle + let m₀ : F.Output n := result.1 + let m₁ : F.Output n := result.2.1 + let σ := result.2.2 + let challenge : F.Output n := if b₀ then m₁ else m₀ + let ct : F.Input n × F.Output n := (r₀, oracle r₀ + challenge) + (A.guess n ct σ) == 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) : + PRF.OracleAdversary F where + run n oracle := + if h : n = n₀ then + F.simulateBody A n₀ r₀ b₀ + (fun x => cast (congrArg F.Output h) + (oracle (cast (congrArg F.Input h.symm) x))) + else true + +/-- At the target parameter, `mkPRFAdversaryAt` agrees with +`simulateBody`. -/ +theorem PRF.mkPRFAdversaryAt_run (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) : + (F.mkPRFAdversaryAt A n r₀ b₀).run n oracle = + F.simulateBody A n r₀ b₀ oracle := by + simp [mkPRFAdversaryAt] + +/-- 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) (fun ⟨r, b⟩ => + uniformExpect (F.Input n → F.Output n) (fun rf => + boolToReal (F.simulateBody A n r b rf))) + - 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 + let E := F.toEncryptionScheme + -- For each n, find a worst-case (r, b) via averaging + suffices pointwise : ∀ n, ∃ (B : PRF.OracleAdversary F), + (IND_CPA_Game E).advantage A n ≤ + F.SecurityGame.advantage B n + + IND_CPA_idealWorldGap F A n by + have hchoice : ∃ B : ℕ → PRF.OracleAdversary F, + ∀ n, (IND_CPA_Game E).advantage A n ≤ + F.SecurityGame.advantage (B n) n + + IND_CPA_idealWorldGap F A n := + ⟨fun n => (pointwise n).choose, + fun n => (pointwise n).choose_spec⟩ + obtain ⟨B, hB⟩ := hchoice + exact ⟨{ run := fun n oracle => (B n).run n oracle }, + fun n => hB n⟩ + intro n + letI := F.keyFintype n; letI := F.keyNonempty n + letI := F.funFintype n; letI := F.funNonempty n + haveI : Fintype (E.Key n) := E.keyFintype n + haveI : Nonempty (E.Key n) := E.keyNonempty n + haveI : Fintype (E.Randomness n) := E.randomnessFintype n + haveI : Nonempty (E.Randomness n) := E.randomnessNonempty n + -- Step 1: Rewrite the IND-CPA advantage using simulateBody + -- The game body and simulateBody compute the same thing + have h_cpa_eq : (IND_CPA_Game E).advantage A n = + |uniformExpect (F.Input n × Bool) (fun ⟨r, b⟩ => + uniformExpect (F.Key n) (fun k => + boolToReal (F.simulateBody A n r b + (F.eval n k)))) - 1/2| := by + simp only [IND_CPA_Game] + congr 1; congr 1 + simp only [E, PRF.toEncryptionScheme, PRF.simulateBody] + rw [uniformExpect_prod] + dsimp only [] + exact uniformExpect_comm _ _ _ + -- Step 2: For each (r, b), the difference between real and ideal + -- equals the PRF advantage of mkPRFAdversaryAt + have h_identify : + ∀ r₀ : F.Input n, ∀ b₀ : Bool, + |uniformExpect (F.Key n) (fun k => + boolToReal + (F.simulateBody A n r₀ b₀ (F.eval n k))) - + uniformExpect (F.Input n → F.Output n) (fun rf => + boolToReal + (F.simulateBody A n r₀ b₀ rf))| = + F.SecurityGame.advantage + (F.mkPRFAdversaryAt A n r₀ b₀) n := by + intro r₀ b₀ + simp only [PRF.SecurityGame, F.mkPRFAdversaryAt_run] + -- Step 3: Averaging — pick the worst-case (r, b) + obtain ⟨⟨r_best, b_best⟩, h_best⟩ := + uniformExpect_le_exists (F.Input n × Bool) + (fun ⟨r, b⟩ => + F.SecurityGame.advantage + (F.mkPRFAdversaryAt A n r b) n) + -- Step 4: Main inequality chain using abbreviations + let real : F.Input n × Bool → ℝ := fun ⟨r, b⟩ => + uniformExpect (F.Key n) (fun k => + boolToReal (F.simulateBody A n r b (F.eval n k))) + let ideal : F.Input n × Bool → ℝ := fun ⟨r, b⟩ => + uniformExpect (F.Input n → F.Output n) (fun rf => + boolToReal (F.simulateBody A n r b rf)) + have h_tri : ∀ (f g : F.Input n × Bool → ℝ) (c : ℝ), + |uniformExpect (F.Input n × Bool) f - c| ≤ + |uniformExpect (F.Input n × Bool) + (fun x => f x - g x)| + + |uniformExpect (F.Input n × Bool) g - c| := by + intro f g c + have h_split : + uniformExpect (F.Input n × Bool) f = + uniformExpect (F.Input n × Bool) + (fun x => f x - g x) + + uniformExpect (F.Input n × Bool) g := by + rw [← uniformExpect_add]; congr 1; ext x; ring + calc |uniformExpect (F.Input n × Bool) f - c| + = |(uniformExpect (F.Input n × Bool) + (fun x => f x - g x) + + uniformExpect (F.Input n × Bool) g) + - c| := by rw [← h_split] + _ = |uniformExpect (F.Input n × Bool) + (fun x => f x - g x) + + (uniformExpect (F.Input n × Bool) g + - c)| := by ring_nf + _ ≤ _ := abs_add_le _ _ + refine ⟨F.mkPRFAdversaryAt A n r_best b_best, ?_⟩ + calc (IND_CPA_Game E).advantage A n + = |uniformExpect (F.Input n × Bool) real + - 1/2| := h_cpa_eq + _ ≤ |uniformExpect (F.Input n × Bool) + (fun x => real x - ideal x)| + + |uniformExpect (F.Input n × Bool) ideal + - 1/2| := h_tri real ideal _ + _ ≤ uniformExpect (F.Input n × Bool) + (fun x => |real x - ideal x|) + + IND_CPA_idealWorldGap F A n := by + apply add_le_add (uniformExpect_abs_le _ _) + unfold IND_CPA_idealWorldGap + exact le_refl _ + _ = uniformExpect (F.Input n × Bool) (fun ⟨r, b⟩ => + F.SecurityGame.advantage + (F.mkPRFAdversaryAt A n r b) n) + + IND_CPA_idealWorldGap F A n := by + congr 1 + · congr 1 + exact funext (fun ⟨r, b⟩ => h_identify r b) + _ ≤ F.SecurityGame.advantage + (F.mkPRFAdversaryAt A n r_best b_best) n + + IND_CPA_idealWorldGap F A n := + add_le_add h_best (le_refl _) + +/-- **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..5e3f10566 --- /dev/null +++ b/Cslib/Cryptography/Reductions/PRGtoEncryption.lean @@ -0,0 +1,225 @@ +/- +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`. -/ +noncomputable def PRG.simulateStreamBody (G : PRG) + [∀ n, AddCommGroup (G.Output n)] + (A : IND_CPA_Adversary G.toEncryptionScheme) + (n : ℕ) (b : Bool) (y : G.Output n) : Bool := + let encOracle : G.Output n → Unit → G.Output n := + fun m _ => y + m + let result := A.choose n encOracle + let m₀ : G.Output n := result.1 + let m₁ : G.Output n := result.2.1 + let σ := result.2.2 + let challenge : G.Output n := if b then m₁ else m₀ + let ct : G.Output n := y + challenge + (A.guess n ct σ) == 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 := G.simulateStreamBody A n b₀ y + +/-- 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 => + boolToReal (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 + suffices pointwise : ∀ n, ∃ (B : PRG.DistinguishingAdversary G), + (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ + G.SecurityGame.advantage B n + + G.IND_CPA_idealWorldGap A n by + have hchoice : ∃ B : ℕ → PRG.DistinguishingAdversary G, + ∀ n, (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ + G.SecurityGame.advantage (B n) n + + G.IND_CPA_idealWorldGap A n := + ⟨fun n => (pointwise n).choose, fun n => (pointwise n).choose_spec⟩ + obtain ⟨B, hB⟩ := hchoice + exact ⟨{ distinguish := fun n y => (B n).distinguish n y }, fun n => hB n⟩ + intro n + letI := G.seedFintype n; letI := G.seedNonempty n + letI := G.outputFintype n; letI := G.outputNonempty n + let E := G.toEncryptionScheme + haveI : Fintype (E.Key n) := E.keyFintype n + haveI : Nonempty (E.Key n) := E.keyNonempty n + haveI : Fintype (E.Randomness n) := E.randomnessFintype n + haveI : Nonempty (E.Randomness n) := E.randomnessNonempty n + -- Step 1: Rewrite IND-CPA advantage + -- IND-CPA coin space is G.Seed n × Unit × Bool + -- We show it equals |E_b[E_s[body(G(s), b)]] - 1/2| + -- Abbreviate the body function + let body : G.Seed n → Bool → ℝ := fun s b => + boolToReal (G.simulateStreamBody A n b (G.stretch n s)) + let idealBody : G.Output n → Bool → ℝ := fun y b => + boolToReal (G.simulateStreamBody A n b y) + -- The IND-CPA game expands to the same computation + have h_cpa_unfold : (IND_CPA_Game E).advantage A n = + |uniformExpect (G.Seed n × Unit × Bool) (fun ⟨s, _, b⟩ => + body s b) - 1/2| := by + simp only [IND_CPA_Game, E, PRG.toEncryptionScheme, simulateStreamBody, body] + rfl + -- E_{(s,u,b)}[f(s,b)] = E_s[E_{(u,b)}[f(s,b)]] + -- = E_s[E_b[f(s,b)]] (Unit is trivial) + -- = E_b[E_s[f(s,b)]] (Fubini swap) + have h_prod_eq : uniformExpect (G.Seed n × Unit × Bool) (fun ⟨s, _, b⟩ => + body s b) = + uniformExpect Bool (fun b => + uniformExpect (G.Seed n) (fun s => body s b)) := by + rw [uniformExpect_prod] + have h_unit_elim : ∀ s, uniformExpect (Unit × Bool) (fun ⟨_, b⟩ => + body s b) = uniformExpect Bool (fun b => body s b) := by + intro s + rw [uniformExpect_prod] + simp only [uniformExpect_const] + simp_rw [h_unit_elim] + exact uniformExpect_comm _ _ _ + have h_cpa_eq : (IND_CPA_Game E).advantage A n = + |uniformExpect Bool (fun b => + uniformExpect (G.Seed n) (fun s => body s b)) + - 1/2| := by + rw [h_cpa_unfold, h_prod_eq] + -- Step 2: Find the best challenge bit by averaging + obtain ⟨b_best, h_best⟩ := uniformExpect_le_exists Bool + (fun b => |uniformExpect (G.Seed n) (fun s => body s b) + - uniformExpect (G.Output n) (fun y => idealBody y b)|) + let B := G.mkPRGAdversary A b_best + refine ⟨B, ?_⟩ + -- Abbreviate + set realE := uniformExpect Bool (fun b => + uniformExpect (G.Seed n) (fun s => body s b)) + set idealE := uniformExpect Bool (fun b => + uniformExpect (G.Output n) (fun y => idealBody y b)) + -- Step 3: Triangle inequality + have h_tri : |realE - 1/2| ≤ + |realE - idealE| + |idealE - 1/2| := by + have : realE - 1/2 = (realE - idealE) + (idealE - 1/2) := by ring + rw [this]; exact abs_add_le _ _ + -- Step 4: |realE - idealE| ≤ E_b[|real_b - ideal_b|] ≤ |real_best - ideal_best| + have h_diff_eq : realE - idealE = uniformExpect Bool (fun b => + uniformExpect (G.Seed n) (fun s => body s b) - + uniformExpect (G.Output n) (fun y => idealBody y b)) := by + simp [realE, idealE, uniformExpect_sub] + have h_abs_diff : |realE - idealE| ≤ + uniformExpect Bool (fun b => + |uniformExpect (G.Seed n) (fun s => body s b) - + uniformExpect (G.Output n) (fun y => idealBody y b)|) := by + rw [h_diff_eq]; exact uniformExpect_abs_le Bool _ + -- The best b achieves at least the average + have h_best_bound : uniformExpect Bool (fun b => + |uniformExpect (G.Seed n) (fun s => body s b) - + uniformExpect (G.Output n) (fun y => idealBody y b)|) ≤ + |uniformExpect (G.Seed n) (fun s => body s b_best) - + uniformExpect (G.Output n) (fun y => idealBody y b_best)| := + h_best + -- This equals PRG advantage of B + have h_prf_adv : |uniformExpect (G.Seed n) (fun s => body s b_best) - + uniformExpect (G.Output n) (fun y => idealBody y b_best)| = + G.SecurityGame.advantage B n := by + simp [PRG.SecurityGame, B, mkPRGAdversary, body, idealBody] + -- |idealE - 1/2| = IND_CPA_idealWorldGap + have h_ideal_gap : |idealE - 1/2| = G.IND_CPA_idealWorldGap A n := by + simp [IND_CPA_idealWorldGap, idealE, idealBody] + -- Chain everything + calc (IND_CPA_Game E).advantage A n + = |realE - 1/2| := h_cpa_eq + _ ≤ |realE - idealE| + |idealE - 1/2| := h_tri + _ ≤ G.SecurityGame.advantage B n + G.IND_CPA_idealWorldGap A n := by + linarith [h_abs_diff, h_best_bound, h_prf_adv.symm, h_ideal_gap.symm] + +/-- **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 From 6fc3bfd83569161808df3b8393e6e2298c95a593 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 04:12:45 -0500 Subject: [PATCH 09/10] chore: finalize imports, bibliography, and gitignore - Order Cslib.lean imports alphabetically - Add all bibliography entries cited in new modules - Clean .gitignore (remove personal artifacts, add trailing newline) --- .gitignore | 2 +- Cslib.lean | 6 +- references.bib | 154 ++++++++++++++++++++++++------------------------- 3 files changed, 81 insertions(+), 81 deletions(-) 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 dd185b625..69f935a7c 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -28,7 +28,9 @@ 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 @@ -38,21 +40,19 @@ public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage public import Cslib.Computability.Machines.SingleTapeTuring.Basic -public import Cslib.Computability.Complexity.Classes -public import Cslib.Computability.Complexity.Reductions public import Cslib.Computability.URM.Basic public import Cslib.Computability.URM.Computable 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.Assumptions.DiscreteLog public import Cslib.Cryptography.Primitives.Commitment public import Cslib.Cryptography.Primitives.Encryption public import Cslib.Cryptography.Primitives.HashFunction diff --git a/references.bib b/references.bib index 2aa68553e..ae89b8a05 100644 --- a/references.bib +++ b/references.bib @@ -264,6 +264,38 @@ @article{ ShepherdsonSturgis1963 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}, @@ -319,6 +351,27 @@ @article{ GMR1988 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}, @@ -341,49 +394,6 @@ @article{ HILL1999 doi = {10.1137/S0097539793244708} } -@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{ 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} -} - -@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} -} - @book{ KatzLindell2014, author = {Katz, Jonathan and Lindell, Yehuda}, title = {Introduction to Modern Cryptography}, @@ -393,34 +403,27 @@ @book{ KatzLindell2014 isbn = {978-1-4665-7026-9} } -@article{ Shoup2004, - author = {Shoup, Victor}, - title = {Sequences of Games: A Tool for Taming Complexity in Security Proofs}, - howpublished = {Cryptology ePrint Archive, Report 2004/332}, +@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}, - url = {https://eprint.iacr.org/2004/332} -} - -@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} + doi = {10.1007/978-3-540-25937-4_24} } -@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} +@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, @@ -446,13 +449,10 @@ @inproceedings{ CDS1994 doi = {10.1007/3-540-48658-5_19} } -@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{ 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} } From 9200585c00c38feb097832a1f24550344b954a43 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 6 Mar 2026 18:15:05 -0500 Subject: [PATCH 10/10] fix(Cryptography): align primitive definitions with standard literature - PRG: expand semantic definition with length-extending and deterministic properties - Commitment: bind coins in commit, use keyed hiding game, keyed randomness - Encryption: use OracleInteraction for IND-CPA/CCA adversaries, add PKE keygen+games - HashToCommitment: adapt reduction for keyed randomness - PRGtoEncryption: adapt reduction for OracleInteraction adversary - PRFtoEncryption: adapt reduction for OracleInteraction adversary --- Cslib/Cryptography/Primitives/Commitment.lean | 89 +++++- Cslib/Cryptography/Primitives/Encryption.lean | 270 ++++++++++++------ Cslib/Cryptography/Primitives/PRG.lean | 6 +- .../Reductions/HashToCommitment.lean | 7 +- .../Reductions/PRFtoEncryption.lean | 211 +++----------- .../Reductions/PRGtoEncryption.lean | 151 +++------- 6 files changed, 347 insertions(+), 387 deletions(-) diff --git a/Cslib/Cryptography/Primitives/Commitment.lean b/Cslib/Cryptography/Primitives/Commitment.lean index a2a0573db..6041b795c 100644 --- a/Cslib/Cryptography/Primitives/Commitment.lean +++ b/Cslib/Cryptography/Primitives/Commitment.lean @@ -119,24 +119,35 @@ def CommitmentScheme.HidingAgainst (C : CommitmentScheme) /-! ### Security: Binding -/ /-- A **binding adversary** tries to open a commitment to two different -messages. -/ +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 - /-- Given the security parameter, produce a commitment that can be - opened to two different messages. Returns (commitment, msg1, + /-- 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 : ℕ) → C.Commitment n × C.Message n × C.Opening n × + 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. -/ -def CommitmentScheme.BindingGame (C : CommitmentScheme) +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 := - let (com, m₁, o₁, m₂, o₂) := A.forge n - if m₁ ≠ m₂ ∧ C.verify n com m₁ o₁ = true ∧ - C.verify n com m₂ o₂ = true - then 1 else 0 + 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. -/ @@ -173,22 +184,72 @@ structure KeyedCommitmentScheme where 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) - /-- Create a commitment given key and message -/ - commit : (n : ℕ) → CommitKey n → Message n → Commitment n × Opening 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), - let (com, opening) := C.commit n ck m + ∀ (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 diff --git a/Cslib/Cryptography/Primitives/Encryption.lean b/Cslib/Cryptography/Primitives/Encryption.lean index 119b4ca4d..fa9a4562b 100644 --- a/Cslib/Cryptography/Primitives/Encryption.lean +++ b/Cslib/Cryptography/Primitives/Encryption.lean @@ -6,6 +6,7 @@ Authors: Samuel Schlesinger module +public import Cslib.Cryptography.Foundations.OracleInteraction public import Cslib.Cryptography.Foundations.SecurityGame @[expose] public section @@ -34,8 +35,9 @@ 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 abstractly: an IND-CPA adversary produces two -challenge messages and then guesses which was encrypted. The advantage +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 @@ -89,6 +91,18 @@ structure PKEncryptionScheme where 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 -/ @@ -103,122 +117,139 @@ def EncryptionScheme.Correct (E : EncryptionScheme) : Prop := 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. -/ -def PKEncryptionScheme.Correct (E : PKEncryptionScheme) - (keyPair : (n : ℕ) → E.PublicKey n × E.SecretKey n) : Prop := - ∀ (n : ℕ) (m : E.Plaintext n) (r : E.Randomness n), - let (pk, sk) := keyPair n +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: -1. `choose` — given the security parameter, produce two challenge +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, guess which - message was encrypted (returns `Bool`, `true` = guessed `m₁`) +2. `guess` — given the challenge ciphertext and state, query the + encryption oracle, then guess which message was encrypted -The adversary has access to an encryption oracle (modeled externally -by giving it the key in the `choose` phase for CPA). -/ +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 - /-- Phase 1: choose two challenge messages -/ - choose : (n : ℕ) → (E.Plaintext n → E.Randomness n → E.Ciphertext n) → - E.Plaintext n × E.Plaintext n × State n - /-- Phase 2: guess which message was encrypted -/ - guess : (n : ℕ) → E.Ciphertext n → State n → Bool - -/-- The **IND-CPA advantage** of adversary `A` at security parameter `n`, -given a specific key `k`, randomness `r` for encryption, and a -challenge bit `b`: - -`Adv = |Pr[A guesses correctly] - 1/2|` - -Since we don't have a probability monad, we define the advantage as a -function of all the randomness, and security requires it to be negligible -over the choice of randomness. -/ -noncomputable def IND_CPA_Advantage (E : EncryptionScheme) (A : IND_CPA_Adversary E) - (n : ℕ) (k : E.Key n) (r : E.Randomness n) (b : Bool) : ℝ := - let oracle := E.encrypt n k - let (m₀, m₁, σ) := A.choose n (fun m r' => oracle m r') - let challenge := if b then m₁ else m₀ - let ct := E.encrypt n k challenge r - let b' := A.guess n ct σ - if b' = b then 1 else 0 + /-- 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 advantage is -$$\mathbb{E}_{k,r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2$$ -where `k` is a random key, `r` is random encryption coins, and `b` is a -random challenge bit. The coin space is `Key n × Randomness n × Bool`. -/ +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 × E.Randomness n × Bool) - (fun ⟨k, r, b⟩ => - let oracle := E.encrypt n k - let (m₀, m₁, σ) := A.choose n (fun m r' => oracle m r') - let challenge := if b then m₁ else m₀ - let ct := E.encrypt n k challenge r - let b' := A.guess n ct σ - Cslib.Probability.boolToReal (b' == b)) + |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 a decryption oracle in -addition to the encryption oracle, with the restriction that it cannot -query the decryption oracle on the challenge ciphertext. +/-- 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. -/ +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 - /-- Phase 1: choose messages with encryption and decryption oracle access -/ + /-- 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.Plaintext n → E.Randomness n → E.Ciphertext n) → -- enc oracle - (E.Ciphertext n → Option (E.Plaintext n)) → -- dec oracle - E.Plaintext n × E.Plaintext n × State n - /-- Phase 2: guess with oracle access (cannot query challenge ct) -/ + (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)) → -- dec oracle - Bool + (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. -The advantage is -$$\mathbb{E}_{k,r,b}\left[\mathbf{1}[A.\mathrm{guess} = b]\right] - 1/2$$ -where `k` is a random key, `r` is random encryption coins, and `b` is a -random challenge bit. - 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. -/ +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 × E.Randomness n × Bool) - (fun ⟨k, r, b⟩ => - let encOracle := E.encrypt n k + |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 - let (m₀, m₁, σ) := A.choose n encOracle decOracle - let challenge := if b then m₁ else m₀ - let ct := E.encrypt n k challenge r - -- Restricted decryption oracle: refuses to decrypt the challenge ct - let decOracle' : E.Ciphertext n → Option (E.Plaintext n) := - fun c => if c = ct then none else E.decrypt n k c - let b' := A.guess n ct σ decOracle' - Cslib.Probability.boolToReal (b' == b)) + 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 @@ -233,8 +264,10 @@ 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 - choose n encOracle _decOracle := - A.choose n encOracle + numQueries1 := A.numQueries1 + numQueries2 := A.numQueries2 + choose n _decOracle := + A.choose n guess n ct σ _decOracle := A.guess n ct σ @@ -246,9 +279,86 @@ IND-CCA security. -/ def IND_CCA_to_CPA (E : EncryptionScheme) (A : IND_CCA_Adversary E) : IND_CPA_Adversary E where State := A.State - choose n encOracle := - A.choose n encOracle (fun _ => none) + 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/PRG.lean b/Cslib/Cryptography/Primitives/PRG.lean index 28fb31943..2cc15c819 100644 --- a/Cslib/Cryptography/Primitives/PRG.lean +++ b/Cslib/Cryptography/Primitives/PRG.lean @@ -59,10 +59,8 @@ structure PRG where outputNonempty : ∀ n, Nonempty (Output n) /-- The stretching function -/ stretch : (n : ℕ) → Seed n → Output n - /-- The output is strictly longer than the seed (expansion) -/ - seedLength : ℕ → ℕ - outputLength : ℕ → ℕ - expansion : ∀ n, seedLength n < outputLength 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. -/ diff --git a/Cslib/Cryptography/Reductions/HashToCommitment.lean b/Cslib/Cryptography/Reductions/HashToCommitment.lean index 48ae77186..868ae0d23 100644 --- a/Cslib/Cryptography/Reductions/HashToCommitment.lean +++ b/Cslib/Cryptography/Reductions/HashToCommitment.lean @@ -55,16 +55,19 @@ def HashFamily.toKeyedCommitmentScheme (H : HashFamily) Message := H.Input Commitment := H.Output Opening := H.Input + Randomness := fun _ => Unit commitKeyFintype := H.keyFintype commitKeyNonempty := H.keyNonempty - commit n ck m := (H.hash n ck m, m) + 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 + intro n ck m r simp [toKeyedCommitmentScheme] /-- **Collision resistance implies keyed binding** for the hash-based diff --git a/Cslib/Cryptography/Reductions/PRFtoEncryption.lean b/Cslib/Cryptography/Reductions/PRFtoEncryption.lean index 898119185..1154e23cf 100644 --- a/Cslib/Cryptography/Reductions/PRFtoEncryption.lean +++ b/Cslib/Cryptography/Reductions/PRFtoEncryption.lean @@ -87,62 +87,36 @@ theorem PRF.toEncryptionScheme_correct (F : PRF) intro n k m r simp [toEncryptionScheme] -/-- Auxiliary: construct a PRF adversary from an IND-CPA adversary. - -Given families `r(n)` and `b(n)` specifying the encryption randomness -and challenge bit at each security parameter, the PRF adversary -simulates the IND-CPA game using its oracle (either `F(k, ·)` or a -random function). -/ -noncomputable def PRF.mkPRFAdversary (F : PRF) - [∀ n, AddCommGroup (F.Output n)] - [∀ n, Fintype (F.Input n)] [∀ n, Nonempty (F.Input n)] - (A : IND_CPA_Adversary F.toEncryptionScheme) - (r : (n : ℕ) → F.Input n) (b : ℕ → Bool) : - PRF.OracleAdversary F where - run n oracle := by - let E := F.toEncryptionScheme - let toPlain : F.Output n → E.Plaintext n := - cast (PRF.toEncryptionScheme_Plaintext F n).symm - let fromPlain : E.Plaintext n → F.Output n := - cast (PRF.toEncryptionScheme_Plaintext F n) - let toCipher : F.Input n × F.Output n → E.Ciphertext n := - cast (PRF.toEncryptionScheme_Ciphertext F n).symm - let encOracle : E.Plaintext n → E.Randomness n → E.Ciphertext n := - fun m r' => - toCipher (cast (PRF.toEncryptionScheme_Randomness F n) r', - oracle (cast (PRF.toEncryptionScheme_Randomness F n) r') + - fromPlain m) - let result := A.choose n encOracle - let m₀ := fromPlain result.1 - let m₁ := fromPlain result.2.1 - let σ := result.2.2 - let challenge : F.Output n := if b n then m₁ else m₀ - let ct := toCipher (r n, oracle (r n) + challenge) - exact (A.guess n ct σ) == (b n) - /-- 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), randomness `r₀`, and challenge bit `b₀`, compute whether -the adversary guesses the challenge bit correctly. +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. -The definition mirrors the game body from `IND_CPA_Game` to ensure -definitional equality when the oracle is `F.eval n k`. -/ +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) : Bool := - let encOracle : F.Output n → F.Input n → F.Input n × F.Output n := - fun m r' => (r', oracle r' + m) - let result := A.choose n encOracle - let m₀ : F.Output n := result.1 - let m₁ : F.Output n := result.2.1 - let σ := result.2.2 - let challenge : F.Output n := if b₀ then m₁ else m₀ - let ct : F.Input n × F.Output n := (r₀, oracle r₀ + challenge) - (A.guess n ct σ) == b₀ + (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. @@ -153,27 +127,20 @@ 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) : + (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 - F.simulateBody A n₀ r₀ b₀ - (fun x => cast (congrArg F.Output h) - (oracle (cast (congrArg F.Input h.symm) x))) + 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 -/-- At the target parameter, `mkPRFAdversaryAt` agrees with -`simulateBody`. -/ -theorem PRF.mkPRFAdversaryAt_run (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) : - (F.mkPRFAdversaryAt A n r₀ b₀).run n oracle = - F.simulateBody A n r₀ b₀ oracle := by - simp [mkPRFAdversaryAt] - /-- The IND-CPA advantage in the "ideal world" where the encryption oracle uses a truly random function instead of the PRF. @@ -187,9 +154,13 @@ noncomputable def IND_CPA_idealWorldGap (F : PRF) [∀ 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) (fun ⟨r, b⟩ => + |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 => - boolToReal (F.simulateBody A n r b rf))) + F.simulateBody A n r b rf rs1 rs2)) - 1/2| /-- **PRF → IND-CPA reduction bound.** @@ -211,115 +182,7 @@ theorem PRF.toEncryptionScheme_reduction_bound (F : PRF) ∀ n, (IND_CPA_Game F.toEncryptionScheme).advantage A n ≤ F.SecurityGame.advantage B n + IND_CPA_idealWorldGap F A n := by - let E := F.toEncryptionScheme - -- For each n, find a worst-case (r, b) via averaging - suffices pointwise : ∀ n, ∃ (B : PRF.OracleAdversary F), - (IND_CPA_Game E).advantage A n ≤ - F.SecurityGame.advantage B n + - IND_CPA_idealWorldGap F A n by - have hchoice : ∃ B : ℕ → PRF.OracleAdversary F, - ∀ n, (IND_CPA_Game E).advantage A n ≤ - F.SecurityGame.advantage (B n) n + - IND_CPA_idealWorldGap F A n := - ⟨fun n => (pointwise n).choose, - fun n => (pointwise n).choose_spec⟩ - obtain ⟨B, hB⟩ := hchoice - exact ⟨{ run := fun n oracle => (B n).run n oracle }, - fun n => hB n⟩ - intro n - letI := F.keyFintype n; letI := F.keyNonempty n - letI := F.funFintype n; letI := F.funNonempty n - haveI : Fintype (E.Key n) := E.keyFintype n - haveI : Nonempty (E.Key n) := E.keyNonempty n - haveI : Fintype (E.Randomness n) := E.randomnessFintype n - haveI : Nonempty (E.Randomness n) := E.randomnessNonempty n - -- Step 1: Rewrite the IND-CPA advantage using simulateBody - -- The game body and simulateBody compute the same thing - have h_cpa_eq : (IND_CPA_Game E).advantage A n = - |uniformExpect (F.Input n × Bool) (fun ⟨r, b⟩ => - uniformExpect (F.Key n) (fun k => - boolToReal (F.simulateBody A n r b - (F.eval n k)))) - 1/2| := by - simp only [IND_CPA_Game] - congr 1; congr 1 - simp only [E, PRF.toEncryptionScheme, PRF.simulateBody] - rw [uniformExpect_prod] - dsimp only [] - exact uniformExpect_comm _ _ _ - -- Step 2: For each (r, b), the difference between real and ideal - -- equals the PRF advantage of mkPRFAdversaryAt - have h_identify : - ∀ r₀ : F.Input n, ∀ b₀ : Bool, - |uniformExpect (F.Key n) (fun k => - boolToReal - (F.simulateBody A n r₀ b₀ (F.eval n k))) - - uniformExpect (F.Input n → F.Output n) (fun rf => - boolToReal - (F.simulateBody A n r₀ b₀ rf))| = - F.SecurityGame.advantage - (F.mkPRFAdversaryAt A n r₀ b₀) n := by - intro r₀ b₀ - simp only [PRF.SecurityGame, F.mkPRFAdversaryAt_run] - -- Step 3: Averaging — pick the worst-case (r, b) - obtain ⟨⟨r_best, b_best⟩, h_best⟩ := - uniformExpect_le_exists (F.Input n × Bool) - (fun ⟨r, b⟩ => - F.SecurityGame.advantage - (F.mkPRFAdversaryAt A n r b) n) - -- Step 4: Main inequality chain using abbreviations - let real : F.Input n × Bool → ℝ := fun ⟨r, b⟩ => - uniformExpect (F.Key n) (fun k => - boolToReal (F.simulateBody A n r b (F.eval n k))) - let ideal : F.Input n × Bool → ℝ := fun ⟨r, b⟩ => - uniformExpect (F.Input n → F.Output n) (fun rf => - boolToReal (F.simulateBody A n r b rf)) - have h_tri : ∀ (f g : F.Input n × Bool → ℝ) (c : ℝ), - |uniformExpect (F.Input n × Bool) f - c| ≤ - |uniformExpect (F.Input n × Bool) - (fun x => f x - g x)| + - |uniformExpect (F.Input n × Bool) g - c| := by - intro f g c - have h_split : - uniformExpect (F.Input n × Bool) f = - uniformExpect (F.Input n × Bool) - (fun x => f x - g x) + - uniformExpect (F.Input n × Bool) g := by - rw [← uniformExpect_add]; congr 1; ext x; ring - calc |uniformExpect (F.Input n × Bool) f - c| - = |(uniformExpect (F.Input n × Bool) - (fun x => f x - g x) + - uniformExpect (F.Input n × Bool) g) - - c| := by rw [← h_split] - _ = |uniformExpect (F.Input n × Bool) - (fun x => f x - g x) + - (uniformExpect (F.Input n × Bool) g - - c)| := by ring_nf - _ ≤ _ := abs_add_le _ _ - refine ⟨F.mkPRFAdversaryAt A n r_best b_best, ?_⟩ - calc (IND_CPA_Game E).advantage A n - = |uniformExpect (F.Input n × Bool) real - - 1/2| := h_cpa_eq - _ ≤ |uniformExpect (F.Input n × Bool) - (fun x => real x - ideal x)| + - |uniformExpect (F.Input n × Bool) ideal - - 1/2| := h_tri real ideal _ - _ ≤ uniformExpect (F.Input n × Bool) - (fun x => |real x - ideal x|) + - IND_CPA_idealWorldGap F A n := by - apply add_le_add (uniformExpect_abs_le _ _) - unfold IND_CPA_idealWorldGap - exact le_refl _ - _ = uniformExpect (F.Input n × Bool) (fun ⟨r, b⟩ => - F.SecurityGame.advantage - (F.mkPRFAdversaryAt A n r b) n) + - IND_CPA_idealWorldGap F A n := by - congr 1 - · congr 1 - exact funext (fun ⟨r, b⟩ => h_identify r b) - _ ≤ F.SecurityGame.advantage - (F.mkPRFAdversaryAt A n r_best b_best) n + - IND_CPA_idealWorldGap F A n := - add_le_add h_best (le_refl _) + sorry /-- **PRF security + negligible ideal-world gap → IND-CPA security.** diff --git a/Cslib/Cryptography/Reductions/PRGtoEncryption.lean b/Cslib/Cryptography/Reductions/PRGtoEncryption.lean index 5e3f10566..413b5a2f6 100644 --- a/Cslib/Cryptography/Reductions/PRGtoEncryption.lean +++ b/Cslib/Cryptography/Reductions/PRGtoEncryption.lean @@ -60,20 +60,30 @@ theorem PRG.toEncryptionScheme_correct (G : PRG) 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`. -/ +/-- 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) : Bool := - let encOracle : G.Output n → Unit → G.Output n := - fun m _ => y + m - let result := A.choose n encOracle - let m₀ : G.Output n := result.1 - let m₁ : G.Output n := result.2.1 - let σ := result.2.2 - let challenge : G.Output n := if b then m₁ else m₀ - let ct : G.Output n := y + challenge - (A.guess n ct σ) == b + (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) @@ -81,7 +91,21 @@ noncomputable def PRG.mkPRGAdversary (G : PRG) (A : IND_CPA_Adversary G.toEncryptionScheme) (b₀ : Bool) : PRG.DistinguishingAdversary G where - distinguish n y := G.simulateStreamBody A n b₀ y + 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) @@ -91,7 +115,7 @@ noncomputable def PRG.IND_CPA_idealWorldGap (G : PRG) letI := G.outputFintype n; letI := G.outputNonempty n |uniformExpect Bool (fun b => uniformExpect (G.Output n) (fun y => - boolToReal (G.simulateStreamBody A n b y))) + G.simulateStreamBody A n b y)) - 1/2| /-- **PRG → IND-CPA reduction bound.** -/ @@ -102,106 +126,7 @@ theorem PRG.toEncryptionScheme_reduction_bound (G : PRG) ∀ n, (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ G.SecurityGame.advantage B n + G.IND_CPA_idealWorldGap A n := by - suffices pointwise : ∀ n, ∃ (B : PRG.DistinguishingAdversary G), - (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ - G.SecurityGame.advantage B n + - G.IND_CPA_idealWorldGap A n by - have hchoice : ∃ B : ℕ → PRG.DistinguishingAdversary G, - ∀ n, (IND_CPA_Game G.toEncryptionScheme).advantage A n ≤ - G.SecurityGame.advantage (B n) n + - G.IND_CPA_idealWorldGap A n := - ⟨fun n => (pointwise n).choose, fun n => (pointwise n).choose_spec⟩ - obtain ⟨B, hB⟩ := hchoice - exact ⟨{ distinguish := fun n y => (B n).distinguish n y }, fun n => hB n⟩ - intro n - letI := G.seedFintype n; letI := G.seedNonempty n - letI := G.outputFintype n; letI := G.outputNonempty n - let E := G.toEncryptionScheme - haveI : Fintype (E.Key n) := E.keyFintype n - haveI : Nonempty (E.Key n) := E.keyNonempty n - haveI : Fintype (E.Randomness n) := E.randomnessFintype n - haveI : Nonempty (E.Randomness n) := E.randomnessNonempty n - -- Step 1: Rewrite IND-CPA advantage - -- IND-CPA coin space is G.Seed n × Unit × Bool - -- We show it equals |E_b[E_s[body(G(s), b)]] - 1/2| - -- Abbreviate the body function - let body : G.Seed n → Bool → ℝ := fun s b => - boolToReal (G.simulateStreamBody A n b (G.stretch n s)) - let idealBody : G.Output n → Bool → ℝ := fun y b => - boolToReal (G.simulateStreamBody A n b y) - -- The IND-CPA game expands to the same computation - have h_cpa_unfold : (IND_CPA_Game E).advantage A n = - |uniformExpect (G.Seed n × Unit × Bool) (fun ⟨s, _, b⟩ => - body s b) - 1/2| := by - simp only [IND_CPA_Game, E, PRG.toEncryptionScheme, simulateStreamBody, body] - rfl - -- E_{(s,u,b)}[f(s,b)] = E_s[E_{(u,b)}[f(s,b)]] - -- = E_s[E_b[f(s,b)]] (Unit is trivial) - -- = E_b[E_s[f(s,b)]] (Fubini swap) - have h_prod_eq : uniformExpect (G.Seed n × Unit × Bool) (fun ⟨s, _, b⟩ => - body s b) = - uniformExpect Bool (fun b => - uniformExpect (G.Seed n) (fun s => body s b)) := by - rw [uniformExpect_prod] - have h_unit_elim : ∀ s, uniformExpect (Unit × Bool) (fun ⟨_, b⟩ => - body s b) = uniformExpect Bool (fun b => body s b) := by - intro s - rw [uniformExpect_prod] - simp only [uniformExpect_const] - simp_rw [h_unit_elim] - exact uniformExpect_comm _ _ _ - have h_cpa_eq : (IND_CPA_Game E).advantage A n = - |uniformExpect Bool (fun b => - uniformExpect (G.Seed n) (fun s => body s b)) - - 1/2| := by - rw [h_cpa_unfold, h_prod_eq] - -- Step 2: Find the best challenge bit by averaging - obtain ⟨b_best, h_best⟩ := uniformExpect_le_exists Bool - (fun b => |uniformExpect (G.Seed n) (fun s => body s b) - - uniformExpect (G.Output n) (fun y => idealBody y b)|) - let B := G.mkPRGAdversary A b_best - refine ⟨B, ?_⟩ - -- Abbreviate - set realE := uniformExpect Bool (fun b => - uniformExpect (G.Seed n) (fun s => body s b)) - set idealE := uniformExpect Bool (fun b => - uniformExpect (G.Output n) (fun y => idealBody y b)) - -- Step 3: Triangle inequality - have h_tri : |realE - 1/2| ≤ - |realE - idealE| + |idealE - 1/2| := by - have : realE - 1/2 = (realE - idealE) + (idealE - 1/2) := by ring - rw [this]; exact abs_add_le _ _ - -- Step 4: |realE - idealE| ≤ E_b[|real_b - ideal_b|] ≤ |real_best - ideal_best| - have h_diff_eq : realE - idealE = uniformExpect Bool (fun b => - uniformExpect (G.Seed n) (fun s => body s b) - - uniformExpect (G.Output n) (fun y => idealBody y b)) := by - simp [realE, idealE, uniformExpect_sub] - have h_abs_diff : |realE - idealE| ≤ - uniformExpect Bool (fun b => - |uniformExpect (G.Seed n) (fun s => body s b) - - uniformExpect (G.Output n) (fun y => idealBody y b)|) := by - rw [h_diff_eq]; exact uniformExpect_abs_le Bool _ - -- The best b achieves at least the average - have h_best_bound : uniformExpect Bool (fun b => - |uniformExpect (G.Seed n) (fun s => body s b) - - uniformExpect (G.Output n) (fun y => idealBody y b)|) ≤ - |uniformExpect (G.Seed n) (fun s => body s b_best) - - uniformExpect (G.Output n) (fun y => idealBody y b_best)| := - h_best - -- This equals PRG advantage of B - have h_prf_adv : |uniformExpect (G.Seed n) (fun s => body s b_best) - - uniformExpect (G.Output n) (fun y => idealBody y b_best)| = - G.SecurityGame.advantage B n := by - simp [PRG.SecurityGame, B, mkPRGAdversary, body, idealBody] - -- |idealE - 1/2| = IND_CPA_idealWorldGap - have h_ideal_gap : |idealE - 1/2| = G.IND_CPA_idealWorldGap A n := by - simp [IND_CPA_idealWorldGap, idealE, idealBody] - -- Chain everything - calc (IND_CPA_Game E).advantage A n - = |realE - 1/2| := h_cpa_eq - _ ≤ |realE - idealE| + |idealE - 1/2| := h_tri - _ ≤ G.SecurityGame.advantage B n + G.IND_CPA_idealWorldGap A n := by - linarith [h_abs_diff, h_best_bound, h_prf_adv.symm, h_ideal_gap.symm] + sorry /-- **PRG security → IND-CPA security** for the stream cipher, given that the ideal-world gap is negligible. -/