diff --git a/ArkLib.lean b/ArkLib.lean index 0ca061716f..9ed8d25e95 100644 --- a/ArkLib.lean +++ b/ArkLib.lean @@ -80,6 +80,7 @@ import ArkLib.Data.CodingTheory.ProximityGap.MCAGenerator import ArkLib.Data.CodingTheory.ProximityGap.ProximityGenerators import ArkLib.Data.CodingTheory.ReedSolomon import ArkLib.Data.CodingTheory.ReedSolomon.Multilinear +import ArkLib.Data.CompPoly.Basic import ArkLib.Data.Domain.CosetFftDomain.Defs import ArkLib.Data.Domain.CosetFftDomain.Log import ArkLib.Data.Domain.CosetFftDomain.Mem @@ -136,6 +137,15 @@ import ArkLib.Data.Polynomial.SplitFold import ArkLib.Data.Polynomial.Trivariate import ArkLib.Data.Probability.Instances import ArkLib.Data.Probability.Notation +import ArkLib.Interaction.Oracle.Bridge +import ArkLib.Interaction.Oracle.Chain +import ArkLib.Interaction.Oracle.Composition +import ArkLib.Interaction.Oracle.Continuation +import ArkLib.Interaction.Oracle.Core +import ArkLib.Interaction.Oracle.Execution +import ArkLib.Interaction.Oracle.Spec +import ArkLib.Interaction.Oracle.StateChain +import ArkLib.Interaction.Reduction import ArkLib.OracleReduction.BCS.Basic import ArkLib.OracleReduction.Basic import ArkLib.OracleReduction.Cast diff --git a/ArkLib/Data/CompPoly/Basic.lean b/ArkLib/Data/CompPoly/Basic.lean new file mode 100644 index 0000000000..b0b8c1d567 --- /dev/null +++ b/ArkLib/Data/CompPoly/Basic.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2024-2025 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import CompPoly.Multivariate.CMvPolynomial +import CompPoly.Multivariate.Operations +import CompPoly.Multivariate.Rename +import CompPoly.Univariate.ToPoly.Impl +import ArkLib.OracleReduction.OracleInterface + +/-! +# Shared CompPoly Wrappers and Oracle Interfaces + +Shared degree-bounded computable polynomial types used across protocols, together +with reusable `OracleInterface` instances. +-/ + +open CompPoly CPoly Std + +namespace CPoly.CMvPolynomial + +variable {n : ℕ} {R : Type} [CommSemiring R] [BEq R] [LawfulBEq R] + +/-- `p` has individual degree at most `deg` when every monomial exponent is +bounded by `deg` in every coordinate. -/ +def IndividualDegreeLE (deg : ℕ) (p : CMvPolynomial n R) : Prop := + letI := Classical.decEq R + ∀ i : Fin n, ∀ mono ∈ Lawful.monomials p, mono.degreeOf i ≤ deg + +end CPoly.CMvPolynomial + +/-- A computable univariate polynomial with `natDegree ≤ d`. -/ +def CDegreeLE (R : Type) [BEq R] [Semiring R] [LawfulBEq R] (d : ℕ) := + { p : CPolynomial R // p.natDegree ≤ d } + +/-- A computable multivariate polynomial with individual degree at most `d` in +every coordinate. -/ +def CMvDegreeLE + (R : Type) [BEq R] [CommSemiring R] [LawfulBEq R] (n d : ℕ) := + { p : CMvPolynomial n R // CMvPolynomial.IndividualDegreeLE (R := R) d p } + +section OracleInterface + +open OracleComp OracleSpec + +variable {n : ℕ} {deg : ℕ} {R : Type} [CommSemiring R] [BEq R] [LawfulBEq R] + +instance instOracleInterfaceCMvPolynomial : + OracleInterface (CMvPolynomial n R) where + Query := Fin n → R + toOC := { + spec := (Fin n → R) →ₒ R + impl := fun points => do return CMvPolynomial.eval points (← read) + } + +instance instOracleInterfaceCPolynomial [Nontrivial R] : + OracleInterface (CPolynomial R) where + Query := R + toOC := { + spec := R →ₒ R + impl := fun point => do return CPolynomial.eval point (← read) + } + +instance instOracleInterfaceCDegreeLE [Semiring R] : + OracleInterface (CDegreeLE R deg) where + Query := R + toOC := { + spec := R →ₒ R + impl := fun point => do return CPolynomial.eval point (← read).1 + } + +instance instOracleInterfaceCMvDegreeLE : + OracleInterface (CMvDegreeLE R n deg) where + Query := Fin n → R + toOC := { + spec := (Fin n → R) →ₒ R + impl := fun points => do return CMvPolynomial.eval points (← read).1 + } + +namespace Examples + +/-- A verifier-side query against a multivariate polynomial oracle. + +The verifier supplies only an evaluation point. The polynomial itself is supplied +later as the read-only oracle environment. -/ +def verifierQueryCMvPolynomial (points : Fin n → R) : + ReaderM (CMvPolynomial n R) R := + (instOracleInterfaceCMvPolynomial (n := n) (R := R)).toOC.impl points + +set_option linter.unusedSectionVars false + +/-- Running the verifier-side query against a concrete polynomial agrees with +ordinary polynomial evaluation. -/ +theorem verifierQueryCMvPolynomial_run (poly : CMvPolynomial n R) (points : Fin n → R) : + (verifierQueryCMvPolynomial (R := R) points).run poly = + CMvPolynomial.eval points poly := by + unfold verifierQueryCMvPolynomial + rfl + +end Examples + +end OracleInterface diff --git a/ArkLib/Interaction/Oracle/Bridge.lean b/ArkLib/Interaction/Oracle/Bridge.lean new file mode 100644 index 0000000000..9dc69d7c8d --- /dev/null +++ b/ArkLib/Interaction/Oracle/Bridge.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Core + +/-! +# Bridge: Interaction.Spec + OracleDecoration → Oracle.Spec + +Structural conversion from the W-type-based +`Interaction.Spec + RoleDecoration + OracleDecoration` to the new +`Interaction.Oracle.Spec` inductive. + +## Main definitions + +- `Interaction.Oracle.Spec.ofInteractionSpec` — convert an `Interaction.Spec` + with `RoleDecoration` and `OracleDecoration` into an `Oracle.Spec`. + At sender nodes the continuation is treated as constant (picking a + representative via a provided default-element function). +- `Interaction.Oracle.Spec.ofRoleDecoration` — convert a `RoleDecoration` + to `Spec.RoleDeco`. +- `Interaction.Oracle.Spec.ofOracleDecoration` — convert an + `OracleDecoration` to `Spec.OracleDeco`. + +## Implementation notes + +The bridge requires a `senderDefault` function to pick a representative +element at each sender node (since oracle message types may not have +`Inhabited` instances). In practice, all oracle message types are nonempty, +so any such function suffices. + +Verifier and reduction conversions (from `OracleVerifier`/`OracleReduction` +to `Oracle.Verifier`/`Oracle.Reduction`) are deferred. The output types need +to be re-indexed from `Interaction.Spec.Transcript` to +`Oracle.Spec.PublicTranscript`, which requires careful coherence proofs. In +practice, consumers should construct `Oracle.Spec`-based reductions natively +rather than converting from the old representation. +-/ + +open OracleComp OracleSpec +open Interaction.TwoParty + +namespace Interaction.Oracle.Spec + +/-- Convert an `Interaction.Spec + RoleDecoration + OracleDecoration` into an +`Oracle.Spec`. + +At sender nodes, the continuation `rest x` is structurally required to be +constant by `OracleDecoration` (oracle messages don't branch). We pick the +representative using the `senderDefault` function. + +At receiver nodes, the continuation genuinely depends on the message, so +`.public` is used. -/ +noncomputable def ofInteractionSpec + (senderDefault : ∀ (X : Type), OracleInterface X → X) : + (spec : Interaction.Spec) → (roles : RoleDecoration spec) → + OracleDecoration spec roles → Oracle.Spec + | .done, _, _ => .done + | .node X rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩ => + let x₀ := senderDefault X oi + .oracle X (ofInteractionSpec senderDefault (rest x₀) (rRest x₀) (odRest x₀)) + | .node X rest, ⟨.receiver, rRest⟩, odFn => + .«public» X (fun x => + ofInteractionSpec senderDefault (rest x) (rRest x) (odFn x)) + +/-- Convert a `RoleDecoration` to `RoleDeco` on the resulting `Oracle.Spec`. +Only receiver nodes carry role information in `Oracle.Spec`; sender nodes +are structurally `.sender` by construction. -/ +noncomputable def ofRoleDecoration + (senderDefault : ∀ (X : Type), OracleInterface X → X) : + (spec : Interaction.Spec) → (roles : RoleDecoration spec) → + (od : OracleDecoration spec roles) → + RoleDeco (ofInteractionSpec senderDefault spec roles od) + | .done, _, _ => ⟨⟩ + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩ => + let x₀ := senderDefault _ oi + ofRoleDecoration senderDefault (rest x₀) (rRest x₀) (odRest x₀) + | .node _ rest, ⟨.receiver, rRest⟩, odFn => + ⟨.receiver, fun x => + ofRoleDecoration senderDefault (rest x) (rRest x) (odFn x)⟩ + +/-- Convert an `OracleDecoration` to `OracleDeco` on the resulting +`Oracle.Spec`. The `OracleInterface` at each sender node becomes the +`.oracle` node's interface. -/ +noncomputable def ofOracleDecoration + (senderDefault : ∀ (X : Type), OracleInterface X → X) : + (spec : Interaction.Spec) → (roles : RoleDecoration spec) → + (od : OracleDecoration spec roles) → + OracleDeco (ofInteractionSpec senderDefault spec roles od) + | .done, _, _ => ⟨⟩ + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩ => + let x₀ := senderDefault _ oi + ⟨oi, ofOracleDecoration senderDefault (rest x₀) (rRest x₀) (odRest x₀)⟩ + | .node _ rest, ⟨.receiver, rRest⟩, odFn => + fun x => ofOracleDecoration senderDefault (rest x) (rRest x) (odFn x) + +end Interaction.Oracle.Spec diff --git a/ArkLib/Interaction/Oracle/Chain.lean b/ArkLib/Interaction/Oracle/Chain.lean new file mode 100644 index 0000000000..b882891143 --- /dev/null +++ b/ArkLib/Interaction/Oracle/Chain.lean @@ -0,0 +1,300 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Composition + +/-! +# N-ary Chain Composition for Oracle.Spec + +A `Spec.Chain n` is a self-contained recipe for an `n`-round oracle protocol: +at each level it carries the current round's `Oracle.Spec`, `RoleDeco`, and +`OracleDeco`, with a `PublicTranscript`-indexed continuation to the next level. +There is **no external state type**. + +Converting to an `Oracle.Spec` via `Chain.toSpec` uses only `Oracle.Spec.append`. + +## Main definitions + +* `Oracle.Spec.Chain` — depth-indexed telescope: oracle spec + decorations + + continuation. +* `Chain.toSpec` / `Chain.toRoles` / `Chain.toOracleDeco` — flatten a chain to a + single `Oracle.Spec` with its decorations. +* `Chain.splitPublicTranscript` / `Chain.appendPublicTranscript` — + `PublicTranscript` operations for the first round vs the rest. +* `Chain.outputFamily` — lift a family on remaining chains to a family on the + flattened `PublicTranscript`. +* `Chain.Prover.comp` / `Chain.Verifier.comp` — compose per-round prover + strategies / verifier counterparts along the chain. +* `Oracle.Reduction.ofChain` — compose per-round steps into a full + `Oracle.Reduction`. + +## Design notes + +This mirrors the non-oracle `Spec.Chain` (in VCVio) and `Reduction.ofChain` +(in `Interaction/Reduction.lean`), but uses `Oracle.Spec` throughout: + +- Continuation depends on `PublicTranscript` (not full `Transcript`). +- Uses `Prover.compAux` / `Verifier.compAux` / `Counterpart.liftAcc` from + `Oracle/Composition.lean` as the binary step. +- Per-round steps produce `PUnit`, no state flows between rounds. +- Final output types are computed from the full `PublicTranscript`. + +## Three composition mechanisms + +| Mechanism | State? | Transcript-dependent? | Use when | +|---|---|---|---| +| `Oracle.Spec.append` + `Reduction.comp` | No | Yes | Binary composition | +| `Oracle.Spec.Chain` + `Reduction.ofChain` | No (baked in) | Yes | N-ary, no external state | +| (future) state chain | Yes | Yes | N-ary with explicit state type | +-/ + +open OracleComp OracleSpec +open Interaction.TwoParty + +namespace Interaction.Oracle + +namespace Spec + +/-! ## Chain type -/ + +/-- A self-contained recipe for an `n`-round oracle protocol. At each level, +carries the current round's `Oracle.Spec`, `RoleDeco`, `OracleDeco`, and a +`PublicTranscript`-indexed continuation to the remaining rounds. -/ +def Chain : Nat → Type 1 + | 0 => PUnit + | n + 1 => (spec : Oracle.Spec) × (_ : RoleDeco spec) × + (_ : OracleDeco spec) × (PublicTranscript spec → Chain n) + +namespace Chain + +/-! ## Flattening -/ + +/-- Flatten a chain into a concrete `Oracle.Spec` via iterated `append`. -/ +def toSpec : (n : Nat) → Chain n → Oracle.Spec + | 0, _ => .done + | n + 1, ⟨spec, _, _, cont⟩ => spec.append (fun pt => toSpec n (cont pt)) + +/-- Flatten the role decorations along a chain. -/ +def toRoles : (n : Nat) → (c : Chain n) → RoleDeco (toSpec n c) + | 0, _ => ⟨⟩ + | n + 1, ⟨spec, roles, _, cont⟩ => + RoleDeco.append spec (fun pt => toSpec n (cont pt)) + roles (fun pt => toRoles n (cont pt)) + +/-- Flatten the oracle decorations along a chain. -/ +def toOracleDeco : (n : Nat) → (c : Chain n) → OracleDeco (toSpec n c) + | 0, _ => ⟨⟩ + | n + 1, ⟨spec, _, od, cont⟩ => + OracleDeco.append spec (fun pt => toSpec n (cont pt)) + od (fun pt => toOracleDeco n (cont pt)) + +@[simp] theorem toSpec_zero (c : Chain 0) : toSpec 0 c = .done := rfl + +theorem toSpec_succ {n : Nat} (spec : Oracle.Spec) + (roles : RoleDeco spec) (od : OracleDeco spec) + (cont : PublicTranscript spec → Chain n) : + toSpec (n + 1) ⟨spec, roles, od, cont⟩ = + spec.append (fun pt => toSpec n (cont pt)) := rfl + +/-! ## PublicTranscript operations -/ + +/-- Split a `PublicTranscript` of a flattened `(n+1)`-round chain into the first +round's public transcript and the remainder. -/ +def splitPublicTranscript (n : Nat) (c : Chain (n + 1)) : + PublicTranscript (toSpec (n + 1) c) → + (pt₁ : PublicTranscript c.1) × PublicTranscript (toSpec n (c.2.2.2 pt₁)) := + PublicTranscript.split c.1 (fun pt => toSpec n (c.2.2.2 pt)) + +/-- Combine a first-round public transcript with a remainder. -/ +def appendPublicTranscript (n : Nat) (c : Chain (n + 1)) + (pt₁ : PublicTranscript c.1) (pt₂ : PublicTranscript (toSpec n (c.2.2.2 pt₁))) : + PublicTranscript (toSpec (n + 1) c) := + PublicTranscript.append c.1 (fun pt => toSpec n (c.2.2.2 pt)) pt₁ pt₂ + +@[simp] +theorem splitPublicTranscript_appendPublicTranscript (n : Nat) (c : Chain (n + 1)) + (pt₁ : PublicTranscript c.1) (pt₂ : PublicTranscript (toSpec n (c.2.2.2 pt₁))) : + splitPublicTranscript n c (appendPublicTranscript n c pt₁ pt₂) = ⟨pt₁, pt₂⟩ := + PublicTranscript.split_append _ _ _ _ + +/-! ## Output family -/ + +/-- Lift a family on remaining chains to a family on `PublicTranscript` of the +flattened `Oracle.Spec`. At `Chain 0`, returns `Family ⟨⟩`. At `Chain (n + 1)`, +uses `PublicTranscript.liftAppend` to split the transcript and recurse. -/ +def outputFamily + (Family : {n : Nat} → Chain n → Type) : + (n : Nat) → (c : Chain n) → PublicTranscript (toSpec n c) → Type + | 0, c, _ => Family c + | n + 1, ⟨spec, _, _, cont⟩, pt => + PublicTranscript.liftAppend spec (fun pt₁ => toSpec n (cont pt₁)) + (fun pt₁ pt₂ => outputFamily Family n (cont pt₁) pt₂) + pt + +/-! ## Prover composition -/ + +namespace Prover + +/-- Compose per-round prover strategies into a full strategy over the flattened +chain. Each round's step receives the remaining `Chain` and produces a strategy +for that round's oracle spec. Output is `PUnit` per round. -/ +def comp + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + (step : {k : Nat} → (rem : Chain (k + 1)) → + OracleComp oSpec + (Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + rem.1.toInteractionSpec (rem.1.toSpecRoles rem.2.1) + (fun _ => PUnit))) : + (n : Nat) → (c : Chain n) → + OracleComp oSpec + (Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + (toSpec n c).toInteractionSpec + ((toSpec n c).toSpecRoles (toRoles n c)) + (fun _ => PUnit)) + | 0, _ => pure ⟨⟩ + | n + 1, ⟨spec, roles, od, cont⟩ => do + let strat ← step ⟨spec, roles, od, cont⟩ + Prover.compAux spec (fun pt => toSpec n (cont pt)) + roles (fun pt => toRoles n (cont pt)) + (Mid := fun _ => PUnit) + (OutType := fun _ _ => PUnit) + strat + (fun tr₁ _ => comp step n (cont (spec.projectPublic tr₁))) + +end Prover + +/-! ## Verifier composition -/ + +namespace Verifier + +/-- Compose per-round verifier counterparts into a full counterpart over the +flattened chain. Each round's step produces a counterpart for the current +round's oracle spec with `accSpec = []ₒ`. During composition, +`Counterpart.liftAcc` lifts subsequent rounds to the accumulated oracle spec. + +The step function is universally quantified over `accSpec` because +`Verifier.compAux` accumulates oracle access through `.oracle` nodes. -/ +def comp + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (step : {k : Nat} → (rem : Chain (k + 1)) → + Interaction.Spec.Counterpart.withMonads + rem.1.toInteractionSpec (rem.1.toSpecRoles rem.2.1) + (rem.1.toMonadDecoration oSpec OStmtIn rem.2.1 rem.2.2.1 []ₒ) + (fun _ => PUnit)) : + (n : Nat) → (c : Chain n) → + Interaction.Spec.Counterpart.withMonads + (toSpec n c).toInteractionSpec + ((toSpec n c).toSpecRoles (toRoles n c)) + ((toSpec n c).toMonadDecoration oSpec OStmtIn (toRoles n c) (toOracleDeco n c) []ₒ) + (fun _ => PUnit) + | 0, _ => ⟨⟩ + | n + 1, ⟨spec, roles, od, cont⟩ => + Verifier.compAux (OStmtIn := OStmtIn) + spec (fun pt => toSpec n (cont pt)) + roles (fun pt => toRoles n (cont pt)) + od (fun pt => toOracleDeco n (cont pt)) + []ₒ + (OutType := fun _ _ => PUnit) + (step ⟨spec, roles, od, cont⟩) + (fun accSpec' tr₁ _ => + let pt₁ := spec.projectPublic tr₁ + Counterpart.liftAcc + (toSpec n (cont pt₁)) (toRoles n (cont pt₁)) (toOracleDeco n (cont pt₁)) + []ₒ accSpec' (fun q => q.elim) + (comp step n (cont pt₁))) + +end Verifier + +end Chain + +end Spec + +/-! ## Reduction.ofChain -/ + +/-- Compose per-round prover and verifier steps into a full `Oracle.Reduction` +over an `n`-round `Chain`. No state flows between rounds: per-round steps +produce `PUnit`. Final output types are computed from the full +`PublicTranscript` via user-provided result functions. -/ +def Reduction.ofChain + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {WitnessIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {n : Nat} + {c : SharedIn → Spec.Chain n} + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Spec.Chain.toSpec n (c shared)) → Type} + {ιₛₒ : (shared : SharedIn) → + Spec.PublicTranscript (Spec.Chain.toSpec n (c shared)) → Type} + {OStatementOut : + (shared : SharedIn) → + (pt : Spec.PublicTranscript (Spec.Chain.toSpec n (c shared))) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + {WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Spec.Chain.toSpec n (c shared)) → Type} + (proverRound : (shared : SharedIn) → WitnessIn shared → + {k : Nat} → (rem : Spec.Chain (k + 1)) → + OracleComp oSpec + (Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + rem.1.toInteractionSpec (rem.1.toSpecRoles rem.2.1) + (fun _ => PUnit))) + (verifierRound : (shared : SharedIn) → + {k : Nat} → (rem : Spec.Chain (k + 1)) → + Interaction.Spec.Counterpart.withMonads + rem.1.toInteractionSpec (rem.1.toSpecRoles rem.2.1) + (rem.1.toMonadDecoration oSpec (OStatementIn shared) rem.2.1 rem.2.2.1 []ₒ) + (fun _ => PUnit)) + (stmtResult : (shared : SharedIn) → + (pt : Spec.PublicTranscript (Spec.Chain.toSpec n (c shared))) → + StatementOut shared pt) + (oStmtResult : (shared : SharedIn) → + (pt : Spec.PublicTranscript (Spec.Chain.toSpec n (c shared))) → + ∀ i, OStatementOut shared pt i) + (witResult : (shared : SharedIn) → + (pt : Spec.PublicTranscript (Spec.Chain.toSpec n (c shared))) → + WitnessOut shared pt) + (simulate : (shared : SharedIn) → + (pt : Spec.PublicTranscript (Spec.Chain.toSpec n (c shared))) → + QueryImpl [OStatementOut shared pt]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + (Spec.Chain.toSpec n (c shared)).toOracleSpec + (Spec.Chain.toOracleDeco n (c shared)) pt))) : + Reduction oSpec SharedIn + (fun shared => Spec.Chain.toSpec n (c shared)) + (fun shared => Spec.Chain.toRoles n (c shared)) + (fun shared => Spec.Chain.toOracleDeco n (c shared)) + (fun _ => PUnit) OStatementIn WitnessIn + StatementOut OStatementOut WitnessOut where + prover shared _sWithOracles w := do + let strat ← Spec.Chain.Prover.comp (proverRound shared w) n (c shared) + pure <| Interaction.Spec.Strategy.mapOutputWithRoles + (fun tr _ => + let pt := (Spec.Chain.toSpec n (c shared)).projectPublic tr + (⟨⟨stmtResult shared pt, oStmtResult shared pt⟩, witResult shared pt⟩ : + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared pt) + (fun _ => OStatementOut shared pt) shared) + (WitnessOut shared pt))) + strat + verifier := { + toFun := fun shared _stmtIn => + Interaction.Spec.Counterpart.withMonads.mapOutput + (Spec.Chain.toSpec n (c shared)).toInteractionSpec + ((Spec.Chain.toSpec n (c shared)).toSpecRoles (Spec.Chain.toRoles n (c shared))) + ((Spec.Chain.toSpec n (c shared)).toMonadDecoration oSpec (OStatementIn shared) + (Spec.Chain.toRoles n (c shared)) (Spec.Chain.toOracleDeco n (c shared)) []ₒ) + (fun tr _ => + stmtResult shared ((Spec.Chain.toSpec n (c shared)).projectPublic tr)) + (Spec.Chain.Verifier.comp (verifierRound shared) n (c shared)) + simulate := simulate + } + +end Interaction.Oracle diff --git a/ArkLib/Interaction/Oracle/Composition.lean b/ArkLib/Interaction/Oracle/Composition.lean new file mode 100644 index 0000000000..daf55b22b4 --- /dev/null +++ b/ArkLib/Interaction/Oracle/Composition.lean @@ -0,0 +1,647 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Core + +/-! +# Oracle.Spec Composition Infrastructure + +Composition utilities for `Oracle.Spec`-based reductions (`Oracle.Reduction`). + +## Main definitions + +### Utilities +- `Oracle.Reduction.id` — identity reduction (no interaction, forward + statement/oracle/witness unchanged). +- `Oracle.Reduction.freezeSharedToPUnit` — fix the shared input, reindex over + `PUnit`. +- `Oracle.Reduction.pullbackShared` — reindex the shared input along a map. + +### Binary composition +- `Oracle.Reduction.comp` — compose two sequential oracle reductions using + `Oracle.Spec.append`. Prover and verifier are composed by structural + recursion on `Oracle.Spec`, so `toInteractionSpec` / `toSpecRoles` / + `toMonadDecoration` all compute at each step without casts. +-/ + +open OracleComp OracleSpec +open Interaction.TwoParty + +namespace Interaction.Oracle + +/-! ## Identity reduction -/ + +/-- Identity oracle reduction: no interaction (`.done` context), forwards +statement, oracle statements, and witness unchanged. -/ +def Reduction.id + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} : + Reduction oSpec SharedIn + (fun _ => .done) + (fun _ => ⟨⟩) + (fun _ => ⟨⟩) + StatementIn OStatementIn WitnessIn + (fun shared _ => StatementIn shared) + (OStatementOut := fun shared _ => OStatementIn shared) + (fun shared _ => WitnessIn shared) where + prover _ sWithOracles w := + pure ⟨⟨sWithOracles.stmt, sWithOracles.oracleStmt⟩, w⟩ + verifier := { + toFun := fun _ stmt => stmt + simulate := fun _ _ q => liftM <| ([OStatementIn _]ₒ).query q + } + +/-! ## SharedIn reindexing -/ + +/-- Freeze the shared input of an `Oracle.Reduction`, reindexing over `PUnit`. -/ +def Reduction.freezeSharedToPUnit + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)} + {OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + {WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (reduction : Reduction oSpec SharedIn Context Roles OracleDeco + StatementIn OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) + (shared : SharedIn) : + Reduction oSpec PUnit + (fun _ => Context shared) + (fun _ => Roles shared) + (fun _ => OracleDeco shared) + (fun _ => StatementIn shared) + (fun _ => OStatementIn shared) + (fun _ => WitnessIn shared) + (fun _ pt => StatementOut shared pt) + (OStatementOut := fun _ pt => OStatementOut shared pt) + (fun _ pt => WitnessOut shared pt) where + prover _ s w := do + let input' : StatementWithOracles StatementIn OStatementIn shared := + ⟨s.stmt, s.oracleStmt⟩ + let remapOutput : + (tr : Interaction.Spec.Transcript (Context shared).toInteractionSpec) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared ((Context shared).projectPublic tr)) + (fun _ => OStatementOut shared ((Context shared).projectPublic tr)) shared) + (WitnessOut shared ((Context shared).projectPublic tr)) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared ((Context shared).projectPublic tr)) + (fun _ => OStatementOut shared ((Context shared).projectPublic tr)) PUnit.unit) + (WitnessOut shared ((Context shared).projectPublic tr)) + | _, ⟨stmtOut, witOut⟩ => ⟨⟨stmtOut.stmt, stmtOut.oracleStmt⟩, witOut⟩ + let strat ← reduction.prover shared input' w + pure <| Interaction.Spec.Strategy.mapOutputWithRoles remapOutput strat + verifier := { + toFun := fun _ stmt => + reduction.verifier.toFun shared stmt + simulate := fun _ pt => + reduction.verifier.simulate shared pt + } + +/-- Reindex the shared input of an `Oracle.Reduction` along a map `f`. -/ +def Reduction.pullbackShared + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn SharedIn' : Type} + (f : SharedIn' → SharedIn) + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)} + {OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + {WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (reduction : Reduction oSpec SharedIn Context Roles OracleDeco + StatementIn OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) : + Reduction oSpec SharedIn' + (fun shared => Context (f shared)) + (fun shared => Roles (f shared)) + (fun shared => OracleDeco (f shared)) + (fun shared => StatementIn (f shared)) + (fun shared => OStatementIn (f shared)) + (fun shared => WitnessIn (f shared)) + (fun shared pt => StatementOut (f shared) pt) + (OStatementOut := fun shared pt => OStatementOut (f shared) pt) + (fun shared pt => WitnessOut (f shared) pt) where + prover shared s w := do + let input' : StatementWithOracles StatementIn OStatementIn (f shared) := + ⟨s.stmt, s.oracleStmt⟩ + let remapOutput : + (tr : Interaction.Spec.Transcript (Context (f shared)).toInteractionSpec) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut (f shared) ((Context (f shared)).projectPublic tr)) + (fun _ => OStatementOut (f shared) ((Context (f shared)).projectPublic tr)) + (f shared)) + (WitnessOut (f shared) ((Context (f shared)).projectPublic tr)) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut (f shared) ((Context (f shared)).projectPublic tr)) + (fun _ => OStatementOut (f shared) ((Context (f shared)).projectPublic tr)) + shared) + (WitnessOut (f shared) ((Context (f shared)).projectPublic tr)) + | _, ⟨stmtOut, witOut⟩ => ⟨⟨stmtOut.stmt, stmtOut.oracleStmt⟩, witOut⟩ + let strat ← reduction.prover (f shared) input' w + pure <| Interaction.Spec.Strategy.mapOutputWithRoles remapOutput strat + verifier := { + toFun := fun shared stmt => + reduction.verifier.toFun (f shared) stmt + simulate := fun shared pt => + reduction.verifier.simulate (f shared) pt + } + +/-! ## Binary composition helpers -/ + +namespace Prover + +/-- Compose two role-aware strategies on `Oracle.Spec` by structural recursion. +At `.oracle` and `.public .sender` nodes, binds the first-phase strategy and +recurses. At `.public .receiver` nodes, produces a function and recurses. + +This is the `Oracle.Spec` analog of `Interaction.Spec.Strategy.compWithRolesFlat`, +with the crucial advantage that `toInteractionSpec`, `toSpecRoles`, and +`projectPublic` all reduce definitionally at each step, so no casts are needed. + +The output type is indexed by `PublicTranscript` via `split ∘ projectPublic`. -/ +def compAux + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} : + (s₁ : Oracle.Spec) → (s₂ : Spec.PublicTranscript s₁ → Oracle.Spec) → + (r₁ : Spec.RoleDeco s₁) → + (r₂ : (pt₁ : Spec.PublicTranscript s₁) → Spec.RoleDeco (s₂ pt₁)) → + {Mid : Interaction.Spec.Transcript s₁.toInteractionSpec → Type} → + {OutType : (pt₁ : Spec.PublicTranscript s₁) → + Spec.PublicTranscript (s₂ pt₁) → Type} → + Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + s₁.toInteractionSpec (s₁.toSpecRoles r₁) Mid → + ((tr₁ : Interaction.Spec.Transcript s₁.toInteractionSpec) → Mid tr₁ → + OracleComp oSpec + (Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + ((s₂ (s₁.projectPublic tr₁)).toInteractionSpec) + ((s₂ (s₁.projectPublic tr₁)).toSpecRoles (r₂ (s₁.projectPublic tr₁))) + (fun tr₂ => OutType (s₁.projectPublic tr₁) + ((s₂ (s₁.projectPublic tr₁)).projectPublic tr₂)))) → + OracleComp oSpec + (Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + ((s₁.append s₂).toInteractionSpec) + ((s₁.append s₂).toSpecRoles (Spec.RoleDeco.append s₁ s₂ r₁ r₂)) + (fun tr => + OutType + (Spec.PublicTranscript.split s₁ s₂ + ((s₁.append s₂).projectPublic tr)).1 + (Spec.PublicTranscript.split s₁ s₂ + ((s₁.append s₂).projectPublic tr)).2)) + | .done, _, _, _, _, _, out, cont => cont ⟨⟩ out + | .oracle _X rest, s₂, r₁, r₂, _, _, strat₁, cont => + pure <| do + let ⟨x, next⟩ ← strat₁ + let result ← compAux rest s₂ r₁ r₂ next + (fun tr₁ mid => cont ⟨x, tr₁⟩ mid) + pure ⟨x, result⟩ + | .«public» _X rest, s₂, ⟨.sender, rRest⟩, r₂, _, OutType, strat₁, cont => + pure <| do + let ⟨x, next⟩ ← strat₁ + let result ← compAux (rest x) (fun pt => s₂ ⟨x, pt⟩) + (rRest x) (fun pt => r₂ ⟨x, pt⟩) + (OutType := fun pt₁ pt₂ => OutType ⟨x, pt₁⟩ pt₂) next + (fun tr₁ mid => cont ⟨x, tr₁⟩ mid) + pure ⟨x, result⟩ + | .«public» _X rest, s₂, ⟨.receiver, rRest⟩, r₂, _, OutType, strat₁, cont => + pure fun x => do + let next ← strat₁ x + compAux (rest x) (fun pt => s₂ ⟨x, pt⟩) + (rRest x) (fun pt => r₂ ⟨x, pt⟩) + (OutType := fun pt₁ pt₂ => OutType ⟨x, pt₁⟩ pt₂) next + (fun tr₁ mid => cont ⟨x, tr₁⟩ mid) + +end Prover + +namespace Verifier + +/-- Compose two monad-decorated counterparts on `Oracle.Spec` by structural +recursion on the first-phase spec. + +At `.oracle` and `.public .sender` nodes the monad is `Id`, so the counterpart +receives a value and recurses. At `.public .receiver` nodes the monad is +`OracleComp`, so the counterpart sends a value monodically and recurses via +`Functor.map`. + +The continuation is universally quantified over `accSpec'` so that the +oracle-spec accumulation through `.oracle` nodes is handled: at each such node +`accSpec` grows by `OracleInterface.spec`, and the continuation sees the final +accumulated spec when the first phase reaches `.done`. -/ +def compAux + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] : + (s₁ : Oracle.Spec) → (s₂ : Spec.PublicTranscript s₁ → Oracle.Spec) → + (r₁ : Spec.RoleDeco s₁) → + (r₂ : (pt₁ : Spec.PublicTranscript s₁) → Spec.RoleDeco (s₂ pt₁)) → + (od₁ : Spec.OracleDeco s₁) → + (od₂ : (pt₁ : Spec.PublicTranscript s₁) → Spec.OracleDeco (s₂ pt₁)) → + {ιₐ : Type} → (accSpec : OracleSpec.{0, 0} ιₐ) → + {Mid : Interaction.Spec.Transcript s₁.toInteractionSpec → Type} → + {OutType : (pt₁ : Spec.PublicTranscript s₁) → + Spec.PublicTranscript (s₂ pt₁) → Type} → + Interaction.Spec.Counterpart.withMonads s₁.toInteractionSpec + (s₁.toSpecRoles r₁) + (s₁.toMonadDecoration oSpec OStmtIn r₁ od₁ accSpec) Mid → + (∀ {ιₐ' : Type} (accSpec' : OracleSpec.{0, 0} ιₐ'), + (tr₁ : Interaction.Spec.Transcript s₁.toInteractionSpec) → Mid tr₁ → + Interaction.Spec.Counterpart.withMonads + ((s₂ (s₁.projectPublic tr₁)).toInteractionSpec) + ((s₂ (s₁.projectPublic tr₁)).toSpecRoles (r₂ (s₁.projectPublic tr₁))) + ((s₂ (s₁.projectPublic tr₁)).toMonadDecoration oSpec OStmtIn + (r₂ (s₁.projectPublic tr₁)) (od₂ (s₁.projectPublic tr₁)) accSpec') + (fun tr₂ => OutType (s₁.projectPublic tr₁) + ((s₂ (s₁.projectPublic tr₁)).projectPublic tr₂))) → + Interaction.Spec.Counterpart.withMonads + ((s₁.append s₂).toInteractionSpec) + ((s₁.append s₂).toSpecRoles (Spec.RoleDeco.append s₁ s₂ r₁ r₂)) + ((s₁.append s₂).toMonadDecoration oSpec OStmtIn + (Spec.RoleDeco.append s₁ s₂ r₁ r₂) + (Spec.OracleDeco.append s₁ s₂ od₁ od₂) accSpec) + (fun tr => + OutType + (Spec.PublicTranscript.split s₁ s₂ + ((s₁.append s₂).projectPublic tr)).1 + (Spec.PublicTranscript.split s₁ s₂ + ((s₁.append s₂).projectPublic tr)).2) + | .done, _, _, _, _, _, _, accSpec, _, _, cpt, cont => cont accSpec ⟨⟩ cpt + | .oracle _X rest, s₂, r₁, r₂, ⟨oi, odRest⟩, od₂, _, accSpec, _, OutType, + cpt, cont => + fun x => compAux rest s₂ r₁ r₂ odRest od₂ + (accSpec + @OracleInterface.spec _ oi) + (OutType := fun pt₁ pt₂ => OutType pt₁ pt₂) (cpt x) + (fun accSpec' tr₁ mid => cont accSpec' ⟨x, tr₁⟩ mid) + | .«public» _X rest, s₂, ⟨.sender, rRest⟩, r₂, odRest, od₂, _, + accSpec, _, OutType, cpt, cont => + fun x => compAux (rest x) (fun pt => s₂ ⟨x, pt⟩) + (rRest x) (fun pt => r₂ ⟨x, pt⟩) (odRest x) (fun pt => od₂ ⟨x, pt⟩) + accSpec + (OutType := fun pt₁ pt₂ => OutType ⟨x, pt₁⟩ pt₂) (cpt x) + (fun accSpec' tr₁ mid => cont accSpec' ⟨x, tr₁⟩ mid) + | .«public» _X rest, s₂, ⟨.receiver, rRest⟩, r₂, odRest, od₂, _, + accSpec, _, OutType, cpt, cont => + (fun ⟨x, cptRest⟩ => + ⟨x, compAux (rest x) (fun pt => s₂ ⟨x, pt⟩) + (rRest x) (fun pt => r₂ ⟨x, pt⟩) (odRest x) (fun pt => od₂ ⟨x, pt⟩) + accSpec + (OutType := fun pt₁ pt₂ => OutType ⟨x, pt₁⟩ pt₂) cptRest + (fun accSpec' tr₁ mid => cont accSpec' ⟨x, tr₁⟩ mid)⟩) <$> cpt + +end Verifier + +namespace Counterpart + +/-- Unifying combinator for oracle-counterpart monad rewriting. + +Traverses an `Oracle.Spec` by structural recursion and rewrites the per-node +monads attached by `toMonadDecoration`, carrying a `reroute` at each receiver +node: + +* `.done` — identity. +* `.oracle` — the per-node monad is `Id`; pass through as a function on the + oracle message. Both sides grow their accumulated oracle spec by the current + oracle's `OracleInterface.spec`; `reroute` is extended so that the new + oracle-message queries pass through to the matching component of the target + spec. +* `.public .sender` — the per-node monad is `Id`; pass through as a function + on the sender message. `accSpec` does not grow. +* `.public .receiver` — the per-node monad is `OracleComp (oSpec + [OStmt?]ₒ + + accSpec?)`; rewrite it via `simulateQ reroute`, then recurse on the + continuation. + +Both `Counterpart.liftAcc` (change `accSpec`) and `Verifier.retargetMonads` +(change `OStmt`) are thin wrappers over this combinator, obtained by building +`reroute` from their respective narrow data. -/ +def mapOracles + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛ₁ : Type} {OStmt₁ : ιₛ₁ → Type} [∀ i, OracleInterface (OStmt₁ i)] + {ιₛ₂ : Type} {OStmt₂ : ιₛ₂ → Type} [∀ i, OracleInterface (OStmt₂ i)] : + (s : Oracle.Spec) → (roles : Spec.RoleDeco s) → (od : Spec.OracleDeco s) → + {ιₐ₁ : Type} → (accSpec₁ : OracleSpec.{0, 0} ιₐ₁) → + {ιₐ₂ : Type} → (accSpec₂ : OracleSpec.{0, 0} ιₐ₂) → + (reroute : QueryImpl (oSpec + [OStmt₁]ₒ + accSpec₁) + (OracleComp (oSpec + [OStmt₂]ₒ + accSpec₂))) → + {Output : Interaction.Spec.Transcript s.toInteractionSpec → Type} → + Interaction.Spec.Counterpart.withMonads s.toInteractionSpec + (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmt₁ roles od accSpec₁) Output → + Interaction.Spec.Counterpart.withMonads s.toInteractionSpec + (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmt₂ roles od accSpec₂) Output + | .done, _, _, _, _, _, _, _, _, cpt => cpt + | .oracle _ rest, _, ⟨oi, odRest⟩, _, accSpec₁, _, accSpec₂, reroute, _, cpt => + let oiSpec := @OracleInterface.spec _ oi + let routeAcc : QueryImpl (accSpec₁ + oiSpec) + (OracleComp (oSpec + [OStmt₂]ₒ + (accSpec₂ + oiSpec))) := + QueryImpl.add + (fun q => (reroute (.inr q)).liftComp _) + (fun q => liftM (oiSpec.query q)) + let newReroute : QueryImpl (oSpec + [OStmt₁]ₒ + (accSpec₁ + oiSpec)) + (OracleComp (oSpec + [OStmt₂]ₒ + (accSpec₂ + oiSpec))) := + QueryImpl.add + (fun q => (reroute (.inl q)).liftComp _) + routeAcc + fun x => mapOracles rest _ odRest + (accSpec₁ + oiSpec) (accSpec₂ + oiSpec) newReroute (cpt x) + | .«public» _ rest, ⟨.sender, rRest⟩, odRest, _, accSpec₁, _, accSpec₂, reroute, + _, cpt => + fun x => mapOracles (rest x) (rRest x) (odRest x) + accSpec₁ accSpec₂ reroute (cpt x) + | .«public» _ rest, ⟨.receiver, rRest⟩, odRest, _, accSpec₁, _, accSpec₂, reroute, + _, cpt => + simulateQ reroute <| do + let ⟨x, cptRest⟩ ← cpt + pure ⟨x, mapOracles (rest x) (rRest x) (odRest x) + accSpec₁ accSpec₂ reroute cptRest⟩ + +/-- Lift a counterpart's accumulated oracle spec from `accSpec₁` to `accSpec₂` +by routing oracle queries. At receiver nodes, `oSpec` and `OStmtIn` queries +pass through; `accSpec₁` queries are rerouted via `routeAcc`. At `.oracle` +nodes, both sides grow by the same oracle interface spec. + +When `accSpec₁ = []ₒ`, the routing is trivially `PEmpty.elim`, since no +queries to the empty spec can exist. + +Thin wrapper over `Counterpart.mapOracles`: the receiver-node reroute is +`QueryImpl.addLift (QueryImpl.id _) routeAcc`, i.e. identity on the fixed +`oSpec + [OStmtIn]ₒ` prefix and `routeAcc` on the accumulated suffix. -/ +def liftAcc + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (s : Oracle.Spec) (roles : Spec.RoleDeco s) (od : Spec.OracleDeco s) + {ιₐ₁ : Type} (accSpec₁ : OracleSpec.{0, 0} ιₐ₁) + {ιₐ₂ : Type} (accSpec₂ : OracleSpec.{0, 0} ιₐ₂) + (routeAcc : QueryImpl accSpec₁ (OracleComp ((oSpec + [OStmtIn]ₒ) + accSpec₂))) + {Output : Interaction.Spec.Transcript s.toInteractionSpec → Type} + (cpt : Interaction.Spec.Counterpart.withMonads s.toInteractionSpec + (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmtIn roles od accSpec₁) Output) : + Interaction.Spec.Counterpart.withMonads s.toInteractionSpec + (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmtIn roles od accSpec₂) Output := + mapOracles s roles od accSpec₁ accSpec₂ + (QueryImpl.addLift (QueryImpl.id _) routeAcc) cpt + +end Counterpart + +namespace Verifier + +/-- Retarget the oracle statement monad of a counterpart from `OStmtMid` to +`OStmtIn`, using a simulate function and a query answerer. + +Thin wrapper over `Counterpart.mapOracles`: the receiver-node reroute maps +`[OStmtMid]ₒ` queries through `simulateMid` (with the `s₁.toOracleSpec` +queries that appear inside `simulateMid`'s output served by `answerQ` via +`liftRoute`), and passes `oSpec`/`accSpec` queries through unchanged. + +Because `mapOracles` already handles the `accSpec` growth at `.oracle` +nodes generically, nothing besides the fixed receiver-node route needs to be +constructed here. -/ +def retargetMonads + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface.{0, 0} (OStmtIn i)] + {ιₛₘ : Type} {OStmtMid : ιₛₘ → Type} [∀ i, OracleInterface.{0, 0} (OStmtMid i)] + {s₁ : Oracle.Spec} {od₁ : Spec.OracleDeco s₁} + {pt₁ : Spec.PublicTranscript s₁} + (simulateMid : QueryImpl [OStmtMid]ₒ + (OracleComp ([OStmtIn]ₒ + s₁.toOracleSpec od₁ pt₁))) + (answerQ : QueryImpl (s₁.toOracleSpec od₁ pt₁) Id) + (s₂ : Oracle.Spec) (roles₂ : Spec.RoleDeco s₂) (od₂ : Spec.OracleDeco s₂) + {ιₐ : Type} (accSpec : OracleSpec.{0, 0} ιₐ) + {Output : Interaction.Spec.Transcript s₂.toInteractionSpec → Type} + (cpt : Interaction.Spec.Counterpart.withMonads s₂.toInteractionSpec + (s₂.toSpecRoles roles₂) + (s₂.toMonadDecoration oSpec OStmtMid roles₂ od₂ accSpec) Output) : + Interaction.Spec.Counterpart.withMonads s₂.toInteractionSpec + (s₂.toSpecRoles roles₂) + (s₂.toMonadDecoration oSpec OStmtIn roles₂ od₂ accSpec) Output := + let liftRoute : QueryImpl ([OStmtIn]ₒ + s₁.toOracleSpec od₁ pt₁) + (OracleComp ((oSpec + [OStmtIn]ₒ) + accSpec)) := fun + | .inl q => liftM <| ([OStmtIn]ₒ).query q + | .inr q => pure (answerQ q) + let route : QueryImpl (oSpec + [OStmtMid]ₒ + accSpec) + (OracleComp (oSpec + [OStmtIn]ₒ + accSpec)) := fun + | .inl (.inl q) => liftM <| oSpec.query q + | .inl (.inr q) => simulateQ liftRoute (simulateMid q) + | .inr q => liftM <| accSpec.query q + Counterpart.mapOracles s₂ roles₂ od₂ accSpec accSpec route cpt + +end Verifier + +/-! ## Binary composition -/ + +/-- Compose two `Oracle.Reduction`s sequentially. The composed reduction runs +the first protocol, then feeds its output statement (at the `PublicTranscript` +level) into the second reduction as shared input. + +The resulting context is `(Context₁ shared).append (fun pt₁ => Context₂ ...)`, +using the `PublicTranscript`-indexed continuation. Output types are those of +the second reduction, accessed via `PublicTranscript.split`. + +The `simulate` field routes output oracle queries through the second +reduction's simulate, with oracle context queries dispatched via +`QueryHandle.splitAppend`. -/ +def Reduction.comp + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {Context₁ : SharedIn → Spec} + {Roles₁ : (shared : SharedIn) → Spec.RoleDeco (Context₁ shared)} + {OracleDeco₁ : (shared : SharedIn) → Spec.OracleDeco (Context₁ shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementMid : + (shared : SharedIn) → Spec.PublicTranscript (Context₁ shared) → Type} + {ιₛₘ : (shared : SharedIn) → Spec.PublicTranscript (Context₁ shared) → Type} + {OStatementMid : + (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + ιₛₘ shared pt₁ → Type} + [∀ shared pt₁ i, OracleInterface (OStatementMid shared pt₁ i)] + {WitnessMid : + (shared : SharedIn) → Spec.PublicTranscript (Context₁ shared) → Type} + {Context₂ : (shared : SharedIn) → Spec.PublicTranscript (Context₁ shared) → Spec} + {Roles₂ : (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Spec.RoleDeco (Context₂ shared pt₁)} + {OracleDeco₂ : (shared : SharedIn) → + (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Spec.OracleDeco (Context₂ shared pt₁)} + {StatementOut : + (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Spec.PublicTranscript (Context₂ shared pt₁) → Type} + {ιₛₒ : (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Spec.PublicTranscript (Context₂ shared pt₁) → Type} + {OStatementOut : + (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + (pt₂ : Spec.PublicTranscript (Context₂ shared pt₁)) → ιₛₒ shared pt₁ pt₂ → Type} + [∀ shared pt₁ pt₂ i, OracleInterface (OStatementOut shared pt₁ pt₂ i)] + {WitnessOut : + (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Spec.PublicTranscript (Context₂ shared pt₁) → Type} + (r₁ : Reduction oSpec SharedIn Context₁ Roles₁ OracleDeco₁ + StatementIn OStatementIn WitnessIn StatementMid OStatementMid WitnessMid) + (r₂ : (shared : SharedIn) → (pt₁ : Spec.PublicTranscript (Context₁ shared)) → + Reduction oSpec PUnit + (fun _ => Context₂ shared pt₁) + (fun _ => Roles₂ shared pt₁) + (fun _ => OracleDeco₂ shared pt₁) + (fun _ => StatementMid shared pt₁) + (fun _ => OStatementMid shared pt₁) + (fun _ => WitnessMid shared pt₁) + (fun _ pt₂ => StatementOut shared pt₁ pt₂) + (OStatementOut := fun _ pt₂ => OStatementOut shared pt₁ pt₂) + (fun _ pt₂ => WitnessOut shared pt₁ pt₂)) : + Reduction oSpec SharedIn + (fun shared => (Context₁ shared).append (Context₂ shared)) + (fun shared => Spec.RoleDeco.append (Context₁ shared) (Context₂ shared) + (Roles₁ shared) (Roles₂ shared)) + (fun shared => Spec.OracleDeco.append (Context₁ shared) (Context₂ shared) + (OracleDeco₁ shared) (OracleDeco₂ shared)) + StatementIn OStatementIn WitnessIn + (fun shared pt => + StatementOut shared + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).1 + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).2) + (ιₛₒ := fun shared pt => + ιₛₒ shared + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).1 + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).2) + (OStatementOut := fun shared pt i => + OStatementOut shared + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).1 + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).2 + i) + (fun shared pt => + WitnessOut shared + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).1 + (Spec.PublicTranscript.split (Context₁ shared) (Context₂ shared) pt).2) where + prover shared sWithOracles w := do + let strat₁ ← r₁.prover shared sWithOracles w + Prover.compAux (Context₁ shared) (Context₂ shared) + (Roles₁ shared) (Roles₂ shared) + (OutType := fun pt₁ pt₂ => + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared pt₁ pt₂) + (fun _ => OStatementOut shared pt₁ pt₂) shared) + (WitnessOut shared pt₁ pt₂)) + strat₁ + fun tr₁ midOut => do + let pt₁ := (Context₁ shared).projectPublic tr₁ + let midStmt : StatementWithOracles + (fun _ => StatementMid shared pt₁) + (fun _ => OStatementMid shared pt₁) PUnit.unit := + ⟨midOut.stmt.stmt, midOut.stmt.oracleStmt⟩ + let strat₂ ← (r₂ shared pt₁).prover PUnit.unit midStmt midOut.wit + pure <| Interaction.Spec.Strategy.mapOutputWithRoles + (fun tr₂ out => + (⟨⟨out.stmt.stmt, out.stmt.oracleStmt⟩, out.wit⟩ : + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared pt₁ + ((Context₂ shared pt₁).projectPublic tr₂)) + (fun _ => OStatementOut shared pt₁ + ((Context₂ shared pt₁).projectPublic tr₂)) + shared) + (WitnessOut shared pt₁ + ((Context₂ shared pt₁).projectPublic tr₂)))) strat₂ + verifier := { + toFun := fun shared stmtIn => + Verifier.compAux (OStmtIn := OStatementIn shared) + (Context₁ shared) (Context₂ shared) + (Roles₁ shared) (Roles₂ shared) (OracleDeco₁ shared) (OracleDeco₂ shared) + []ₒ + (OutType := fun pt₁ pt₂ => StatementOut shared pt₁ pt₂) + (r₁.verifier.toFun shared stmtIn) + (fun accSpec' tr₁ midStmt => + let pt₁ := (Context₁ shared).projectPublic tr₁ + Counterpart.liftAcc + (Context₂ shared pt₁) (Roles₂ shared pt₁) (OracleDeco₂ shared pt₁) + []ₒ accSpec' (fun q => nomatch q) + (Verifier.retargetMonads + (r₁.verifier.simulate shared pt₁) + (Spec.answerQuery (Context₁ shared) (OracleDeco₁ shared) tr₁) + (Context₂ shared pt₁) (Roles₂ shared pt₁) (OracleDeco₂ shared pt₁) + []ₒ + ((r₂ shared pt₁).verifier.toFun PUnit.unit midStmt))) + -- This `simulate` operates directly on `QueryImpl`s over combined + -- oracle specs, not on `Counterpart.withMonads` values, so + -- `Counterpart.mapOracles` (which rewrites per-node monads in a + -- counterpart) is not applicable here. The routing below is a + -- specialized plumbing of `simulateQ` through the two sub-verifiers' + -- `simulate`s. + simulate := fun shared pt => + let pt₁ := (Spec.PublicTranscript.split + (Context₁ shared) (Context₂ shared) pt).1 + let pt₂ := (Spec.PublicTranscript.split + (Context₁ shared) (Context₂ shared) pt).2 + let s₁ := Context₁ shared + let s₂ := Context₂ shared + let od₁ := OracleDeco₁ shared + let od₂ := OracleDeco₂ shared + let od_app := Spec.OracleDeco.append s₁ s₂ od₁ od₂ + let midSpec := [OStatementMid shared pt₁]ₒ + + Spec.toOracleSpec (s₁.append s₂) od_app pt + let inSpec := [OStatementIn shared]ₒ + + Spec.toOracleSpec (s₁.append s₂) od_app pt + let embedMid : QueryImpl + (Spec.toOracleSpec (s₁.append s₂) od_app pt) (OracleComp midSpec) := + fun q => liftM <| midSpec.query (.inr q) + let embedIn : QueryImpl + (Spec.toOracleSpec (s₁.append s₂) od_app pt) (OracleComp inSpec) := + fun q => liftM <| inSpec.query (.inr q) + fun ⟨i, q⟩ => + let base := (r₂ shared pt₁).verifier.simulate PUnit.unit pt₂ ⟨i, q⟩ + let routeRight : QueryImpl + ([OStatementMid shared pt₁]ₒ + + Spec.toOracleSpec (s₂ pt₁) (od₂ pt₁) pt₂) + (OracleComp midSpec) := fun + | .inl q => liftM <| midSpec.query (.inl q) + | .inr q => Spec.restrictRight s₁ s₂ od₁ od₂ pt embedMid q + let routedSuffix := simulateQ routeRight base + let routeLeft : QueryImpl + ([OStatementIn shared]ₒ + + Spec.toOracleSpec s₁ od₁ pt₁) + (OracleComp inSpec) := fun + | .inl q => liftM <| inSpec.query (.inl q) + | .inr q => Spec.restrictLeft s₁ s₂ od₁ od₂ pt embedIn q + let routeMid : QueryImpl midSpec (OracleComp inSpec) := fun + | .inl q => simulateQ routeLeft + (r₁.verifier.simulate shared pt₁ q) + | .inr q => liftM <| inSpec.query (.inr q) + simulateQ routeMid routedSuffix + } + +end Interaction.Oracle diff --git a/ArkLib/Interaction/Oracle/Continuation.lean b/ArkLib/Interaction/Oracle/Continuation.lean new file mode 100644 index 0000000000..c1e53e1aee --- /dev/null +++ b/ArkLib/Interaction/Oracle/Continuation.lean @@ -0,0 +1,1834 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Execution + +set_option linter.style.longFile 2000 + +open OracleComp OracleSpec +open Interaction.TwoParty + +namespace Interaction + +namespace OracleDecoration + +/-! ## Oracle reduction composition -/ + +namespace OracleReduction + +/-- Freeze the shared input of an oracle reduction, reindexing the ambient +protocol spine over `PUnit`. This is a bridge utility for proofs that want to +view a fixed shared spine as a degenerate one-point ambient index. -/ +def freezeSharedToPUnit + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStmtOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStmtIn WitnessIn StatementOut OStmtOut WitnessOut) + (shared : SharedIn) : + OracleReduction oSpec + PUnit + (fun _ => Context shared) + (fun _ => Roles shared) + (fun _ => oracleDeco shared) + (fun _ => StatementIn shared) + (fun _ => OStmtIn shared) + (fun _ => WitnessIn shared) + (fun _ tr => StatementOut shared tr) + (fun _ tr => OStmtOut shared tr) + (fun _ tr => WitnessOut shared tr) where + prover _ s w := do + let input' : + StatementWithOracles StatementIn OStmtIn shared := + ⟨s.stmt, s.oracleStmt⟩ + let remapOutput : + (tr : Spec.Transcript (Context shared)) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) shared) + (WitnessOut shared tr) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) PUnit.unit) + (WitnessOut shared tr) + | _, ⟨stmtOut, witOut⟩ => ⟨⟨stmtOut.stmt, stmtOut.oracleStmt⟩, witOut⟩ + let strat ← reduction.prover shared input' w + pure <| Spec.Strategy.mapOutputWithRoles remapOutput strat + verifier _ {_} accSpec stmt := + reduction.verifier shared accSpec stmt + simulate _ tr := + reduction.simulate shared tr + +/-- Identity continuation: no further interaction, and the carried local +statement, oracle family, and witness are forwarded unchanged. -/ +def id + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} : + OracleReduction oSpec SharedIn + (fun _ => .done) + (fun _ => ⟨⟩) + (fun _ => ⟨⟩) + StatementIn OStmtIn WitnessIn + (fun shared _ => StatementIn shared) + (fun shared _ => OStmtIn shared) + (fun shared _ => WitnessIn shared) where + prover _ sWithOracles w := + pure ⟨⟨sWithOracles.stmt, sWithOracles.oracleStmt⟩, w⟩ + verifier _ {_} _accSpec stmt := + stmt + simulate _ _ := + fun q => liftM <| ([OStmtIn _]ₒ).query q + +/-- Freeze the shared spine of a continuation-shaped oracle reduction and +promote the carried statement to the new ambient index. This is a bridge +utility for one-shot views whose ambient input is precisely the explicit +current statement. -/ +def promoteStatementToShared + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStmtOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStmtIn WitnessIn StatementOut OStmtOut WitnessOut) + (shared : SharedIn) : + OracleReduction oSpec + (StatementIn shared) + (fun _ => Context shared) + (fun _ => Roles shared) + (fun _ => oracleDeco shared) + (fun _ => PUnit) + (fun _ => OStmtIn shared) + (fun _ => WitnessIn shared) + (fun _ tr => StatementOut shared tr) + (fun _ tr => OStmtOut shared tr) + (fun _ tr => WitnessOut shared tr) where + prover stmt sWithOracles w := do + let input' : + StatementWithOracles StatementIn OStmtIn shared := + ⟨stmt, sWithOracles.oracleStmt⟩ + let remapOutput : + (tr : Spec.Transcript (Context shared)) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) shared) + (WitnessOut shared tr) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) stmt) + (WitnessOut shared tr) + | _, ⟨stmtOut, witOut⟩ => ⟨⟨stmtOut.stmt, stmtOut.oracleStmt⟩, witOut⟩ + let strat ← reduction.prover shared input' w + pure <| Spec.Strategy.mapOutputWithRoles remapOutput strat + verifier stmt {_} accSpec _ := + reduction.verifier shared accSpec stmt + simulate _ tr := + reduction.simulate shared tr + +/-- Reindex the shared input of a continuation along a pure map. This is useful +for composing with a later continuation that ignores some earlier transcript +components of the shared input. -/ +def pullbackShared + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {SharedIn' : Type} + (f : SharedIn' → SharedIn) + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStmtOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStmtIn WitnessIn StatementOut OStmtOut WitnessOut) : + OracleReduction oSpec SharedIn' + (fun shared => Context (f shared)) + (fun shared => Roles (f shared)) + (fun shared => oracleDeco (f shared)) + (fun shared => StatementIn (f shared)) + (fun shared => OStmtIn (f shared)) + (fun shared => WitnessIn (f shared)) + (fun shared tr => StatementOut (f shared) tr) + (fun shared tr => OStmtOut (f shared) tr) + (fun shared tr => WitnessOut (f shared) tr) where + prover shared sWithOracles w := do + let input' : + StatementWithOracles StatementIn OStmtIn (f shared) := + ⟨sWithOracles.stmt, sWithOracles.oracleStmt⟩ + let remapOutput : + (tr : Spec.Transcript (Context (f shared))) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut (f shared) tr) (fun _ => OStmtOut (f shared) tr) (f shared)) + (WitnessOut (f shared) tr) → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut (f shared) tr) (fun _ => OStmtOut (f shared) tr) shared) + (WitnessOut (f shared) tr) + | _, ⟨stmtOut, witOut⟩ => ⟨⟨stmtOut.stmt, stmtOut.oracleStmt⟩, witOut⟩ + let strat ← reduction.prover (f shared) input' w + pure <| Spec.Strategy.mapOutputWithRoles remapOutput strat + verifier shared {_} accSpec := + reduction.verifier (f shared) accSpec + simulate shared tr := + reduction.simulate (f shared) tr + +/-! ## Intrinsic continuation chains -/ + +/-- An oracle-native intrinsic chain of `n` continuation rounds. Each round +packages its current `Spec`, `RoleDecoration`, and `OracleDecoration` +directly, so no external stage family or total `roles/od` map is needed. -/ +inductive Chain : Nat → Type _ + | nil : Chain 0 + | cons {n : Nat} + (spec : Spec) (roles : RoleDecoration spec) (od : OracleDecoration spec roles) + (cont : Spec.Transcript spec → Chain n) : Chain (n + 1) + +namespace Chain + +/-- Flatten an intrinsic continuation chain into a `Spec`. -/ +def toSpec : {n : Nat} → Chain n → Spec + | 0, .nil => .done + | _ + 1, .cons spec _ _ cont => spec.append fun tr => toSpec (cont tr) + +/-- Flatten the per-round role decorations of an intrinsic continuation chain. -/ +def roles : {n : Nat} → (c : Chain n) → RoleDecoration (toSpec c) + | 0, .nil => PUnit.unit + | _ + 1, .cons _ headRoles _ cont => + Spec.Decoration.append headRoles fun tr => roles (cont tr) + +/-- Flatten the per-round oracle decorations of an intrinsic continuation chain. -/ +def od : {n : Nat} → (c : Chain n) → OracleDecoration (toSpec c) (roles c) + | 0, .nil => PUnit.unit + | _ + 1, .cons _ _ headOD cont => + Role.Refine.append headOD fun tr => od (cont tr) + +/-- Lift a family on the remaining intrinsic chain to a family on transcripts of +the flattened chain. -/ +def outputFamily + (Family : {n : Nat} → Chain n → Type) : + {n : Nat} → (c : Chain n) → Spec.Transcript (toSpec c) → Type + | 0, c, _ => Family c + | _ + 1, .cons spec _ _ cont, tr => + Spec.Transcript.liftAppend spec + (fun tr₁ => toSpec (cont tr₁)) + (fun tr₁ tr₂ => outputFamily Family (cont tr₁) tr₂) + tr + +/-- Collapse a lifted chain output back to the unique terminal chain state. -/ +def outputAtEnd + (Family : {n : Nat} → Chain n → Type) : + {n : Nat} → (c : Chain n) → (tr : Spec.Transcript (toSpec c)) → + outputFamily Family c tr → Family .nil + | 0, .nil, _, out => out + | _ + 1, .cons spec _ _ cont, tr, out => + let split := + Spec.Transcript.split spec (fun tr₁ => toSpec (cont tr₁)) tr + let tailOut := + Spec.Transcript.unliftAppend spec + (fun tr₁ => toSpec (cont tr₁)) + (fun tr₁ tr₂ => outputFamily Family (cont tr₁) tr₂) + tr out + outputAtEnd Family (cont split.1) split.2 tailOut + +end Chain + +private def chainStrategy + {ι : Type} {oSpec : OracleSpec ι} + {Family : {n : Nat} → Chain n → Type} + (step : {n : Nat} → (c : Chain (n + 1)) → Family c → + OracleComp oSpec + (match c with + | .cons spec roles _ cont => + Spec.Strategy.withRoles (OracleComp oSpec) spec roles + (fun tr => Family (cont tr)))) : + {n : Nat} → (c : Chain n) → Family c → + OracleComp oSpec + (Spec.Strategy.withRoles (OracleComp oSpec) (Chain.toSpec c) (Chain.roles c) + (Chain.outputFamily Family c)) + | 0, .nil, out => pure out + | _ + 1, .cons spec roles od cont, state => do + let strat ← step (.cons spec roles od cont) state + Spec.Strategy.compWithRoles strat fun tr next => + chainStrategy step (cont tr) next + +private def chainVerifier + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + {Family : {n : Nat} → Chain n → Type} + {ιₐ : Type} (accSpec : OracleSpec ιₐ) + (step : {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + {n : Nat} → (c : Chain (n + 1)) → Family c → + (match c with + | .cons spec roles od cont => + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) + (fun tr => Family (cont tr)))) : + {n : Nat} → (c : Chain n) → Family c → + Spec.Counterpart.withMonads (Chain.toSpec c) (Chain.roles c) + (toMonadDecoration oSpec OStmtIn (Chain.toSpec c) (Chain.roles c) (Chain.od c) accSpec) + (Chain.outputFamily Family c) + | 0, .nil, out => out + | _ + 1, .cons spec roles od cont, state => by + simpa [Chain.toSpec, Chain.roles, Chain.od, Chain.outputFamily, + toMonadDecoration_append] using + (Spec.Counterpart.withMonads.append + (step accSpec (.cons spec roles od cont) state) + (fun tr next => + chainVerifier + ((accSpecAfter spec roles od accSpec tr).2) + step + (cont tr) + next)) + +/-- Compose an intrinsic oracle continuation chain while threading arbitrary +internal prover and verifier state along the chain. Unlike `stateChainComp`, +the round structure lives directly in the chain itself, so callers do not need +an external stage family or transport through stage-indexed decorations. -/ +def chainComp + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {n : Nat} + (chain : SharedIn → Chain n) + {ProverState : (shared : SharedIn) → {m : Nat} → Chain m → Type} + {VerifierState : (shared : SharedIn) → {m : Nat} → Chain m → Type} + {StatementOut : (shared : SharedIn) → + Spec.Transcript (Chain.toSpec (chain shared)) → Type} + {ιₛₒ : (shared : SharedIn) → + (tr : Spec.Transcript (Chain.toSpec (chain shared))) → Type} + {OStmtOut : + (shared : SharedIn) → + (tr : Spec.Transcript (Chain.toSpec (chain shared))) → + ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → + Spec.Transcript (Chain.toSpec (chain shared)) → Type} + (proverInit : + (shared : SharedIn) → + StatementWithOracles StatementIn OStmtIn shared → + WitnessIn shared → + OracleComp oSpec (ProverState shared (chain shared))) + (proverStep : + (shared : SharedIn) → + {m : Nat} → (c : Chain (m + 1)) → ProverState shared c → + OracleComp oSpec + (match c with + | .cons spec roles _ cont => + Spec.Strategy.withRoles (OracleComp oSpec) spec roles + (fun tr => ProverState shared (cont tr)))) + (proverResult : + (shared : SharedIn) → + (s : StatementWithOracles StatementIn OStmtIn shared) → + (tr : Spec.Transcript (Chain.toSpec (chain shared))) → + ProverState shared Chain.nil → + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) shared) + (WitnessOut shared tr)) + (verifierInit : + (shared : SharedIn) → StatementIn shared → + VerifierState shared (chain shared)) + (verifierStep : + (shared : SharedIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + {m : Nat} → (c : Chain (m + 1)) → VerifierState shared c → + (match c with + | .cons spec roles od cont => + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec (OStmtIn shared) spec roles od accSpec) + (fun tr => VerifierState shared (cont tr)))) + (verifierResult : + (shared : SharedIn) → (stmt : StatementIn shared) → + (tr : Spec.Transcript (Chain.toSpec (chain shared))) → + VerifierState shared Chain.nil → + StatementOut shared tr) + (simulateResult : + (shared : SharedIn) → + (tr : Spec.Transcript (Chain.toSpec (chain shared))) → + QueryImpl [OStmtOut shared tr]ₒ + (OracleComp ([OStmtIn shared]ₒ + + toOracleSpec (Chain.toSpec (chain shared)) + (Chain.roles (chain shared)) + (Chain.od (chain shared)) + tr))) : + OracleReduction oSpec SharedIn + (fun shared => Chain.toSpec (chain shared)) + (fun shared => Chain.roles (chain shared)) + (fun shared => Chain.od (chain shared)) + StatementIn OStmtIn WitnessIn + StatementOut + OStmtOut + WitnessOut where + prover shared sWithOracles witness := do + let init ← proverInit shared sWithOracles witness + let strat ← chainStrategy (proverStep shared) (chain shared) init + pure <| Spec.Strategy.mapOutputWithRoles + (fun tr pOut => + proverResult shared sWithOracles tr + (Chain.outputAtEnd + (fun {_} c => ProverState shared c) + (chain shared) tr pOut)) + strat + verifier shared {_} accSpec stmt := + Spec.Counterpart.withMonads.mapOutput + (Chain.toSpec (chain shared)) + (Chain.roles (chain shared)) + (toMonadDecoration oSpec (OStmtIn shared) + (Chain.toSpec (chain shared)) + (Chain.roles (chain shared)) + (Chain.od (chain shared)) + accSpec) + (fun tr vOut => + verifierResult shared stmt tr + (Chain.outputAtEnd + (fun {_} c => VerifierState shared c) + (chain shared) tr vOut)) + (chainVerifier accSpec (verifierStep shared) (chain shared) (verifierInit shared stmt)) + simulate shared tr := + simulateResult shared tr + +/-- Run an arbitrary prover strategy against an oracle continuation's verifier and +package the resulting plain verifier output with transcript-dependent oracle +access semantics. -/ +def run + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStmtOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStmtIn WitnessIn StatementOut OStmtOut WitnessOut) + (shared : SharedIn) (stmt : StatementIn shared) + (inputImpl : QueryImpl [OStmtIn shared]ₒ Id) + {OutputP : Spec.Transcript (Context shared) → Type} + (prover : Spec.Strategy.withRoles (OracleComp oSpec) (Context shared) (Roles shared) OutputP) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) : + OracleComp oSpec ((tr : Spec.Transcript (Context shared)) × OutputP tr × + (StatementOut shared tr × QueryImpl [OStmtOut shared tr]ₒ + (OracleComp + ([OStmtIn shared]ₒ + toOracleSpec (Context shared) (Roles shared) + (oracleDeco shared) tr)))) := do + let ⟨tr, outP, stmtOutV⟩ ← + runWithOracleCounterpart inputImpl + (Context shared) (Roles shared) (oracleDeco shared) accSpec accImpl + prover (reduction.verifier shared accSpec stmt) + pure ⟨tr, outP, ⟨stmtOutV, reduction.simulate shared tr⟩⟩ + +/-- Execute an oracle continuation honestly and package the verifier's plain +output with transcript-dependent oracle access semantics. -/ +def execute + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : (shared : SharedIn) → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStmtOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStmtOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStmtIn WitnessIn StatementOut OStmtOut WitnessOut) + (shared : SharedIn) + (s : StatementWithOracles StatementIn OStmtIn shared) + (w : WitnessIn shared) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) : + OracleComp oSpec ((tr : Spec.Transcript (Context shared)) × + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStmtOut shared tr) shared) + (WitnessOut shared tr) × + (StatementOut shared tr × QueryImpl [OStmtOut shared tr]ₒ + (OracleComp + ([OStmtIn shared]ₒ + toOracleSpec (Context shared) (Roles shared) + (oracleDeco shared) tr)))) := do + let strategy ← reduction.prover shared s w + let ⟨tr, proverOut, stmtOutV⟩ ← + runWithOracleCounterpart (OracleInterface.simOracle0 (OStmtIn shared) s.oracleStmt) + (Context shared) (Roles shared) (oracleDeco shared) accSpec accImpl + strategy (reduction.verifier shared accSpec s.stmt) + pure ⟨tr, proverOut, ⟨stmtOutV, reduction.simulate shared tr⟩⟩ + +private def liftSimulatedMidOracleContextContinuation + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStmtIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStmtIn shared i)] + {WitnessIn : SharedIn → Type} + {ctx₁ : SharedIn → Spec} + {roles₁ : (shared : SharedIn) → RoleDecoration (ctx₁ shared)} + {oracleDeco₁ : (shared : SharedIn) → OracleDecoration (ctx₁ shared) (roles₁ shared)} + {StmtMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ιₛₘ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → Type} + {OStmtMid : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + ιₛₘ shared tr₁ → Type} + [∀ shared tr₁ i, OracleInterface (OStmtMid shared tr₁ i)] + {WitMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ctx₂ : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Spec} + {roles₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + RoleDecoration (ctx₂ shared tr₁)} + {oracleDeco₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + OracleDecoration (ctx₂ shared tr₁) (roles₂ shared tr₁)} + (reduction1 : OracleReduction oSpec SharedIn + ctx₁ roles₁ oracleDeco₁ StatementIn OStmtIn WitnessIn StmtMid OStmtMid WitMid) + (shared : SharedIn) + (tr₁ : Spec.Transcript (ctx₁ shared)) + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) : + QueryImpl + ([OStmtMid shared tr₁]ₒ + + toOracleSpec ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) + (OracleComp + ([OStmtIn shared]ₒ + + toOracleSpec ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂))) + | .inl q => + simulateQ + (liftAppendLeftContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStmtIn shared) tr₁ tr₂) + (reduction1.simulate shared tr₁ q) + | .inr q => + liftM <| ([OStmtIn shared]ₒ + + toOracleSpec ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)).query (.inr q) + +private def liftPrefixOracleContext + {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + (s : StatementIn) (tr₁ : Spec.Transcript (ctx₁ s)) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) : + QueryImpl ([OStmtIn s]ₒ + toOracleSpec (ctx₁ s) (roles₁ s) (oracleDeco₁ s) tr₁) + (OracleComp ((oSpec + [OStmtIn s]ₒ) + accSpec)) + | .inl q => + liftM <| ([OStmtIn s]ₒ).query q + | .inr q => + pure <| OracleDecoration.answerQuery (ctx₁ s) (roles₁ s) (oracleDeco₁ s) tr₁ q + +private def retargetContinuationVerifier + {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (s : StatementIn) (tr₁ : Spec.Transcript (ctx₁ s)) : + (spec : Spec) → (roles : RoleDecoration spec) → + (od : OracleDecoration spec roles) → + (Output : Spec.Transcript spec → Type) → + {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec (OStmtMid s tr₁) spec roles od accSpec) + Output → + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec (OStmtIn s) spec roles od accSpec) + Output + | .done, _, _, _, _, _, cpt => + cpt + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, Output, _, accSpec, cpt => + fun x => + retargetContinuationVerifier reduction1 s tr₁ + (rest x) (rRest x) (odRest x) (fun p => Output ⟨x, p⟩) + (accSpec + @OracleInterface.spec _ oi) (cpt x) + | .node _ rest, ⟨.receiver, rRest⟩, odFn, Output, _, accSpec, cpt => + let route : + QueryImpl ((oSpec + [OStmtMid s tr₁]ₒ) + accSpec) + (OracleComp ((oSpec + [OStmtIn s]ₒ) + accSpec)) := + fun + | .inl (.inl q) => + liftM <| oSpec.query q + | .inl (.inr q) => + simulateQ (liftPrefixOracleContext + (oSpec := oSpec) (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + s tr₁ accSpec) (reduction1.simulate s tr₁ q) + | .inr q => + liftM <| accSpec.query q + simulateQ route <| do + let ⟨x, cptRest⟩ ← cpt + pure ⟨x, retargetContinuationVerifier reduction1 s tr₁ + (rest x) (rRest x) (odFn x) (fun p => Output ⟨x, p⟩) + accSpec cptRest⟩ + +private def liftSimulatedMidOracleContext + {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (s : StatementIn) + (tr₁ : Spec.Transcript (ctx₁ s)) + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) : + QueryImpl + ([OStmtMid s tr₁]ₒ + + toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (OracleComp + ([OStmtIn s]ₒ + + toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) + | .inl q => + simulateQ + (liftAppendLeftContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtIn s) tr₁ tr₂) + (reduction1.simulate s tr₁ q) + | .inr q => + liftM <| ([OStmtIn s]ₒ + + toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)).query (.inr q) + +private theorem simulateQ_liftSimulatedMidOracleContext_eq + {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (s : StatementIn) + (tr₁ : Spec.Transcript (ctx₁ s)) + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) + (oStmtIn : OracleStatement (OStmtIn s)) + (midImpl : QueryImpl [OStmtMid s tr₁]ₒ Id) + (hMid : ∀ i (q : OracleInterface.Query (OStmtMid s tr₁ i)), + simulateQ + (OracleDecoration.oracleContextImpl (ctx₁ s) (roles₁ s) (oracleDeco₁ s) oStmtIn tr₁) + (reduction1.simulate s tr₁ ⟨i, q⟩) = pure (midImpl ⟨i, q⟩)) : + ∀ q, + simulateQ + (OracleDecoration.oracleContextImpl ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + oStmtIn + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (liftSimulatedMidOracleContext + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 s tr₁ tr₂ q) = + (QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) q := by + intro q + cases q with + | inl q => + rcases q with ⟨i, q⟩ + simp only [liftSimulatedMidOracleContext, add_apply_inl] + rw [← QueryImpl.simulateQ_compose] + have hroute : + ((OracleDecoration.oracleContextImpl ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + oStmtIn + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) ∘ₛ + (liftAppendLeftContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtIn s) tr₁ tr₂)) = + OracleDecoration.oracleContextImpl (ctx₁ s) (roles₁ s) (oracleDeco₁ s) oStmtIn tr₁ := by + funext q' + exact simulateQ_liftAppendLeftContext_eq + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtIn s) tr₁ tr₂ oStmtIn q' + rw [simulateQ_ext (fun q' => congrFun hroute q')] + simpa [QueryImpl.add] using hMid i q + | inr q => + simp [liftSimulatedMidOracleContext, QueryImpl.add, OracleDecoration.oracleContextImpl, + simulateQ_query] + +private theorem simulateQ_liftSimulatedMidOracleContextContinuation_eq + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {ctx₁ : SharedIn → Spec} + {roles₁ : (shared : SharedIn) → RoleDecoration (ctx₁ shared)} + {oracleDeco₁ : (shared : SharedIn) → OracleDecoration (ctx₁ shared) (roles₁ shared)} + {StatementMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ιₛₘ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → Type} + {OStatementMid : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → ιₛₘ shared tr₁ → Type} + [∀ shared tr₁ i, OracleInterface (OStatementMid shared tr₁ i)] + {WitnessMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ctx₂ : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Spec} + {roles₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + RoleDecoration (ctx₂ shared tr₁)} + {oracleDeco₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + OracleDecoration (ctx₂ shared tr₁) (roles₂ shared tr₁)} + (reduction1 : OracleReduction oSpec SharedIn + ctx₁ roles₁ oracleDeco₁ + StatementIn OStatementIn WitnessIn + StatementMid OStatementMid WitnessMid) + (shared : SharedIn) + (tr₁ : Spec.Transcript (ctx₁ shared)) + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) + (oStatementIn : OracleStatement (OStatementIn shared)) + (midImpl : QueryImpl [OStatementMid shared tr₁]ₒ Id) + (hMid : ∀ i (q : OracleInterface.Query (OStatementMid shared tr₁ i)), + simulateQ + (OracleDecoration.oracleContextImpl + (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) oStatementIn tr₁) + (reduction1.simulate shared tr₁ ⟨i, q⟩) = pure (midImpl ⟨i, q⟩)) : + ∀ q, + simulateQ + (OracleDecoration.oracleContextImpl ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) + (liftSimulatedMidOracleContextContinuation + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 shared tr₁ tr₂ q) = + (QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂))) q := by + intro q + cases q with + | inl q => + rcases q with ⟨i, q⟩ + simp only [liftSimulatedMidOracleContextContinuation] + rw [← QueryImpl.simulateQ_compose] + have hRoute : + ((OracleDecoration.oracleContextImpl ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) ∘ₛ + (liftAppendLeftContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStatementIn shared) tr₁ tr₂)) = + OracleDecoration.oracleContextImpl + (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) oStatementIn tr₁ := by + funext q' + exact simulateQ_liftAppendLeftContext_eq + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStatementIn shared) tr₁ tr₂ oStatementIn q' + rw [simulateQ_ext (fun q' => congrFun hRoute q')] + simpa [QueryImpl.add] using hMid i q + | inr q => + simp [liftSimulatedMidOracleContextContinuation, QueryImpl.add, + OracleDecoration.oracleContextImpl, simulateQ_query] + +private theorem simulateQ_liftAppendRightContext_withImpl_eq + {StatementIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : + (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + (s : StatementIn) + (tr₁ : Spec.Transcript (ctx₁ s)) + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) + (midImpl : QueryImpl [OStmtMid s tr₁]ₒ Id) : + ∀ q, + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂ q) = + (QueryImpl.add midImpl + (OracleDecoration.answerQuery (ctx₂ s tr₁) (roles₂ s tr₁) (oracleDeco₂ s tr₁) tr₂)) q := by + intro q + exact simulateQ_liftAppendRightContext_eq_of_impl + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂ midImpl q +/- + intro q + cases q with + | inl q => + simp [QueryImpl.add, liftAppendRightContext, simulateQ_query] + | inr q => + have hLifted : + liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂ (.inr q) = + cast + (congrArg + (OracleComp <| [OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (OracleDecoration.QueryHandle.appendRight_range + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) + (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q)) + (liftM (query + (spec := [OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) + (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q))) := by + simpa [liftAppendRightContext, liftAppendRightQuery] using + (liftM_cast_query_add_right + (spec₁ := [OStmtMid s tr₁]ₒ) + (spec₂ := OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (t := OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) + (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q) + (h := OracleDecoration.QueryHandle.appendRight_range + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) + (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q)) + calc + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂ (.inr q)) = + cast + (OracleDecoration.QueryHandle.appendRight_range + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) + tr₁ tr₂ q) + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂) + (OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) + tr₁ tr₂ q)) := by + rw [hLifted] + simpa [QueryImpl.add] using + (simulateQ_cast_query + (spec := [OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (α := ([OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) + (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q)) + (β := ([OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec (ctx₂ s tr₁) + (roles₂ s tr₁) (oracleDeco₂ s tr₁) tr₂).Range (Sum.inr q)) + (h := (OracleDecoration.QueryHandle.appendRight_range + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) + (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q : + ([OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) + (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q) = + ([OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec (ctx₂ s tr₁) + (roles₂ s tr₁) (oracleDeco₂ s tr₁) tr₂).Range (Sum.inr q))) + (impl := QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) + (q := query + (spec := [OStmtMid s tr₁]ₒ + + OracleDecoration.toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) + (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) tr₁ tr₂ q))) + _ = OracleDecoration.answerQuery + (ctx₂ s tr₁) (roles₂ s tr₁) (oracleDeco₂ s tr₁) tr₂ q := by + simpa using OracleDecoration.QueryHandle.answerQuery_appendRight + (ctx₁ s) (ctx₂ s) (roles₁ s) (roles₂ s) (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr) + tr₁ tr₂ q +-/ + +private def compSimulate + {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + {StmtOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + {ιₛₒ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → Type} + {OStmtOut : + (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → ιₛₒ s tr₁ tr₂ → Type} + [∀ s tr₁ tr₂ i, OracleInterface (OStmtOut s tr₁ tr₂ i)] + {WitOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (reduction2 : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleReduction oSpec + PUnit + (fun _ => ctx₂ s tr₁) + (fun _ => roles₂ s tr₁) + (fun _ => oracleDeco₂ s tr₁) + (fun _ => StmtMid s tr₁) + (fun _ => OStmtMid s tr₁) + (fun _ => WitMid s tr₁) + (fun _ tr₂ => StmtOut s tr₁ tr₂) + (fun _ tr₂ => OStmtOut s tr₁ tr₂) + (fun _ tr₂ => WitOut s tr₁ tr₂)) + (s : StatementIn) (tr : Spec.Transcript ((ctx₁ s).append (ctx₂ s))) : + QueryImpl + [liftAppendOracleFamily (ctx₁ s) (ctx₂ s) (ιₛₒ s) (OStmtOut s) tr]ₒ + (OracleComp ([OStmtIn s]ₒ + toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr₁ => oracleDeco₂ s tr₁)) tr)) := by + intro qOut + let split := Spec.Transcript.split (ctx₁ s) (ctx₂ s) tr + let tr₁ := split.1 + let tr₂ := split.2 + let qSplit : ([OStmtOut s tr₁ tr₂]ₒ).Domain := + splitLiftAppendOracleQuery (ctx₁ s) (ctx₂ s) (ιₛₒ s) (OStmtOut s) tr qOut + let routedSuffix := + simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂) + ((reduction2 s tr₁).simulate PUnit.unit tr₂ qSplit) + let routed := + simulateQ + (liftSimulatedMidOracleContext + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 s tr₁ tr₂) + routedSuffix + let baseSpec := fun tr' => + [OStmtIn s]ₒ + toOracleSpec ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr₁ => oracleDeco₂ s tr₁)) tr' + let baseIdx := fun tr' => + (i : ιₛᵢ s) × OracleInterface.Query (OStmtIn s i) ⊕ + OracleDecoration.QueryHandle + ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr₁ => oracleDeco₂ s tr₁)) + tr' + have routed' : + let split := Spec.Transcript.split (ctx₁ s) (ctx₂ s) tr + OracleComp + (baseSpec (Spec.Transcript.append (ctx₁ s) (ctx₂ s) split.1 split.2)) + (([OStmtOut s split.1 split.2]ₒ).Range + (splitLiftAppendOracleQuery (ctx₁ s) (ctx₂ s) (ιₛₒ s) (OStmtOut s) tr qOut)) := by + simpa [baseSpec, split, tr₁, tr₂, qSplit] using routed + refine _root_.Interaction.OracleDecoration.collapseAppendOracleComp + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (Idx := baseIdx) + (baseSpec := baseSpec) + (ιₛ := ιₛₒ s) (OStmt := OStmtOut s) (tr := tr) (qOut := qOut) ?_ + exact routed' + +/-- Binary sequential composition of oracle reductions. The first reduction runs +over `ctx₁`, producing intermediate outputs. The second reduction is a +continuation over the shared input `(s, tr₁)`, taking the intermediate bundled +oracle statement and witness as its local input. -/ +private def compFlat {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + {StmtOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + {ιₛₒ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → Type} + {OStmtOut : + (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → ιₛₒ s tr₁ tr₂ → Type} + [∀ s tr₁ tr₂ i, OracleInterface (OStmtOut s tr₁ tr₂ i)] + {WitOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (reduction2 : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleReduction oSpec + PUnit + (fun _ => ctx₂ s tr₁) + (fun _ => roles₂ s tr₁) + (fun _ => oracleDeco₂ s tr₁) + (fun _ => StmtMid s tr₁) + (fun _ => OStmtMid s tr₁) + (fun _ => WitMid s tr₁) + (fun _ tr₂ => StmtOut s tr₁ tr₂) + (fun _ tr₂ => OStmtOut s tr₁ tr₂) + (fun _ tr₂ => WitOut s tr₁ tr₂)) : + OracleReduction oSpec StatementIn + (fun s => (ctx₁ s).append (ctx₂ s)) + (fun s => Spec.Decoration.append (roles₁ s) (roles₂ s)) + (fun s => Role.Refine.append (oracleDeco₁ s) (fun tr₁ => oracleDeco₂ s tr₁)) + (fun _ => PUnit) + OStmtIn + (fun _ => WitnessIn) + (fun s => Spec.Transcript.liftAppend (ctx₁ s) (ctx₂ s) (StmtOut s)) + (fun s tr => liftAppendOracleFamily (ctx₁ s) (ctx₂ s) (ιₛₒ s) (OStmtOut s) tr) + (fun s => Spec.Transcript.liftAppend (ctx₁ s) (ctx₂ s) (WitOut s)) where + prover s sWithOracles w := do + let strat₁ ← reduction1.prover s sWithOracles w + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => do + let midStmt : + StatementWithOracles + (fun _ => StmtMid s tr₁) (fun _ => OStmtMid s tr₁) PUnit.unit := + ⟨midOut.stmt.stmt, midOut.stmt.oracleStmt⟩ + (reduction2 s tr₁).prover PUnit.unit midStmt midOut.wit) + pure <| Spec.Strategy.mapOutputWithRoles + (fun tr out => by + let split := Spec.Transcript.split (ctx₁ s) (ctx₂ s) tr + let splitOuter := Spec.Transcript.liftAppendProd + (ctx₁ s) (ctx₂ s) + (fun tr₁ tr₂ => + StatementWithOracles (fun _ => StmtOut s tr₁ tr₂) + (fun _ => OStmtOut s tr₁ tr₂) PUnit.unit) + (WitOut s) tr out + let splitStmtOracle := Spec.Transcript.unliftAppend + (ctx₁ s) (ctx₂ s) + (fun tr₁ tr₂ => + StatementWithOracles (fun _ => StmtOut s tr₁ tr₂) + (fun _ => OStmtOut s tr₁ tr₂) PUnit.unit) + tr splitOuter.1 + have htr : + Spec.Transcript.append + (ctx₁ s) (ctx₂ s) + split.1 split.2 = tr := by + simpa [split] using + (Spec.Transcript.append_split (ctx₁ s) (ctx₂ s) tr) + have stmtOut : + Spec.Transcript.liftAppend (ctx₁ s) (ctx₂ s) (StmtOut s) tr := by + exact cast + (congrArg + (fun tr' => Spec.Transcript.liftAppend (ctx₁ s) (ctx₂ s) (StmtOut s) tr') + htr) + (Spec.Transcript.packAppend (ctx₁ s) (ctx₂ s) (StmtOut s) + split.1 split.2 splitStmtOracle.stmt) + have oracleOut : + OracleStatement + (liftAppendOracleFamily (ctx₁ s) (ctx₂ s) + (ιₛₒ s) (OStmtOut s) tr) := by + intro i + exact splitStmtOracle.oracleStmt + (Spec.Transcript.unliftAppend (ctx₁ s) (ctx₂ s) (ιₛₒ s) tr i) + exact ⟨⟨stmtOut, oracleOut⟩, splitOuter.2⟩) + strat + verifier s {ιₐ} accSpec _ := by + simpa [toMonadDecoration_append] using + (Spec.Counterpart.withMonads.append + (reduction1.verifier s accSpec PUnit.unit) + (fun tr₁ sMid => + retargetContinuationVerifier reduction1 s tr₁ + (ctx₂ s tr₁) (roles₂ s tr₁) (oracleDeco₂ s tr₁) + (fun tr₂ => StmtOut s tr₁ tr₂) + ((accSpecAfter (ctx₁ s) (roles₁ s) (oracleDeco₁ s) accSpec tr₁).2) + ((reduction2 s tr₁).verifier PUnit.unit + ((accSpecAfter (ctx₁ s) (roles₁ s) (oracleDeco₁ s) accSpec tr₁).2) + sMid))) + simulate := compSimulate reduction1 reduction2 + +/-- Binary sequential composition of oracle continuations over a fixed shared +input. The first continuation runs over `ctx₁`, producing intermediate outputs. +The suffix continuation is indexed by the ambient spine `⟨shared, tr₁⟩`, so the +shared input together with the prefix transcript determines the fixed protocol +context for the second stage. -/ +def comp {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {ctx₁ : SharedIn → Spec} + {roles₁ : (shared : SharedIn) → RoleDecoration (ctx₁ shared)} + {oracleDeco₁ : (shared : SharedIn) → OracleDecoration (ctx₁ shared) (roles₁ shared)} + {StmtMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ιₛₘ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → Type} + {OStatementMid : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + ιₛₘ shared tr₁ → Type} + [∀ shared tr₁ i, OracleInterface (OStatementMid shared tr₁ i)] + {WitMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ctx₂ : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Spec} + {roles₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + RoleDecoration (ctx₂ shared tr₁)} + {oracleDeco₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + OracleDecoration (ctx₂ shared tr₁) (roles₂ shared tr₁)} + {StmtOut : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + Spec.Transcript (ctx₂ shared tr₁) → Type} + {ιₛₒ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) → ιₛₒ shared tr₁ tr₂ → Type} + [∀ shared tr₁ tr₂ i, OracleInterface (OStatementOut shared tr₁ tr₂ i)] + {WitOut : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + Spec.Transcript (ctx₂ shared tr₁) → Type} + (reduction1 : OracleReduction oSpec SharedIn + ctx₁ roles₁ oracleDeco₁ StatementIn OStatementIn WitnessIn + StmtMid OStatementMid WitMid) + (reduction2 : OracleReduction oSpec + (Sigma fun shared : SharedIn => Spec.Transcript (ctx₁ shared)) + (fun st => ctx₂ st.1 st.2) + (fun st => roles₂ st.1 st.2) + (fun st => oracleDeco₂ st.1 st.2) + (fun st => StmtMid st.1 st.2) + (fun st => OStatementMid st.1 st.2) + (fun st => WitMid st.1 st.2) + (fun st tr₂ => StmtOut st.1 st.2 tr₂) + (fun st tr₂ => OStatementOut st.1 st.2 tr₂) + (fun st tr₂ => WitOut st.1 st.2 tr₂)) : + OracleReduction oSpec SharedIn + (fun shared => (ctx₁ shared).append (ctx₂ shared)) + (fun shared => Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (fun shared => Role.Refine.append (oracleDeco₁ shared) (fun tr₁ => oracleDeco₂ shared tr₁)) + StatementIn OStatementIn WitnessIn + (fun shared => Spec.Transcript.liftAppend (ctx₁ shared) (ctx₂ shared) (StmtOut shared)) + (fun shared tr => + liftAppendOracleFamily + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) tr) + (fun shared => Spec.Transcript.liftAppend (ctx₁ shared) (ctx₂ shared) (WitOut shared)) + where + prover shared sWithOracles w := do + let strat₁ ← reduction1.prover shared sWithOracles w + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => do + let reduction2Fixed := freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩ + let midStmt : + StatementWithOracles + (fun _ => StmtMid shared tr₁) (fun _ => OStatementMid shared tr₁) PUnit.unit := + ⟨midOut.stmt.stmt, midOut.stmt.oracleStmt⟩ + reduction2Fixed.prover PUnit.unit midStmt midOut.wit) + pure <| Spec.Strategy.mapOutputWithRoles + (fun tr out => + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + let splitOuter := Spec.Transcript.liftAppendProd + (ctx₁ shared) (ctx₂ shared) + (fun tr₁ tr₂ => + StatementWithOracles (fun _ => StmtOut shared tr₁ tr₂) + (fun _ => OStatementOut shared tr₁ tr₂) PUnit.unit) + (WitOut shared) tr out + let splitStmtOracle := Spec.Transcript.unliftAppend + (ctx₁ shared) (ctx₂ shared) + (fun tr₁ tr₂ => + StatementWithOracles (fun _ => StmtOut shared tr₁ tr₂) + (fun _ => OStatementOut shared tr₁ tr₂) PUnit.unit) + tr splitOuter.1 + have htr : + Spec.Transcript.append + (ctx₁ shared) (ctx₂ shared) + split.1 split.2 = tr := by + simpa [split] using + (Spec.Transcript.append_split + (ctx₁ shared) (ctx₂ shared) tr) + have stmtOut : + Spec.Transcript.liftAppend + (ctx₁ shared) (ctx₂ shared) + (StmtOut shared) tr := by + exact cast + (congrArg + (fun tr' => + Spec.Transcript.liftAppend + (ctx₁ shared) (ctx₂ shared) + (StmtOut shared) tr') + htr) + (Spec.Transcript.packAppend + (ctx₁ shared) (ctx₂ shared) + (StmtOut shared) + split.1 split.2 splitStmtOracle.stmt) + let oracleOut : + OracleStatement + (liftAppendOracleFamily (ctx₁ shared) (ctx₂ shared) + (ιₛₒ shared) (OStatementOut shared) tr) := by + intro i + exact splitStmtOracle.oracleStmt + (Spec.Transcript.unliftAppend (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) tr i) + ⟨⟨stmtOut, oracleOut⟩, splitOuter.2⟩) + strat + verifier shared {ιₐ} accSpec stmt := by + let reduction1Fixed := promoteStatementToShared reduction1 shared + simpa [toMonadDecoration_append] using + (Spec.Counterpart.withMonads.append + (reduction1.verifier shared accSpec stmt) + (fun tr₁ sMid => + let reduction2Fixed := freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩ + retargetContinuationVerifier reduction1Fixed stmt tr₁ + (ctx₂ shared tr₁) (roles₂ shared tr₁) (oracleDeco₂ shared tr₁) + (fun tr₂ => StmtOut shared tr₁ tr₂) + ((accSpecAfter (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) + accSpec tr₁).2) + (reduction2Fixed.verifier PUnit.unit + ((accSpecAfter (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) + accSpec tr₁).2) + sMid))) + simulate shared tr := by + intro qOut + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + let tr₁ := split.1 + let tr₂ := split.2 + let reduction2Fixed := freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩ + let qSplit : ([OStatementOut shared tr₁ tr₂]ₒ).Domain := + splitLiftAppendOracleQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) tr qOut + let routedSuffix := + simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr₁ => oracleDeco₂ shared tr₁) + (OStmt := OStatementMid shared tr₁) tr₁ tr₂) + (reduction2Fixed.simulate PUnit.unit tr₂ qSplit) + let routed := + simulateQ + (liftSimulatedMidOracleContextContinuation + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 shared tr₁ tr₂) + routedSuffix + let baseSpec := fun tr' => + [OStatementIn shared]ₒ + + toOracleSpec ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr₁ => oracleDeco₂ shared tr₁)) tr' + let baseIdx := fun tr' => + (i : ιₛᵢ shared) × OracleInterface.Query (OStatementIn shared i) ⊕ + OracleDecoration.QueryHandle + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr₁ => oracleDeco₂ shared tr₁)) + tr' + have routed' : + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + OracleComp + (baseSpec (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) split.1 split.2)) + (([OStatementOut shared split.1 split.2]ₒ).Range + (splitLiftAppendOracleQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) tr qOut)) := by + simpa [baseSpec, split, tr₁, tr₂, qSplit] using routed + refine _root_.Interaction.OracleDecoration.collapseAppendOracleComp + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (Idx := baseIdx) + (baseSpec := baseSpec) + (ιₛ := ιₛₒ shared) (OStmt := OStatementOut shared) (tr := tr) (qOut := qOut) ?_ + exact routed' + +/-- If the prefix reduction's simulated oracle output agrees with `midImpl`, and +the suffix continuation's simulated oracle output agrees with `outImpl` when run +against `midImpl`, then routing the suffix simulator through the appended +message context and then routing mid-oracle queries through the prefix reduction +agrees with `outImpl`. This is the low-level simulator-composition theorem used +to lift concrete reified oracle outputs through sequential composition. -/ +theorem simulate_compFlat {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : Type} + {ctx₁ : StatementIn → Spec} + {roles₁ : (s : StatementIn) → RoleDecoration (ctx₁ s)} + {oracleDeco₁ : (s : StatementIn) → OracleDecoration (ctx₁ s) (roles₁ s)} + {StmtMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ιₛₘ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → Type} + {OStmtMid : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → ιₛₘ s tr₁ → Type} + [∀ s tr₁ i, OracleInterface (OStmtMid s tr₁ i)] + {WitMid : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Type} + {ctx₂ : (s : StatementIn) → Spec.Transcript (ctx₁ s) → Spec} + {roles₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + RoleDecoration (ctx₂ s tr₁)} + {oracleDeco₂ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleDecoration (ctx₂ s tr₁) (roles₂ s tr₁)} + {StmtOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + {ιₛₒ : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → Type} + {OStmtOut : + (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) → ιₛₒ s tr₁ tr₂ → Type} + [∀ s tr₁ tr₂ i, OracleInterface (OStmtOut s tr₁ tr₂ i)] + {WitOut : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + Spec.Transcript (ctx₂ s tr₁) → Type} + (reduction1 : OracleReduction oSpec StatementIn + ctx₁ roles₁ oracleDeco₁ + (fun _ => PUnit) OStmtIn (fun _ => WitnessIn) + StmtMid OStmtMid WitMid) + (reduction2 : (s : StatementIn) → (tr₁ : Spec.Transcript (ctx₁ s)) → + OracleReduction oSpec + PUnit + (fun _ => ctx₂ s tr₁) + (fun _ => roles₂ s tr₁) + (fun _ => oracleDeco₂ s tr₁) + (fun _ => StmtMid s tr₁) + (fun _ => OStmtMid s tr₁) + (fun _ => WitMid s tr₁) + (fun _ tr₂ => StmtOut s tr₁ tr₂) + (fun _ tr₂ => OStmtOut s tr₁ tr₂) + (fun _ tr₂ => WitOut s tr₁ tr₂)) + (s : StatementIn) + (tr₁ : Spec.Transcript (ctx₁ s)) + (tr₂ : Spec.Transcript (ctx₂ s tr₁)) + (oStmtIn : OracleStatement (OStmtIn s)) + (midImpl : QueryImpl [OStmtMid s tr₁]ₒ Id) + (outImpl : QueryImpl [OStmtOut s tr₁ tr₂]ₒ Id) + (hMid : ∀ i (q : OracleInterface.Query (OStmtMid s tr₁ i)), + simulateQ + (OracleDecoration.oracleContextImpl (ctx₁ s) (roles₁ s) (oracleDeco₁ s) oStmtIn tr₁) + (reduction1.simulate s tr₁ ⟨i, q⟩) = pure (midImpl ⟨i, q⟩)) + (hOut : ∀ i (q : OracleInterface.Query (OStmtOut s tr₁ tr₂ i)), + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery (ctx₂ s tr₁) (roles₂ s tr₁) (oracleDeco₂ s tr₁) tr₂)) + ((reduction2 s tr₁).simulate PUnit.unit tr₂ ⟨i, q⟩) = pure (outImpl ⟨i, q⟩)) : + ∀ i (q : OracleInterface.Query (OStmtOut s tr₁ tr₂ i)), + simulateQ + (OracleDecoration.oracleContextImpl ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + oStmtIn + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (simulateQ + (liftSimulatedMidOracleContext + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (StmtMid := StmtMid) (ιₛₘ := ιₛₘ) (OStmtMid := OStmtMid) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 s tr₁ tr₂) + (simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂) + ((reduction2 s tr₁).simulate PUnit.unit tr₂ ⟨i, q⟩))) = + pure (outImpl ⟨i, q⟩) := by + intro i q + rw [← QueryImpl.simulateQ_compose] + change + simulateQ + (fun q => + simulateQ + (OracleDecoration.oracleContextImpl ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + oStmtIn + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂)) + (liftSimulatedMidOracleContext + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (StmtMid := StmtMid) (ιₛₘ := ιₛₘ) (OStmtMid := OStmtMid) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 s tr₁ tr₂ q)) + (simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂) + ((reduction2 s tr₁).simulate PUnit.unit tr₂ ⟨i, q⟩)) = + pure (outImpl ⟨i, q⟩) + rw [simulateQ_ext + (simulateQ_liftSimulatedMidOracleContext_eq + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (StmtMid := StmtMid) (ιₛₘ := ιₛₘ) (OStmtMid := OStmtMid) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 s tr₁ tr₂ oStmtIn midImpl hMid)] + rw [← QueryImpl.simulateQ_compose] + change + simulateQ + (fun q => + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery ((ctx₁ s).append (ctx₂ s)) + (Spec.Decoration.append (roles₁ s) (roles₂ s)) + (Role.Refine.append (oracleDeco₁ s) (fun tr => oracleDeco₂ s tr)) + (Spec.Transcript.append (ctx₁ s) (ctx₂ s) tr₁ tr₂))) + (liftAppendRightContext + (spec₁ := ctx₁ s) (spec₂ := ctx₂ s) + (roles₁ := roles₁ s) (roles₂ := roles₂ s) + (od₁ := oracleDeco₁ s) (od₂ := fun tr => oracleDeco₂ s tr) + (OStmt := OStmtMid s tr₁) tr₁ tr₂ q)) + ((reduction2 s tr₁).simulate PUnit.unit tr₂ ⟨i, q⟩) = + pure (outImpl ⟨i, q⟩) + rw [simulateQ_ext + (simulateQ_liftAppendRightContext_withImpl_eq + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + (ιₛₘ := ιₛₘ) (OStmtMid := OStmtMid) + s tr₁ tr₂ midImpl)] + simpa using hOut i q + +/-- Public append-transcript bridge for binary oracle composition: if the split +simulators for the two stages agree with `midImpl` and `outImpl`, then a fused +query to `OracleReduction.comp reduction1 reduction2` is answered by routing to +the split query and repackaging the split answer through +`answerSplitLiftAppendQuery`. -/ +theorem simulate_comp {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {StatementIn : SharedIn → Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {ctx₁ : SharedIn → Spec} + {roles₁ : (shared : SharedIn) → RoleDecoration (ctx₁ shared)} + {oracleDeco₁ : (shared : SharedIn) → OracleDecoration (ctx₁ shared) (roles₁ shared)} + {StatementMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ιₛₘ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → Type} + {OStatementMid : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → ιₛₘ shared tr₁ → Type} + [∀ shared tr₁ i, OracleInterface (OStatementMid shared tr₁ i)] + {WitnessMid : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Type} + {ctx₂ : (shared : SharedIn) → Spec.Transcript (ctx₁ shared) → Spec} + {roles₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + RoleDecoration (ctx₂ shared tr₁)} + {oracleDeco₂ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + OracleDecoration (ctx₂ shared tr₁) (roles₂ shared tr₁)} + {StatementOut : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + Spec.Transcript (ctx₂ shared tr₁) → Type} + {ιₛₒ : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + (tr₂ : Spec.Transcript (ctx₂ shared tr₁)) → ιₛₒ shared tr₁ tr₂ → Type} + [∀ shared tr₁ tr₂ i, OracleInterface (OStatementOut shared tr₁ tr₂ i)] + {WitnessOut : (shared : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ shared)) → + Spec.Transcript (ctx₂ shared tr₁) → Type} + (reduction1 : OracleReduction oSpec SharedIn + ctx₁ roles₁ oracleDeco₁ + StatementIn OStatementIn WitnessIn + StatementMid OStatementMid WitnessMid) + (reduction2 : OracleReduction oSpec + (Sigma fun shared : SharedIn => Spec.Transcript (ctx₁ shared)) + (fun st => ctx₂ st.1 st.2) + (fun st => roles₂ st.1 st.2) + (fun st => oracleDeco₂ st.1 st.2) + (fun st => StatementMid st.1 st.2) + (fun st => OStatementMid st.1 st.2) + (fun st => WitnessMid st.1 st.2) + (fun st tr₂ => StatementOut st.1 st.2 tr₂) + (fun st tr₂ => OStatementOut st.1 st.2 tr₂) + (fun st tr₂ => WitnessOut st.1 st.2 tr₂)) + (shared : SharedIn) + (_stmt : StatementIn shared) + (oStatementIn : OracleStatement (OStatementIn shared)) + (tr : Spec.Transcript ((ctx₁ shared).append (ctx₂ shared))) + (midImpl : + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + QueryImpl [OStatementMid shared split.1]ₒ Id) + (outImpl : + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + QueryImpl [OStatementOut shared split.1 split.2]ₒ Id) + (hMid : + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + ∀ i (q : OracleInterface.Query (OStatementMid shared split.1 i)), + simulateQ + (OracleDecoration.oracleContextImpl + (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) oStatementIn split.1) + (reduction1.simulate shared split.1 ⟨i, q⟩) = pure (midImpl ⟨i, q⟩)) + (hOut : + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + ∀ i (q : OracleInterface.Query (OStatementOut shared split.1 split.2 i)), + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery + (ctx₂ shared split.1) (roles₂ shared split.1) (oracleDeco₂ shared split.1) split.2)) + ((freezeSharedToPUnit reduction2 ⟨shared, split.1⟩).simulate PUnit.unit split.2 ⟨i, q⟩) = + pure (outImpl ⟨i, q⟩)) : + ∀ (qOut : + ([liftAppendOracleFamily (ctx₁ shared) (ctx₂ shared) + (ιₛₒ shared) (OStatementOut shared) + tr]ₒ).Domain), + simulateQ + (OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn tr) + ((OracleReduction.comp reduction1 reduction2).simulate shared + tr qOut) = + answerSplitLiftAppendQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) + tr qOut + (outImpl (splitLiftAppendOracleQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) tr qOut)) := by + intro qOut + let split := Spec.Transcript.split (ctx₁ shared) (ctx₂ shared) tr + let tr₁ := split.1 + let tr₂ := split.2 + let qSplit := + splitLiftAppendOracleQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) tr qOut + let oracleCtx := + OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn tr + let routedRaw := + simulateQ + (liftSimulatedMidOracleContextContinuation + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 shared tr₁ tr₂) + (simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStatementMid shared tr₁) tr₁ tr₂) + ((freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩).simulate PUnit.unit tr₂ qSplit)) + let baseSpec := fun tr' => + [OStatementIn shared]ₒ + + toOracleSpec ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr₁ => oracleDeco₂ shared tr₁)) tr' + let baseIdx := fun tr' => + (i : ιₛᵢ shared) × OracleInterface.Query (OStatementIn shared i) ⊕ + OracleDecoration.QueryHandle + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr₁ => oracleDeco₂ shared tr₁)) + tr' + let oracleCtxSplit : + QueryImpl (baseSpec (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) Id := + cast + (by + have htr : Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂ = tr := by + simpa [split, tr₁, tr₂] using + (Spec.Transcript.append_split (ctx₁ shared) (ctx₂ shared) tr) + simpa [baseSpec] using + (congrArg (fun tr' => QueryImpl (baseSpec tr') Id) htr).symm) + oracleCtx + have htrAppend : + Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂ = tr := by + simpa [split, tr₁, tr₂] using + (Spec.Transcript.append_split (ctx₁ shared) (ctx₂ shared) tr) + have hMid' : + ∀ i (q : OracleInterface.Query (OStatementMid shared tr₁ i)), + simulateQ + (OracleDecoration.oracleContextImpl + (ctx₁ shared) (roles₁ shared) (oracleDeco₁ shared) oStatementIn tr₁) + (reduction1.simulate shared tr₁ ⟨i, q⟩) = pure (midImpl ⟨i, q⟩) := by + simpa [split, tr₁, tr₂] using hMid + have hOut' : + ∀ i (q : OracleInterface.Query (OStatementOut shared tr₁ tr₂ i)), + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery + (ctx₂ shared tr₁) (roles₂ shared tr₁) (oracleDeco₂ shared tr₁) tr₂)) + ((freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩).simulate PUnit.unit tr₂ ⟨i, q⟩) = + pure (outImpl ⟨i, q⟩) := by + simpa [split, tr₁, tr₂] using hOut + have hRoutedDirect : + simulateQ + (OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) + routedRaw = outImpl qSplit := by + rw [← QueryImpl.simulateQ_compose] + change + simulateQ + (fun q => + simulateQ + (OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂)) + (liftSimulatedMidOracleContextContinuation + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 shared tr₁ tr₂ q)) + (simulateQ + (liftAppendRightContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStatementMid shared tr₁) tr₁ tr₂) + ((freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩).simulate PUnit.unit tr₂ qSplit)) = + outImpl qSplit + rw [simulateQ_ext + (simulateQ_liftSimulatedMidOracleContextContinuation_eq + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + reduction1 shared tr₁ tr₂ oStatementIn midImpl hMid')] + rw [← QueryImpl.simulateQ_compose] + change + simulateQ + (fun q => + simulateQ + (QueryImpl.add midImpl + (OracleDecoration.answerQuery + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂))) + (liftAppendRightContext + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (roles₁ := roles₁ shared) (roles₂ := roles₂ shared) + (od₁ := oracleDeco₁ shared) (od₂ := fun tr => oracleDeco₂ shared tr) + (OStmt := OStatementMid shared tr₁) tr₁ tr₂ q)) + ((freezeSharedToPUnit reduction2 ⟨shared, tr₁⟩).simulate PUnit.unit tr₂ qSplit) = + outImpl qSplit + rw [simulateQ_ext + (simulateQ_liftAppendRightContext_withImpl_eq + (ctx₁ := ctx₁) (roles₁ := roles₁) (oracleDeco₁ := oracleDeco₁) + (ctx₂ := ctx₂) (roles₂ := roles₂) (oracleDeco₂ := oracleDeco₂) + (ιₛₘ := ιₛₘ) (OStmtMid := OStatementMid) + shared tr₁ tr₂ midImpl)] + simpa [qSplit] using hOut' qSplit.1 qSplit.2 + have hCtxCast : + oracleCtxSplit = + OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn + (Spec.Transcript.append (ctx₁ shared) (ctx₂ shared) tr₁ tr₂) := by + dsimp [oracleCtxSplit, oracleCtx, baseSpec] + apply (cast_eq_iff_heq).2 + simpa using + (congr_arg_heq + (fun tr' => + OracleDecoration.oracleContextImpl + ((ctx₁ shared).append (ctx₂ shared)) + (Spec.Decoration.append (roles₁ shared) (roles₂ shared)) + (Role.Refine.append (oracleDeco₁ shared) (fun tr => oracleDeco₂ shared tr)) + oStatementIn tr') + htrAppend.symm) + have hRouted : + simulateQ oracleCtxSplit routedRaw = outImpl qSplit := by + rw [hCtxCast] + exact hRoutedDirect + have hPublic : + simulateQ oracleCtx + ((OracleReduction.comp reduction1 reduction2).simulate shared tr qOut) = + answerSplitLiftAppendQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) + tr qOut + (simulateQ oracleCtxSplit routedRaw) := by + simpa [OracleReduction.comp, split, tr₁, tr₂, qSplit, baseSpec, baseIdx, + oracleCtx, oracleCtxSplit, routedRaw] + using + (simulateQ_collapseAppendOracleComp + (spec₁ := ctx₁ shared) (spec₂ := ctx₂ shared) + (Idx := baseIdx) + (baseSpec := baseSpec) + (ιₛ := ιₛₒ shared) (OStmt := OStatementOut shared) + (tr := tr) (qOut := qOut) + (impl := oracleCtx) + routedRaw) + calc + simulateQ oracleCtx + ((OracleReduction.comp reduction1 reduction2).simulate shared tr qOut) = + answerSplitLiftAppendQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) + tr qOut + (simulateQ oracleCtxSplit routedRaw) := hPublic + _ = + answerSplitLiftAppendQuery + (ctx₁ shared) (ctx₂ shared) (ιₛₒ shared) (OStatementOut shared) + tr qOut + (outImpl qSplit) := by + simpa [answerSplitLiftAppendQuery] using hRouted + +end OracleReduction + +end OracleDecoration + +end Interaction diff --git a/ArkLib/Interaction/Oracle/Core.lean b/ArkLib/Interaction/Oracle/Core.lean new file mode 100644 index 0000000000..27b18dc4b8 --- /dev/null +++ b/ArkLib/Interaction/Oracle/Core.lean @@ -0,0 +1,1264 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Reduction +import ArkLib.Interaction.Oracle.Spec +import PolyFun.Interaction.TwoParty.Refine + +/-! +# Oracle Decoration, Oracle Verifiers, and Oracle Reductions + +This module bridges the generic `Interaction.Spec` layer with VCVio's oracle +computation model. It introduces: + +- `OracleDecoration` — per-node attachment of `OracleInterface` instances at + sender nodes, specifying how prover messages can be queried as oracles. +- `OracleDecoration.QueryHandle` — an index type for oracle queries, parameterized + by a transcript (the transcript determines the path through the interaction tree, + and hence which oracle interfaces are available). +- `OracleDecoration.toOracleSpec` — the VCVio `OracleSpec` for querying sender + messages along a given transcript path. + +- `OracleDecoration.toMonadDecoration` — bridge from oracle decoration to per-node + `MonadDecoration`: sender nodes get `Id`, receiver nodes get `OracleComp`. +- `OracleDecoration.liftOutput` — converts oracle-spec-indexed output to + transcript-indexed output by threading the accumulated spec. +- `OracleCounterpart` — round-by-round challenger with growing oracle access, + unified as `Counterpart.withMonads` via `toMonadDecoration`. +- `InteractiveOracleVerifier` — a transcript-indexed challenger whose terminal + output is a verification function. +- `OracleVerifier` — statement-indexed verifier-side interaction together with + statement/transcript-dependent oracle simulation. +- `OracleProver` / `OracleReduction` — prover and reduction with oracle statements, + using the full dependency chain. + +## Path-dependent oracle access + +In a W-type interaction spec, move types at each node depend on prior moves. +Consequently, the oracle interfaces available to the verifier depend on the +actual transcript. This is reflected in the type of `toOracleSpec`: it takes a +`Transcript` and produces an `OracleSpec` over `QueryHandle` for that specific +path. + +## Unification with `Counterpart.withMonads` + +`OracleCounterpart` is defined as `Counterpart.withMonads` with a +`MonadDecoration` computed from the oracle decoration via `toMonadDecoration`. +Sender nodes use `Id` (pure observation, `Id α = α` definitionally) and receiver +nodes use `OracleComp` with the current accumulated oracle access. This means all +generic `Counterpart.withMonads` composition combinators automatically apply to +oracle counterparts. + +## Universe constraints + +The oracle decoration layer (`OracleDecoration`, `QueryHandle`, +`toOracleSpec`, `answerQuery`) is universe-polymorphic in its statement and +oracle families. The downstream verifier and reduction interfaces are also +polymorphic in their statement, witness, and oracle-family universes where the +underlying `Spec`, `Counterpart.withMonads`, and `OracleComp` interfaces permit +it. + +## See also + +- `Oracle/Continuation.lean` — intrinsic oracle composition, shared-input + reindexing, and `Chain` +- `Oracle/Composition.lean` — append-level oracle composition infrastructure +- `Oracle/StateChain.lean` — N-ary state chain composition for oracle reductions +- `OracleReification.lean` — optional concrete oracle materialization +- `OracleSecurity.lean` — completeness, soundness, knowledge soundness +-/ + +universe u v w + +open OracleComp OracleSpec + +namespace Interaction + +open TwoParty + +/-! ## Oracle decoration + +`OracleDecoration` is a `Role.Refine` specialized to `OracleInterface`: +it carries an `OracleInterface X` at each sender node and recurses directly +at receiver nodes (no junk data). -/ + +/-- An `OracleDecoration` assigns an `OracleInterface` instance (as data, not a +typeclass) to each sender node. Defined as `Role.Refine OracleInterface`. -/ +abbrev OracleDecoration (spec : Spec) (roles : RoleDecoration spec) := + Role.Refine OracleInterface spec roles + +/-- Oracle-statement data for an indexed oracle-statement family. -/ +abbrev OracleStatement {ιₛ : Type v} (OStmt : ιₛ → Type w) := + ∀ i, OStmt i + +/-- A local statement bundled with oracle-statement data for a fixed ambient +input `i`. Used for both oracle inputs and oracle outputs. -/ +structure StatementWithOracles + {Input : Type u} + (LocalStmt : Input → Type v) {ιₛ : Input → Type v} + (OStmt : (i : Input) → ιₛ i → Type w) + (i : Input) where + stmt : LocalStmt i + oracleStmt : OracleStatement (OStmt i) + +/-! ## Query handles and oracle spec -/ + +/-- Index type for oracle queries given a specific transcript path. At each +sender node, the verifier can either: +- query the current node's oracle interface (`.inl q`), or +- recurse into the subtree determined by the transcript move (`.inr h`). + +At receiver nodes, there is no oracle to query, so we recurse immediately. + +The transcript parameter ensures that the index type is well-typed: it +determines which subtree (and hence which oracle interfaces) are reachable. -/ +def OracleDecoration.QueryHandle : + (spec : Spec) → (roles : RoleDecoration spec) → OracleDecoration spec roles → + Spec.Transcript spec → Type + | .done, _, _, _ => Empty + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, ⟨x, trRest⟩ => + oi.Query ⊕ QueryHandle (rest x) (rRest x) (odRest x) trRest + | .node _ rest, ⟨.receiver, rRest⟩, odFn, ⟨x, trRest⟩ => + QueryHandle (rest x) (rRest x) (odFn x) trRest + +/-- The oracle specification for querying sender-node messages along a given +transcript path. Maps each `QueryHandle` to its response type. -/ +def OracleDecoration.toOracleSpec : + (spec : Spec) → (roles : RoleDecoration spec) → (od : OracleDecoration spec roles) → + (tr : Spec.Transcript spec) → OracleSpec (QueryHandle spec roles od tr) + | .done, _, _, _ => Empty.elim + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, ⟨x, trRest⟩ => + fun + | .inl q => oi.toOC.spec q + | .inr handle => toOracleSpec (rest x) (rRest x) (odRest x) trRest handle + | .node _ rest, ⟨.receiver, rRest⟩, odFn, ⟨x, trRest⟩ => + toOracleSpec (rest x) (rRest x) (odFn x) trRest + +/-- Answer oracle queries using the message values from a transcript. At each +sender node, the transcript provides the actual move `x : X`, which is used as +the message argument to `OracleInterface`'s implementation. -/ +def OracleDecoration.answerQuery : + (spec : Spec) → (roles : RoleDecoration spec) → (od : OracleDecoration spec roles) → + (tr : Spec.Transcript spec) → + QueryImpl (toOracleSpec spec roles od tr) Id + | .done, _, _, _ => fun q => q.elim + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, ⟨x, trRest⟩ => + fun + | .inl q => (oi.toOC.impl q).run x + | .inr handle => answerQuery (rest x) (rRest x) (odRest x) trRest handle + | .node _ rest, ⟨.receiver, rRest⟩, odFn, ⟨x, trRest⟩ => + answerQuery (rest x) (rRest x) (odFn x) trRest + +/-- Answer queries to the combined oracle context consisting of the input oracle +statements and the sender-message oracles available along a transcript. -/ +def OracleDecoration.oracleContextImpl + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface.{0, u} (OStmtIn i)] : + (spec : Spec.{0}) → (roles : RoleDecoration spec) → (od : OracleDecoration.{0, 0} spec roles) → + OracleStatement OStmtIn → (tr : Spec.Transcript spec) → + QueryImpl ([OStmtIn]ₒ + toOracleSpec spec roles od tr) Id + | spec, roles, od, oStmtIn, tr => + QueryImpl.add (OracleInterface.simOracle0 OStmtIn oStmtIn) + (answerQuery spec roles od tr) + +namespace OracleDecoration.QueryHandle + +/-- Embed a first-phase query handle into the combined query-handle type for +`Spec.append`. -/ +def appendLeft : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + QueryHandle spec₁ roles₁ od₁ tr₁ → + QueryHandle (spec₁.append spec₂) (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + | .done, _, _, _, _, _, ⟨⟩, _, q => q.elim + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => + match q with + | .inl q0 => .inl q0 + | .inr qRest => + .inr <| appendLeft (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ qRest + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => + appendLeft (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +/-- Embed a second-phase query handle into the combined query-handle type for +`Spec.append`. -/ +def appendRight : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + QueryHandle (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂ → + QueryHandle (spec₁.append spec₂) (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + | .done, _, _, _, _, _, ⟨⟩, _, q => q + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => + .inr <| appendRight (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => + appendRight (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +theorem appendLeft_range : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (q : QueryHandle spec₁ roles₁ od₁ tr₁) → + OracleDecoration.toOracleSpec (spec₁.append spec₂) (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (appendLeft spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) = + OracleDecoration.toOracleSpec spec₁ roles₁ od₁ tr₁ q + | .done, _, _, _, _, _, ⟨⟩, _, q => q.elim + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => by + cases q with + | inl q0 => rfl + | inr qRest => + simpa using appendLeft_range (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ qRest + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using appendLeft_range (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +theorem appendRight_range : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (q : QueryHandle (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂) → + OracleDecoration.toOracleSpec (spec₁.append spec₂) (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (appendRight spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) = + OracleDecoration.toOracleSpec (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂ q + | .done, _, _, _, _, _, ⟨⟩, _, _ => rfl + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using appendRight_range (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using appendRight_range (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +theorem answerQuery_appendLeft : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (q : QueryHandle spec₁ roles₁ od₁ tr₁) → + cast (appendLeft_range spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (appendLeft spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) = + OracleDecoration.answerQuery spec₁ roles₁ od₁ tr₁ q + | .done, _, _, _, _, _, ⟨⟩, _, q => q.elim + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => by + cases q with + | inl q0 => + rfl + | inr qRest => + simpa using answerQuery_appendLeft (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ qRest + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using answerQuery_appendLeft (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +theorem answerQuery_appendRight : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (q : QueryHandle (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂) → + cast (appendRight_range spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (appendRight spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) = + OracleDecoration.answerQuery (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂ q + | .done, _, _, _, _, _, ⟨⟩, _, q => by + rfl + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨_, odRest⟩, od₂, + ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using answerQuery_appendRight (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, ⟨x, tr₁Rest⟩, tr₂, q => by + simpa using answerQuery_appendRight (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) + tr₁Rest tr₂ q + +end OracleDecoration.QueryHandle + +section QueryRouting + +variable {spec₁ : Spec} {spec₂ : Spec.Transcript spec₁ → Spec} +variable {roles₁ : RoleDecoration spec₁} +variable {roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)} +variable {od₁ : OracleDecoration spec₁ roles₁} +variable {od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)} +variable (tr₁ : Spec.Transcript spec₁) (tr₂ : Spec.Transcript (spec₂ tr₁)) + +/-- Route a first-phase transcript-message query into the appended transcript's +oracle specification. The only transport needed here is the response-type +equality witnessed by `QueryHandle.appendLeft_range`. -/ +def liftAppendLeftQuery : + QueryImpl (OracleDecoration.toOracleSpec spec₁ roles₁ od₁ tr₁) + (OracleComp + (OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) := + fun q => + let appendSpec := + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + cast + (congrArg (OracleComp appendSpec) + (OracleDecoration.QueryHandle.appendLeft_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (liftM (appendSpec.query + (OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + +/-- Route a second-phase transcript-message query into the appended transcript's +oracle specification. The only transport needed here is the response-type +equality witnessed by `QueryHandle.appendRight_range`. -/ +def liftAppendRightQuery : + QueryImpl (OracleDecoration.toOracleSpec (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂) + (OracleComp + (OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) := + fun q => + let appendSpec := + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + cast + (congrArg (OracleComp appendSpec) + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (liftM (appendSpec.query + (OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + +variable {ιₛ : Type} {OStmt : ιₛ → Type} +variable [∀ i, OracleInterface (OStmt i)] + +/-- Lift the first-phase oracle context `[OStmt]ₒ + msgSpec₁` into the appended +oracle context `[OStmt]ₒ + msgSpecAppend`. -/ +def liftAppendLeftContext : + QueryImpl ([OStmt]ₒ + OracleDecoration.toOracleSpec spec₁ roles₁ od₁ tr₁) + (OracleComp + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) := + fun + | .inl q => + liftM (([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).query (.inl q)) + | .inr q => + let appendSpec := + [OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + cast + (congrArg (OracleComp appendSpec) + (OracleDecoration.QueryHandle.appendLeft_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (liftM (appendSpec.query + (.inr <| OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + +/-- Lift the second-phase oracle context `[OStmt]ₒ + msgSpec₂` into the +appended oracle context `[OStmt]ₒ + msgSpecAppend`. -/ +def liftAppendRightContext : + QueryImpl ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂) + (OracleComp + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) := + fun + | .inl q => + liftM (([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).query (.inl q)) + | .inr q => + let appendSpec := + [OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + cast + (congrArg (OracleComp appendSpec) + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (liftM (appendSpec.query + (.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + +theorem simulateQ_ext + {ι : Type _} {spec : OracleSpec ι} {r : Type _ → Type _} + [Monad r] [LawfulMonad r] + {impl₁ impl₂ : QueryImpl spec r} + (himpl : ∀ q, impl₁ q = impl₂ q) : + ∀ {α : Type _} (oa : OracleComp spec α), simulateQ impl₁ oa = simulateQ impl₂ oa := by + intro α oa + induction oa using OracleComp.inductionOn with + | pure x => + simp + | query_bind t oa ih => + simp [himpl t, ih] + +theorem simulateQ_cast_query + {ι : Type u} {spec : OracleSpec.{u, v} ι} {r : Type v → Type} + [Monad r] [LawfulMonad r] + {α β : Type v} (h : α = β) (impl : QueryImpl spec r) (q : OracleQuery spec α) : + simulateQ impl (cast (congrArg (OracleComp spec) h) (liftM q)) = + cast (congrArg r h) (q.cont <$> impl q.input) := by + cases h + simp [simulateQ_query] + +theorem simulateQ_cast_query_id + {ι : Type u} {spec : OracleSpec.{u, v} ι} + {α β : Type v} (h : α = β) (impl : QueryImpl spec Id) (q : OracleQuery spec α) : + simulateQ impl (cast (congrArg (OracleComp spec) h) (liftM q)) = + cast h (q.cont (impl q.input)) := by + cases h + change simulateQ impl (liftM q) = q.cont (impl q.input) + rw [simulateQ_query] + rfl + +theorem simulateQ_cast + {ι : Type u} {spec : OracleSpec.{u, v} ι} {r : Type v → Type} + [Monad r] [LawfulMonad r] + {α β : Type v} (h : α = β) (impl : QueryImpl spec r) (oa : OracleComp spec α) : + simulateQ impl (cast (congrArg (OracleComp spec) h) oa) = + cast (congrArg r h) (simulateQ impl oa) := by + cases h + rfl + +theorem simulateQ_cast_spec + {ι : Type u} + {spec₁ spec₂ : OracleSpec.{u, v} ι} + {r : Type v → Type} + [Monad r] [LawfulMonad r] + {α : Type v} + (h : spec₁ = spec₂) + (impl : QueryImpl spec₂ r) + (oa : OracleComp spec₁ α) : + simulateQ impl (cast (by cases h; rfl) oa) = + simulateQ (cast (by cases h; rfl) impl) oa := by + cases h + rfl + +theorem simulateQ_cast_dep + {α : Sort u} + {Idx : α → Type v} + {SpecFam : (a : α) → OracleSpec (Idx a)} + {r : Type w → Type w} + [Monad r] [LawfulMonad r] + {a a' : α} + {β : Type w} + (h : a = a') + (impl : QueryImpl (SpecFam a') r) + (oa : OracleComp (SpecFam a) β) : + simulateQ impl (cast (by cases h; rfl) oa) = + simulateQ (cast (by cases h; rfl) impl) oa := by + cases h + rfl + +theorem liftM_cast_query_add_right + {ι₁ : Type u} {ι₂ : Type w} {spec₁ : OracleSpec.{u, v} ι₁} + {spec₂ : OracleSpec.{w, v} ι₂} + {t : spec₂.Domain} {α : Type v} (h : spec₂.Range t = α) : + (liftM (cast (congrArg (OracleComp spec₂) h) + (liftM (spec₂.query t) : OracleComp spec₂ (spec₂.Range t)) : + OracleComp spec₂ α) : + OracleComp (spec₁ + spec₂) α) = + cast (congrArg (OracleComp (spec₁ + spec₂)) h) + ((liftM ((spec₁ + spec₂).query (Sum.inr t)) : + OracleComp (spec₁ + spec₂) ((spec₁ + spec₂).Range (Sum.inr t)))) := by + cases h + change + (liftM + ((liftM (spec₂.query t) : + OracleQuery (spec₁ + spec₂) (spec₂.Range t))) : + OracleComp (spec₁ + spec₂) (spec₂.Range t)) = + liftM ((spec₁ + spec₂).query (Sum.inr t)) + simp + +theorem simulateQ_liftAppendLeftContext_eq + (oStmt : OracleStatement OStmt) : + ∀ q, + simulateQ + (OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (liftAppendLeftContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ q) = + (OracleDecoration.oracleContextImpl spec₁ roles₁ od₁ oStmt tr₁) q := by + intro q + cases q with + | inl q => + simp [OracleDecoration.oracleContextImpl, QueryImpl.add, liftAppendLeftContext] + | inr q => + have hSim : + simulateQ + (OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (liftAppendLeftContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ (.inr q)) = + cast + (OracleDecoration.QueryHandle.appendLeft_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) := by + simpa [OracleDecoration.oracleContextImpl, QueryImpl.add, + liftAppendLeftContext] using + (simulateQ_cast_query_id + (spec := [OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (α := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (β := ([OStmt]ₒ + OracleDecoration.toOracleSpec spec₁ roles₁ od₁ tr₁).Range + (Sum.inr q)) + (h := (OracleDecoration.QueryHandle.appendLeft_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q : + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) = + ([OStmt]ₒ + OracleDecoration.toOracleSpec spec₁ roles₁ od₁ tr₁).Range + (Sum.inr q))) + (impl := OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (q := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).query + (Sum.inr <| OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + have hAns : + cast + (OracleDecoration.QueryHandle.appendLeft_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) = + OracleDecoration.answerQuery spec₁ roles₁ od₁ tr₁ q := by + simpa using OracleDecoration.QueryHandle.answerQuery_appendLeft + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q + exact hSim.trans hAns + +theorem simulateQ_liftAppendRightContext_eq + (oStmt : OracleStatement OStmt) : + ∀ q, + simulateQ + (OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (liftAppendRightContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ q) = + (QueryImpl.add (OracleInterface.simOracle0 OStmt oStmt) + (OracleDecoration.answerQuery (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂)) q := by + intro q + cases q with + | inl q => + simp [OracleDecoration.oracleContextImpl, QueryImpl.add, liftAppendRightContext] + | inr q => + have hSim : + simulateQ + (OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (liftAppendRightContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ (.inr q)) + = + cast + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) := by + simpa [OracleDecoration.oracleContextImpl, QueryImpl.add, + liftAppendRightContext] using + (simulateQ_cast_query_id + (spec := [OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (α := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (β := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₂ tr₁) + (roles₂ tr₁) (od₂ tr₁) tr₂).Range (Sum.inr q)) + (h := (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q : + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) = + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₂ tr₁) + (roles₂ tr₁) (od₂ tr₁) tr₂).Range + (Sum.inr q))) + (impl := OracleDecoration.oracleContextImpl (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) oStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (q := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).query + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + have hAns : + cast + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) = + OracleDecoration.answerQuery (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂ q := by + simpa using OracleDecoration.QueryHandle.answerQuery_appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q + exact hSim.trans hAns + +theorem simulateQ_liftAppendRightContext_eq_of_impl + (impl : QueryImpl [OStmt]ₒ Id) : + ∀ q, + simulateQ + (QueryImpl.add impl + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) + (liftAppendRightContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ q) = + (QueryImpl.add impl + (OracleDecoration.answerQuery (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂)) q := by + intro q + cases q with + | inl q => + simp [QueryImpl.add, liftAppendRightContext] + | inr q => + have hSim : + simulateQ + (QueryImpl.add impl + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) + (liftAppendRightContext (spec₁ := spec₁) (spec₂ := spec₂) + (roles₁ := roles₁) (roles₂ := roles₂) + (od₁ := od₁) (od₂ := od₂) (OStmt := OStmt) tr₁ tr₂ (.inr q)) = + cast + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) := by + simpa [QueryImpl.add, liftAppendRightContext] using + (simulateQ_cast_query_id + (spec := [OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (α := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) + (β := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₂ tr₁) + (roles₂ tr₁) (od₂ tr₁) tr₂).Range (Sum.inr q)) + (h := (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q : + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).Range + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) = + ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₂ tr₁) + (roles₂ tr₁) (od₂ tr₁) tr₂).Range + (Sum.inr q))) + (impl := QueryImpl.add impl + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂))) + (q := ([OStmt]ₒ + OracleDecoration.toOracleSpec (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).query + (Sum.inr <| OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q))) + have hAns : + cast + (OracleDecoration.QueryHandle.appendRight_range + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q) + (OracleDecoration.answerQuery (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) + (Role.Refine.append od₁ od₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (OracleDecoration.QueryHandle.appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q)) = + OracleDecoration.answerQuery (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) tr₂ q := by + simpa using OracleDecoration.QueryHandle.answerQuery_appendRight + spec₁ spec₂ roles₁ roles₂ od₁ od₂ tr₁ tr₂ q + exact hSim.trans hAns + +end QueryRouting + +namespace OracleDecoration + +/-! ## Bridge definitions + +These definitions bridge `OracleDecoration` to `MonadDecoration` and +transcript-indexed output, enabling the unification of `OracleCounterpart` +with `Counterpart.withMonads`. The oracle computation monad `OracleComp` +constrains these definitions to `Spec.{0}`. -/ + +/-- Compute the per-node `MonadDecoration` from an oracle decoration and +accumulated oracle spec. Sender nodes get `Id` (pure observation, `Id α = α` +definitionally), receiver nodes get `OracleComp (oSpec + [OStmtIn]ₒ + accSpec)` +(oracle computation with current access). The accumulated spec grows at sender +nodes and stays fixed at receiver nodes. -/ +def toMonadDecoration {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + {ιₛᵢ : Type} (OStmtIn : ιₛᵢ → Type) [∀ i, OracleInterface.{0, 0} (OStmtIn i)] : + (spec : Spec.{0}) → (roles : RoleDecoration spec) → OracleDecoration.{0, 0} spec roles → + {ιₐ : Type} → OracleSpec.{0, 0} ιₐ → Spec.MonadDecoration spec + | .done, _, _, _, _ => ⟨⟩ + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, _, accSpec => + ⟨⟨Id, inferInstance⟩, + fun x => toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odRest x) + (accSpec + @OracleInterface.spec _ oi)⟩ + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec => + ⟨⟨OracleComp (oSpec + [OStmtIn]ₒ + accSpec), inferInstance⟩, + fun x => toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odFn x) accSpec⟩ + +/-- Convert oracle-spec-indexed output to transcript-indexed output by threading +the accumulated oracle spec through the tree. At each `.done` node, applies +`Output` to the final accumulated spec. At sender nodes, the accumulated spec +grows by the sender's oracle interface spec. At receiver nodes, the accumulated +spec is unchanged. -/ +def liftOutput + (Output : {ιₐ : Type} → OracleSpec.{0, u} ιₐ → Type) : + (spec : Spec.{u}) → (roles : RoleDecoration spec) → OracleDecoration.{u, 0} spec roles → + {ιₐ : Type} → OracleSpec.{0, u} ιₐ → Spec.Transcript spec → Type + | .done, _, _, _, accSpec, _ => Output accSpec + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, _, accSpec, ⟨x, trRest⟩ => + liftOutput Output (rest x) (rRest x) (odRest x) + (accSpec + @OracleInterface.spec _ oi) trRest + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec, ⟨x, trRest⟩ => + liftOutput Output (rest x) (rRest x) (odFn x) accSpec trRest + +/-! ## Oracle counterpart (unified with `Counterpart.withMonads`) + +`OracleCounterpart` is the round-by-round challenger with growing oracle access, +defined as `Counterpart.withMonads` with the `MonadDecoration` computed from +the oracle decoration. At sender nodes the monad is `Id` (pure observation); +at receiver nodes the monad is `OracleComp` with accumulated oracle access. -/ + +/-- Round-by-round challenger with growing oracle access, defined as +`Counterpart.withMonads` with the monad decoration computed from the oracle +decoration. The oracle-spec-indexed `Output` is converted to a +transcript-indexed family by `liftOutput`. -/ +abbrev OracleCounterpart {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + {ιₛᵢ : Type} (OStmtIn : ιₛᵢ → Type) [∀ i, OracleInterface.{0, 0} (OStmtIn i)] + (Output : {ιₐ : Type} → OracleSpec.{0, 0} ιₐ → Type) + (spec : Spec.{0}) (roles : RoleDecoration spec) (od : OracleDecoration.{0, 0} spec roles) + {ιₐ : Type} (accSpec : OracleSpec.{0, 0} ιₐ) := + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) + (liftOutput Output spec roles od accSpec) + +/-- `InteractiveOracleVerifier` is the round-by-round oracle verifier whose +terminal output is a verification function. The return type may depend on both +the input statement and the realized transcript. -/ +abbrev InteractiveOracleVerifier {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + (pSpec : Spec.{0}) (roles : RoleDecoration pSpec) + (od : OracleDecoration.{0, 0} pSpec roles) + (StmtIn : Type) {ιₛᵢ : Type} (OStmtIn : ιₛᵢ → Type) + (StmtOut : StmtIn → Spec.Transcript pSpec → Type) + [∀ i, OracleInterface.{0, 0} (OStmtIn i)] := + Spec.Counterpart.withMonads pSpec roles + (toMonadDecoration oSpec OStmtIn pSpec roles od (ιₐ := PEmpty) []ₒ) + (fun tr => + (s : StmtIn) → + OracleComp (oSpec + [OStmtIn]ₒ + toOracleSpec pSpec roles od tr) + (StmtOut s tr)) + +/-! ## Conversions -/ + +/-- Map the output of an `OracleCounterpart`, applying `f` at each `.done` leaf. +At sender nodes (monad = `Id`), the map is applied purely. At receiver nodes +(monad = `OracleComp`), the map is lifted through the oracle computation. -/ +def OracleCounterpart.mapOutput {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface.{0, 0} (OStmtIn i)] + {Output₁ Output₂ : {ιₐ : Type} → OracleSpec.{0, 0} ιₐ → Type} + (f : ∀ {ιₐ : Type} (accSpec : OracleSpec.{0, 0} ιₐ), Output₁ accSpec → Output₂ accSpec) : + (spec : Spec.{0}) → (roles : RoleDecoration spec) → + (od : OracleDecoration.{0, 0} spec roles) → + {ιₐ : Type} → (accSpec : OracleSpec.{0, 0} ιₐ) → + OracleCounterpart oSpec OStmtIn Output₁ spec roles od accSpec → + OracleCounterpart oSpec OStmtIn Output₂ spec roles od accSpec + | .done, _, _, _, accSpec => f accSpec + | .node _ rest, ⟨.sender, rRest⟩, ⟨_, odRest⟩, _, _ => + fun oc x => mapOutput f (rest x) (rRest x) (odRest x) _ (oc x) + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec => + fun oc => do + let ⟨x, ocRest⟩ ← oc + return ⟨x, mapOutput f (rest x) (rRest x) (odFn x) accSpec ocRest⟩ + +/-! ## Oracle prover and oracle reduction -/ + +/-- Oracle prover: given ambient input `i`, local statement/oracle data, +performs monadic setup in `OracleComp oSpec` and produces a role-dependent +strategy. The honest prover output is the next local statement bundled with its +output oracle statements, together with the next witness. + +This is a specialization of `Prover` with `m = OracleComp oSpec` and the +local statement type bundled with named oracle statements. -/ +abbrev OracleProver {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + (SharedIn : Type) + (Context : SharedIn → Spec.{0}) + (Roles : (shared : SharedIn) → RoleDecoration (Context shared)) + (StatementIn WitnessIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + (StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + (OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type) + (WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type) := + Prover (OracleComp oSpec) + SharedIn Context Roles + (fun shared => StatementWithOracles StatementIn OStatementIn shared) WitnessIn + (fun shared tr => + StatementWithOracles + (fun _ => StatementOut shared tr) (fun _ => OStatementOut shared tr) shared) + WitnessOut + +/-- Oracle reduction: pairs an oracle prover with a verifier that uses per-node +monads (`Id` at sender, `OracleComp` at receiver) via `Counterpart.withMonads`. +This is the oracle analog of `Reduction`, where the verifier's per-node monad +structure (growing oracle access) replaces the fixed monad of `Counterpart`. + +The honest prover outputs the next plain statement bundled with its output +oracle statements. The verifier produces the plain next statement, while the +`simulate` field exposes query-level access to the output oracle family. +Concrete reification of those output oracles is optional and lives in a +separate layer. -/ +structure OracleReduction {ι : Type} (oSpec : OracleSpec ι) + (SharedIn : Type) + (Context : SharedIn → Spec) + (Roles : (shared : SharedIn) → RoleDecoration (Context shared)) + (oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)) + (StatementIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + [∀ shared i, OracleInterface (OStatementIn shared i)] + (WitnessIn : SharedIn → Type) + (StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + (OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type) + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + (WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type) where + prover : OracleProver oSpec SharedIn Context Roles StatementIn WitnessIn OStatementIn + StatementOut OStatementOut WitnessOut + verifier : (shared : SharedIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + StatementIn shared → + Spec.Counterpart.withMonads (Context shared) (Roles shared) + (toMonadDecoration oSpec (OStatementIn shared) + (Context shared) (Roles shared) (oracleDeco shared) accSpec) + (fun tr => StatementOut shared tr) + simulate : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → + QueryImpl [OStatementOut shared tr]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + toOracleSpec (Context shared) (Roles shared) (oracleDeco shared) tr)) + +namespace OracleReduction + +/-- Full oracle-only verifier output for an oracle reduction at transcript `tr`: +the plain output statement together with the query implementation exposing the +output-oracle access. -/ +abbrev VerifierOutput + {SharedIn : Type} + {Context : SharedIn → Spec.{0}} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛᵢ : SharedIn → Type} {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration.{0, 0} (Context shared) (Roles shared)} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + (OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type) + [∀ shared i, OracleInterface.{0, 0} (OStatementIn shared i)] + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + (shared : SharedIn) (tr : Spec.Transcript (Context shared)) := + StatementOut shared tr × QueryImpl [OStatementOut shared tr]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + toOracleSpec (Context shared) (Roles shared) (oracleDeco shared) tr)) + +/-- Package the verifier's plain output statement together with the verifier's +output-oracle query access. -/ +def verifierOutput + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface.{0, 0} (OStatementIn shared i)] + {Context : SharedIn → Spec.{0}} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration.{0, 0} (Context shared) (Roles shared)} + {StatementIn WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) + (shared : SharedIn) (tr : Spec.Transcript (Context shared)) (stmtOut : StatementOut shared tr) : + VerifierOutput (Context := Context) (StatementOut := StatementOut) + (SharedIn := SharedIn) (OStatementIn := OStatementIn) + (Roles := Roles) (oracleDeco := oracleDeco) OStatementOut shared tr := + ⟨stmtOut, reduction.simulate shared tr⟩ + +/-- The verifier-side monad decoration induced by an oracle reduction, starting +from an accumulated sender-message oracle spec `accSpec`. -/ +abbrev verifierMD + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface.{0, 0} (OStatementIn shared i)] + {Context : SharedIn → Spec.{0}} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration.{0, 0} (Context shared) (Roles shared)} + {StatementIn WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (_reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) + (shared : SharedIn) {ιₐ : Type} (accSpec : OracleSpec.{0, 0} ιₐ) : + Spec.MonadDecoration (Context shared) := + toMonadDecoration oSpec (OStatementIn shared) + (Context shared) (Roles shared) (oracleDeco shared) accSpec + +end OracleReduction + +end OracleDecoration + +/-- A verifier-only oracle protocol surface, analogous to `Interaction.Verifier`. +Its primary index is the shared ambient spine `SharedIn`, which determines the +protocol context, roles, oracle decoration, and oracle families. The carried +explicit claim inside that fixed protocol is `StatementIn shared`. + +The verifier returns the explicit output statement directly, while `simulate` +exposes the implicit output oracle behavior at the query level. Concrete +reification of that output oracle family is an optional outer layer. -/ +structure OracleVerifier {ι : Type} (oSpec : OracleSpec ι) + (SharedIn : Type) + (Context : SharedIn → Spec) + (Roles : (shared : SharedIn) → RoleDecoration (Context shared)) + (oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)) + (StatementIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + [∀ shared i, OracleInterface (OStatementIn shared i)] + (StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + (OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type) + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] where + toFun : (shared : SharedIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + StatementIn shared → + Spec.Counterpart.withMonads (Context shared) (Roles shared) + (OracleDecoration.toMonadDecoration oSpec (OStatementIn shared) + (Context shared) (Roles shared) (oracleDeco shared) accSpec) + (fun tr => StatementOut shared tr) + simulate : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → + QueryImpl [OStatementOut shared tr]ₒ + (OracleComp ([OStatementIn shared]ₒ + OracleDecoration.toOracleSpec + (Context shared) (Roles shared) (oracleDeco shared) tr)) + +instance + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] : + CoeFun + (OracleVerifier oSpec SharedIn Context Roles oracleDeco StatementIn OStatementIn + StatementOut OStatementOut) + (fun _ => (shared : SharedIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + StatementIn shared → + Spec.Counterpart.withMonads (Context shared) (Roles shared) + (OracleDecoration.toMonadDecoration oSpec (OStatementIn shared) + (Context shared) (Roles shared) (oracleDeco shared) accSpec) + (fun tr => StatementOut shared tr)) where + coe verifier := verifier.toFun + +namespace OracleDecoration.OracleReduction + +/-- Forget the prover and witness bookkeeping of an oracle reduction, keeping +only the verifier-side interaction and output-oracle simulation. -/ +def toVerifier + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : OracleReduction oSpec SharedIn Context Roles oracleDeco + StatementIn OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) : + Interaction.OracleVerifier oSpec SharedIn Context Roles oracleDeco + StatementIn OStatementIn StatementOut OStatementOut where + toFun shared {_} accSpec stmt := + reduction.verifier shared accSpec stmt + simulate := + reduction.simulate + +end OracleDecoration.OracleReduction + +/-! ## Oracle.Spec-based prover, verifier, and reduction + +These definitions use `Oracle.Spec` (the inductive type with `.public`/`.oracle`) +instead of `Spec` + `OracleDecoration`. Output types and `simulate` are indexed +by `Oracle.Spec.PublicTranscript`, giving definitional independence from oracle +message values. + +Like the `OracleDecoration`-based types above, everything is indexed by a +`SharedIn` ambient input that determines the protocol context, roles, oracle +decoration, and statement/witness families. -/ + +namespace Oracle + +/-- Oracle prover on `Oracle.Spec`: given ambient input `shared`, local +statement/oracle data and witness, performs monadic setup in `OracleComp oSpec` +and produces a role-dependent strategy on `(Context shared).toInteractionSpec`. +The honest prover output is the next local statement bundled with its output +oracle statements, plus the next witness. -/ +abbrev Prover {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + (SharedIn : Type) + (Context : SharedIn → Spec) + (Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)) + (StatementIn WitnessIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + (StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type) + (WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type) := + Interaction.Prover (OracleComp oSpec) + SharedIn + (fun shared => (Context shared).toInteractionSpec) + (fun shared => (Context shared).toSpecRoles (Roles shared)) + (fun shared => StatementWithOracles StatementIn OStatementIn shared) + WitnessIn + (fun shared tr => + StatementWithOracles + (fun _ => StatementOut shared ((Context shared).projectPublic tr)) + (fun _ => OStatementOut shared ((Context shared).projectPublic tr)) + shared) + (fun shared tr => WitnessOut shared ((Context shared).projectPublic tr)) + +/-- Oracle verifier on `Oracle.Spec`: the interactive verifier (`toFun`) and +output-oracle simulation (`simulate`), both on the same `Oracle.Spec`. + +The verifier uses `Counterpart.withMonads` with `toMonadDecoration`, giving +`Id` monad at sender/oracle nodes and `OracleComp` at receiver nodes. The +accumulated oracle spec starts at `[]ₒ` and grows as `.oracle` nodes are +traversed, so the verifier's oracle access is fully determined by the +protocol structure. + +The `simulate` field provides query-level access to output oracle statements, +indexed by `PublicTranscript` (so it is definitionally independent of oracle +message values). -/ +structure Verifier {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + (SharedIn : Type) + (Context : SharedIn → Spec) + (Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)) + (OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)) + (StatementIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + [∀ shared i, OracleInterface (OStatementIn shared i)] + (StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type) + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] where + toFun : (shared : SharedIn) → + StatementIn shared → + Interaction.Spec.Counterpart.withMonads + (Context shared).toInteractionSpec + ((Context shared).toSpecRoles (Roles shared)) + ((Context shared).toMonadDecoration oSpec (OStatementIn shared) + (Roles shared) (OracleDeco shared) []ₒ) + (fun tr => StatementOut shared ((Context shared).projectPublic tr)) + simulate : (shared : SharedIn) → + (pt : Spec.PublicTranscript (Context shared)) → + QueryImpl [OStatementOut shared pt]ₒ + (OracleComp + ([OStatementIn shared]ₒ + (Context shared).toOracleSpec (OracleDeco shared) pt)) + +/-- Oracle reduction on `Oracle.Spec`: bundles a prover and a verifier for the +same protocol. The prover produces strategies on `(Context shared).toInteractionSpec` +while the verifier interacts via `Counterpart.withMonads` with growing oracle +access. + +All output types are indexed by `PublicTranscript`, ensuring they do not +depend on oracle message values. -/ +structure Reduction {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + (SharedIn : Type) + (Context : SharedIn → Spec) + (Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)) + (OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)) + (StatementIn : SharedIn → Type) + {ιₛᵢ : SharedIn → Type} + (OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type) + [∀ shared i, OracleInterface (OStatementIn shared i)] + (WitnessIn : SharedIn → Type) + (StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type) + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type) + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + (WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type) where + prover : Prover oSpec SharedIn Context Roles StatementIn WitnessIn OStatementIn + StatementOut OStatementOut WitnessOut + verifier : Verifier oSpec SharedIn Context Roles OracleDeco StatementIn OStatementIn + StatementOut OStatementOut + +/-- Forget the prover and witness of an `Oracle.Reduction`, keeping the +verifier. -/ +def Reduction.toVerifier + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)} + {OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + {WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (r : Reduction oSpec SharedIn Context Roles OracleDeco StatementIn OStatementIn + WitnessIn StatementOut OStatementOut WitnessOut) : + Verifier oSpec SharedIn Context Roles OracleDeco StatementIn OStatementIn + StatementOut OStatementOut := + r.verifier + +end Oracle + +end Interaction diff --git a/ArkLib/Interaction/Oracle/Execution.lean b/ArkLib/Interaction/Oracle/Execution.lean new file mode 100644 index 0000000000..2f497bad6a --- /dev/null +++ b/ArkLib/Interaction/Oracle/Execution.lean @@ -0,0 +1,1768 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Core + +set_option linter.style.longFile 1700 + +/-! +# Oracle Reduction Execution + +Concrete execution of oracle-decorated reductions. The oracle decoration adds +per-sender-node oracle interfaces that grow the ambient `OracleSpec` as the +protocol progresses. This module provides: + +- `simulateQ` lemmas for splitting, appending, and casting oracle query handlers +- `run` / `execute`: running an `OracleVerifier` or `OracleReduction` against + an oracle-aware prover, reducing to `OracleComp` computations +- `mapExecuteWitness` / `forgetExecuteWitness`: post-processing the witness + output of an executed oracle reduction +- equivalence lemmas between running against concrete oracle implementations + and running via `simulateQ`-based composition + +## See also + +- `Oracle/Core.lean` — oracle decoration definitions and query handle algebra +- `Oracle/Continuation.lean` — chained (multi-stage) oracle composition +-/ + +open OracleComp OracleSpec +open Interaction.TwoParty + +namespace Interaction + +namespace OracleDecoration + +theorem simulateQ_map + {ι : Type _} {spec : OracleSpec ι} + {r : Type _ → Type _} + [Monad r] [LawfulMonad r] + {α β : Type _} + (impl : QueryImpl spec r) + (f : α → β) + (oa : OracleComp spec α) : + simulateQ impl (f <$> oa) = f <$> simulateQ impl oa := by + induction oa using OracleComp.inductionOn with + | pure x => + simp + | query_bind t oa ih => + simp [ih] + +/-! ## Composition infrastructure + +To compose oracle reductions, we need that `toMonadDecoration` distributes over +`Spec.append` and `Spec.stateChain`. The accumulated oracle spec after the first phase +serves as the starting spec for the second phase. -/ + +/-- Lift a transcript-split oracle index family to the fused append transcript. -/ +abbrev liftAppendOracleIdx + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) : + Spec.Transcript (spec₁.append spec₂) → Type := + Spec.Transcript.liftAppend spec₁ spec₂ ιₛ + +/-- Lift a transcript-split oracle statement family to the fused append +transcript. -/ +abbrev liftAppendOracleFamily + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) : + (tr : Spec.Transcript (spec₁.append spec₂)) → liftAppendOracleIdx spec₁ spec₂ ιₛ tr → Type := + fun tr i => + let split := Spec.Transcript.split spec₁ spec₂ tr + OStmt split.1 split.2 (Spec.Transcript.unliftAppend spec₁ spec₂ ιₛ tr i) + +/-- View a fused append-oracle query as a query to the split append oracle family +without first rewriting the transcript back to `append tr₁ tr₂`. -/ +def splitLiftAppendOracleQuery + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] + (tr : Spec.Transcript (spec₁.append spec₂)) + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Domain) : + let split := Spec.Transcript.split spec₁ spec₂ tr + ([OStmt split.1 split.2]ₒ).Domain := by + exact ⟨Spec.Transcript.unliftAppend spec₁ spec₂ ιₛ tr qOut.1, qOut.2⟩ + +/-- View an answer to the split append oracle family as an answer to the fused +append oracle family. -/ +def answerSplitLiftAppendQuery + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] + (tr : Spec.Transcript (spec₁.append spec₂)) + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Domain) : + ([OStmt (Spec.Transcript.split spec₁ spec₂ tr).1 + (Spec.Transcript.split spec₁ spec₂ tr).2]ₒ).Range + (splitLiftAppendOracleQuery spec₁ spec₂ ιₛ OStmt tr qOut) → + ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut + | a => a + +/-- At an appended transcript `append tr₁ tr₂`, the fused lifted oracle family +reduces to the split oracle family after unpacking the lifted index. -/ +theorem liftAppendOracleFamily_append_eq + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] + (tr₁ : Spec.Transcript spec₁) + (tr₂ : Spec.Transcript (spec₂ tr₁)) + (i : + liftAppendOracleIdx spec₁ spec₂ ιₛ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) : + liftAppendOracleFamily + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) i = + OStmt tr₁ tr₂ + (Spec.Transcript.unpackAppend spec₁ spec₂ ιₛ tr₁ tr₂ i) := by + let iSplit := Spec.Transcript.unpackAppend spec₁ spec₂ ιₛ tr₁ tr₂ i + have hi : + Spec.Transcript.packAppend spec₁ spec₂ ιₛ tr₁ tr₂ iSplit = i := by + dsimp [iSplit] + exact Spec.Transcript.packAppend_unpackAppend spec₁ spec₂ ιₛ tr₁ tr₂ i + calc + liftAppendOracleFamily + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) i = + liftAppendOracleFamily + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (Spec.Transcript.packAppend spec₁ spec₂ ιₛ tr₁ tr₂ iSplit) := by + rw [← hi] + _ = OStmt tr₁ tr₂ iSplit := by + calc + OStmt + (Spec.Transcript.split spec₁ spec₂ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).fst + (Spec.Transcript.split spec₁ spec₂ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).snd + (Spec.Transcript.unliftAppend spec₁ spec₂ ιₛ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (Spec.Transcript.packAppend spec₁ spec₂ ιₛ tr₁ tr₂ iSplit)) = + OStmt tr₁ tr₂ + (Spec.Transcript.unliftAppend + spec₁ spec₂ (fun _ _ => ιₛ tr₁ tr₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (Spec.Transcript.packAppend + spec₁ spec₂ (fun _ _ => ιₛ tr₁ tr₂) tr₁ tr₂ iSplit)) := by + simpa [liftAppendOracleFamily] using + (Spec.Transcript.rel_unliftAppend_append + spec₁ spec₂ + ιₛ + (fun _ _ => ιₛ tr₁ tr₂) + (fun tr₁' tr₂' i j => OStmt tr₁' tr₂' i = OStmt tr₁ tr₂ j) + tr₁ tr₂ iSplit iSplit) + _ = OStmt tr₁ tr₂ iSplit := by + have hConst : + Spec.Transcript.unliftAppend + spec₁ spec₂ (fun _ _ => ιₛ tr₁ tr₂) + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) + (Spec.Transcript.packAppend + spec₁ spec₂ (fun _ _ => ιₛ tr₁ tr₂) tr₁ tr₂ iSplit) = + iSplit := by + let rec h : + ∀ {s₁ : Spec} {s₂ : Spec.Transcript s₁ → Spec} + (A : Type _) + (tr₁ : Spec.Transcript s₁) (tr₂ : Spec.Transcript (s₂ tr₁)) + (x : A), + Spec.Transcript.unliftAppend s₁ s₂ (fun _ _ => A) + (Spec.Transcript.append s₁ s₂ tr₁ tr₂) + (Spec.Transcript.packAppend s₁ s₂ (fun _ _ => A) tr₁ tr₂ x) = x + | .done, _, _, ⟨⟩, _, _ => rfl + | .node _ rest, s₂, A, ⟨xm, tail₁⟩, tr₂, x => by + simpa [Spec.Transcript.unliftAppend, Spec.Transcript.packAppend, + Spec.Transcript.append] using + h (s₁ := rest xm) (s₂ := fun p => s₂ ⟨xm, p⟩) A tail₁ tr₂ x + exact h (A := ιₛ tr₁ tr₂) tr₁ tr₂ iSplit + exact congrArg (fun j => OStmt tr₁ tr₂ j) hConst + +/-- Specialization of `answerSplitLiftAppendQuery` to a fused transcript +already known to be `append tr₁ tr₂`, phrased in terms of the corresponding +casted split query `qSplit`. -/ +def answerSplitLiftAppendQueryAppend + (spec₁ : Spec) : + (spec₂ : Spec.Transcript spec₁ → Spec) → + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) → + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) → + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] → + (tr₁ : Spec.Transcript spec₁) → + (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)]ₒ).Domain) → + let qSplit : ([OStmt tr₁ tr₂]ₒ).Domain := + cast + (congrArg (fun p => ([OStmt p.1 p.2]ₒ).Domain) + (Spec.Transcript.split_append spec₁ spec₂ tr₁ tr₂)) + (splitLiftAppendOracleQuery + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut) + ([OStmt tr₁ tr₂]ₒ).Range qSplit → + ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)]ₒ).Range qOut := + match spec₁ with + | .done => fun spec₂ ιₛ OStmt _ tr₁ tr₂ qOut => by + cases tr₁ + dsimp + intro a + simpa using a + | .node X rest => fun spec₂ ιₛ OStmt _ tr₁ tr₂ qOut => by + cases tr₁ with + | mk x tail₁ => + dsimp + simpa using + (answerSplitLiftAppendQueryAppend + (rest x) + (fun p => spec₂ ⟨x, p⟩) + (fun tr₁ tr₂ => ιₛ ⟨x, tr₁⟩ tr₂) + (fun tr₁ tr₂ i => OStmt ⟨x, tr₁⟩ tr₂ i) + tail₁ tr₂ qOut) + +/-- At a fused append transcript already known to be `append tr₁ tr₂`, the raw +split-query response type used by `answerSplitLiftAppendQuery` agrees with the +casted split-query response type used by `answerSplitLiftAppendQueryAppend`. -/ +theorem splitLiftAppendOracleRange_eq + (spec₁ : Spec) : + (spec₂ : Spec.Transcript spec₁ → Spec) → + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) → + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) → + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] → + (tr₁ : Spec.Transcript spec₁) → + (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)]ₒ).Domain) → + let qSplit : ([OStmt tr₁ tr₂]ₒ).Domain := + cast + (congrArg (fun p => ([OStmt p.1 p.2]ₒ).Domain) + (Spec.Transcript.split_append spec₁ spec₂ tr₁ tr₂)) + (splitLiftAppendOracleQuery + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut) + ([OStmt (Spec.Transcript.split spec₁ spec₂ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).1 + (Spec.Transcript.split spec₁ spec₂ + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)).2]ₒ).Range + (splitLiftAppendOracleQuery + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut) = + ([OStmt tr₁ tr₂]ₒ).Range qSplit + := by + intro spec₂ ιₛ OStmt _ tr₁ tr₂ qOut + induction spec₁ with + | done => + cases tr₁ + rfl + | node X rest ih => + cases tr₁ with + | mk x tail₁ => + dsimp [splitLiftAppendOracleQuery] + simpa using + (ih + (spec₂ := fun p => spec₂ ⟨x, p⟩) + (ιₛ := fun tr₁ tr₂ => ιₛ ⟨x, tr₁⟩ tr₂) + (OStmt := fun tr₁ tr₂ i => OStmt ⟨x, tr₁⟩ tr₂ i) + (tr₁ := tail₁) (tr₂ := tr₂) (qOut := qOut)) + +/-- Repackaging a casted split-query answer through `answerSplitLiftAppendQuery` +agrees with the append-specialized helper `answerSplitLiftAppendQueryAppend`. -/ +theorem answerSplitLiftAppendQueryAppend_eq + (spec₁ : Spec) : + (spec₂ : Spec.Transcript spec₁ → Spec) → + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) → + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) → + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] → + (tr₁ : Spec.Transcript spec₁) → + (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)]ₒ).Domain) → + let qSplit : ([OStmt tr₁ tr₂]ₒ).Domain := + cast + (congrArg (fun p => ([OStmt p.1 p.2]ₒ).Domain) + (Spec.Transcript.split_append spec₁ spec₂ tr₁ tr₂)) + (splitLiftAppendOracleQuery + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut) + (ans : ([OStmt tr₁ tr₂]ₒ).Range qSplit) → + answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut + (cast + (splitLiftAppendOracleRange_eq spec₁ spec₂ ιₛ OStmt tr₁ tr₂ qOut).symm + ans) = + answerSplitLiftAppendQueryAppend spec₁ spec₂ ιₛ OStmt tr₁ tr₂ qOut ans + := by + intro spec₂ ιₛ OStmt _ tr₁ tr₂ qOut ans + induction spec₁ with + | done => + cases tr₁ + dsimp [splitLiftAppendOracleRange_eq] + intro a + rfl + | node X rest ih => + cases tr₁ with + | mk x tail₁ => + dsimp [answerSplitLiftAppendQuery, answerSplitLiftAppendQueryAppend, + splitLiftAppendOracleRange_eq] + intro a + simpa using + (ih + (spec₂ := fun p => spec₂ ⟨x, p⟩) + (ιₛ := fun tr₁ tr₂ => ιₛ ⟨x, tr₁⟩ tr₂) + (OStmt := fun tr₁ tr₂ i => OStmt ⟨x, tr₁⟩ tr₂ i) + (tr₁ := tail₁) (tr₂ := tr₂) (qOut := qOut) (ans := a)) + +/-- At a fused append transcript already known to be `append tr₁ tr₂`, feeding +the casted split query to a concrete split oracle statement and then +repackaging the answer through `answerSplitLiftAppendQueryAppend` agrees with +directly answering the fused query against the corresponding fused oracle +statement. -/ +theorem answerSplitLiftAppendQueryAppend_simOracle0 + (spec₁ : Spec) : + (spec₂ : Spec.Transcript spec₁ → Spec) → + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) → + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) → + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] → + (tr₁ : Spec.Transcript spec₁) → + (tr₂ : Spec.Transcript (spec₂ tr₁)) → + (oStatement : OracleStatement (OStmt tr₁ tr₂)) → + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)]ₒ).Domain) → + let qSplit : ([OStmt tr₁ tr₂]ₒ).Domain := + cast + (congrArg (fun p => ([OStmt p.1 p.2]ₒ).Domain) + (Spec.Transcript.split_append spec₁ spec₂ tr₁ tr₂)) + (splitLiftAppendOracleQuery + spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) qOut) + answerSplitLiftAppendQueryAppend spec₁ spec₂ ιₛ OStmt tr₁ tr₂ qOut + ((OracleInterface.simOracle0 (OStmt tr₁ tr₂) oStatement) qSplit) = + let i := qOut.1 + let q := qOut.2 + let iSplit := Spec.Transcript.unpackAppend spec₁ spec₂ ιₛ tr₁ tr₂ i + let hQueryTy : + liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt + (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂) i = + OStmt tr₁ tr₂ iSplit := + liftAppendOracleFamily_append_eq spec₁ spec₂ ιₛ OStmt tr₁ tr₂ i + OracleInterface.answer (cast hQueryTy.symm (oStatement iSplit)) q := + match spec₁ with + | .done => fun spec₂ ιₛ OStmt _ tr₁ tr₂ oStatement qOut => by + cases tr₁ + cases qOut with + | mk i q => + rfl + | .node X rest => fun spec₂ ιₛ OStmt _ tr₁ tr₂ oStatement qOut => by + cases tr₁ with + | mk x tail₁ => + simpa [Spec.Transcript.unpackAppend, liftAppendOracleFamily_append_eq] + using + (answerSplitLiftAppendQueryAppend_simOracle0 + (rest x) + (fun p => spec₂ ⟨x, p⟩) + (fun tr₁ tr₂ => ιₛ ⟨x, tr₁⟩ tr₂) + (fun tr₁ tr₂ j => OStmt ⟨x, tr₁⟩ tr₂ j) + tail₁ tr₂ oStatement qOut) + +/-- Repackage a routed split-world append-oracle computation as the public +fused append-oracle computation. This centralizes the only propositional +transport needed at the append boundary: internally we work with the split +transcript recovered by `Transcript.split`, while the public API is indexed by +the fused transcript `tr`. -/ +def collapseAppendOracleComp + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (Idx : + Spec.Transcript (spec₁.append spec₂) → Type _) + (baseSpec : (tr : Spec.Transcript (spec₁.append spec₂)) → OracleSpec (Idx tr)) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] + (tr : Spec.Transcript (spec₁.append spec₂)) + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Domain) + (oa : + let split := Spec.Transcript.split spec₁ spec₂ tr + OracleComp + (baseSpec (Spec.Transcript.append spec₁ spec₂ split.1 split.2)) + (([OStmt split.1 split.2]ₒ).Range + (splitLiftAppendOracleQuery spec₁ spec₂ ιₛ OStmt tr qOut))) : + OracleComp + (baseSpec tr) + (([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut) := by + let split := Spec.Transcript.split spec₁ spec₂ tr + let tr₁ := split.1 + let tr₂ := split.2 + let qSplit := + splitLiftAppendOracleQuery spec₁ spec₂ ιₛ OStmt tr qOut + let fusedAnswer := + answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut + have htr : Spec.Transcript.append spec₁ spec₂ tr₁ tr₂ = tr := by + simpa [tr₁, tr₂, split] using + (Spec.Transcript.append_split spec₁ spec₂ tr) + have hSpec : + OracleComp + (baseSpec (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) + (([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut) = + OracleComp (baseSpec tr) + (([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut) := by + simpa using + congrArg + (fun tr' => + OracleComp (baseSpec tr') + (([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut)) + htr + exact cast hSpec (fusedAnswer <$> oa) + +/-- Simulating `collapseAppendOracleComp` evaluates the routed split-world +computation and then repackages its answer via `answerSplitLiftAppendQuery`. -/ +theorem simulateQ_collapseAppendOracleComp + (spec₁ : Spec) (spec₂ : Spec.Transcript spec₁ → Spec) + (Idx : + Spec.Transcript (spec₁.append spec₂) → Type _) + (baseSpec : (tr : Spec.Transcript (spec₁.append spec₂)) → OracleSpec (Idx tr)) + (ιₛ : (tr₁ : Spec.Transcript spec₁) → Spec.Transcript (spec₂ tr₁) → Type) + (OStmt : + (tr₁ : Spec.Transcript spec₁) → (tr₂ : Spec.Transcript (spec₂ tr₁)) → ιₛ tr₁ tr₂ → Type) + [∀ tr₁ tr₂ i, OracleInterface (OStmt tr₁ tr₂ i)] + (tr : Spec.Transcript (spec₁.append spec₂)) + (qOut : ([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Domain) + (impl : QueryImpl (baseSpec tr) Id) + (oa : + let split := Spec.Transcript.split spec₁ spec₂ tr + OracleComp + (baseSpec (Spec.Transcript.append spec₁ spec₂ split.1 split.2)) + (([OStmt split.1 split.2]ₒ).Range + (splitLiftAppendOracleQuery spec₁ spec₂ ιₛ OStmt tr qOut))) : + simulateQ impl + (collapseAppendOracleComp spec₁ spec₂ Idx baseSpec ιₛ OStmt tr qOut oa) = + answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut + (simulateQ + (cast + (by + let split := Spec.Transcript.split spec₁ spec₂ tr + let tr₁ := split.1 + let tr₂ := split.2 + have htr : Spec.Transcript.append spec₁ spec₂ tr₁ tr₂ = tr := by + simpa [tr₁, tr₂, split] using + (Spec.Transcript.append_split spec₁ spec₂ tr) + simpa using (congrArg (fun tr' => QueryImpl (baseSpec tr') Id) htr).symm) + impl) + oa) := by + unfold collapseAppendOracleComp + let split := Spec.Transcript.split spec₁ spec₂ tr + let tr₁ := split.1 + let tr₂ := split.2 + have htr : Spec.Transcript.append spec₁ spec₂ tr₁ tr₂ = tr := by + simpa [tr₁, tr₂, split] using + (Spec.Transcript.append_split spec₁ spec₂ tr) + let impl' : + QueryImpl (baseSpec (Spec.Transcript.append spec₁ spec₂ tr₁ tr₂)) Id := + cast + (by + simpa using (congrArg (fun tr' => QueryImpl (baseSpec tr') Id) htr).symm) + impl + calc + simulateQ impl + (cast + (by + simpa using + congrArg + (fun tr' => + OracleComp (baseSpec tr') + (([liftAppendOracleFamily spec₁ spec₂ ιₛ OStmt tr]ₒ).Range qOut)) + htr) + (answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut <$> oa)) = + simulateQ impl' (answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut <$> oa) := by + simpa [impl'] using + (simulateQ_cast_dep + (Idx := Idx) (SpecFam := baseSpec) htr + impl + (answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut <$> oa)) + _ = + answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut + <$> simulateQ impl' oa := by + exact + (simulateQ_map impl' + (answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut) oa) + _ = + answerSplitLiftAppendQuery spec₁ spec₂ ιₛ OStmt tr qOut + (simulateQ impl' oa) := by + rfl + +/-- Accumulated oracle spec after traversing `spec` along transcript `tr`, +starting from `accSpec`. At sender nodes, adds the node's oracle interface spec. +At receiver nodes, the accumulated spec is unchanged. -/ +def accSpecAfter : + (spec : Spec) → (roles : RoleDecoration spec) → OracleDecoration spec roles → + {ιₐ : Type} → OracleSpec ιₐ → Spec.Transcript spec → + Σ (ιₐ' : Type), OracleSpec ιₐ' + | .done, _, _, _, accSpec, _ => ⟨_, accSpec⟩ + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, _, accSpec, ⟨x, trRest⟩ => + accSpecAfter (rest x) (rRest x) (odRest x) + (accSpec + @OracleInterface.spec _ oi) trRest + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec, ⟨x, trRest⟩ => + accSpecAfter (rest x) (rRest x) (odFn x) accSpec trRest + +/-- Concrete implementation of the accumulated sender-message oracle spec after +traversing a transcript. -/ +def accImplAfter : + (spec : Spec) → (roles : RoleDecoration spec) → (od : OracleDecoration spec roles) → + {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → QueryImpl accSpec Id → + (tr : Spec.Transcript spec) → + QueryImpl ((accSpecAfter spec roles od accSpec tr).2) Id + | .done, _, _, _, _, accImpl, _ => accImpl + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, _, accSpec, accImpl, ⟨x, trRest⟩ => + let implX : QueryImpl (@OracleInterface.spec _ oi) Id := fun q => (oi.toOC.impl q).run x + accImplAfter (rest x) (rRest x) (odRest x) (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl implX) trRest + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec, accImpl, ⟨x, trRest⟩ => + accImplAfter (rest x) (rRest x) (odFn x) accSpec accImpl trRest + +/-- Execute a prover strategy against a monadic oracle verifier counterpart. + +This is the core operational engine behind the impl-based oracle execution APIs +and their concrete-input specializations. It threads three oracle sources +through the verifier: + +- ambient base oracles `oSpec`, +- concrete input oracles `OStmtIn`, +- accumulated sender-message oracles `accSpec`. + +The result packages the realized transcript, prover output, and verifier output +for that transcript. -/ +def runWithOracleCounterpart + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (inputImpl : QueryImpl [OStmtIn]ₒ Id) : + (spec : Spec) → (roles : RoleDecoration spec) → (od : OracleDecoration spec roles) → + {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → QueryImpl accSpec Id → + {OutputP OutputC : Spec.Transcript spec → Type} → + Spec.Strategy.withRoles (OracleComp oSpec) spec roles OutputP → + Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) OutputC → + OracleComp oSpec ((tr : Spec.Transcript spec) × OutputP tr × OutputC tr) + | .done, _, _, _, _, _, _, _, output, cOutput => + pure ⟨⟨⟩, output, cOutput⟩ + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩, _, accSpec, accImpl, OutputP, OutputC, + send, dualFn => do + let ⟨x, next⟩ ← send + let implX : QueryImpl (@OracleInterface.spec _ oi) Id := fun q => (oi.toOC.impl q).run x + let z ← runWithOracleCounterpart inputImpl + (rest x) (rRest x) (odRest x) (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl implX) next (dualFn x) + let tail := z.1 + let outP := z.2.1 + let outC := z.2.2 + return ⟨⟨x, tail⟩, outP, outC⟩ + | .node _ rest, ⟨.receiver, rRest⟩, odFn, _, accSpec, accImpl, OutputP, OutputC, + respond, dualSample => do + let routeImpl : + QueryImpl ((oSpec + [OStmtIn]ₒ) + accSpec) (OracleComp oSpec) := + fun + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q) + have dualSample' : OracleComp ((oSpec + [OStmtIn]ₒ) + accSpec) _ := by + simpa using dualSample + let z' : Sigma (fun x => + Spec.Counterpart.withMonads (rest x) (rRest x) + (toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odFn x) accSpec) + (fun p => OutputC ⟨x, p⟩)) ← + simulateQ routeImpl dualSample' + let x := z'.1 + let dualRest := z'.2 + let next ← respond x + let z ← runWithOracleCounterpart inputImpl + (rest x) (rRest x) (odFn x) accSpec accImpl next dualRest + let tail := z.1 + let outP := z.2.1 + let outC := z.2.2 + return ⟨⟨x, tail⟩, outP, outC⟩ + +namespace OracleReduction + +/-- Run an arbitrary prover strategy against a concrete oracle input statement, +using the empty accumulated oracle context. This is the concrete-input +specialization of the more general impl-based execution API. -/ +def runConcrete + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : + OracleReduction oSpec SharedIn Context Roles oracleDeco StatementIn OStatementIn WitnessIn + StatementOut OStatementOut WitnessOut) + (shared : SharedIn) + (s : StatementWithOracles StatementIn OStatementIn shared) + {OutputP : Spec.Transcript (Context shared) → Type} + (prover : Spec.Strategy.withRoles (OracleComp oSpec) (Context shared) (Roles shared) OutputP) : + OracleComp oSpec ((tr : Spec.Transcript (Context shared)) × OutputP tr × + (StatementOut shared tr × QueryImpl [OStatementOut shared tr]ₒ + (OracleComp + ([OStatementIn shared]ₒ + toOracleSpec (Context shared) (Roles shared) + (oracleDeco shared) tr)))) := do + let ⟨tr, outP, stmtOutV⟩ ← + runWithOracleCounterpart (OracleInterface.simOracle0 (OStatementIn shared) s.oracleStmt) + (Context shared) (Roles shared) (oracleDeco shared) []ₒ (fun q => q.elim) + prover (reduction.verifier shared []ₒ s.stmt) + pure ⟨tr, outP, ⟨stmtOutV, reduction.simulate shared tr⟩⟩ + +end OracleReduction + +end OracleDecoration + +namespace OracleVerifier + +/-- Run an arbitrary prover strategy against a verifier-only oracle protocol +surface against abstract deterministic input and accumulated oracle +implementations, and package the resulting plain verifier output with +transcript-indexed oracle access semantics. -/ +def run + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + (verifier : + @Interaction.OracleVerifier ι oSpec SharedIn Context Roles oracleDeco StatementIn ιₛᵢ + OStatementIn (by infer_instance) StatementOut ιₛₒ OStatementOut + (by infer_instance)) + (shared : SharedIn) + (stmt : StatementIn shared) + (inputImpl : QueryImpl [OStatementIn shared]ₒ Id) + {OutputP : Spec.Transcript (Context shared) → Type} + (prover : Spec.Strategy.withRoles (OracleComp oSpec) (Context shared) (Roles shared) OutputP) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) : + OracleComp oSpec ((tr : Spec.Transcript (Context shared)) × OutputP tr × + (StatementOut shared tr × QueryImpl [OStatementOut shared tr]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + OracleDecoration.toOracleSpec + (Context shared) (Roles shared) (oracleDeco shared) tr)))) := do + let ⟨tr, outP, stmtOutV⟩ ← + OracleDecoration.runWithOracleCounterpart inputImpl + (Context shared) (Roles shared) (oracleDeco shared) accSpec accImpl + prover (verifier shared accSpec stmt) + pure ⟨tr, outP, ⟨stmtOutV, verifier.simulate shared tr⟩⟩ +end OracleVerifier + +namespace OracleDecoration + +namespace OracleReduction + +/-- Execute an oracle reduction honestly, but erase the prover's private witness +output and retain only the public outgoing statement-with-oracles together with +the verifier's plain output and transcript-indexed oracle simulation. -/ +def executePublicConcrete + {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → RoleDecoration (Context shared)} + {oracleDeco : (shared : SharedIn) → OracleDecoration (Context shared) (Roles shared)} + {StatementIn WitnessIn : SharedIn → Type} + {StatementOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → Type} + {OStatementOut : + (shared : SharedIn) → (tr : Spec.Transcript (Context shared)) → ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + {WitnessOut : (shared : SharedIn) → Spec.Transcript (Context shared) → Type} + (reduction : + OracleReduction oSpec SharedIn Context Roles oracleDeco StatementIn OStatementIn WitnessIn + StatementOut OStatementOut WitnessOut) + (shared : SharedIn) (s : StatementWithOracles StatementIn OStatementIn shared) + (w : WitnessIn shared) : + OracleComp oSpec ((tr : Spec.Transcript (Context shared)) × + StatementWithOracles (fun _ => StatementOut shared tr) (fun _ => OStatementOut shared tr) + shared × + (StatementOut shared tr × QueryImpl [OStatementOut shared tr]ₒ + (OracleComp + ([OStatementIn shared]ₒ + toOracleSpec (Context shared) (Roles shared) + (oracleDeco shared) tr)))) := do + let strategy ← reduction.prover shared s w + let ⟨tr, stmtOutP, stmtOutV⟩ ← + runWithOracleCounterpart (OracleInterface.simOracle0 (OStatementIn shared) s.oracleStmt) + (Context shared) (Roles shared) (oracleDeco shared) []ₒ (fun q => q.elim) + (Spec.Strategy.mapOutputWithRoles (fun _ out => out.stmt) strategy) + (reduction.verifier shared []ₒ s.stmt) + pure ⟨tr, stmtOutP, ⟨stmtOutV, reduction.simulate shared tr⟩⟩ + +/-- Two oracle reductions with the same public interface are *honestly publicly +equivalent* when, after relating their input witness types by `liftWitness`, +their honest executions produce exactly the same public transcript/output view. + +This intentionally ignores private witness bookkeeping while keeping the full +verifier-facing behavior fixed. -/ +def HonestPubliclyEquivalent + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt WitnessIn₁ WitnessIn₂ : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut₁ WitnessOut₂ : (i : Input) → Spec.Transcript (Context i) → Type} + (liftWitness : + (i : Input) → StatementWithOracles LocalStmt OStmtIn i → WitnessIn₁ i → WitnessIn₂ i) + (reduction₁ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₁ + StatementOut OStmtOut WitnessOut₁) + (reduction₂ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₂ + StatementOut OStmtOut WitnessOut₂) : Prop := + ∀ (i : Input) (s : StatementWithOracles LocalStmt OStmtIn i) (w : WitnessIn₁ i), + reduction₁.executePublicConcrete i s w = + reduction₂.executePublicConcrete i s (liftWitness i s w) + +/-- Execute an oracle reduction honestly and package the verifier's plain output +with transcript-dependent oracle access semantics. -/ +def executeConcrete + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt WitnessIn : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut : (i : Input) → Spec.Transcript (Context i) → Type} + (reduction : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn + StatementOut OStmtOut WitnessOut) + (i : Input) (s : StatementWithOracles LocalStmt OStmtIn i) (w : WitnessIn i) : + OracleComp oSpec ((tr : Spec.Transcript (Context i)) × + HonestProverOutput + (StatementWithOracles (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut i tr) × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))) := do + let strategy ← reduction.prover i s w + let ⟨tr, proverOut, stmtOutV⟩ ← + runWithOracleCounterpart (OracleInterface.simOracle0 (OStmtIn i) s.oracleStmt) + (Context i) (Roles i) (oracleDeco i) []ₒ (fun q => q.elim) + strategy (reduction.verifier i []ₒ s.stmt) + pure ⟨tr, proverOut, ⟨stmtOutV, reduction.simulate i tr⟩⟩ + +/-- Map the private honest-prover witness component of an executed oracle +reduction while leaving its public transcript/output view unchanged. -/ +def mapExecuteWitness + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut₁ WitnessOut₂ : (i : Input) → Spec.Transcript (Context i) → Type} + (i : Input) + (s : StatementWithOracles LocalStmt OStmtIn i) + (liftWitness : (tr : Spec.Transcript (Context i)) → + WitnessOut₁ i tr → WitnessOut₂ i tr) : + ((tr : Spec.Transcript (Context i)) × + HonestProverOutput + (StatementWithOracles (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut₁ i tr) × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))) → + ((tr : Spec.Transcript (Context i)) × + HonestProverOutput + (StatementWithOracles (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut₂ i tr) × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))) := + let _ := oSpec + let _ := s + fun ⟨tr, out, view⟩ => ⟨tr, ⟨out.stmt, liftWitness tr out.wit⟩, view⟩ + +/-- Forget the private honest-prover witness component of an executed oracle +reduction, keeping only its public transcript/output view. -/ +def forgetExecuteWitness + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut : (i : Input) → Spec.Transcript (Context i) → Type} + (i : Input) + (s : StatementWithOracles LocalStmt OStmtIn i) : + ((tr : Spec.Transcript (Context i)) × + HonestProverOutput + (StatementWithOracles (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut i tr) × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))) → + ((tr : Spec.Transcript (Context i)) × + StatementWithOracles (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))) := + let _ := oSpec + let _ := s + fun ⟨tr, out, view⟩ => ⟨tr, out.stmt, view⟩ + +/-- Two oracle reductions with the same public interface are *honestly +execution-equivalent* when, after relating their input witnesses by +`liftWitnessIn`, their full honest executions agree once the first reduction's +private output witness is transported along `liftWitnessOut`. + +This is stronger than `HonestPubliclyEquivalent` and is the right notion for +sequential composition, since suffix reductions consume the honest prover's +private output witness. -/ +def HonestExecutionEquivalent + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt WitnessIn₁ WitnessIn₂ : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut₁ WitnessOut₂ : (i : Input) → Spec.Transcript (Context i) → Type} + (liftWitnessIn : + (i : Input) → StatementWithOracles LocalStmt OStmtIn i → WitnessIn₁ i → WitnessIn₂ i) + (liftWitnessOut : + (i : Input) → (s : StatementWithOracles LocalStmt OStmtIn i) → + (tr : Spec.Transcript (Context i)) → + WitnessOut₁ i tr → WitnessOut₂ i tr) + (reduction₁ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₁ + StatementOut OStmtOut WitnessOut₁) + (reduction₂ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₂ + StatementOut OStmtOut WitnessOut₂) : Prop := + ∀ (i : Input) (s : StatementWithOracles LocalStmt OStmtIn i) (w : WitnessIn₁ i), + (OracleReduction.mapExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut₁ := WitnessOut₁) + (WitnessOut₂ := WitnessOut₂) + (i := i) + (s := s) + (liftWitness := liftWitnessOut i s)) <$> reduction₁.executeConcrete i s w = + reduction₂.executeConcrete i s (liftWitnessIn i s w) + +end OracleReduction + +/-- `toMonadDecoration` distributes over `Spec.append`: the monad decoration for +the appended spec equals `Decoration.append` of the individual monad decorations, +where the second phase starts from the accumulated oracle spec of the first. -/ +theorem toMonadDecoration_append + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] : + (spec₁ : Spec) → (spec₂ : Spec.Transcript spec₁ → Spec) → + (roles₁ : RoleDecoration spec₁) → + (roles₂ : (tr₁ : Spec.Transcript spec₁) → RoleDecoration (spec₂ tr₁)) → + (od₁ : OracleDecoration spec₁ roles₁) → + (od₂ : (tr₁ : Spec.Transcript spec₁) → OracleDecoration (spec₂ tr₁) (roles₂ tr₁)) → + {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + toMonadDecoration oSpec OStmtIn (spec₁.append spec₂) + (Spec.Decoration.append roles₁ roles₂) (Role.Refine.append od₁ od₂) accSpec = + Spec.Decoration.append (toMonadDecoration oSpec OStmtIn spec₁ roles₁ od₁ accSpec) + (fun tr₁ => toMonadDecoration oSpec OStmtIn (spec₂ tr₁) (roles₂ tr₁) (od₂ tr₁) + (accSpecAfter spec₁ roles₁ od₁ accSpec tr₁).2) + | .done, _, _, _, _, _, _, _ => rfl + | .node _ rest, spec₂, ⟨.sender, rRest⟩, roles₂, ⟨oi, odRest⟩, od₂, _, accSpec => by + simp only [Spec.append, PFunctor.FreeM.append, toMonadDecoration, + Spec.Decoration.append, PFunctor.FreeM.Displayed.Decoration.append, + Role.Refine.append, accSpecAfter] + congr 1; funext x + exact toMonadDecoration_append (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odRest x) (fun p => od₂ ⟨x, p⟩) _ + | .node _ rest, spec₂, ⟨.receiver, rRest⟩, roles₂, odFn, od₂, _, accSpec => by + simp only [Spec.append, PFunctor.FreeM.append, toMonadDecoration, + Spec.Decoration.append, PFunctor.FreeM.Displayed.Decoration.append, + Role.Refine.append, accSpecAfter] + congr 1; funext x + exact toMonadDecoration_append (rest x) (fun p => spec₂ ⟨x, p⟩) + (rRest x) (fun p => roles₂ ⟨x, p⟩) (odFn x) (fun p => od₂ ⟨x, p⟩) _ + +/-- Mapping the prover-side output of a strategy before execution is equivalent +to executing first and then mapping the prover component of the result. -/ +theorem runWithOracleCounterpart_mapOutputWithRoles + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (inputImpl : QueryImpl [OStmtIn]ₒ Id) + (spec : Spec) (roles : RoleDecoration spec) (od : OracleDecoration spec roles) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) + {OutputP OutputP' OutputC : Spec.Transcript spec → Type} + (fP : ∀ tr, OutputP tr → OutputP' tr) + (strat : Spec.Strategy.withRoles (OracleComp oSpec) spec roles OutputP) + (cpt : Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) OutputC) : + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl + (Spec.Strategy.mapOutputWithRoles fP strat) cpt = + (fun z => ⟨z.1, fP z.1 z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl strat cpt := by + let rec go + (spec : Spec) (roles : RoleDecoration spec) (od : OracleDecoration spec roles) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) + {OutputP OutputP' OutputC : Spec.Transcript spec → Type} + (fP : ∀ tr, OutputP tr → OutputP' tr) + (strat : Spec.Strategy.withRoles (OracleComp oSpec) spec roles OutputP) + (cpt : Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) OutputC) : + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl + (Spec.Strategy.mapOutputWithRoles fP strat) cpt = + (fun z => ⟨z.1, fP z.1 z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl strat cpt := by + match spec, roles, od with + | .done, roles, od => + cases roles + cases od + simp [runWithOracleCounterpart, Spec.Strategy.mapOutputWithRoles, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id] + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩ => + simp only [Spec.Strategy.mapOutputWithRoles, Spec.Counterpart.mapReceiver, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id, + runWithOracleCounterpart, bind_pure_comp, bind_map_left, map_bind, Functor.map_map] + refine congrArg (fun k => strat >>= k) ?_ + funext xc + let addPrefix : + ((tr : Spec.Transcript (rest xc.1)) × + (fun tr => OutputP' ⟨xc.1, tr⟩) tr × + (fun tr => OutputC ⟨xc.1, tr⟩) tr) → + ((tr : Spec.Transcript (Spec.node _ rest)) × OutputP' tr × OutputC tr) := + fun a => ⟨⟨xc.1, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + (Spec.Strategy.mapOutputWithRoles (fun tr => fP ⟨xc.1, tr⟩) xc.2) + (cpt xc.1) + = addPrefix <$> ((fun z => ⟨z.1, fP ⟨xc.1, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) + (odRest xc.1) (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + xc.2 (cpt xc.1)) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + (fun tr => fP ⟨xc.1, tr⟩) + xc.2 + (cpt xc.1)) + _ = (fun z => ⟨⟨xc.1, z.1⟩, fP ⟨xc.1, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + xc.2 (cpt xc.1) := by + simp [addPrefix, Functor.map_map] + | .node _ rest, ⟨.receiver, rRest⟩, odFn => + simp only [runWithOracleCounterpart, Spec.Strategy.mapOutputWithRoles, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id, + bind_pure_comp, bind_map_left, map_bind, Functor.map_map] + let routeImpl : + QueryImpl ((oSpec + [OStmtIn]ₒ) + accSpec) (OracleComp oSpec) := + fun + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q) + refine congrArg (fun k => simulateQ routeImpl cpt >>= k) ?_ + funext xc + refine congrArg (fun k => strat xc.1 >>= k) ?_ + funext next + let addPrefix : + ((tr : Spec.Transcript (rest xc.1)) × + (fun tr => OutputP' ⟨xc.1, tr⟩) tr × + (fun tr => OutputC ⟨xc.1, tr⟩) tr) → + ((tr : Spec.Transcript (Spec.node _ rest)) × OutputP' tr × OutputC tr) := + fun a => ⟨⟨xc.1, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl + (Spec.Strategy.mapOutputWithRoles (fun tr => fP ⟨xc.1, tr⟩) next) + xc.2 + = addPrefix <$> ((fun z => ⟨z.1, fP ⟨xc.1, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) + (odFn xc.1) accSpec accImpl next xc.2) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl + (fun tr => fP ⟨xc.1, tr⟩) + next + xc.2) + _ = (fun z => ⟨⟨xc.1, z.1⟩, fP ⟨xc.1, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl next xc.2 := by + simp [addPrefix, Functor.map_map] + exact go spec roles od accSpec accImpl fP strat cpt + +/-- Mapping the honest prover's private witness output after executing an oracle +reduction is equivalent to first mapping the honest prover output of its +strategy and then executing. -/ +theorem OracleReduction.mapExecuteWitness_eq_execute_mappedOutput + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt : Input → Type} + {WitnessIn : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut₁ WitnessOut₂ : (i : Input) → Spec.Transcript (Context i) → Type} + (reduction : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn + StatementOut OStmtOut WitnessOut₁) + (i : Input) + (s : StatementWithOracles LocalStmt OStmtIn i) + (w : WitnessIn i) + (liftWitness : (tr : Spec.Transcript (Context i)) → + WitnessOut₁ i tr → WitnessOut₂ i tr) : + (OracleReduction.mapExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut₁ := WitnessOut₁) + (WitnessOut₂ := WitnessOut₂) + (i := i) + (s := s) + liftWitness) <$> + reduction.executeConcrete i s w = + (do + let strategy ← reduction.prover i s w + let a ← + runWithOracleCounterpart + (OracleInterface.simOracle0 (OStmtIn i) s.oracleStmt) + (Context i) (Roles i) (oracleDeco i) []ₒ (fun q => q.elim) + (Spec.Strategy.mapOutputWithRoles + (fun tr out => + (⟨out.stmt, liftWitness tr out.wit⟩ : + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut₂ i tr))) + strategy) + (reduction.verifier i []ₒ s.stmt) + pure + ((⟨a.1, a.2.1, ⟨a.2.2, reduction.simulate i a.1⟩⟩ : + (tr : Spec.Transcript (Context i)) × + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut i tr) (fun _ => OStmtOut i tr) i) + (WitnessOut₂ i tr) × + (StatementOut i tr × QueryImpl [OStmtOut i tr]ₒ + (OracleComp + ([OStmtIn i]ₒ + toOracleSpec (Context i) (Roles i) + (oracleDeco i) tr)))))) := by + simp [OracleReduction.executeConcrete, OracleReduction.mapExecuteWitness, + runWithOracleCounterpart_mapOutputWithRoles, Functor.map_map] + +/-- Mapping the verifier-side output of a monadic counterpart before execution +is equivalent to executing first and then mapping the verifier component of the +result. -/ +theorem runWithOracleCounterpart_mapCounterpartOutput + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (inputImpl : QueryImpl [OStmtIn]ₒ Id) + (spec : Spec) (roles : RoleDecoration spec) (od : OracleDecoration spec roles) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) + {OutputP OutputC OutputC' : Spec.Transcript spec → Type} + (fC : ∀ tr, OutputC tr → OutputC' tr) + (strat : Spec.Strategy.withRoles (OracleComp oSpec) spec roles OutputP) + (cpt : Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) OutputC) : + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl + strat + (Spec.Counterpart.withMonads.mapOutput spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) fC cpt) = + (fun z => ⟨z.1, z.2.1, fC z.1 z.2.2⟩) <$> + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl strat cpt := by + let rec go + (spec : Spec) (roles : RoleDecoration spec) (od : OracleDecoration spec roles) + {ιₐ : Type} (accSpec : OracleSpec ιₐ) (accImpl : QueryImpl accSpec Id) + {OutputP OutputC OutputC' : Spec.Transcript spec → Type} + (fC : ∀ tr, OutputC tr → OutputC' tr) + (strat : Spec.Strategy.withRoles (OracleComp oSpec) spec roles OutputP) + (cpt : Spec.Counterpart.withMonads spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) OutputC) : + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl + strat + (Spec.Counterpart.withMonads.mapOutput spec roles + (toMonadDecoration oSpec OStmtIn spec roles od accSpec) fC cpt) = + (fun z => ⟨z.1, z.2.1, fC z.1 z.2.2⟩) <$> + runWithOracleCounterpart inputImpl spec roles od accSpec accImpl strat cpt := by + match spec, roles, od with + | .done, roles, od => + cases roles + cases od + rw [Spec.Counterpart.withMonads.mapOutput_done] + simp [runWithOracleCounterpart] + | .node _ rest, ⟨.sender, rRest⟩, ⟨oi, odRest⟩ => + have hMap : + Spec.Counterpart.withMonads.mapOutput + (Spec.node _ rest) ⟨.sender, rRest⟩ + (toMonadDecoration oSpec OStmtIn (Spec.node _ rest) ⟨.sender, rRest⟩ + ⟨oi, odRest⟩ accSpec) + fC cpt = + fun x => + Spec.Counterpart.withMonads.mapOutput + (rest x) (rRest x) + (toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odRest x) + (accSpec + @OracleInterface.spec _ oi)) + (fun tr => fC ⟨x, tr⟩) (cpt x) := by + rfl + rw [hMap] + simp only [runWithOracleCounterpart, + bind_pure_comp, map_bind, Functor.map_map] + refine congrArg (fun k => strat >>= k) ?_ + funext xc + let addPrefix : + ((tr : Spec.Transcript (rest xc.1)) × + (fun tr => OutputP ⟨xc.1, tr⟩) tr × + (fun tr => OutputC' ⟨xc.1, tr⟩) tr) → + ((tr : Spec.Transcript (Spec.node _ rest)) × OutputP tr × OutputC' tr) := + fun a => ⟨⟨xc.1, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) xc.2 + (Spec.Counterpart.withMonads.mapOutput (rest xc.1) (rRest xc.1) + (toMonadDecoration oSpec OStmtIn (rest xc.1) (rRest xc.1) + (odRest xc.1) (accSpec + @OracleInterface.spec _ oi)) + (fun tr => fC ⟨xc.1, tr⟩) (cpt xc.1)) + = addPrefix <$> ((fun z => ⟨z.1, z.2.1, fC ⟨xc.1, z.1⟩ z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) + (odRest xc.1) (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + xc.2 (cpt xc.1)) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + (fun tr => fC ⟨xc.1, tr⟩) + xc.2 + (cpt xc.1)) + _ = (fun z => ⟨⟨xc.1, z.1⟩, z.2.1, fC ⟨xc.1, z.1⟩ z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odRest xc.1) + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run xc.1)) + xc.2 (cpt xc.1) := by + simp [addPrefix, Functor.map_map] + | .node _ rest, ⟨.receiver, rRest⟩, odFn => + let routeImpl : + QueryImpl ((oSpec + [OStmtIn]ₒ) + accSpec) (OracleComp oSpec) := + fun + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q) + let mapCpt : + ((x : _) × + Spec.Counterpart.withMonads (rest x) (rRest x) + (toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odFn x) accSpec) + (fun tr => OutputC ⟨x, tr⟩)) → + ((x : _) × + Spec.Counterpart.withMonads (rest x) (rRest x) + (toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odFn x) accSpec) + (fun tr => OutputC' ⟨x, tr⟩)) := + fun xc => + ⟨xc.1, + Spec.Counterpart.withMonads.mapOutput + (rest xc.1) (rRest xc.1) + (toMonadDecoration oSpec OStmtIn (rest xc.1) (rRest xc.1) + (odFn xc.1) accSpec) + (fun tr => fC ⟨xc.1, tr⟩) xc.2⟩ + have hSim : simulateQ routeImpl (mapCpt <$> cpt) = + mapCpt <$> simulateQ routeImpl cpt := + simulateQ_map routeImpl mapCpt cpt + have hMap : + Spec.Counterpart.withMonads.mapOutput + (Spec.node _ rest) ⟨.receiver, rRest⟩ + (toMonadDecoration oSpec OStmtIn (Spec.node _ rest) ⟨.receiver, rRest⟩ + odFn accSpec) + fC cpt = + mapCpt <$> cpt := by + rfl + rw [hMap] + simp only [runWithOracleCounterpart] + dsimp [routeImpl] at hSim + change + (simulateQ + (fun x => + match x with + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q)) + (mapCpt <$> cpt) >>= fun z' => + strat z'.1 >>= fun next => + runWithOracleCounterpart inputImpl (rest z'.1) (rRest z'.1) + (odFn z'.1) accSpec accImpl next z'.2 >>= fun z => + pure + ((⟨⟨z'.1, z.1⟩, (z.2.1, z.2.2)⟩ : + (tr : Spec.Transcript (Spec.node _ rest)) × + OutputP tr × OutputC' tr))) = _ + trans + ((mapCpt <$> + simulateQ + (fun x => + match x with + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q)) + cpt) >>= fun z' => + strat z'.1 >>= fun next => + runWithOracleCounterpart inputImpl (rest z'.1) (rRest z'.1) + (odFn z'.1) accSpec accImpl next z'.2 >>= fun z => + pure + ((⟨⟨z'.1, z.1⟩, (z.2.1, z.2.2)⟩ : + (tr : Spec.Transcript (Spec.node _ rest)) × + OutputP tr × OutputC' tr))) + · exact congrArg + (fun m => + m >>= fun z' => + strat z'.1 >>= fun next => + runWithOracleCounterpart inputImpl (rest z'.1) (rRest z'.1) + (odFn z'.1) accSpec accImpl next z'.2 >>= fun z => + pure + ((⟨⟨z'.1, z.1⟩, (z.2.1, z.2.2)⟩ : + (tr : Spec.Transcript (Spec.node _ rest)) × + OutputP tr × OutputC' tr))) + hSim + simp only [bind_map_left, bind_pure_comp, map_bind, Functor.map_map] + refine congrArg (fun k => simulateQ routeImpl cpt >>= k) ?_ + funext xc + refine congrArg (fun k => strat xc.1 >>= k) ?_ + funext next + let addPrefix : + ((tr : Spec.Transcript (rest xc.1)) × + (fun tr => OutputP ⟨xc.1, tr⟩) tr × + (fun tr => OutputC' ⟨xc.1, tr⟩) tr) → + ((tr : Spec.Transcript (Spec.node _ rest)) × OutputP tr × OutputC' tr) := + fun a => ⟨⟨xc.1, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl next + (Spec.Counterpart.withMonads.mapOutput (rest xc.1) (rRest xc.1) + (toMonadDecoration oSpec OStmtIn (rest xc.1) (rRest xc.1) + (odFn xc.1) accSpec) + (fun tr => fC ⟨xc.1, tr⟩) xc.2) + = addPrefix <$> ((fun z => ⟨z.1, z.2.1, fC ⟨xc.1, z.1⟩ z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) + (odFn xc.1) accSpec accImpl next xc.2) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl + (fun tr => fC ⟨xc.1, tr⟩) + next + xc.2) + _ = (fun z => ⟨⟨xc.1, z.1⟩, z.2.1, fC ⟨xc.1, z.1⟩ z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest xc.1) (rRest xc.1) (odFn xc.1) + accSpec accImpl next xc.2 := by + simp [addPrefix, Functor.map_map] + exact go spec roles od accSpec accImpl fC strat cpt + +/-- Public execution is just full honest execution with the prover's private +witness component erased afterwards. -/ +theorem OracleReduction.executePublic_eq_map_execute + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt WitnessIn : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut : (i : Input) → Spec.Transcript (Context i) → Type} + (reduction : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn + StatementOut OStmtOut WitnessOut) + (i : Input) (s : StatementWithOracles LocalStmt OStmtIn i) (w : WitnessIn i) : + reduction.executePublicConcrete i s w = + (OracleReduction.forgetExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut := WitnessOut) + (i := i) + (s := s)) <$> reduction.executeConcrete i s w := by + unfold OracleReduction.executePublicConcrete OracleReduction.executeConcrete + OracleReduction.forgetExecuteWitness + simp [runWithOracleCounterpart_mapOutputWithRoles] + +/-- Honest execution equivalence implies honest public equivalence by erasing +the private prover witnesses. -/ +theorem OracleReduction.HonestExecutionEquivalent.toPublic + {ι : Type} {oSpec : OracleSpec ι} + {Input : Type} {ιₛᵢ : Input → Type} + {OStmtIn : (i : Input) → ιₛᵢ i → Type} + [∀ i j, OracleInterface (OStmtIn i j)] + {Context : Input → Spec} + {Roles : (i : Input) → RoleDecoration (Context i)} + {oracleDeco : (i : Input) → OracleDecoration (Context i) (Roles i)} + {LocalStmt WitnessIn₁ WitnessIn₂ : Input → Type} + {StatementOut : (i : Input) → Spec.Transcript (Context i) → Type} + {ιₛₒ : (i : Input) → (tr : Spec.Transcript (Context i)) → Type} + {OStmtOut : (i : Input) → (tr : Spec.Transcript (Context i)) → ιₛₒ i tr → Type} + [∀ i tr j, OracleInterface (OStmtOut i tr j)] + {WitnessOut₁ WitnessOut₂ : (i : Input) → Spec.Transcript (Context i) → Type} + {liftWitnessIn : + (i : Input) → StatementWithOracles LocalStmt OStmtIn i → WitnessIn₁ i → WitnessIn₂ i} + {liftWitnessOut : + (i : Input) → (s : StatementWithOracles LocalStmt OStmtIn i) → + (tr : Spec.Transcript (Context i)) → + WitnessOut₁ i tr → WitnessOut₂ i tr} + {reduction₁ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₁ + StatementOut OStmtOut WitnessOut₁} + {reduction₂ : OracleReduction oSpec Input Context Roles oracleDeco LocalStmt OStmtIn WitnessIn₂ + StatementOut OStmtOut WitnessOut₂} + (hEq : OracleReduction.HonestExecutionEquivalent + liftWitnessIn liftWitnessOut reduction₁ reduction₂) : + OracleReduction.HonestPubliclyEquivalent liftWitnessIn reduction₁ reduction₂ := by + intro i s w + have hForget : + (OracleReduction.forgetExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut := WitnessOut₂) + (i := i) + (s := s)) ∘ + (OracleReduction.mapExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut₁ := WitnessOut₁) + (WitnessOut₂ := WitnessOut₂) + (i := i) + (s := s) + (liftWitness := liftWitnessOut i s)) = + (OracleReduction.forgetExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut := WitnessOut₁) + (i := i) + (s := s)) := by + funext z + cases z + rfl + rw [OracleReduction.executePublic_eq_map_execute, + OracleReduction.executePublic_eq_map_execute] + simpa [Functor.map_map, Function.comp, hForget] using + congrArg + (Functor.map <| + OracleReduction.forgetExecuteWitness + (oSpec := oSpec) + (Context := Context) + (Roles := Roles) + (oracleDeco := oracleDeco) + (LocalStmt := LocalStmt) + (StatementOut := StatementOut) + (OStmtOut := OStmtOut) + (WitnessOut := WitnessOut₂) + (i := i) + (s := s)) + (hEq i s w) + +end OracleDecoration + +/-! ## Execution for Oracle.Spec-based reductions -/ + +namespace Oracle + +/-- Run a prover strategy against a verifier counterpart on `Oracle.Spec`, +threading accumulated oracle access. This is the `Oracle.Spec` analog of +`OracleDecoration.runWithOracleCounterpart`. -/ +def Spec.runWithOracleCounterpart + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (inputImpl : QueryImpl [OStmtIn]ₒ Id) : + (s : Spec) → (roles : Spec.RoleDeco s) → (od : Spec.OracleDeco s) → + {ιₐ : Type} → (accSpec : OracleSpec.{0, 0} ιₐ) → QueryImpl accSpec Id → + {OutputP OutputC : Interaction.Spec.Transcript s.toInteractionSpec → Type} → + Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + s.toInteractionSpec (s.toSpecRoles roles) OutputP → + Interaction.Spec.Counterpart.withMonads s.toInteractionSpec (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmtIn roles od accSpec) OutputC → + OracleComp oSpec ((tr : Interaction.Spec.Transcript s.toInteractionSpec) × + OutputP tr × OutputC tr) + | .done, _, _, _, _, _, _, _, output, cOutput => + pure ⟨⟨⟩, output, cOutput⟩ + | .«public» _ rest, ⟨.sender, rRest⟩, odRest, _, accSpec, accImpl, _, _, + send, dualFn => do + let ⟨x, next⟩ ← send + let z ← runWithOracleCounterpart inputImpl + (rest x) (rRest x) (odRest x) accSpec accImpl next (dualFn x) + return ⟨⟨x, z.1⟩, z.2.1, z.2.2⟩ + | .«public» X rest, ⟨.receiver, rRest⟩, odRest, _, accSpec, accImpl, OutputP, OutputC, + respond, dualSample => do + let routeImpl : QueryImpl ((oSpec + [OStmtIn]ₒ) + accSpec) (OracleComp oSpec) := + fun + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q) + have dualSample' : OracleComp ((oSpec + [OStmtIn]ₒ) + accSpec) _ := by + simpa using dualSample + let z' : Sigma (fun x => + Interaction.Spec.Counterpart.withMonads (rest x).toInteractionSpec + ((rest x).toSpecRoles (rRest x)) + ((rest x).toMonadDecoration oSpec OStmtIn (rRest x) (odRest x) accSpec) + (fun p => OutputC ⟨x, p⟩)) ← + simulateQ routeImpl dualSample' + let x := z'.1 + let dualRest := z'.2 + let next ← respond x + let z ← runWithOracleCounterpart inputImpl + (rest x) (rRest x) (odRest x) accSpec accImpl next dualRest + return ⟨⟨x, z.1⟩, z.2.1, z.2.2⟩ + | .oracle _ rest, roles, ⟨oi, odRest⟩, _, accSpec, accImpl, _, _, + send, dualFn => do + let ⟨x, next⟩ ← send + let implX : QueryImpl (@OracleInterface.spec _ oi) Id := + fun q => (oi.toOC.impl q).run x + let z ← runWithOracleCounterpart inputImpl + rest roles odRest (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl implX) next (dualFn x) + return ⟨⟨x, z.1⟩, z.2.1, z.2.2⟩ + +/-- Execute an `Oracle.Reduction` against concrete oracle input statements. +Produces the realized transcript, prover output (statement + oracle statements + +witness), and verifier output (statement + output oracle simulation). -/ +def Reduction.executeConcrete + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)} + {OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + {WitnessOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + (reduction : Oracle.Reduction oSpec SharedIn Context Roles OracleDeco StatementIn + OStatementIn WitnessIn StatementOut OStatementOut WitnessOut) + (shared : SharedIn) + (s : StatementWithOracles StatementIn OStatementIn shared) + (w : WitnessIn shared) : + OracleComp oSpec + ((tr : Interaction.Spec.Transcript (Context shared).toInteractionSpec) × + HonestProverOutput + (StatementWithOracles + (fun _ => StatementOut shared ((Context shared).projectPublic tr)) + (fun _ => OStatementOut shared ((Context shared).projectPublic tr)) + shared) + (WitnessOut shared ((Context shared).projectPublic tr)) × + (StatementOut shared ((Context shared).projectPublic tr) × + QueryImpl [OStatementOut shared ((Context shared).projectPublic tr)]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + (Context shared).toOracleSpec (OracleDeco shared) + ((Context shared).projectPublic tr))))) := do + let strategy ← reduction.prover shared s w + let ⟨tr, proverOut, stmtOutV⟩ ← + Spec.runWithOracleCounterpart + (OracleInterface.simOracle0 (OStatementIn shared) s.oracleStmt) + (Context shared) (Roles shared) (OracleDeco shared) []ₒ (fun q => q.elim) + strategy (reduction.verifier.toFun shared s.stmt) + pure ⟨tr, proverOut, + ⟨stmtOutV, + reduction.verifier.simulate shared ((Context shared).projectPublic tr)⟩⟩ + +/-- Run an arbitrary prover strategy against an `Oracle.Verifier`, producing the +full transcript, prover output, and the verifier's statement output paired with +its output oracle simulation. This is the `Oracle.Spec` analog of +`OracleVerifier.run`. -/ +def Verifier.run + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {SharedIn : Type} + {Context : SharedIn → Spec} + {Roles : (shared : SharedIn) → Spec.RoleDeco (Context shared)} + {OracleDeco : (shared : SharedIn) → Spec.OracleDeco (Context shared)} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {StatementOut : + (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {ιₛₒ : (shared : SharedIn) → Spec.PublicTranscript (Context shared) → Type} + {OStatementOut : + (shared : SharedIn) → (pt : Spec.PublicTranscript (Context shared)) → + ιₛₒ shared pt → Type} + [∀ shared pt i, OracleInterface (OStatementOut shared pt i)] + (verifier : Oracle.Verifier oSpec SharedIn Context Roles OracleDeco StatementIn + OStatementIn StatementOut OStatementOut) + (shared : SharedIn) + (stmt : StatementIn shared) + (inputImpl : QueryImpl [OStatementIn shared]ₒ Id) + {OutputP : Interaction.Spec.Transcript (Context shared).toInteractionSpec → Type} + (prover : Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + (Context shared).toInteractionSpec + ((Context shared).toSpecRoles (Roles shared)) OutputP) : + OracleComp oSpec + ((tr : Interaction.Spec.Transcript (Context shared).toInteractionSpec) × + OutputP tr × + (StatementOut shared ((Context shared).projectPublic tr) × + QueryImpl [OStatementOut shared ((Context shared).projectPublic tr)]ₒ + (OracleComp + ([OStatementIn shared]ₒ + + (Context shared).toOracleSpec (OracleDeco shared) + ((Context shared).projectPublic tr))))) := do + let ⟨tr, outP, stmtOutV⟩ ← + Spec.runWithOracleCounterpart inputImpl + (Context shared) (Roles shared) (OracleDeco shared) []ₒ (fun q => q.elim) + prover (verifier.toFun shared stmt) + pure ⟨tr, outP, + ⟨stmtOutV, + verifier.simulate shared ((Context shared).projectPublic tr)⟩⟩ + +/-- Mapping the prover-side output of a strategy before execution is equivalent +to executing first and then mapping the prover component of the result. +This is the `Oracle.Spec` analog of +`OracleDecoration.runWithOracleCounterpart_mapOutputWithRoles`. -/ +theorem Spec.runWithOracleCounterpart_mapOutputWithRoles + {ι : Type} {oSpec : OracleSpec.{0, 0} ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + (inputImpl : QueryImpl [OStmtIn]ₒ Id) : + (s : Spec) → (roles : Spec.RoleDeco s) → (od : Spec.OracleDeco s) → + {ιₐ : Type} → (accSpec : OracleSpec.{0, 0} ιₐ) → (accImpl : QueryImpl accSpec Id) → + {OutputP OutputP' OutputC : Interaction.Spec.Transcript s.toInteractionSpec → Type} → + (fP : ∀ tr, OutputP tr → OutputP' tr) → + (strat : Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + s.toInteractionSpec (s.toSpecRoles roles) OutputP) → + (cpt : Interaction.Spec.Counterpart.withMonads s.toInteractionSpec (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmtIn roles od accSpec) OutputC) → + Spec.runWithOracleCounterpart inputImpl s roles od accSpec accImpl + (Interaction.Spec.Strategy.mapOutputWithRoles fP strat) cpt = + (fun z => ⟨z.1, fP z.1 z.2.1, z.2.2⟩) <$> + Spec.runWithOracleCounterpart inputImpl s roles od accSpec accImpl strat cpt := by + intro s roles od ιₐ accSpec accImpl OutputP OutputP' OutputC fP strat cpt + let rec go + (s : Spec) (roles : Spec.RoleDeco s) (od : Spec.OracleDeco s) + {ιₐ : Type} (accSpec : OracleSpec.{0, 0} ιₐ) (accImpl : QueryImpl accSpec Id) + {OutputP OutputP' OutputC : Interaction.Spec.Transcript s.toInteractionSpec → Type} + (fP : ∀ tr, OutputP tr → OutputP' tr) + (strat : Interaction.Spec.Strategy.withRoles (OracleComp oSpec) + s.toInteractionSpec (s.toSpecRoles roles) OutputP) + (cpt : Interaction.Spec.Counterpart.withMonads s.toInteractionSpec (s.toSpecRoles roles) + (s.toMonadDecoration oSpec OStmtIn roles od accSpec) OutputC) : + Spec.runWithOracleCounterpart inputImpl s roles od accSpec accImpl + (Interaction.Spec.Strategy.mapOutputWithRoles fP strat) cpt = + (fun z => ⟨z.1, fP z.1 z.2.1, z.2.2⟩) <$> + Spec.runWithOracleCounterpart inputImpl s roles od accSpec accImpl strat cpt := by + match s, roles, od with + | .done, _, _ => + rfl + | .«public» _X rest, ⟨.sender, rRest⟩, odRest => + simp only [Spec.toInteractionSpec, Spec.toSpecRoles, + Interaction.Spec.Strategy.mapOutputWithRoles, + Interaction.Spec.Counterpart.mapReceiver, Spec.runWithOracleCounterpart, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id, + bind_pure_comp, bind_map_left, map_bind, Functor.map_map] + refine congrArg (fun k => strat >>= k) ?_ + funext ⟨x, next⟩ + let addPrefix : + ((tr : Interaction.Spec.Transcript (rest x).toInteractionSpec) × + OutputP' ⟨x, tr⟩ × OutputC ⟨x, tr⟩) → + ((tr : Interaction.Spec.Transcript + (Oracle.Spec.public _X rest).toInteractionSpec) × + OutputP' tr × OutputC tr) := + fun a => ⟨⟨x, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl + (Spec.Strategy.mapOutputWithRoles (fun tr => fP ⟨x, tr⟩) next) + (cpt x) + = addPrefix <$> ((fun z => ⟨z.1, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl next (cpt x)) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest x) (rRest x) (odRest x) accSpec accImpl + (fun tr => fP ⟨x, tr⟩) next (cpt x)) + _ = (fun z => ⟨⟨x, z.1⟩, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl next (cpt x) := by + simp [addPrefix, Functor.map_map] + | .«public» _X rest, ⟨.receiver, rRest⟩, odRest => + simp only [Spec.toInteractionSpec, Spec.toSpecRoles, Spec.runWithOracleCounterpart, + Interaction.Spec.Strategy.mapOutputWithRoles, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id, + bind_pure_comp, bind_map_left, map_bind, Functor.map_map] + let routeImpl : QueryImpl ((oSpec + [OStmtIn]ₒ) + accSpec) (OracleComp oSpec) := + fun + | .inl (.inl q) => liftM (oSpec.query q) + | .inl (.inr q) => liftM (inputImpl q) + | .inr q => liftM (accImpl q) + refine congrArg (fun k => simulateQ routeImpl cpt >>= k) ?_ + funext ⟨x, cptRest⟩ + refine congrArg (fun k => strat x >>= k) ?_ + funext next + let addPrefix : + ((tr : Interaction.Spec.Transcript (rest x).toInteractionSpec) × + OutputP' ⟨x, tr⟩ × OutputC ⟨x, tr⟩) → + ((tr : Interaction.Spec.Transcript + (Oracle.Spec.public _X rest).toInteractionSpec) × + OutputP' tr × OutputC tr) := + fun a => ⟨⟨x, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl + (Spec.Strategy.mapOutputWithRoles (fun tr => fP ⟨x, tr⟩) next) + cptRest + = addPrefix <$> ((fun z => ⟨z.1, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl next cptRest) := by + exact congrArg (fun z => addPrefix <$> z) + (go (rest x) (rRest x) (odRest x) accSpec accImpl + (fun tr => fP ⟨x, tr⟩) next cptRest) + _ = (fun z => ⟨⟨x, z.1⟩, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl (rest x) (rRest x) (odRest x) + accSpec accImpl next cptRest := by + simp [addPrefix, Functor.map_map] + | .oracle _X rest, roles, ⟨oi, odRest⟩ => + simp only [Spec.toInteractionSpec, Spec.toSpecRoles, + Interaction.Spec.Strategy.mapOutputWithRoles, + Interaction.Spec.Counterpart.mapReceiver, Spec.runWithOracleCounterpart, + StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id, + bind_pure_comp, bind_map_left, map_bind, Functor.map_map] + refine congrArg (fun k => strat >>= k) ?_ + funext ⟨x, next⟩ + let addPrefix : + ((tr : Interaction.Spec.Transcript rest.toInteractionSpec) × + OutputP' ⟨x, tr⟩ × OutputC ⟨x, tr⟩) → + ((tr : Interaction.Spec.Transcript + (Oracle.Spec.oracle _X rest).toInteractionSpec) × + OutputP' tr × OutputC tr) := + fun a => ⟨⟨x, a.1⟩, a.2.1, a.2.2⟩ + calc + addPrefix <$> + runWithOracleCounterpart inputImpl rest roles odRest + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run x)) + (Spec.Strategy.mapOutputWithRoles (fun tr => fP ⟨x, tr⟩) next) + (cpt x) + = addPrefix <$> ((fun z => ⟨z.1, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl rest roles odRest + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run x)) + next (cpt x)) := by + exact congrArg (fun z => addPrefix <$> z) + (go rest roles odRest + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run x)) + (fun tr => fP ⟨x, tr⟩) next (cpt x)) + _ = (fun z => ⟨⟨x, z.1⟩, fP ⟨x, z.1⟩ z.2.1, z.2.2⟩) <$> + runWithOracleCounterpart inputImpl rest roles odRest + (accSpec + @OracleInterface.spec _ oi) + (QueryImpl.add accImpl (fun q => (oi.toOC.impl q).run x)) + next (cpt x) := by + simp [addPrefix, Functor.map_map] + exact go s roles od accSpec accImpl fP strat cpt + +end Oracle + +end Interaction diff --git a/ArkLib/Interaction/Oracle/Spec.lean b/ArkLib/Interaction/Oracle/Spec.lean new file mode 100644 index 0000000000..c06d082d71 --- /dev/null +++ b/ArkLib/Interaction/Oracle/Spec.lean @@ -0,0 +1,588 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import PolyFun.Interaction.Basic.Spec +import PolyFun.Interaction.Basic.Append +import PolyFun.Interaction.TwoParty.Strategy +import ArkLib.OracleReduction.OracleInterface + +/-! +# Oracle Protocol Specification + +`Oracle.Spec` is the canonical protocol specification for oracle reductions. +It distinguishes two kinds of message nodes: + +- `.public X rest`: the continuation depends on the message value `x : X`. Used + for plain sender messages (metadata) and receiver messages (challenges). Both + parties see the message value directly. + +- `.oracle X rest`: the continuation is structurally constant. Used for oracle + sender messages: the prover sends the message, but the verifier only accesses + it through oracle queries. The key invariant is that `rest : Oracle.Spec` does + not depend on the message, so all downstream types are definitionally + independent of the oracle message value. + +This structural distinction gives: +- **`PublicTranscript`**: transcript of `.public` nodes only, the verifier's + direct view of the interaction. +- **`QueryHandle` / `toOracleSpec`**: indexed by `PublicTranscript`, not by the + full transcript. No casts needed for oracle spec composition. +- **`toMonadDecoration`**: at `.oracle` nodes the monad is `Id` (verifier ignores + the message), but the accumulated oracle spec grows for subsequent queries. + +## Main definitions + +### Core types +- `Oracle.Spec` — the inductive type with `.done`, `.public`, `.oracle`. +- `Spec.RoleDeco` — role assignment on `.public` nodes only. +- `Spec.OracleDeco` — oracle interface assignment on `.oracle` nodes only. + +### Forgetful map +- `Spec.toInteractionSpec` — convert to `Interaction.Spec` (W-type). +- `Spec.toSpecRoles` — lift role decoration. + +### Transcripts +- `Spec.PublicTranscript` — transcript of `.public` nodes (verifier's view). +- `Spec.projectPublic` — project full transcript to `PublicTranscript`. + +### Oracle query infrastructure +- `Spec.QueryHandle` — query index type, indexed by `PublicTranscript`. +- `Spec.toOracleSpec` — oracle spec, indexed by `PublicTranscript`. +- `Spec.answerQuery` — answer queries using full transcript data. + +### Verifier monad decoration +- `Spec.toMonadDecoration` — per-node monad assignment for the verifier. +-/ + +universe u + +open OracleComp OracleSpec + +namespace Interaction.Oracle + +open Interaction.TwoParty + +/-- The canonical protocol specification for oracle reductions. + +- `.public X rest`: a public message node. The continuation depends on the + message `x : X`. Used for plain sender messages and receiver challenges. +- `.oracle X rest`: an oracle message node. The continuation is structurally + constant (does not depend on the message). Used for prover oracle messages + that the verifier accesses only through queries. +- `.done`: end of protocol. -/ +inductive Spec : Type 1 where + | done : Spec + | «public» (X : Type) (rest : X → Spec) : Spec + | oracle (X : Type) (rest : Spec) : Spec + +namespace Spec + +/-! ## Role and oracle decorations -/ + +/-- Role assignment for an `Oracle.Spec`. Only `.public` nodes carry a role +(`sender` or `receiver`). `.oracle` nodes are always sender, so no annotation +is stored. -/ +def RoleDeco : Oracle.Spec → Type + | .done => PUnit + | .«public» _ rest => Role × ((x : _) → RoleDeco (rest x)) + | .oracle _ rest => RoleDeco rest + +/-- Oracle interface assignment. `.oracle` nodes carry an `OracleInterface` +(defining the query-response structure). `.public` nodes just recurse. -/ +def OracleDeco : Oracle.Spec → Type 1 + | .done => PUnit + | .«public» _ rest => (x : _) → OracleDeco (rest x) + | .oracle X rest => OracleInterface X × OracleDeco rest + +/-! ## Forgetful map to Interaction.Spec -/ + +/-- Convert an `Oracle.Spec` to a plain `Interaction.Spec`. `.oracle` nodes +become nodes with *definitionally constant* continuation. -/ +def toInteractionSpec : Oracle.Spec → Interaction.Spec + | .done => .done + | .«public» X rest => .node X (fun x => (rest x).toInteractionSpec) + | .oracle X rest => .node X (fun _ => rest.toInteractionSpec) + +/-- Lift role decoration to `RoleDecoration` on `toInteractionSpec`. `.oracle` +nodes are always `.sender`. -/ +def toSpecRoles : (s : Oracle.Spec) → RoleDeco s → RoleDecoration s.toInteractionSpec + | .done, _ => ⟨⟩ + | .«public» _ rest, ⟨role, rRest⟩ => + ⟨role, fun x => toSpecRoles (rest x) (rRest x)⟩ + | .oracle _ rest, roles => + ⟨.sender, fun _ => toSpecRoles rest roles⟩ + +/-! ## Public transcript -/ + +/-- The *public transcript* contains only `.public` node messages (challenges +and plain sender messages). All `.oracle` messages are dropped. This is the +verifier's direct view of the interaction, without oracle queries. -/ +def PublicTranscript : Oracle.Spec → Type + | .done => PUnit + | .«public» X rest => (x : X) × PublicTranscript (rest x) + | .oracle _ rest => PublicTranscript rest + +/-- Project a full `Interaction.Spec.Transcript` to the `PublicTranscript`. -/ +def projectPublic : + (s : Oracle.Spec) → + Interaction.Spec.Transcript s.toInteractionSpec → PublicTranscript s + | .done, _ => ⟨⟩ + | .«public» _ rest, ⟨x, tr⟩ => ⟨x, projectPublic (rest x) tr⟩ + | .oracle _ rest, ⟨_, tr⟩ => projectPublic rest tr + +/-! ## Oracle query infrastructure -/ + +/-- Index type for oracle queries, parameterized by `PublicTranscript`. +At `.oracle` nodes, the verifier can query the current node's oracle interface +(`.inl q`) or recurse into subsequent oracles (`.inr h`). At `.public` nodes, +the transcript determines which subtree to recurse into. -/ +def QueryHandle : + (s : Oracle.Spec) → OracleDeco s → PublicTranscript s → Type + | .done, _, _ => Empty + | .«public» _ rest, odRest, ⟨x, pt⟩ => + QueryHandle (rest x) (odRest x) pt + | .oracle _X rest, ⟨oi, odRest⟩, pt => + oi.Query ⊕ QueryHandle rest odRest pt + +/-- The oracle specification for querying oracle messages along a given +`PublicTranscript` path. Maps each `QueryHandle` to its response type. -/ +def toOracleSpec : + (s : Oracle.Spec) → (od : OracleDeco s) → + (pt : PublicTranscript s) → OracleSpec (QueryHandle s od pt) + | .done, _, _ => fun q => q.elim + | .«public» _ rest, odRest, ⟨x, pt⟩ => + toOracleSpec (rest x) (odRest x) pt + | .oracle _X rest, ⟨oi, odRest⟩, pt => fun + | .inl q => oi.toOC.spec q + | .inr handle => toOracleSpec rest odRest pt handle + +/-- Answer oracle queries using the message values from a full transcript. +At each `.oracle` node, the transcript provides the actual message `x : X`, +which is used to compute responses via `OracleInterface`. -/ +def answerQuery : + (s : Oracle.Spec) → (od : OracleDeco s) → + (tr : Interaction.Spec.Transcript s.toInteractionSpec) → + QueryImpl (toOracleSpec s od (s.projectPublic tr)) Id + | .done, _, _ => fun q => q.elim + | .«public» _ rest, odRest, ⟨x, tr⟩ => + answerQuery (rest x) (odRest x) tr + | .oracle _X rest, ⟨oi, odRest⟩, ⟨x, tr⟩ => fun + | .inl q => (oi.toOC.impl q).run x + | .inr handle => answerQuery rest odRest tr handle + +/-! ## Verifier monad decoration -/ + +/-- Compute the per-node `MonadDecoration` for the verifier on `toInteractionSpec`. + +- At `.oracle` nodes: monad is `Id` (verifier ignores the message value), + but the accumulated oracle spec grows (verifier can query this oracle at + subsequent `.public .receiver` nodes). +- At `.public .sender` nodes: monad is `Id`, no accumulation. +- At `.public .receiver` nodes: monad is `OracleComp` with full accumulated + access (external oracles + input oracle statements + accumulated oracle + messages). -/ +def toMonadDecoration {ι : Type} (oSpec : OracleSpec.{0, 0} ι) + {ιₛᵢ : Type} (OStmtIn : ιₛᵢ → Type) [∀ i, OracleInterface.{0, 0} (OStmtIn i)] : + (s : Oracle.Spec) → (roles : RoleDeco s) → (od : OracleDeco s) → + {ιₐ : Type} → OracleSpec.{0, 0} ιₐ → + Interaction.Spec.MonadDecoration s.toInteractionSpec + | .done, _, _, _, _ => ⟨⟩ + | .«public» _ rest, ⟨.sender, rRest⟩, odRest, _, accSpec => + ⟨⟨Id, inferInstance⟩, + fun x => toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odRest x) accSpec⟩ + | .«public» _ rest, ⟨.receiver, rRest⟩, odRest, _, accSpec => + ⟨⟨OracleComp (oSpec + [OStmtIn]ₒ + accSpec), inferInstance⟩, + fun x => toMonadDecoration oSpec OStmtIn (rest x) (rRest x) (odRest x) accSpec⟩ + | .oracle _ rest, roles, ⟨oi, odRest⟩, _, accSpec => + ⟨⟨Id, inferInstance⟩, + fun _ => toMonadDecoration oSpec OStmtIn rest roles odRest + (accSpec + @OracleInterface.spec _ oi)⟩ + +/-! ## Sequential composition -/ + +/-- Sequential composition of `Oracle.Spec`: run `s₁` first, then continue with +`s₂ pt₁` where `pt₁ : PublicTranscript s₁` records the public messages from the +first phase. At `.oracle` nodes the suffix is passed through unchanged, since +oracle messages do not appear in `PublicTranscript`. -/ +def append : (s₁ : Oracle.Spec) → (PublicTranscript s₁ → Oracle.Spec) → Oracle.Spec + | .done, s₂ => s₂ ⟨⟩ + | .«public» X rest, s₂ => .«public» X (fun x => (rest x).append (fun pt => s₂ ⟨x, pt⟩)) + | .oracle X rest, s₂ => .oracle X (rest.append s₂) + +/-- Role decoration for an appended `Oracle.Spec`. -/ +def RoleDeco.append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + RoleDeco s₁ → ((pt : PublicTranscript s₁) → RoleDeco (s₂ pt)) → RoleDeco (s₁.append s₂) + | .done, _, _, r₂ => r₂ ⟨⟩ + | .«public» _ rest, s₂, ⟨role, rRest⟩, r₂ => + ⟨role, fun x => RoleDeco.append (rest x) (fun pt => s₂ ⟨x, pt⟩) + (rRest x) (fun pt => r₂ ⟨x, pt⟩)⟩ + | .oracle _ rest, s₂, r₁, r₂ => RoleDeco.append rest s₂ r₁ r₂ + +/-- Oracle decoration for an appended `Oracle.Spec`. -/ +def OracleDeco.append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + OracleDeco s₁ → ((pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + OracleDeco (s₁.append s₂) + | .done, _, _, od₂ => od₂ ⟨⟩ + | .«public» _ rest, s₂, od₁, od₂ => + fun x => OracleDeco.append (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) + | .oracle _ rest, s₂, ⟨oi, odRest⟩, od₂ => + ⟨oi, OracleDeco.append rest s₂ odRest od₂⟩ + +/-- `PublicTranscript` of an appended spec decomposes into a prefix and suffix. -/ +def PublicTranscript.append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → + PublicTranscript (s₁.append s₂) + | .done, _, _, pt₂ => pt₂ + | .«public» _ rest, s₂, ⟨x, pt₁⟩, pt₂ => + ⟨x, PublicTranscript.append (rest x) (fun pt => s₂ ⟨x, pt⟩) pt₁ pt₂⟩ + | .oracle _ rest, s₂, pt₁, pt₂ => + PublicTranscript.append rest s₂ pt₁ pt₂ + +/-- Split a `PublicTranscript` of an appended spec into prefix and suffix. -/ +def PublicTranscript.split : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + PublicTranscript (s₁.append s₂) → + (pt₁ : PublicTranscript s₁) × PublicTranscript (s₂ pt₁) + | .done, _, pt => ⟨⟨⟩, pt⟩ + | .«public» _ rest, s₂, ⟨x, ptRest⟩ => + let ⟨pt₁, pt₂⟩ := PublicTranscript.split (rest x) (fun pt => s₂ ⟨x, pt⟩) ptRest + ⟨⟨x, pt₁⟩, pt₂⟩ + | .oracle _ rest, s₂, pt => + PublicTranscript.split rest s₂ pt + +/-- Splitting after appending recovers the original components. -/ +@[simp] +theorem PublicTranscript.split_append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + PublicTranscript.split s₁ s₂ (PublicTranscript.append s₁ s₂ pt₁ pt₂) = ⟨pt₁, pt₂⟩ + | .done, _, _, _ => rfl + | .«public» _ rest, s₂, ⟨x, pt₁⟩, pt₂ => by + simp only [PublicTranscript.append, PublicTranscript.split] + rw [split_append] + | .oracle _ rest, s₂, pt₁, pt₂ => + split_append rest s₂ pt₁ pt₂ + +/-- Appending the components produced by `split` recovers the original. -/ +@[simp] +theorem PublicTranscript.append_split : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (pt : PublicTranscript (s₁.append s₂)) → + let ⟨pt₁, pt₂⟩ := PublicTranscript.split s₁ s₂ pt + PublicTranscript.append s₁ s₂ pt₁ pt₂ = pt + | .done, _, _ => rfl + | .«public» _ rest, s₂, ⟨x, ptRest⟩ => by + simp only [PublicTranscript.split, PublicTranscript.append] + rw [append_split] + | .oracle _ rest, s₂, pt => + append_split rest s₂ pt + +/-- Lift a two-argument type family indexed by per-phase `PublicTranscript`s to a +single-argument family on the combined `PublicTranscript` of `s₁.append s₂`. + +`liftAppend s₁ s₂ F (PublicTranscript.append s₁ s₂ pt₁ pt₂)` reduces +**definitionally** to `F pt₁ pt₂`. -/ +def PublicTranscript.liftAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + ((pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → Type u) → + PublicTranscript (s₁.append s₂) → Type u + | .done, _, F, pt => F ⟨⟩ pt + | .«public» _ rest, s₂, F, ⟨x, ptRest⟩ => + liftAppend (rest x) (fun pt => s₂ ⟨x, pt⟩) + (fun pt₁ pt₂ => F ⟨x, pt₁⟩ pt₂) ptRest + | .oracle _ rest, s₂, F, pt => + liftAppend rest s₂ F pt + +/-- `liftAppend` on an appended transcript reduces to the original family. -/ +@[simp] +theorem PublicTranscript.liftAppend_append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (F : (pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → Type u) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + PublicTranscript.liftAppend s₁ s₂ F + (PublicTranscript.append s₁ s₂ pt₁ pt₂) = F pt₁ pt₂ + | .done, _, _, _, _ => rfl + | .«public» _ rest, s₂, F, ⟨x, pt₁⟩, pt₂ => by + simp only [PublicTranscript.append, PublicTranscript.liftAppend] + exact liftAppend_append (rest x) (fun pt => s₂ ⟨x, pt⟩) + (fun pt₁ pt₂ => F ⟨x, pt₁⟩ pt₂) pt₁ pt₂ + | .oracle _ rest, s₂, F, pt₁, pt₂ => + liftAppend_append rest s₂ F pt₁ pt₂ + +/-- `liftAppend` equals the original family applied to the split components. -/ +theorem PublicTranscript.liftAppend_split : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (F : (pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → Type u) → + (pt : PublicTranscript (s₁.append s₂)) → + let ⟨pt₁, pt₂⟩ := PublicTranscript.split s₁ s₂ pt + PublicTranscript.liftAppend s₁ s₂ F pt = F pt₁ pt₂ + | .done, _, _, _ => rfl + | .«public» _ rest, s₂, F, ⟨x, ptRest⟩ => by + simp only [PublicTranscript.split, PublicTranscript.liftAppend] + exact liftAppend_split (rest x) (fun pt => s₂ ⟨x, pt⟩) + (fun pt₁ pt₂ => F ⟨x, pt₁⟩ pt₂) ptRest + | .oracle _ rest, s₂, F, pt => + liftAppend_split rest s₂ F pt + +/-- Transport a `liftAppend` value to the pair-indexed family via `split`. -/ +def PublicTranscript.unliftAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (F : (pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → Type u) → + (pt : PublicTranscript (s₁.append s₂)) → + PublicTranscript.liftAppend s₁ s₂ F pt → + let ⟨pt₁, pt₂⟩ := PublicTranscript.split s₁ s₂ pt + F pt₁ pt₂ + | .done, _, _, _, x => x + | .«public» _ rest, s₂, F, ⟨x, ptRest⟩, val => + unliftAppend (rest x) (fun pt => s₂ ⟨x, pt⟩) + (fun pt₁ pt₂ => F ⟨x, pt₁⟩ pt₂) ptRest val + | .oracle _ rest, s₂, F, pt, val => + unliftAppend rest s₂ F pt val + +/-- Transport a pair-indexed value into `liftAppend` via `append`. -/ +def PublicTranscript.packAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (F : (pt₁ : PublicTranscript s₁) → PublicTranscript (s₂ pt₁) → Type u) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + F pt₁ pt₂ → liftAppend s₁ s₂ F (append s₁ s₂ pt₁ pt₂) + | .done, _, _, ⟨⟩, _, x => x + | .«public» _ rest, s₂, F, ⟨xm, pt₁⟩, pt₂, x => + packAppend (rest xm) (fun pt => s₂ ⟨xm, pt⟩) + (fun pt₁ pt₂ => F ⟨xm, pt₁⟩ pt₂) pt₁ pt₂ x + | .oracle _ rest, s₂, F, pt₁, pt₂, x => + packAppend rest s₂ F pt₁ pt₂ x + +/-- `toInteractionSpec` commutes with `append`: the interaction spec of a +composed oracle spec is the interaction spec append (with appropriate indexing +through `projectPublic`). -/ +theorem toInteractionSpec_append : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (s₁.append s₂).toInteractionSpec = + s₁.toInteractionSpec.append (fun tr => (s₂ (s₁.projectPublic tr)).toInteractionSpec) + | .done, _ => rfl + | .«public» _ rest, s₂ => by + simp only [Spec.append, toInteractionSpec] + congr 1; ext x + exact toInteractionSpec_append (rest x) (fun pt => s₂ ⟨x, pt⟩) + | .oracle _ rest, s₂ => by + simp only [Spec.append, toInteractionSpec] + congr 1; ext _ + exact toInteractionSpec_append rest s₂ + +/-- Embed a pair of `Interaction.Spec.Transcript`s (one for each phase) into a +single transcript of the composed oracle spec. Defined by structural recursion +on `Oracle.Spec`, so `toInteractionSpec` reduces at each step. -/ +def transcriptAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (tr₁ : Interaction.Spec.Transcript s₁.toInteractionSpec) → + Interaction.Spec.Transcript + ((s₂ (s₁.projectPublic tr₁)).toInteractionSpec) → + Interaction.Spec.Transcript (s₁.append s₂).toInteractionSpec + | .done, _, _, tr₂ => tr₂ + | .«public» _ rest, s₂, ⟨x, tr₁⟩, tr₂ => + ⟨x, transcriptAppend (rest x) (fun pt => s₂ ⟨x, pt⟩) tr₁ tr₂⟩ + | .oracle _ rest, s₂, ⟨x, tr₁⟩, tr₂ => + ⟨x, transcriptAppend rest s₂ tr₁ tr₂⟩ + +/-- `projectPublic` commutes with `transcriptAppend`. -/ +theorem projectPublic_transcriptAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (tr₁ : Interaction.Spec.Transcript s₁.toInteractionSpec) → + (tr₂ : Interaction.Spec.Transcript + ((s₂ (s₁.projectPublic tr₁)).toInteractionSpec)) → + (s₁.append s₂).projectPublic (transcriptAppend s₁ s₂ tr₁ tr₂) = + PublicTranscript.append s₁ s₂ (s₁.projectPublic tr₁) + ((s₂ (s₁.projectPublic tr₁)).projectPublic tr₂) + | .done, _, _, _ => rfl + | .«public» _ rest, s₂, ⟨x, tr₁⟩, tr₂ => by + simp only [Spec.append, projectPublic, + transcriptAppend, PublicTranscript.append] + congr 1 + exact projectPublic_transcriptAppend (rest x) (fun pt => s₂ ⟨x, pt⟩) tr₁ tr₂ + | .oracle _ rest, s₂, ⟨x, tr₁⟩, tr₂ => by + simp only [Spec.append, projectPublic, transcriptAppend] + exact projectPublic_transcriptAppend rest s₂ tr₁ tr₂ + +/-! ## Query infrastructure for appended specs -/ + +/-- Embed a query handle from the first phase into the appended spec. -/ +def QueryHandle.appendLeft : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + QueryHandle s₁ od₁ pt₁ → + QueryHandle (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) + (PublicTranscript.append s₁ s₂ pt₁ pt₂) + | .«public» _ rest, s₂, od₁, od₂, ⟨x, pt₁⟩, pt₂, q => + QueryHandle.appendLeft (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) pt₁ pt₂ q + | .oracle _ _, _, ⟨_, _⟩, _, _, _, .inl q => .inl q + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt₁, pt₂, .inr h => + .inr (QueryHandle.appendLeft rest s₂ odRest od₂ pt₁ pt₂ h) + +/-- Embed a query handle from the second phase into the appended spec. -/ +def QueryHandle.appendRight : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + QueryHandle (s₂ pt₁) (od₂ pt₁) pt₂ → + QueryHandle (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) + (PublicTranscript.append s₁ s₂ pt₁ pt₂) + | .done, _, _, _, _, _, q => q + | .«public» _ rest, s₂, od₁, od₂, ⟨x, pt₁⟩, pt₂, q => + QueryHandle.appendRight (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) pt₁ pt₂ q + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt₁, pt₂, q => + .inr (QueryHandle.appendRight rest s₂ odRest od₂ pt₁ pt₂ q) + +/-- Decompose a query handle of the appended spec into a left (first phase) or +right (second phase) query handle. Inverse of `appendLeft`/`appendRight`. -/ +def QueryHandle.splitAppend : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + (pt : PublicTranscript (s₁.append s₂)) → + QueryHandle (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) pt → + QueryHandle s₁ od₁ (PublicTranscript.split s₁ s₂ pt).1 ⊕ + QueryHandle (s₂ (PublicTranscript.split s₁ s₂ pt).1) + (od₂ (PublicTranscript.split s₁ s₂ pt).1) + (PublicTranscript.split s₁ s₂ pt).2 + | .done, _, _, _, _, q => .inr q + | .«public» _ rest, s₂, od₁, od₂, ⟨x, ptRest⟩, q => + splitAppend (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) ptRest q + | .oracle _ _, _, ⟨_, _⟩, _, _, .inl q => .inl (.inl q) + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt, .inr q => + match splitAppend rest s₂ odRest od₂ pt q with + | .inl q₁ => .inl (.inr q₁) + | .inr q₂ => .inr q₂ + +/-- Route a first-phase query handle into the combined spec indexed by `pt`, +where `pt : PublicTranscript (s₁.append s₂)`. Unlike `appendLeft` (which +takes `pt₁` and `pt₂` separately and produces a handle at `append pt₁ pt₂`), +this takes the combined `pt` directly and indexes the input handle by +`(split pt).1`. The key property is that `toOracleSpec` at the routed handle +**definitionally** agrees with the first phase's `toOracleSpec`. -/ +def QueryHandle.routeLeft : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt₁ : PublicTranscript s₁) → OracleDeco (s₂ pt₁)) → + (pt : PublicTranscript (s₁.append s₂)) → + QueryHandle s₁ od₁ (PublicTranscript.split s₁ s₂ pt).1 → + QueryHandle (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) pt + | .done, _, _, _, _, q => q.elim + | .«public» _ rest, s₂, od₁, od₂, ⟨x, ptRest⟩, q => + routeLeft (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) ptRest q + | .oracle _ _, _, ⟨_, _⟩, _, _, .inl q => .inl q + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt, .inr h => + .inr (routeLeft rest s₂ odRest od₂ pt h) + +/-- Route a second-phase query handle into the combined spec indexed by `pt`. +Unlike `appendRight`, takes the combined `pt` directly and indexes the input +handle by `(split pt).1` and `(split pt).2`. The key property is that +`toOracleSpec` at the routed handle **definitionally** agrees with the second +phase's `toOracleSpec`. -/ +def QueryHandle.routeRight : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt₁ : PublicTranscript s₁) → OracleDeco (s₂ pt₁)) → + (pt : PublicTranscript (s₁.append s₂)) → + QueryHandle (s₂ (PublicTranscript.split s₁ s₂ pt).1) + (od₂ (PublicTranscript.split s₁ s₂ pt).1) + (PublicTranscript.split s₁ s₂ pt).2 → + QueryHandle (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) pt + | .done, _, _, _, _, q => q + | .«public» _ rest, s₂, od₁, od₂, ⟨x, ptRest⟩, q => + routeRight (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) ptRest q + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt, q => + .inr (routeRight rest s₂ odRest od₂ pt q) + +/-- The oracle spec at a left query handle in the appended spec matches the +first phase's oracle spec. -/ +theorem toOracleSpec_appendLeft : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + (q : QueryHandle s₁ od₁ pt₁) → + toOracleSpec (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) + (PublicTranscript.append s₁ s₂ pt₁ pt₂) + (QueryHandle.appendLeft s₁ s₂ od₁ od₂ pt₁ pt₂ q) = + toOracleSpec s₁ od₁ pt₁ q + | .«public» _ rest, s₂, od₁, od₂, ⟨x, pt₁⟩, pt₂, q => + toOracleSpec_appendLeft (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) pt₁ pt₂ q + | .oracle _ _, _, ⟨_, _⟩, _, _, _, .inl _ => rfl + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt₁, pt₂, .inr h => + toOracleSpec_appendLeft rest s₂ odRest od₂ pt₁ pt₂ h + +/-- The oracle spec at a right query handle in the appended spec matches the +second phase's oracle spec. -/ +theorem toOracleSpec_appendRight : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt : PublicTranscript s₁) → OracleDeco (s₂ pt)) → + (pt₁ : PublicTranscript s₁) → (pt₂ : PublicTranscript (s₂ pt₁)) → + (q : QueryHandle (s₂ pt₁) (od₂ pt₁) pt₂) → + toOracleSpec (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) + (PublicTranscript.append s₁ s₂ pt₁ pt₂) + (QueryHandle.appendRight s₁ s₂ od₁ od₂ pt₁ pt₂ q) = + toOracleSpec (s₂ pt₁) (od₂ pt₁) pt₂ q + | .done, _, _, _, _, _, _ => rfl + | .«public» _ rest, s₂, od₁, od₂, ⟨x, pt₁⟩, pt₂, q => + toOracleSpec_appendRight (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) pt₁ pt₂ q + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt₁, pt₂, q => + toOracleSpec_appendRight rest s₂ odRest od₂ pt₁ pt₂ q + +/-- Restrict an oracle query implementation for the combined `toOracleSpec` of +`s₁.append s₂` at combined transcript `pt` to answer only first-phase queries. + +Defined by structural recursion on `s₁`. At each step, `toOracleSpec`, +`OracleDeco.append`, and `PublicTranscript.split` all reduce definitionally, +so no casts are needed. At `.oracle` nodes, first-phase handles are in `.inl` +position; the embedding is restricted via `.inr` to skip the current oracle +node. -/ +def restrictLeft {r : Type → Type} [Monad r] : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt₁ : PublicTranscript s₁) → OracleDeco (s₂ pt₁)) → + (pt : PublicTranscript (s₁.append s₂)) → + QueryImpl (toOracleSpec (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) pt) r → + QueryImpl (toOracleSpec s₁ od₁ (PublicTranscript.split s₁ s₂ pt).1) r + | .done, _, _, _, _, _ => fun q => q.elim + | .«public» _ rest, s₂, od₁, od₂, ⟨x, ptRest⟩, embed => + restrictLeft (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) ptRest embed + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt, embed => fun + | .inl q => embed (.inl q) + | .inr h => + restrictLeft rest s₂ odRest od₂ pt (fun h' => embed (.inr h')) h + +/-- Restrict an oracle query implementation for the combined `toOracleSpec` of +`s₁.append s₂` at combined transcript `pt` to answer only second-phase queries. + +Defined by structural recursion on `s₁`. At `.done`, the combined spec +reduces to the second-phase spec, so the embedding applies directly. At +`.oracle` nodes, the embedding is restricted via `.inr`. At `.public` nodes, +the transcript component `x` routes into the correct subtree. -/ +def restrictRight {r : Type → Type} [Monad r] : + (s₁ : Oracle.Spec) → (s₂ : PublicTranscript s₁ → Oracle.Spec) → + (od₁ : OracleDeco s₁) → (od₂ : (pt₁ : PublicTranscript s₁) → OracleDeco (s₂ pt₁)) → + (pt : PublicTranscript (s₁.append s₂)) → + QueryImpl (toOracleSpec (s₁.append s₂) (OracleDeco.append s₁ s₂ od₁ od₂) pt) r → + QueryImpl (toOracleSpec (s₂ (PublicTranscript.split s₁ s₂ pt).1) + (od₂ (PublicTranscript.split s₁ s₂ pt).1) + (PublicTranscript.split s₁ s₂ pt).2) r + | .done, _, _, _, _, embed => embed + | .«public» _ rest, s₂, od₁, od₂, ⟨x, ptRest⟩, embed => + restrictRight (rest x) (fun pt => s₂ ⟨x, pt⟩) + (od₁ x) (fun pt => od₂ ⟨x, pt⟩) ptRest embed + | .oracle _ rest, s₂, ⟨_, odRest⟩, od₂, pt, embed => + restrictRight rest s₂ odRest od₂ pt (fun h => embed (.inr h)) + +end Spec + +end Interaction.Oracle diff --git a/ArkLib/Interaction/Oracle/StateChain.lean b/ArkLib/Interaction/Oracle/StateChain.lean new file mode 100644 index 0000000000..2eb4b8381f --- /dev/null +++ b/ArkLib/Interaction/Oracle/StateChain.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import ArkLib.Interaction.Oracle.Continuation + +namespace Interaction + +open TwoParty + +namespace OracleDecoration + +/-- Build the verifier-side counterpart for an oracle state chain while +threading the accumulated sender-message oracle spec stage by stage. -/ +private def stateChainVerifier + {ι : Type} {oSpec : OracleSpec ι} + {ιₛᵢ : Type} {OStmtIn : ιₛᵢ → Type} [∀ i, OracleInterface (OStmtIn i)] + {Stage : Nat → Type} {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Spec.Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + (od : (i : Nat) → (s : Stage i) → OracleDecoration (spec i s) (roles i s)) + {VerifierState : (i : Nat) → Stage i → Type} + {ιₐ : Type} (accSpec : OracleSpec ιₐ) + (verifierStep : {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + (i : Nat) → (st : Stage i) → VerifierState i st → + Spec.Counterpart.withMonads (spec i st) (roles i st) + (toMonadDecoration oSpec OStmtIn (spec i st) (roles i st) (od i st) accSpec) + (fun tr => VerifierState (i + 1) (advance i st tr))) : + (n : Nat) → (i : Nat) → (st : Stage i) → VerifierState i st → + Spec.Counterpart.withMonads (Spec.stateChain Stage spec advance n i st) + (Spec.Decoration.stateChain roles n i st) + (toMonadDecoration oSpec OStmtIn (Spec.stateChain Stage spec advance n i st) + (Spec.Decoration.stateChain roles n i st) (Role.Refine.stateChain od n i st) accSpec) + (PFunctor.FreeM.Path.stateChainFamily VerifierState n i st) + | 0, _, _, b => b + | n + 1, i, st, b => by + simpa [Spec.stateChain_succ, Spec.Decoration.stateChain, + Role.Refine.stateChain, PFunctor.FreeM.Path.stateChainFamily, + toMonadDecoration_append] + using + (Spec.Counterpart.withMonads.append + (verifierStep accSpec i st b) + (fun tr b' => + stateChainVerifier od + ((accSpecAfter (spec i st) (roles i st) (od i st) accSpec tr).2) + verifierStep n (i + 1) (advance i st tr) b')) + +/-- Concrete-input specialization of state-chain composition for oracle +reductions. The canonical ambient-spine version is defined below. -/ +private def stateChainCompConcrete {ι : Type} {oSpec : OracleSpec ι} + {StatementIn : Type} {ιₛᵢ : StatementIn → Type} + {OStmtIn : (s : StatementIn) → ιₛᵢ s → Type} + [∀ s i, OracleInterface (OStmtIn s i)] + {WitnessIn : StatementIn → Type} + {Stage : Nat → Type} + {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Spec.Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + {od : (i : Nat) → (s : Stage i) → OracleDecoration (spec i s) (roles i s)} + {ProverState VerifierState : (i : Nat) → Stage i → Type} + (n : Nat) + (initStage : StatementIn → Stage 0) + {ιₛₒ : (s : StatementIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage s))) → Type} + {OStmtOut : + (s : StatementIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage s))) → + ιₛₒ s tr → Type} + [∀ s tr i, OracleInterface (OStmtOut s tr i)] + (proverInit : + (s : StatementIn) → + StatementWithOracles (fun _ => PUnit) OStmtIn s → + WitnessIn s → + OracleComp oSpec (ProverState 0 (initStage s))) + (proverStep : (i : Nat) → (st : Stage i) → ProverState i st → + OracleComp oSpec (Spec.Strategy.withRoles (OracleComp oSpec) (spec i st) (roles i st) + (fun tr => ProverState (i + 1) (advance i st tr)))) + (stmtResult : (s : StatementIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage s))) → + PFunctor.FreeM.Path.stateChainFamily VerifierState n 0 (initStage s) tr) + (proverOStmtResult : + (s : StatementIn) → + StatementWithOracles (fun _ => PUnit) OStmtIn s → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage s))) → + OracleStatement (OStmtOut s tr)) + (verifierInit : (s : StatementIn) → VerifierState 0 (initStage s)) + (verifierStep : (s : StatementIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + (i : Nat) → (st : Stage i) → VerifierState i st → + Spec.Counterpart.withMonads (spec i st) (roles i st) + (toMonadDecoration oSpec (OStmtIn s) (spec i st) (roles i st) (od i st) accSpec) + (fun tr => VerifierState (i + 1) (advance i st tr))) + (simulateResult : (s : StatementIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage s))) → + QueryImpl [OStmtOut s tr]ₒ + (OracleComp ([OStmtIn s]ₒ + toOracleSpec + (Spec.stateChain Stage spec advance n 0 (initStage s)) + (Spec.Decoration.stateChain roles n 0 (initStage s)) + (Role.Refine.stateChain (fun i st => od i st) n 0 (initStage s)) tr))) : + OracleReduction oSpec StatementIn + (fun s => Spec.stateChain Stage spec advance n 0 (initStage s)) + (fun s => Spec.Decoration.stateChain roles n 0 (initStage s)) + (fun s => Role.Refine.stateChain (fun i st => od i st) n 0 (initStage s)) + (fun _ => PUnit) + OStmtIn + WitnessIn + (fun s => PFunctor.FreeM.Path.stateChainFamily VerifierState n 0 (initStage s)) + OStmtOut + (fun s => PFunctor.FreeM.Path.stateChainFamily ProverState n 0 (initStage s)) where + prover s sWithOracles w := do + let a ← proverInit s sWithOracles w + let strat ← Spec.Strategy.stateChainCompWithRoles proverStep n 0 (initStage s) a + pure <| by + simpa [Spec.stateChain, Spec.Decoration.stateChain, + PFunctor.FreeM.Path.stateChainFamily] using + (Spec.Strategy.mapOutputWithRoles + (fun tr pOut => ⟨⟨stmtResult s tr, proverOStmtResult s sWithOracles tr⟩, pOut⟩) + strat) + verifier s {_} accSpec _ := + stateChainVerifier od accSpec (verifierStep s) n 0 (initStage s) (verifierInit s) + simulate := simulateResult + +/-- N-ary state chain composition of oracle continuations. The shared input +determines the full chained protocol, while the continuation-local statement and +witness are only used to initialize and interpret the carried prover/verifier +state. Each stage's verifier sees oracle access from `oSpec + [OStatementIn]ₒ` plus +the accumulated sender-message spec. -/ +def OracleReduction.stateChainComp {ι : Type} {oSpec : OracleSpec ι} + {SharedIn : Type} + {StatementIn : SharedIn → Type} + {ιₛᵢ : SharedIn → Type} + {OStatementIn : (shared : SharedIn) → ιₛᵢ shared → Type} + [∀ shared i, OracleInterface (OStatementIn shared i)] + {WitnessIn : SharedIn → Type} + {Stage : Nat → Type} + {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Spec.Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + {od : (i : Nat) → (s : Stage i) → OracleDecoration (spec i s) (roles i s)} + {ProverState VerifierState : (shared : SharedIn) → (i : Nat) → Stage i → Type} + (n : Nat) + (initStage : SharedIn → Stage 0) + {ιₛₒ : (shared : SharedIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage shared))) → Type} + {OStatementOut : + (shared : SharedIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage shared))) → + ιₛₒ shared tr → Type} + [∀ shared tr i, OracleInterface (OStatementOut shared tr i)] + (proverInit : + (shared : SharedIn) → + StatementWithOracles StatementIn OStatementIn shared → + WitnessIn shared → + OracleComp oSpec (ProverState shared 0 (initStage shared))) + (proverStep : (shared : SharedIn) → (i : Nat) → (st : Stage i) → + ProverState shared i st → + OracleComp oSpec (Spec.Strategy.withRoles (OracleComp oSpec) (spec i st) (roles i st) + (fun tr => ProverState shared (i + 1) (advance i st tr)))) + (stmtResult : (shared : SharedIn) → (stmt : StatementIn shared) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage shared))) → + PFunctor.FreeM.Path.stateChainFamily (fun i st => VerifierState shared i st) + n 0 (initStage shared) tr) + (proverOStatementResult : + (shared : SharedIn) → + (s : StatementWithOracles StatementIn OStatementIn shared) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage shared))) → + OracleStatement (OStatementOut shared tr)) + (verifierInit : (shared : SharedIn) → StatementIn shared → + VerifierState shared 0 (initStage shared)) + (verifierStep : (shared : SharedIn) → {ιₐ : Type} → (accSpec : OracleSpec ιₐ) → + (i : Nat) → (st : Stage i) → VerifierState shared i st → + Spec.Counterpart.withMonads (spec i st) (roles i st) + (toMonadDecoration oSpec + (OStatementIn shared) (spec i st) (roles i st) (od i st) accSpec) + (fun tr => VerifierState shared (i + 1) (advance i st tr))) + (simulateResult : (shared : SharedIn) → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage shared))) → + QueryImpl [OStatementOut shared tr]ₒ + (OracleComp ([OStatementIn shared]ₒ + toOracleSpec + (Spec.stateChain Stage spec advance n 0 (initStage shared)) + (Spec.Decoration.stateChain roles n 0 (initStage shared)) + (Role.Refine.stateChain (fun i st => od i st) n 0 (initStage shared)) tr))) : + OracleReduction oSpec SharedIn + (fun shared => Spec.stateChain Stage spec advance n 0 (initStage shared)) + (fun shared => Spec.Decoration.stateChain roles n 0 (initStage shared)) + (fun shared => Role.Refine.stateChain (fun i st => od i st) n 0 (initStage shared)) + StatementIn OStatementIn WitnessIn + (fun shared tr => + PFunctor.FreeM.Path.stateChainFamily (fun i st => VerifierState shared i st) + n 0 (initStage shared) tr) + OStatementOut + (fun shared tr => + PFunctor.FreeM.Path.stateChainFamily (fun i st => ProverState shared i st) + n 0 (initStage shared) tr) where + prover shared sWithOracles w := do + let a ← proverInit shared sWithOracles w + let strat ← Spec.Strategy.stateChainCompWithRoles + (proverStep shared) n 0 (initStage shared) a + pure <| by + simpa [Spec.stateChain, Spec.Decoration.stateChain, + PFunctor.FreeM.Path.stateChainFamily] using + (Spec.Strategy.mapOutputWithRoles + (fun tr pOut => + ⟨⟨stmtResult shared sWithOracles.stmt tr, + proverOStatementResult shared sWithOracles tr⟩, pOut⟩) + strat) + verifier shared {_} accSpec stmt := + stateChainVerifier od accSpec (verifierStep shared) n 0 (initStage shared) + (verifierInit shared stmt) + simulate shared tr := + simulateResult shared tr + +end OracleDecoration + +end Interaction diff --git a/ArkLib/Interaction/Reduction.lean b/ArkLib/Interaction/Reduction.lean new file mode 100644 index 0000000000..4f29de6817 --- /dev/null +++ b/ArkLib/Interaction/Reduction.lean @@ -0,0 +1,1013 @@ +/- +Copyright (c) 2026 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao +-/ +import PolyFun.Interaction.Basic.Spec +import PolyFun.Interaction.Basic.Chain +import PolyFun.Interaction.TwoParty.Compose + +/-! +# Provers, Verifiers, and Reductions + +Interactive protocol participants and their composition, built on `Spec` with +a `RoleDecoration`. This module replaces the old `OracleReduction/Basic.lean` +flat-list model with one natively built on the W-type interaction tree. + +## Type architecture + +The canonical interaction object is indexed by: + +- `SharedIn` — ambient input fixing the protocol context +- `StatementIn : SharedIn → Type` — carried local statement/state interpreted inside + the protocol fixed by `SharedIn` +- `WitnessIn : SharedIn → Type` — carried prover-local witness/state +- `Context : SharedIn → Spec` — protocol spec depends on the ambient input +- `Roles : (i : SharedIn) → RoleDecoration (Context i)` — roles per input +- `StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type` +- `WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type` + +This unifies both top-level protocols and suffix/continuation protocols. +Ordinary top-level protocols are the special case `StatementIn := fun _ => PUnit`; +mid-protocol suffixes use `SharedIn` for ambient setup or prefix transcript data +and `StatementIn` for the carried local state inside that fixed protocol. + +SharedIn and output are represented as: +- **SharedIn**: `Σ i, StatementIn i × WitnessIn i` +- **Honest prover output**: `HonestProverOutput (StatementOut i tr) (WitnessOut i tr)` + +## Participants + +- **Prover**: monadic setup producing a role-dependent `Strategy` whose output is + `HonestProverOutput StatementOut WitnessOut`. +- **Verifier**: an `SharedIn`-indexed, `StatementIn`-parameterized `Counterpart` + with `StatementOut` at `.done`. No `OptionT` — acceptance semantics (if + needed) are chosen by the caller through the `StatementOut` type + (e.g., `StatementOut = fun _ _ => Option Bool`). +- **PublicCoinVerifier**: a stronger verifier surface whose receiver nodes are + replayable public-coin continuations (`Spec.PublicCoinCounterpart`), used by + the interaction-native Fiat-Shamir transform. +- **Reduction**: pairs a prover with a verifier for the same protocol spec. +- **PublicCoinReduction**: pairs a prover with a public-coin verifier; forgetting + the extra verifier structure recovers an ordinary `Reduction`. + +Both `Prover` and `Verifier` are `abbrev`s (transparent type aliases) for +the underlying function types. + +## Composition + +Sequential composition is phrased directly at the canonical `Reduction` shape: +the second protocol is indexed by `(input, tr₁)`, where `tr₁` is the realized +prefix transcript. This subsumes the old continuation surface without requiring +a separate foundational object. + +## Running a reduction + +`Reduction.execute` runs the prover's strategy against the verifier (via +`Strategy.runWithRoles`), returning the transcript plus both outputs. + +See `Security.lean` for completeness, soundness, and knowledge soundness +definitions built on this execution model. +-/ + +universe u v w + +namespace Interaction + +open TwoParty + +/-! ## Compatibility aliases for the PolyFun v4.30 interaction API -/ + +namespace Spec + +/-- Compatibility name for dependent append on interaction specs. -/ +abbrev append (s₁ : Spec) (s₂ : Transcript s₁ → Spec) : Spec := + PFunctor.FreeM.append s₁ s₂ + +namespace Transcript + +abbrev append (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) : + Transcript (s₁.append s₂) := + PFunctor.FreeM.Path.append s₁ s₂ tr₁ tr₂ + +abbrev liftAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr : Transcript (s₁.append s₂)) : Type u := + PFunctor.FreeM.Path.liftAppend s₁ s₂ F tr + +abbrev packAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) + (x : F tr₁ tr₂) : + liftAppend s₁ s₂ F (append s₁ s₂ tr₁ tr₂) := + PFunctor.FreeM.Path.packAppend s₁ s₂ F tr₁ tr₂ x + +abbrev split (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (tr : Transcript (s₁.append s₂)) : + (tr₁ : Transcript s₁) × Transcript (s₂ tr₁) := + PFunctor.FreeM.Path.split s₁ s₂ tr + +abbrev unliftAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr : Transcript (s₁.append s₂)) (x : liftAppend s₁ s₂ F tr) : + let splitPath := split s₁ s₂ tr + F splitPath.1 splitPath.2 := + PFunctor.FreeM.Path.unliftAppend s₁ s₂ F tr x + +abbrev unpackAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) + (x : liftAppend s₁ s₂ F (append s₁ s₂ tr₁ tr₂)) : + F tr₁ tr₂ := + PFunctor.FreeM.Path.unpackAppend s₁ s₂ F tr₁ tr₂ x + +@[simp] +theorem split_append (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) : + split s₁ s₂ (append s₁ s₂ tr₁ tr₂) = ⟨tr₁, tr₂⟩ := + PFunctor.FreeM.Path.split_append s₁ s₂ tr₁ tr₂ + +@[simp] +theorem append_split (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (tr : Transcript (s₁.append s₂)) : + let splitPath := split s₁ s₂ tr + append s₁ s₂ splitPath.1 splitPath.2 = tr := + PFunctor.FreeM.Path.append_split s₁ s₂ tr + +@[simp] +theorem unpackAppend_packAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) + (x : F tr₁ tr₂) : + unpackAppend s₁ s₂ F tr₁ tr₂ (packAppend s₁ s₂ F tr₁ tr₂ x) = x := + PFunctor.FreeM.Path.unpackAppend_packAppend s₁ s₂ F tr₁ tr₂ x + +@[simp] +theorem packAppend_unpackAppend (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) + (x : liftAppend s₁ s₂ F (append s₁ s₂ tr₁ tr₂)) : + packAppend s₁ s₂ F tr₁ tr₂ (unpackAppend s₁ s₂ F tr₁ tr₂ x) = x := + PFunctor.FreeM.Path.packAppend_unpackAppend s₁ s₂ F tr₁ tr₂ x + +theorem rel_unliftAppend_append (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (F G : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (R : ∀ tr₁ tr₂, F tr₁ tr₂ → G tr₁ tr₂ → Prop) + (tr₁ : Transcript s₁) (tr₂ : Transcript (s₂ tr₁)) + (x : F tr₁ tr₂) (y : G tr₁ tr₂) : + let path := append s₁ s₂ tr₁ tr₂ + R (split s₁ s₂ path).1 (split s₁ s₂ path).2 + (unliftAppend s₁ s₂ F path + (packAppend s₁ s₂ F tr₁ tr₂ x)) + (unliftAppend s₁ s₂ G path + (packAppend s₁ s₂ G tr₁ tr₂ y)) = + R tr₁ tr₂ x y := + PFunctor.FreeM.Path.rel_unliftAppend_append s₁ s₂ F G R tr₁ tr₂ x y + +abbrev liftAppendProd (s₁ : Spec) (s₂ : Transcript s₁ → Spec) + (A B : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u) + (tr : Transcript (s₁.append s₂)) + (x : liftAppend s₁ s₂ (fun tr₁ tr₂ => A tr₁ tr₂ × B tr₁ tr₂) tr) : + liftAppend s₁ s₂ A tr × liftAppend s₁ s₂ B tr := + PFunctor.FreeM.Path.liftAppendProd s₁ s₂ A B tr x + +abbrev stateChainFamily + {Stage : Nat → Type u} {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Transcript (spec i s) → Stage (i + 1)} + (Family : (i : Nat) → Stage i → Type u) + (n : Nat) (i : Nat) (stage : Stage i) : + Transcript (Spec.stateChain Stage spec advance n i stage) → Type u := + PFunctor.FreeM.Path.stateChainFamily (advance := advance) Family n i stage + +end Transcript + +namespace Strategy + +abbrev withRoles (m : Type u → Type u) + (spec : Spec) (roles : RoleDecoration spec) + (Output : Transcript spec → Type u) : Type u := + StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.focal spec roles Output + +def runWithRoles {m : Type u → Type u} [Monad m] + (spec : Spec) (roles : RoleDecoration spec) + {OutputP OutputC : Transcript spec → Type u} + (strat : withRoles m spec roles OutputP) + (cpt : StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.counterpart + spec roles OutputC) : + m ((tr : Transcript spec) × OutputP tr × OutputC tr) := + TwoParty.run spec roles strat cpt + +def compWithRoles {m : Type u → Type u} [Monad m] + {s₁ : Spec} {s₂ : Transcript s₁ → Spec} + {r₁ : RoleDecoration s₁} + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} + {Mid : Transcript s₁ → Type u} + {F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u} + (strat₁ : withRoles m s₁ r₁ Mid) + (f : (tr₁ : Transcript s₁) → Mid tr₁ → m (withRoles m (s₂ tr₁) (r₂ tr₁) (F tr₁))) : + m (withRoles m (s₁.append s₂) (r₁.append r₂) + (PFunctor.FreeM.Path.liftAppend s₁ s₂ F)) := + StrategyOver.TwoParty.Focal.comp strat₁ f + +def compWithRolesFlat {m : Type u → Type u} [Monad m] + {s₁ : Spec} {s₂ : Transcript s₁ → Spec} + {r₁ : RoleDecoration s₁} + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} + {Mid : Transcript s₁ → Type u} + {Output : Transcript (s₁.append s₂) → Type u} + (strat₁ : withRoles m s₁ r₁ Mid) + (f : (tr₁ : Transcript s₁) → Mid tr₁ → + m (withRoles m (s₂ tr₁) (r₂ tr₁) + (fun tr₂ => Output (PFunctor.FreeM.Path.append s₁ s₂ tr₁ tr₂)))) : + m (withRoles m (s₁.append s₂) (r₁.append r₂) Output) := + StrategyOver.TwoParty.Focal.compFlat strat₁ f + +def mapOutputWithRoles {m : Type u → Type u} [Functor m] : + {spec : Spec} → {roles : RoleDecoration spec} → + {A B : Transcript spec → Type u} → + (∀ tr, A tr → B tr) → + withRoles m spec roles A → withRoles m spec roles B + | .done, _, _, _, f, output => f ⟨⟩ output + | .node _ _rest, ⟨.sender, _rRest⟩, _, _, f, strat => + (fun xc => ⟨xc.1, mapOutputWithRoles (fun tr => f ⟨xc.1, tr⟩) xc.2⟩) <$> strat + | .node _ _rest, ⟨.receiver, _rRest⟩, _, _, f, strat => + fun x => mapOutputWithRoles (fun tr => f ⟨x, tr⟩) <$> strat x + +theorem mapOutputWithRoles_eq_focal_mapOutput {m : Type u → Type u} [Functor m] : + {spec : Spec} → {roles : RoleDecoration spec} → + {A B : Transcript spec → Type u} → + (f : ∀ tr, A tr → B tr) → + (strat : withRoles m spec roles A) → + mapOutputWithRoles f strat = StrategyOver.TwoParty.Focal.mapOutput f strat + | .done, roles, _, _, f, strat => by + cases roles + rfl + | .node _ rest, ⟨.sender, rRest⟩, _, _, f, strat => by + simp only [mapOutputWithRoles, StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id] + congr 1 + funext xc + exact Sigma.ext rfl + (heq_of_eq (mapOutputWithRoles_eq_focal_mapOutput + (fun tr => f ⟨xc.1, tr⟩) xc.2)) + | .node _ rest, ⟨.receiver, rRest⟩, _, _, f, strat => by + simp only [mapOutputWithRoles, StrategyOver.TwoParty.Focal.mapOutput, ShapeOver.mapOutput, + ShapeOver.TwoParty.pairedSpec, ShapeOver.TwoParty.paired, + SyntaxOver.TwoParty.paired, PFunctor.Lens.id] + funext x + congr 1 + funext next + exact mapOutputWithRoles_eq_focal_mapOutput + (fun tr => f ⟨x, tr⟩) next + +abbrev stateChainCompWithRoles {m : Type u → Type u} [Monad m] + {Stage : Nat → Type u} {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + {Family : (i : Nat) → Stage i → Type u} + (step : (i : Nat) → (s : Stage i) → Family i s → + m (withRoles m (spec i s) (roles i s) + (fun tr => Family (i + 1) (advance i s tr)))) := + StrategyOver.TwoParty.Focal.stateChainComp + (advance := advance) (roles := roles) (Family := Family) step + +theorem runWithRoles_mapOutputWithRoles_mapOutput + {m : Type u → Type u} [Monad m] [LawfulMonad m] + {spec : Spec} {roles : RoleDecoration spec} + {OutputP OutputP' OutputC OutputC' : Transcript spec → Type u} + (fP : ∀ tr, OutputP tr → OutputP' tr) + (fC : ∀ tr, OutputC tr → OutputC' tr) + (strat : withRoles m spec roles OutputP) + (cpt : StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.counterpart + spec roles OutputC) : + runWithRoles spec roles (mapOutputWithRoles fP strat) + (StrategyOver.TwoParty.Counterpart.mapOutput fC cpt) = + (fun z => ⟨z.1, fP z.1 z.2.1, fC z.1 z.2.2⟩) <$> + runWithRoles spec roles strat cpt := + by + rw [mapOutputWithRoles_eq_focal_mapOutput] + exact TwoParty.run_mapOutput_mapOutput fP fC strat cpt + +theorem runWithRoles_compWithRoles_append + {m : Type u → Type u} [Monad m] [LawfulCommMonad m] + {s₁ : Spec} {s₂ : Transcript s₁ → Spec} + {r₁ : RoleDecoration s₁} + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} + {Mid OutputC : Transcript s₁ → Type u} + {F : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u} + {G : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u} + (strat₁ : withRoles m s₁ r₁ Mid) + (f : (tr₁ : Transcript s₁) → Mid tr₁ → m (withRoles m (s₂ tr₁) (r₂ tr₁) (F tr₁))) + (cpt₁ : StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.counterpart + s₁ r₁ OutputC) + (cpt₂ : (tr₁ : Transcript s₁) → OutputC tr₁ → + StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.counterpart + (s₂ tr₁) (r₂ tr₁) (G tr₁)) : + (do + let strat ← compWithRoles strat₁ f + runWithRoles (s₁.append s₂) (r₁.append r₂) strat + (StrategyOver.TwoParty.Counterpart.append cpt₁ cpt₂)) = + (do + let ⟨tr₁, mid, outC⟩ ← runWithRoles s₁ r₁ strat₁ cpt₁ + let strat₂ ← f tr₁ mid + let ⟨tr₂, outP, outC₂⟩ ← runWithRoles (s₂ tr₁) (r₂ tr₁) strat₂ (cpt₂ tr₁ outC) + pure ⟨PFunctor.FreeM.Path.append s₁ s₂ tr₁ tr₂, + PFunctor.FreeM.Path.packAppend s₁ s₂ F tr₁ tr₂ outP, + PFunctor.FreeM.Path.packAppend s₁ s₂ G tr₁ tr₂ outC₂⟩) := + TwoParty.run_comp_append (strat₁ := strat₁) (f := f) (cpt₁ := cpt₁) (cpt₂ := cpt₂) + +end Strategy + +abbrev Counterpart (m : Type u → Type u) + (spec : Spec) (roles : RoleDecoration spec) + (Output : Transcript spec → Type u) : Type u := + StrategyOver (SyntaxOver.TwoParty.pairedSpec m) Participant.counterpart spec roles Output + +namespace Counterpart + +abbrev withMonads (spec : Spec) (roles : RoleDecoration spec) + (md : MonadDecoration spec) + (Output : Transcript spec → Type u) : Type u := + StrategyOver SyntaxOver.TwoParty.Counterpart.monadicSpec.{u + 1, u, u} + (PUnit.unit : PUnit.{u + 1}) spec (RoleDecoration.withMonads roles md) Output + +def append {m : Type u → Type u} [Monad m] + {s₁ : Spec} {s₂ : Transcript s₁ → Spec} + {r₁ : RoleDecoration s₁} + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} + {A : Transcript s₁ → Type u} + {B : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u} + (cpt₁ : Counterpart m s₁ r₁ A) + (cpt₂ : (tr₁ : Transcript s₁) → A tr₁ → Counterpart m (s₂ tr₁) (r₂ tr₁) (B tr₁)) : + Counterpart m (s₁.append s₂) (r₁.append r₂) + (PFunctor.FreeM.Path.liftAppend s₁ s₂ B) := + StrategyOver.TwoParty.Counterpart.append cpt₁ cpt₂ + +def appendFlat {m : Type u → Type u} [Monad m] + {s₁ : Spec} {s₂ : Transcript s₁ → Spec} + {r₁ : RoleDecoration s₁} + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} + {A : Transcript s₁ → Type u} + {Output : Transcript (s₁.append s₂) → Type u} + (cpt₁ : Counterpart m s₁ r₁ A) + (cpt₂ : (tr₁ : Transcript s₁) → A tr₁ → Counterpart m (s₂ tr₁) (r₂ tr₁) + (fun tr₂ => Output (PFunctor.FreeM.Path.append s₁ s₂ tr₁ tr₂))) : + Counterpart m (s₁.append s₂) (r₁.append r₂) Output := + StrategyOver.TwoParty.Counterpart.appendFlat cpt₁ cpt₂ + +def mapOutput {m : Type u → Type u} [Functor m] + {spec : Spec} {roles : RoleDecoration spec} + {A B : Transcript spec → Type u} + (f : ∀ tr, A tr → B tr) + (cpt : Counterpart m spec roles A) : + Counterpart m spec roles B := + StrategyOver.TwoParty.Counterpart.mapOutput f cpt + +abbrev mapReceiver {m : Type u → Type u} [Functor m] + {spec : Spec} {roles : RoleDecoration spec} + {A B : Transcript spec → Type u} + (f : ∀ tr, A tr → B tr) + (cpt : Counterpart m spec roles A) : + Counterpart m spec roles B := + mapOutput f cpt + +abbrev stateChainComp {m : Type u → Type u} [Monad m] + {Stage : Nat → Type u} {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + {Family : (i : Nat) → Stage i → Type u} + (step : (i : Nat) → (s : Stage i) → Family i s → + Counterpart m (spec i s) (roles i s) + (fun tr => Family (i + 1) (advance i s tr))) := + StrategyOver.TwoParty.Counterpart.stateChainComp + (advance := advance) (roles := roles) (Family := Family) step + +theorem mapOutput_id {m : Type u → Type u} [Functor m] [LawfulFunctor m] + {spec : Spec} {roles : RoleDecoration spec} {A : Transcript spec → Type u} + (cpt : Counterpart m spec roles A) : + mapOutput (fun _ x => x) cpt = cpt := + StrategyOver.TwoParty.Counterpart.mapOutput_id cpt + +namespace withMonads + +def append : + {s₁ : Spec} → {s₂ : Transcript s₁ → Spec} → + {r₁ : RoleDecoration s₁} → + {r₂ : (tr₁ : Transcript s₁) → RoleDecoration (s₂ tr₁)} → + {md₁ : MonadDecoration s₁} → + {md₂ : (tr₁ : Transcript s₁) → MonadDecoration (s₂ tr₁)} → + {A : Transcript s₁ → Type u} → + {B : (tr₁ : Transcript s₁) → Transcript (s₂ tr₁) → Type u} → + Counterpart.withMonads s₁ r₁ md₁ A → + ((tr₁ : Transcript s₁) → A tr₁ → + Counterpart.withMonads (s₂ tr₁) (r₂ tr₁) (md₂ tr₁) (B tr₁)) → + Counterpart.withMonads (s₁.append s₂) (r₁.append r₂) (md₁.append md₂) + (PFunctor.FreeM.Path.liftAppend s₁ s₂ B) + | .done, _, _, _, _, _, _, _, cpt₁, cpt₂ => cpt₂ ⟨⟩ cpt₁ + | .node _ rest, s₂, ⟨.sender, rRest⟩, r₂, ⟨_, mdRest⟩, md₂, _, _, cpt₁, cpt₂ => + fun x => do + let cRest ← cpt₁ x + pure <| append + (s₁ := rest x) + (s₂ := fun tr => s₂ ⟨x, tr⟩) + (r₁ := rRest x) + (r₂ := fun tr => r₂ ⟨x, tr⟩) + (md₁ := mdRest x) + (md₂ := fun tr => md₂ ⟨x, tr⟩) + cRest + (fun tr out => cpt₂ ⟨x, tr⟩ out) + | .node _ rest, s₂, ⟨.receiver, rRest⟩, r₂, ⟨_, mdRest⟩, md₂, _, _, cpt₁, cpt₂ => + do + let ⟨x, cRest⟩ ← cpt₁ + pure ⟨x, append + (s₁ := rest x) + (s₂ := fun tr => s₂ ⟨x, tr⟩) + (r₁ := rRest x) + (r₂ := fun tr => r₂ ⟨x, tr⟩) + (md₁ := mdRest x) + (md₂ := fun tr => md₂ ⟨x, tr⟩) + cRest + (fun tr out => cpt₂ ⟨x, tr⟩ out)⟩ + +def mapOutput + (spec : Spec) (roles : RoleDecoration spec) (md : MonadDecoration spec) + {A B : Transcript spec → Type u} + (f : ∀ tr, A tr → B tr) + (cpt : Counterpart.withMonads spec roles md A) : + Counterpart.withMonads spec roles md B := by + simpa [Counterpart.withMonads] using + (ShapeOver.mapOutput ShapeOver.TwoParty.Counterpart.monadicSpec + (RoleDecoration.withMonads roles md) f cpt) + +@[simp] +theorem mapOutput_done + {roles : RoleDecoration Spec.done} {md : MonadDecoration Spec.done} + {A B : Transcript Spec.done → Type u} + (f : ∀ tr, A tr → B tr) + (cpt : Counterpart.withMonads Spec.done roles md A) : + mapOutput Spec.done roles md f cpt = f ⟨⟩ cpt := by + cases roles + cases md + rfl + +end withMonads + +end Counterpart + +abbrev PublicCoinCounterpart (m : Type u → Type u) + (spec : Spec) (roles : RoleDecoration spec) + (Output : Transcript spec → Type u) : Type u := + StrategyOver (TwoParty.PublicCoinCounterpart.counterpartSyntax.{u, u + 1} m) + (PUnit.unit : PUnit.{u + 2}) spec roles Output + +namespace PublicCoinCounterpart + +def toCounterpart {m : Type u → Type u} [Monad m] + {spec : Spec} {roles : RoleDecoration spec} {Output : Transcript spec → Type u} + (cpt : PublicCoinCounterpart m spec roles Output) : + Counterpart m spec roles Output := + TwoParty.PublicCoinCounterpart.toCounterpart cpt + +def replay {m : Type u → Type u} [Monad m] + {spec : Spec} {roles : RoleDecoration spec} {Output : Transcript spec → Type u} + (cpt : PublicCoinCounterpart m spec roles Output) + (tr : Transcript spec) : m (Output tr) := + TwoParty.PublicCoinCounterpart.replay cpt tr + +end PublicCoinCounterpart + +abbrev LawfulCommMonad (m : Type u → Type u) [Monad m] := + TwoParty.LawfulCommMonad m + +end Spec + +/-! ## Protocol participants -/ + +/-- Output produced by an honest prover: the next statement together with the +next witness to be forwarded by composition. -/ +abbrev HonestProverOutput (StatementOut : Type u) (WitnessOut : Type v) := + StatementOut × WitnessOut + +namespace HonestProverOutput + +/-- Statement component of an honest prover output. -/ +abbrev stmt {StatementOut : Type u} {WitnessOut : Type v} + (out : HonestProverOutput StatementOut WitnessOut) : StatementOut := + out.1 + +/-- Witness component of an honest prover output. -/ +abbrev wit {StatementOut : Type u} {WitnessOut : Type v} + (out : HonestProverOutput StatementOut WitnessOut) : WitnessOut := + out.2 + +end HonestProverOutput + +/-- A prover: given ambient input `i`, local statement `stmt`, and local witness +`wit`, performs monadic setup and produces a role-dependent strategy whose +output is `HonestProverOutput (StatementOut i tr) (WitnessOut i tr)`. -/ +abbrev Prover (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn WitnessIn : SharedIn → Type w) + (StatementOut WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) := + (i : SharedIn) → StatementIn i → WitnessIn i → + m (Spec.Strategy.withRoles m (Context i) (Roles i) + (fun tr => HonestProverOutput (StatementOut i tr) (WitnessOut i tr))) + +/-- A verifier: given ambient input `i` and local statement `stmt`, provides a +`Counterpart` with `StatementOut i tr` at `.done`. No `OptionT` wrapping — the +caller chooses whether `StatementOut` includes `Option` for accept/reject +semantics. -/ +abbrev Verifier (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn : SharedIn → Type w) + (StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) := + (i : SharedIn) → StatementIn i → + Spec.Counterpart m (Context i) (Roles i) (fun tr => StatementOut i tr) + +/-- A verifier whose receiver nodes are public-coin in the strong replayable +sense captured by `Spec.PublicCoinCounterpart`. + +An ordinary `Verifier` is enough to execute a protocol, but not enough to +replay a prescribed receiver transcript: at a verifier node, the continuation +is hidden inside an opaque monadic sample. `PublicCoinVerifier` keeps the same +overall interface while strengthening receiver nodes so they expose both a +challenge sampler and a challenge-indexed continuation family. Forgetting this +extra structure recovers an ordinary `Verifier`. -/ +abbrev PublicCoinVerifier (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn : SharedIn → Type w) + (StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) := + (i : SharedIn) → StatementIn i → + Spec.PublicCoinCounterpart m (Context i) (Roles i) + (fun tr => StatementOut i tr) + +namespace PublicCoinVerifier + +/-- Forget that a verifier is public-coin and view it as an ordinary verifier. -/ +def toVerifier {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {Context : SharedIn → Spec} + {Roles : (i : SharedIn) → RoleDecoration (Context i)} + {StatementIn : SharedIn → Type w} + {StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + (verifier : PublicCoinVerifier m SharedIn Context Roles StatementIn StatementOut) : + Verifier m SharedIn Context Roles StatementIn StatementOut := + fun i stmt => (verifier i stmt).toCounterpart + +/-- Replay a full transcript through a public-coin verifier. -/ +def replay {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {Context : SharedIn → Spec} + {Roles : (i : SharedIn) → RoleDecoration (Context i)} + {StatementIn : SharedIn → Type w} + {StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + (verifier : PublicCoinVerifier m SharedIn Context Roles StatementIn StatementOut) + (i : SharedIn) (stmt : StatementIn i) (tr : Spec.Transcript (Context i)) : + m (StatementOut i tr) := + Spec.PublicCoinCounterpart.replay (verifier i stmt) tr + +end PublicCoinVerifier + +/-- A reduction pairs a prover with a verifier for the same protocol. -/ +structure Reduction (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn WitnessIn : SharedIn → Type w) + (StatementOut WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) where + prover : Prover m SharedIn Context Roles StatementIn WitnessIn StatementOut WitnessOut + verifier : Verifier m SharedIn Context Roles StatementIn StatementOut + +/-- A reduction whose verifier is public-coin in the replayable sense of +`PublicCoinVerifier`. The prover is unchanged; only the verifier carries the +extra structure needed by verifier-side Fiat-Shamir. -/ +structure PublicCoinReduction (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn WitnessIn : SharedIn → Type w) + (StatementOut WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) where + prover : Prover m SharedIn Context Roles StatementIn WitnessIn StatementOut WitnessOut + verifier : PublicCoinVerifier m SharedIn Context Roles StatementIn StatementOut + +namespace PublicCoinReduction + +/-- Forget that a reduction is public-coin and recover the underlying ordinary +interactive reduction. -/ +def toReduction {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {Context : SharedIn → Spec} + {Roles : (i : SharedIn) → RoleDecoration (Context i)} + {StatementIn WitnessIn : SharedIn → Type w} + {StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + {WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + (reduction : + PublicCoinReduction m SharedIn Context Roles StatementIn WitnessIn StatementOut WitnessOut) : + Reduction m SharedIn Context Roles StatementIn WitnessIn StatementOut WitnessOut where + prover := reduction.prover + verifier := reduction.verifier.toVerifier + +end PublicCoinReduction + +/-- A proof system is a reduction where the prover does not forward any +witness to the next stage (`WitnessOut = PUnit`). Accept/reject semantics +are not fixed here — they are determined by the choice of `StatementOut` +(e.g., `Bool`, `Option _`) and the security definitions. Its honest prover +output is `HonestProverOutput StatementOut PUnit`. -/ +abbrev Proof (m : Type u → Type u) + (SharedIn : Type v) + (Context : SharedIn → Spec) + (Roles : (i : SharedIn) → RoleDecoration (Context i)) + (StatementIn WitnessIn : SharedIn → Type w) + (StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u) := + Reduction m SharedIn Context Roles StatementIn WitnessIn StatementOut (fun _ _ => PUnit) + +/-! ## Execution -/ + +/-- Execute a reduction: run the prover's strategy against the verifier's +counterpart (via `Strategy.runWithRoles`). Returns the transcript, the + prover's output (`HonestProverOutput StatementOut WitnessOut`), and the verifier's output + (`StatementOut`). -/ +def Reduction.execute {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {Context : SharedIn → Spec} + {Roles : (i : SharedIn) → RoleDecoration (Context i)} + {StatementIn WitnessIn : SharedIn → Type w} + {StatementOut WitnessOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + (reduction : Reduction m SharedIn Context Roles StatementIn WitnessIn StatementOut WitnessOut) + (i : SharedIn) (stmt : StatementIn i) (wit : WitnessIn i) : + m ((tr : Spec.Transcript (Context i)) × + HonestProverOutput (StatementOut i tr) (WitnessOut i tr) × + StatementOut i tr) := do + let strategy ← reduction.prover i stmt wit + Spec.Strategy.runWithRoles (Context i) (Roles i) strategy (reduction.verifier i stmt) + +/-- Run a prover strategy against a verifier. Convenience wrapper around +`Spec.Strategy.runWithRoles` that applies the input-indexed verifier. -/ +def Verifier.run {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {Context : SharedIn → Spec} + {Roles : (i : SharedIn) → RoleDecoration (Context i)} + {StatementIn : SharedIn → Type w} + {StatementOut : (i : SharedIn) → Spec.Transcript (Context i) → Type u} + (v : Verifier m SharedIn Context Roles StatementIn StatementOut) + (i : SharedIn) + (stmt : StatementIn i) + {OutputP : Spec.Transcript (Context i) → Type u} + (prover : Spec.Strategy.withRoles m (Context i) (Roles i) OutputP) : + m ((tr : Spec.Transcript (Context i)) × OutputP tr × StatementOut i tr) := + Spec.Strategy.runWithRoles (Context i) (Roles i) prover (v i stmt) + +/-! ## Sequential composition -/ + +/-- Compose a reduction with a transcript-indexed continuation reduction. +The first reduction runs over `ctx₁`, producing intermediate outputs `StmtMid` and +`WitMid`. These feed into `reduction2`, whose protocol `ctx₂` may depend on the +first transcript. The composed output types are factored two-argument families, +lifted through `Transcript.liftAppend`. -/ +def Reduction.comp {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {StatementIn : SharedIn → Type w} + {WitnessIn : SharedIn → Type w} + {ctx₁ : SharedIn → Spec} + {roles₁ : (i : SharedIn) → RoleDecoration (ctx₁ i)} + {StmtMid WitMid : (i : SharedIn) → Spec.Transcript (ctx₁ i) → Type u} + {ctx₂ : (i : SharedIn) → Spec.Transcript (ctx₁ i) → Spec} + {roles₂ : (i : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ i)) → + RoleDecoration (ctx₂ i tr₁)} + {StmtOut WitOut : (i : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ i)) → + Spec.Transcript (ctx₂ i tr₁) → Type u} + (reduction1 : Reduction m SharedIn ctx₁ roles₁ StatementIn WitnessIn StmtMid WitMid) + (reduction2 : Reduction m + ((i : SharedIn) × StatementIn i × Spec.Transcript (ctx₁ i)) + (fun shared => ctx₂ shared.1 shared.2.2) + (fun shared => roles₂ shared.1 shared.2.2) + (fun shared => StmtMid shared.1 shared.2.2) + (fun shared => WitMid shared.1 shared.2.2) + (fun shared tr₂ => StmtOut shared.1 shared.2.2 tr₂) + (fun shared tr₂ => WitOut shared.1 shared.2.2 tr₂)) : + Reduction m SharedIn + (fun i => (ctx₁ i).append (ctx₂ i)) + (fun i => (roles₁ i).append (roles₂ i)) + StatementIn + WitnessIn + (fun i => Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (StmtOut i)) + (fun i => Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (WitOut i)) where + prover i stmt w := do + let strat₁ ← reduction1.prover i stmt w + let strat ← Spec.Strategy.compWithRoles strat₁ (fun tr₁ midOut => + reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + pure <| Spec.Strategy.mapOutputWithRoles + (fun tr out => + Spec.Transcript.liftAppendProd (ctx₁ i) (ctx₂ i) (StmtOut i) (WitOut i) tr out) + strat + verifier i stmt := + Spec.Counterpart.append (reduction1.verifier i stmt) (fun tr₁ sMid => + reduction2.verifier ⟨i, stmt, tr₁⟩ sMid) + +/-- Executing a sequentially composed reduction factors into first executing the +prefix reduction and then the suffix interaction induced by its outputs. -/ +theorem Reduction.execute_comp + {m : Type u → Type u} [Monad m] [Spec.LawfulCommMonad m] + {SharedIn : Type v} + {StatementIn : SharedIn → Type w} + {WitnessIn : SharedIn → Type w} + {ctx₁ : SharedIn → Spec} + {roles₁ : (i : SharedIn) → RoleDecoration (ctx₁ i)} + {StmtMid WitMid : (i : SharedIn) → Spec.Transcript (ctx₁ i) → Type u} + {ctx₂ : (i : SharedIn) → Spec.Transcript (ctx₁ i) → Spec} + {roles₂ : (i : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ i)) → + RoleDecoration (ctx₂ i tr₁)} + {StmtOut WitOut : (i : SharedIn) → (tr₁ : Spec.Transcript (ctx₁ i)) → + Spec.Transcript (ctx₂ i tr₁) → Type u} + (reduction1 : Reduction m SharedIn ctx₁ roles₁ StatementIn WitnessIn StmtMid WitMid) + (reduction2 : Reduction m + ((i : SharedIn) × StatementIn i × Spec.Transcript (ctx₁ i)) + (fun shared => ctx₂ shared.1 shared.2.2) + (fun shared => roles₂ shared.1 shared.2.2) + (fun shared => StmtMid shared.1 shared.2.2) + (fun shared => WitMid shared.1 shared.2.2) + (fun shared tr₂ => StmtOut shared.1 shared.2.2 tr₂) + (fun shared tr₂ => WitOut shared.1 shared.2.2 tr₂)) + (i : SharedIn) (stmt : StatementIn i) (w : WitnessIn i) : + (Reduction.comp reduction1 reduction2).execute i stmt w = + (do + let ⟨tr₁, midOut, sMid⟩ ← reduction1.execute i stmt w + let strat₂ ← reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit + let ⟨tr₂, out, sOut⟩ ← + Spec.Strategy.runWithRoles (ctx₂ i tr₁) (roles₂ i tr₁) strat₂ + (reduction2.verifier ⟨i, stmt, tr₁⟩ sMid) + pure ⟨Spec.Transcript.append (ctx₁ i) (ctx₂ i) tr₁ tr₂, + ⟨Spec.Transcript.packAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr₁ tr₂ out.stmt, + Spec.Transcript.packAppend (ctx₁ i) (ctx₂ i) (WitOut i) tr₁ tr₂ out.wit⟩, + Spec.Transcript.packAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr₁ tr₂ sOut⟩) := by + simp only [execute, comp, bind_assoc, pure_bind] + refine congrArg (fun k => reduction1.prover i stmt w >>= k) ?_ + funext strat₁ + let mapOut : + (tr : Spec.Transcript ((ctx₁ i).append (ctx₂ i))) → + Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) + (fun tr₁ tr₂ => HonestProverOutput (StmtOut i tr₁ tr₂) (WitOut i tr₁ tr₂)) tr → + HonestProverOutput + (Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr) + (Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (WitOut i) tr) := + fun tr out => + Spec.Transcript.liftAppendProd (ctx₁ i) (ctx₂ i) (StmtOut i) (WitOut i) tr out + let mapTriple : + ((tr : Spec.Transcript ((ctx₁ i).append (ctx₂ i))) × + Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) + (fun tr₁ tr₂ => HonestProverOutput (StmtOut i tr₁ tr₂) (WitOut i tr₁ tr₂)) tr × + Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr) → + ((tr : Spec.Transcript ((ctx₁ i).append (ctx₂ i))) × + HonestProverOutput + (Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr) + (Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (WitOut i) tr) × + Spec.Transcript.liftAppend (ctx₁ i) (ctx₂ i) (StmtOut i) tr) := + fun z => ⟨z.1, mapOut z.1 z.2.1, z.2.2⟩ + have hmap : + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + (Spec.Strategy.mapOutputWithRoles mapOut strat) + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) = + mapTriple <$> + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + strat + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) := by + have hraw : + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + (Spec.Strategy.mapOutputWithRoles mapOut strat) + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) = + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + mapTriple <$> + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + strat + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) := by + refine congrArg + (fun k => + Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) >>= k) ?_ + funext strat + simpa [mapTriple, mapOut, Spec.Counterpart.mapOutput_id] using + (Spec.Strategy.runWithRoles_mapOutputWithRoles_mapOutput + (fP := mapOut) (fC := fun _ x => x) strat + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) + calc + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + (Spec.Strategy.mapOutputWithRoles mapOut strat) + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) = + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + mapTriple <$> + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + strat + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) := hraw + _ = mapTriple <$> + (do + let strat ← Spec.Strategy.compWithRoles strat₁ + (fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + Spec.Strategy.runWithRoles ((ctx₁ i).append (ctx₂ i)) ((roles₁ i).append (roles₂ i)) + strat + (Spec.Counterpart.append (reduction1.verifier i stmt) + (fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid))) := by + simp + rw [hmap] + simpa [mapTriple, mapOut, bind_assoc] using + congrArg (fun mx => mapTriple <$> mx) + (Spec.Strategy.runWithRoles_compWithRoles_append + (strat₁ := strat₁) + (f := fun tr₁ midOut => reduction2.prover ⟨i, stmt, tr₁⟩ midOut.stmt midOut.wit) + (cpt₁ := reduction1.verifier i stmt) + (cpt₂ := fun tr₁ sMid => reduction2.verifier ⟨i, stmt, tr₁⟩ sMid)) + +/-- Compose per-stage prover and verifier step functions into a reduction over +a chained protocol `Spec.stateChain Stage spec advance n`. + +The prover and verifier each carry evolving state through the state chain: +- `ProverState i st` is the prover's state at stage `i` with state chain state `st`. + Initialized from the witness via `proverInit`, then transformed at each stage + by `proverStep`. The terminal prover state becomes `WitnessOut`. +- `VerifierState i st` is the verifier's state at stage `i`. + Initialized from the statement via `verifierInit`, then transformed by + `verifierStep`. The terminal verifier state becomes `StatementOut`. + +Both output types are computed as `Transcript.stateChainFamily` of the respective +state families. -/ +def Reduction.stateChainComp {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {StatementIn WitnessIn : SharedIn → Type w} + {Stage : Nat → Type u} + {spec : (i : Nat) → Stage i → Spec} + {advance : (i : Nat) → (s : Stage i) → Spec.Transcript (spec i s) → Stage (i + 1)} + {roles : (i : Nat) → (s : Stage i) → RoleDecoration (spec i s)} + {ProverState VerifierState : (i : Nat) → Stage i → Type u} + (n : Nat) + (initStage : SharedIn → Stage 0) + (proverInit : (i : SharedIn) → StatementIn i → WitnessIn i → + m (ProverState 0 (initStage i))) + (proverStep : (j : Nat) → (st : Stage j) → ProverState j st → + m (Spec.Strategy.withRoles m (spec j st) (roles j st) + (fun tr => ProverState (j + 1) (advance j st tr)))) + (stmtResult : (i : SharedIn) → StatementIn i → + (tr : Spec.Transcript (Spec.stateChain Stage spec advance n 0 (initStage i))) → + PFunctor.FreeM.Path.stateChainFamily VerifierState n 0 (initStage i) tr) + (verifierInit : (i : SharedIn) → StatementIn i → VerifierState 0 (initStage i)) + (verifierStep : (j : Nat) → (st : Stage j) → VerifierState j st → + Spec.Counterpart m (spec j st) (roles j st) + (fun tr => VerifierState (j + 1) (advance j st tr))) : + Reduction m SharedIn + (fun i => Spec.stateChain Stage spec advance n 0 (initStage i)) + (fun i => Spec.Decoration.stateChain roles n 0 (initStage i)) + StatementIn + WitnessIn + (fun i => PFunctor.FreeM.Path.stateChainFamily VerifierState n 0 (initStage i)) + (fun i => PFunctor.FreeM.Path.stateChainFamily ProverState n 0 (initStage i)) where + prover i stmt w := do + let a ← proverInit i stmt w + let strat ← Spec.Strategy.stateChainCompWithRoles proverStep n 0 (initStage i) a + pure <| Spec.Strategy.mapOutputWithRoles (fun tr pOut => ⟨stmtResult i stmt tr, pOut⟩) strat + verifier i stmt := + Spec.Counterpart.stateChainComp verifierStep n 0 (initStage i) (verifierInit i stmt) + +/-! ## Chain-based (stateless) reduction composition + +Reduction composition over an `n`-round protocol described by `Spec.Chain`, +with **no prover state, no verifier state, and no round index family**. + +Each participant provides a per-round step that receives the remaining +`Chain` and produces the strategy/counterpart for the current round. +The remaining chain implicitly encodes prior transcript context +(since it was obtained by applying prior transcripts to the original +continuation). No state flows between rounds (per-round outputs are `PUnit`). +The final `StatementOut` and `WitnessOut` are computed from the full +transcript via caller-supplied result functions. -/ + +namespace Spec + +/-- Build a `Decoration S` for `Chain.toSpec n c` from per-round decorators. +At each level, the decorator receives the remaining `Chain` and +produces the decoration for the current round's spec. -/ +def Decoration.ofChain {S : Type u → Type v} + (decoAt : {k : Nat} → (rem : Chain.{u} (k + 1)) → Decoration S rem.1) : + (n : Nat) → (c : Chain.{u} n) → Decoration S (Chain.toSpec n c) + | 0, _ => ⟨⟩ + | n + 1, ⟨spec, cont⟩ => + Decoration.append (decoAt ⟨spec, cont⟩) + (fun tr => Decoration.ofChain decoAt n (cont tr)) + +namespace Chain + +/-- Build a `RoleDecoration` for the full spec from per-round role +assignments. Specializes `Decoration.ofChain` to `fun _ => Role`. -/ +abbrev roles + (rolesAt : {k : Nat} → (rem : Chain.{u} (k + 1)) → RoleDecoration rem.1) : + (n : Nat) → (c : Chain.{u} n) → RoleDecoration (Chain.toSpec n c) := + Decoration.ofChain rolesAt + +end Chain + +/-- Compose per-round prover strategies into a full strategy over the +chain. Each round's step receives the remaining `Chain` and +produces the strategy for that round's spec. Output is `PUnit` — no +state flows between rounds. -/ +def Strategy.ofChain {m : Type u → Type u} [Monad m] + {rolesAt : {k : Nat} → (rem : Chain.{u} (k + 1)) → RoleDecoration rem.1} + (step : {k : Nat} → (rem : Chain.{u} (k + 1)) → + m (Strategy.withRoles m rem.1 (rolesAt rem) (fun _ => PUnit.{u + 1}))) : + (n : Nat) → (c : Chain.{u} n) → + m (Strategy.withRoles m (Chain.toSpec n c) + (Decoration.ofChain rolesAt n c) (fun _ => PUnit.{u + 1})) + | 0, _ => pure ⟨⟩ + | n + 1, ⟨spec, cont⟩ => do + let strat ← step ⟨spec, cont⟩ + @Strategy.compWithRolesFlat m _ spec (fun tr => Chain.toSpec n (cont tr)) + (rolesAt ⟨spec, cont⟩) (fun tr => Decoration.ofChain rolesAt n (cont tr)) + (fun _ => PUnit.{u + 1}) (fun _ => PUnit.{u + 1}) + strat (fun tr _ => Strategy.ofChain step n (cont tr)) + +/-- Compose per-round verifier counterparts into a full counterpart over +the chain. Each round's step receives the remaining `Chain` and +produces the counterpart for that round's spec. Output is `PUnit`. -/ +def Counterpart.ofChain {m : Type u → Type u} [Monad m] + {rolesAt : {k : Nat} → (rem : Chain.{u} (k + 1)) → RoleDecoration rem.1} + (step : {k : Nat} → (rem : Chain.{u} (k + 1)) → + Counterpart m rem.1 (rolesAt rem) (fun _ => PUnit.{u + 1})) : + (n : Nat) → (c : Chain.{u} n) → + Counterpart m (Chain.toSpec n c) + (Decoration.ofChain rolesAt n c) (fun _ => PUnit.{u + 1}) + | 0, _ => ⟨⟩ + | n + 1, ⟨spec, cont⟩ => + @Counterpart.appendFlat m _ spec (fun tr => Chain.toSpec n (cont tr)) + (rolesAt ⟨spec, cont⟩) (fun tr => Decoration.ofChain rolesAt n (cont tr)) + (fun _ => PUnit.{u + 1}) (fun _ => PUnit.{u + 1}) + (step ⟨spec, cont⟩) + (fun tr _ => Counterpart.ofChain step n (cont tr)) + +end Spec + +/-- Compose per-round prover and verifier steps into a full `Reduction` +over an `n`-round `Chain`. No `ProverState`, `VerifierState`, or +round index family. Per-round steps produce `PUnit` — no state flows +between rounds. The final `StatementOut` and `WitnessOut` are computed +from the full transcript via `stmtResult` and `witResult`. -/ +def Reduction.ofChain {m : Type u → Type u} [Monad m] + {SharedIn : Type v} + {WitnessIn : SharedIn → Type w} + {n : Nat} + {c : SharedIn → Spec.Chain.{u} n} + {rolesAt : {k : Nat} → (rem : Spec.Chain.{u} (k + 1)) → RoleDecoration rem.1} + {StatementOut WitnessOut : (i : SharedIn) → + Spec.Transcript (Spec.Chain.toSpec n (c i)) → Type u} + (proverRound : (i : SharedIn) → WitnessIn i → + {k : Nat} → (rem : Spec.Chain.{u} (k + 1)) → + m (Spec.Strategy.withRoles m rem.1 (rolesAt rem) (fun _ => PUnit.{u + 1}))) + (verifierRound : (i : SharedIn) → + {k : Nat} → (rem : Spec.Chain.{u} (k + 1)) → + Spec.Counterpart m rem.1 (rolesAt rem) (fun _ => PUnit.{u + 1})) + (witResult : (i : SharedIn) → + (tr : Spec.Transcript (Spec.Chain.toSpec n (c i))) → WitnessOut i tr) + (stmtResult : (i : SharedIn) → + (tr : Spec.Transcript (Spec.Chain.toSpec n (c i))) → StatementOut i tr) : + Reduction m SharedIn + (fun i => Spec.Chain.toSpec n (c i)) + (fun i => Spec.Decoration.ofChain rolesAt n (c i)) + (fun _ => PUnit) + WitnessIn + StatementOut WitnessOut where + prover i _ w := do + let strat ← Spec.Strategy.ofChain (rolesAt := rolesAt) (proverRound i w) n (c i) + pure <| Spec.Strategy.mapOutputWithRoles + (fun tr _ => ⟨stmtResult i tr, witResult i tr⟩) strat + verifier i _ := + Spec.Counterpart.mapOutput (fun tr _ => stmtResult i tr) + (Spec.Counterpart.ofChain (rolesAt := rolesAt) (verifierRound i) n (c i)) + +end Interaction diff --git a/lake-manifest.json b/lake-manifest.json index 204a7accdd..79f56bfe68 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -38,7 +38,7 @@ "rev": "5f7707fbeb0c53754580b0a506af8952f75e9019", "name": "VCVio", "manifestFile": "lake-manifest.json", - "inputRev": "5f7707fbeb0c53754580b0a506af8952f75e9019", + "inputRev": "v4.30.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/mathlib4",