syntax "integral_domain_tactic" : tactic

macro_rules
| `(tactic| simplify_mvpoly_option_eqn) =>
  `(tactic|
    simp only [monomial_zero', List.singleton_append, List.cons_append, List.append_assoc,
      List.map_cons, Sum.elim_inl, Sum.elim_inr, List.map_append, List.map_map, List.sum_cons,
      List.sum_append, List.map_nil, List.sum_nil, add_zero, Sum.elim_lam_const_lam_const, map_one,
      one_mul, map_zero, zero_mul, map_neg, neg_mul, neg_add_rev, zero_add, mul_zero,

      Function.comp, List.sum_map_zero] at eqn;
    simp only [mul_add, add_mul, List.sum_map_add] at eqn;

    simp only [

      mul_assoc,

      mul_left_comm (C _) (X (some _)) _, mul_left_comm (List.sum _) (X (some _)) _,
      mul_comm (C _) (X (some _)), mul_comm (List.sum _) (X (some _)),

      neg_mul, mul_neg,

      List.sum_map_mul_right, List.sum_map_mul_left] at eqn;

    trace "Converting to MvPolynomial over Polynomials";
    replace eqn := congr_arg (MvPolynomial.optionEquivRight F Vars) eqn;
    simp only [AlgEquiv.map_add, AlgEquiv.map_zero, AlgEquiv.map_mul, AlgEquiv.map_one,
      AlgEquiv.map_neg, AlgEquiv.list_map_sum, AlgEquiv.map_pow] at eqn;
    simp only [MvPolynomial.optionEquivRight_C, MvPolynomial.optionEquivRight_X_none, MvPolynomial.optionEquivRight_X_some, optionEquivRight_to_MvPolynomial_Option] at eqn;

    simp only [←MvPolynomial.C_mul, ←MvPolynomial.C_pow, ←MvPolynomial.C_add,
      MvPolynomial.sum_map_C] at eqn;

    simp only [MvPolynomial.X, C_apply, MvPolynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, mul_add, add_mul] at eqn
  )

macro_rules
| `(tactic| polynomial_ext) =>
  `(tactic| sorry)

macro_rules
| `(tactic| integral_domain_tactic) =>
  `(tactic|
      trace "Call to integral_domain_tactic";

      simp_all (config := {decide := false, failIfUnchanged := false}) only [

            false_or, or_false, true_or, or_true, not_true, not_false_iff,

            add_zero, zero_add, mul_zero, zero_mul, mul_one, one_mul, neg_zero,

            neg_eq_zero, add_eq_zero_iff_eq_neg,
            eq_self_iff_true, eq_zero_of_zero_eq, one_ne_zero, mul_ne_zero_iff, zero_sub_eq_iff,

            mul_eq_zero];
      first

        | done

        | cases_or _ ∨ _
          all_goals integral_domain_tactic

        | skip
   )

Vars

inductive Vars : Type where
  | α : Vars
  | β_v : Vars
  | β_w : Vars
  | β_y : Vars
  | γ : Vars
deriving Repr, BEq

local notation "poly_α" => X (some Vars.α)
local notation "poly_β_v" => X (some Vars.β_v)
local notation "poly_β_w" => X (some Vars.β_w)
local notation "poly_β_y" => X (some Vars.β_y)
local notation "poly_γ" => X (some Vars.γ)
local notation "poly_s" => X (none)

inductive Vars : Type where
  | r_v : Vars
  | r_w : Vars
  | α_v : Vars
  | α_w : Vars
  | α_y : Vars
  | β : Vars
  | γ : Vars
deriving Repr, BEq

local notation "poly_r_v" => X (some Vars.r_v)
local notation "poly_r_w" => X (some Vars.r_w)
local notation "poly_α_v" => X (some Vars.α_v)
local notation "poly_α_w" => X (some Vars.α_w)
local notation "poly_α_y" => X (some Vars.α_y)
local notation "poly_β" => X (some Vars.β)
local notation "poly_γ" => X (some Vars.γ)
local notation "poly_s" => X (none)

inductive SRS_Elements_G1_Idx {n_stmt n_wit n_var : ℕ} : Type where
  | α : SRS_Elements_G1_Idx
  | β : SRS_Elements_G1_Idx
  | δ : SRS_Elements_G1_Idx
  | x_pow : Fin n_var → SRS_Elements_G1_Idx
  | x_pow_times_t : Fin (n_var - 1) → SRS_Elements_G1_Idx
  | y : Fin n_stmt → SRS_Elements_G1_Idx
  | q : Fin n_wit → SRS_Elements_G1_Idx

inductive SRS_Elements_G2_Idx {n_stmt n_wit n_var : ℕ} : Type where
  | β : SRS_Elements_G2_Idx
  | γ : SRS_Elements_G2_Idx
  | δ : SRS_Elements_G2_Idx
  | x_pow : Fin n_var → SRS_Elements_G2_Idx

AGMProofSystemInstantiation

structure AGMProofSystemInstantiation (F : Type) [Field F] where
  Stmt Sample SRSElements Proof EqualityChecks : Type

  ListSRSElements : List SRSElements
  SRSElementValue : SRSElements → MvPolynomial Sample F
  ListProof : List Proof
  Pairings : EqualityChecks → Type
  ListPairings : (k : EqualityChecks) → List (Pairings k)
  verificationPairingSRS_G1 : Stmt -> (k : EqualityChecks) → Pairings k → SRSElements → F
  verificationPairingSRS_G2 : Stmt -> (k : EqualityChecks) → Pairings k → SRSElements → F
  verificationPairingProof_G1 : Stmt -> (k : EqualityChecks) → Pairings k → Proof → F
  verificationPairingProof_G2 : Stmt -> (k : EqualityChecks) → Pairings k → Proof → F

noncomputable def proof_element_G1_as_poly {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (pf_elem : 𝓟.Proof_G1) :
    MvPolynomial (𝓟.Sample) F :=
  (𝓟.ListSRSElements_G1.map fun SRS_elem =>
          MvPolynomial.C (prover.fst pf_elem SRS_elem) * (𝓟.SRSElementValue_G1 SRS_elem)).sum

Prover

def Prover (F : Type) [Field F]
    (𝓟 : AGMProofSystemInstantiation F) : Type :=
  (𝓟.Proof -> 𝓟.SRSElements -> F) × (𝓟.Proof -> 𝓟.SRSElements -> F)

noncomputable def proof_element_G2_as_poly {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (pf_elem : 𝓟.Proof_G2) :
    MvPolynomial (𝓟.Sample) F :=
  (𝓟.ListSRSElements_G2.map fun SRS_elem =>
          MvPolynomial.C (prover.snd pf_elem SRS_elem) * (𝓟.SRSElementValue_G2 SRS_elem)).sum

soundness

def soundness (F : Type) [Field F]
    (𝓟 : AGMProofSystemInstantiation F)
    (Wit : Type) (relation : 𝓟.Stmt -> Wit -> Prop)
    (extractor : 𝓟.Prover -> Wit) : Prop :=
   ∀ stmt : 𝓟.Stmt,
    ∀ prover : 𝓟.Prover,
      𝓟.verify prover stmt -> relation stmt (extractor prover)

verify

def verify {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (stmt : 𝓟.Stmt) : Prop :=
  (
    ∀ check_idx : 𝓟.EqualityChecks, 𝓟.check_poly prover stmt check_idx = 0
  )
  ∧
  ∀ pfs ∈ 𝓟.Identified_Proof_Elems,
    𝓟.proof_element_as_poly prover pfs.fst = 𝓟.proof_element_as_poly prover pfs.snd

noncomputable def check_poly {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (stmt : 𝓟.Stmt) (check_idx : 𝓟.EqualityChecks) :
    MvPolynomial 𝓟.Sample F :=
  (
  (𝓟.ListPairings check_idx).map fun pairing =>
    𝓟.pairing_poly prover stmt check_idx pairing
  ).sum

noncomputable def pairing_poly {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (stmt : 𝓟.Stmt) (check_idx : 𝓟.EqualityChecks) (pairing : 𝓟.Pairings check_idx) :
    MvPolynomial 𝓟.Sample F :=
  (
    (

      (
        (𝓟.ListProof.map fun pf_elem =>
          C (𝓟.verificationPairingProof stmt check_idx pairing pf_elem)
            *

            𝓟.proof_element_as_poly prover pf_elem).sum
      )
      +
      (
        (𝓟.ListSRSElements.map fun SRS_elem =>
          C (𝓟.verificationPairingSRS stmt check_idx pairing SRS_elem) * (𝓟.SRSElementValue SRS_elem)).sum
      )
    )
    *
    (

      (
        (𝓟.ListProof.map fun pf_elem =>
          C (𝓟.verificationPairingProof stmt check_idx pairing pf_elem)
            *

            𝓟.proof_element_as_poly prover pf_elem).sum
      )
      +
      (
        (𝓟.ListSRSElements.map fun SRS_elem =>
          C (𝓟.verificationPairingSRS stmt check_idx pairing SRS_elem) * (𝓟.SRSElementValue SRS_elem)).sum
      )
    )
  )

noncomputable def proof_element_as_poly {F : Type} [Field F]
    (𝓟 : AGMProofSystemInstantiation F) (prover : 𝓟.Prover) (pf_elem : 𝓟.Proof) :
    MvPolynomial (𝓟.Sample) F :=
  (𝓟.ListSRSElements.map fun SRS_elem =>
          MvPolynomial.C (prover.fst pf_elem SRS_elem) * (𝓟.SRSElementValue SRS_elem)).sum

noncomputable def to_MvPolynomial_Option {F : Type} [Field F] (V : Type) :
    Polynomial F →+* MvPolynomial (Option V) F
  where
    toFun p := Polynomial.eval₂ (MvPolynomial.C) (MvPolynomial.X none) p
    map_one' := by admit /- proof elided -/

lemma MvPolynomial.sum_map_C {σ A R : Type} [CommSemiring R] (l : List A) (f : A → R) :
    (l.map (fun (x : A) => C (σ := σ) (f x))).sum = C ((l.map f).sum)

theorem AlgEquiv.list_map_sum {R : Type uR} {A₁ : Type uA₁} {A₂ : Type uA₂}
    [CommSemiring R] [Semiring A₁] [Semiring A₂] [Algebra R A₁] [Algebra R A₂]
    (e : A₁ ≃ₐ[R] A₂) {ι : Type u_1} (f : ι → A₁) (l : List ι) :
    e (l.map (fun (x : ι) => f x)).sum = (l.map fun (x : ι) => e (f x)).sum

lemma optionEquivRight_to_MvPolynomial_Option {F V : Type} [Field F] (p : Polynomial F) :
    (MvPolynomial.optionEquivRight F V) (to_MvPolynomial_Option V p) = C p

lemma optionEquivRight_comp_to_MvPolynomial_Option {F V : Type} [Field F] :
    RingHom.comp (MvPolynomial.optionEquivRight F V).toRingEquiv.toRingHom (to_MvPolynomial_Option (F := F) V) = C

lemma to_MvPolynomial_Option_C {F V : Type} [Field F] (r : F) :
    to_MvPolynomial_Option V (Polynomial.C r) = MvPolynomial.C r

theorem Polynomial.hom_congr_vars {R : Type u} {S : Type v}
    [CommSemiring R] [CommSemiring S]
    {f₁ : Polynomial R →+* S} {f₂ : Polynomial R →+* S}
    (hC : RingHom.comp f₁ Polynomial.C = RingHom.comp f₂ Polynomial.C)
    (hv : f₁ (Polynomial.X) = f₂ (Polynomial.X)) :
    f₁ = f₂

lemma to_MvPolynomial_Option_X {F V : Type} [Field F] :
    to_MvPolynomial_Option V (Polynomial.X) = MvPolynomial.X (R := F) none

ToySnark.WitEntries

def Proof_G2_Idx : Type := Empty

ToySnark.ToySnark

lemma Vars.finsupp_eq_ext (f g : Vars →₀ ℕ) : f = g ↔
    f Vars.α = g Vars.α
    ∧ f Vars.β = g Vars.β

import FormalSnarksProject.Models.AGMProofSystemInstantiation

import Mathlib.Algebra.Polynomial.Div

import FormalSnarksProject.ToMathlib.OptionEquivRight

import Mathlib.Algebra.MvPolynomial.Equiv

import FormalSnarksProject.SoundnessTactic.SoundnessProver

open scoped BigOperators Classical

section ToySnark

open MvPolynomial Option List

namespace ToySnark

inductive Vars : Type where
  | α : Vars
  | β : Vars
deriving Repr, BEq

inductive StmtEntries : Type where
  | x : StmtEntries
  | y : StmtEntries
  | z : StmtEntries
deriving Repr, BEq

inductive WitEntries : Type where
  | A : WitEntries
  | B : WitEntries
deriving Repr, BEq

local notation "Vars_α" => some Vars.α
local notation "Vars_β" => some Vars.β
local notation "Vars_x" => none

inductive Proof_G1_Idx : Type where
  | Pf : Proof_G1_Idx

def Proof_G2_Idx : Type := Empty

inductive PairingsIdx : Type where
  | lhs : PairingsIdx
  | rhs : PairingsIdx

inductive SRS_Elements_G2_Idx : Type where
  | α : SRS_Elements_G2_Idx
  | β : SRS_Elements_G2_Idx

noncomputable def ToySnark

    {F : Type} [Field F] :
    AGMProofSystemInstantiation F :=
  {
    Stmt := StmtEntries -> F
    Sample := Option Vars
    SRSElements_G1 := SRS_Elements_G1_Idx
    ListSRSElements_G1 :=
      [.α, .β]
    SRSElements_G2 := SRS_Elements_G2_Idx
    ListSRSElements_G2 :=
      [.α, .β]
    SRSElementValue_G1 := fun SRS_idx => match SRS_idx with
      | SRS_Elements_G1_Idx.α => MvPolynomial.X Vars_α
      | SRS_Elements_G1_Idx.β => MvPolynomial.X Vars_β
    SRSElementValue_G2 := fun SRS_idx => match SRS_idx with
      | SRS_Elements_G2_Idx.α => MvPolynomial.X Vars_α
      | SRS_Elements_G2_Idx.β => MvPolynomial.X Vars_β
    Proof_G1 := Proof_G1_Idx
    ListProof_G1 := [Proof_G1_Idx.Pf]
    Proof_G2 := Proof_G2_Idx
    ListProof_G2 := []
    EqualityChecks := Unit
    Pairings := fun _ => PairingsIdx
    ListPairings := fun _ => [PairingsIdx.lhs, PairingsIdx.rhs]
    verificationPairingSRS_G1 := fun stmt _ i SRS_idx => match i with
      | PairingsIdx.lhs => 0
      | PairingsIdx.rhs => match SRS_idx with
        | SRS_Elements_G1_Idx.α => stmt StmtEntries.z
        | SRS_Elements_G1_Idx.β => 0
    verificationPairingSRS_G2 := fun stmt _ i SRS_idx => match i with
      | PairingsIdx.lhs => match SRS_idx with
        | SRS_Elements_G2_Idx.α => stmt StmtEntries.x
        | SRS_Elements_G2_Idx.β => stmt StmtEntries.y
      | PairingsIdx.rhs => match SRS_idx with
        | SRS_Elements_G2_Idx.α => 0
        | SRS_Elements_G2_Idx.β => -1
    verificationPairingProof_G1 := fun stmt _ i pf => match i with
      | PairingsIdx.lhs => match pf with
        | Proof_G1_Idx.Pf => 1
      | PairingsIdx.rhs => match pf with
        | Proof_G1_Idx.Pf => 0
    verificationPairingProof_G2 := fun stmt _ i pf => 0
  }

section soundness

lemma soundness
    {F : Type} [Field F] :
    (AGMProofSystemInstantiation.soundness
      F
      (ToySnark
        (F := F))
      (WitEntries -> F)
      (fun (stmt : StmtEntries → F) (wit : WitEntries -> F) =>
        wit WitEntries.A * stmt StmtEntries.y = stmt StmtEntries.z -- - wit WitEntries.I
        ∨
        wit WitEntries.B * stmt StmtEntries.x = stmt StmtEntries.z -- - wit WitEntries.I
      )
      (fun prover i => prover.fst Proof_G1_Idx.Pf (if i = WitEntries.A then .α else .β))

    ) :=

:= by
  unfold AGMProofSystemInstantiation.soundness AGMProofSystemInstantiation.verify AGMProofSystemInstantiation.proof_element_G1_as_poly AGMProofSystemInstantiation.proof_element_G2_as_poly
  intros stmt prover eqns'
  rcases eqns' with ⟨eqns, null⟩
  have eqn := eqns ()
  clear eqns null

  -- Step 1: Obtain the coefficient equations of the mv_polynomials
  simp_rw [ToySnark] at eqn
  simp only [monomial_zero', List.singleton_append, List.cons_append, List.append_assoc,
    List.map_cons, Sum.elim_inl, Sum.elim_inr, List.map_append, List.map_map, List.sum_cons,
    List.sum_append, List.map_nil, List.sum_nil, add_zero, Sum.elim_lam_const_lam_const, map_one,
    one_mul, map_zero, zero_mul, map_neg, neg_mul, neg_add_rev, zero_add, mul_zero,
    -- Note: everything above is @simp tagged
    Function.comp, List.sum_map_zero] at eqn

  simp only [mul_add, add_mul, List.sum_map_add] at eqn

  -- Move all the X (some _) terms to the left, and out of sums
  simp only [
    -- Associativity to obtain a right-leaning tree
    mul_assoc,
    -- Commutativity lemmas to move X (some _) to the left
    mul_left_comm (C _) (X (some _)) _, mul_left_comm (List.sum _) (X (some _)) _,
    mul_comm (C _) (X (some _)), mul_comm (List.sum _) (X (some _)),
    -- Move negations to the bottom
    neg_mul, mul_neg,
    -- Move constant multiplications (which the X (some _) terms should be) out of sums
    List.sum_map_mul_right, List.sum_map_mul_left] at eqn

  -- I apply MvPolynomial.optionEquivRight *here*,
  -- so that we can treat polynomials in Vars_X as constants
  trace "Converting to MvPolynomial over Polynomials"
  replace eqn := congr_arg (MvPolynomial.optionEquivRight F Vars) eqn
  simp only [AlgEquiv.map_add, AlgEquiv.map_zero, AlgEquiv.map_mul, AlgEquiv.map_one,
    AlgEquiv.map_neg, AlgEquiv.list_map_sum, AlgEquiv.map_pow] at eqn
  simp only [MvPolynomial.optionEquivRight_C, MvPolynomial.optionEquivRight_X_none, MvPolynomial.optionEquivRight_X_some, optionEquivRight_to_MvPolynomial_Option] at eqn
  -- Move Cs back out so we can recognize the monomials
  -- simp only [←MvPolynomial.C_mul, ←MvPolynomial.C_pow, ←MvPolynomial.C_add,
  --   MvPolynomial.sum_map_C] at eqn

  simp only [MvPolynomial.X, C_apply, MvPolynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, mul_add, add_mul] at eqn

  trace "Applying individual coefficients"

  have h20 := congr_arg (coeff (Finsupp.single Vars.α 2 + Finsupp.single Vars.β 0)) eqn
  have h11 := congr_arg (coeff (Finsupp.single Vars.α 1 + Finsupp.single Vars.β 1)) eqn
  have h02 := congr_arg (coeff (Finsupp.single Vars.α 0 + Finsupp.single Vars.β 2)) eqn

  clear eqn

  trace "Distribute coefficient-taking over terms"
  simp only [coeff_monomial, coeff_add, coeff_neg, coeff_zero] at h20 h11 h02

  trace "Simplifying coefficient expressions"
  simp only [Vars.finsupp_eq_ext, Finsupp.single_apply, Finsupp.add_apply] at h20 h11 h02

  simp [ite_true, ite_self, add_zero, ite_false, and_self, zero_add,
    one_ne_zero, and_false, false_and, add_eq_zero, mul_eq_zero,
    add_right_eq_self, zero_ne_one, and_true, true_and, neg_zero] at h20 h11 h02 ⊢

  -- Completely remove references to Polynomial
  simp only [add_neg_eq_zero, Polynomial.C_inj, ←Polynomial.C_add, ←Polynomial.C_mul] at h20 h11 h02

  integral_domain_tactic


theorem theorem1 : ¬adversaryWon (attackGame requests) := λ contra ↦ by
  /-
    PAPER: Suppose an adversary and a challenger have interacted in Attack game 1.
    We will show that either the resulting contract balance is positive (the adver-
    sary lost the game), or the adversary has been able to either break the bind-
    ing property of the authenticated dictionary scheme or found a collision of the
    hash function H.
  -/

  /-
    The attack game plays out the same regardless of validity of requests.
  -/
  rw [attackGame_eq_attackGameBlocks!_normalise, attackGameBlocks_eq_attackGameR] at contra
  set requests! := normalise requests with eqRequests
  /-
    PAPER: Let B∗ = (Bi)i∈[n] be the contract state after the attack game
  -/
  set Bstar := attackGameR requests! [] with eqBstar
  /-
    As such, we can consider a state with only valid requests.
  -/
  have hValid : ∀ request ∈ (normalise requests), request.isValid

local macro:max (priority := high) "↪" b:term : term => `(⟨$

local macro:max (priority := high) "↪" b:term : term => `(⟨$b, by admit /- proof elided -/
⟩)

notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

notation:65 π₁:65 " <+> " π₂:66 => Dict.Merge π₁ π₂

notation:65 π₁:65 " <+> " π₂:66 => Dict.Merge π₁ π₂

notation:51 π₁:52 " <≅> " π₂:52 => BalanceProof.compat π₁ π₂

notation:51 π₁:52 " <≅> " π₂:52 => BalanceProof.compat π₁ π₂

BalanceProof

abbrev BalanceProof (K₁ K₂ : Type) [Finite K₁] [Finite K₂]
                    (C Pi V : Type) [PreWithZero V] : Type :=
  Dict (C × K₂) ((Pi × ExtraDataT) × TransactionBatch K₁ K₂ V)

TransactionBatch

abbrev TransactionBatch (K₁ : Type) [Finite K₁]
                        (K₂ : Type) [Finite K₂]
                        (V : Type) [PreWithZero V] :=
  Key K₁ K₂ → V₊

Key

abbrev Key (K₁ K₂ : Type) := K₁ ⊕ K₂

abbrev

class abbrev PreWithZero (α : Type) := Preorder α, Zero α

NonNeg

def NonNeg (α : Type) [PreWithZero α] := { a : α // 0 ≤ a }

ExtraDataT

abbrev ExtraDataT : Type := ℕ

Dict

abbrev Dict (α ω : Type) : Type := α → Option ω

Merge

def Merge (D₁ D₂ : Dict α ω) : Dict α ω := D
  where D := λ x ↦ First (D₁ x) (D₂ x)

First

def First (x₁ x₂ : Option α) : Option α :=
  match x₁, x₂ with
  | .some x, .none => .some x
  | .some x, .some _ => .some x
  | .none, .some y => .some y
  | .none, .none => .none

getBalanceProof

def getBalanceProof (requests : List (Request K₁ K₂ C Sigma Pi V))
                    (h₀ : ∀ request ∈ requests, request.isValid)
                    (i : Fin (attackGameR requests []).length)
                    (h₁ : (attackGameR requests [])[i].isWithdrawalBlock) :
                    BalanceProof K₁ K₂ C Pi V :=
  let request := requests[i]'(by admit /- proof elided -/
  )
  have : request.getWithdrawal.isSome := by admit /- proof elided -/

attackGameR

def attackGameR : Scontract K₁ K₂ V C Sigma :=
  σ ++ attackGameRGo requests σ

attackGameRGo

def attackGameRGo (requests : List (Request K₁ K₂ C Sigma Pi V))
                  (σ : Scontract K₁ K₂ V C Sigma) : Scontract K₁ K₂ V C Sigma :=
  match requests with
  | [] => []
  | hd :: tl => hd.toBlock! σ :: attackGameRGo tl (σ.appendBlock! hd)

appendBlock!

def appendBlock! (σ : Scontract K₁ K₂ V C Sigma)
                 (request : Request K₁ K₂ C Sigma Pi V) : Scontract K₁ K₂ V C Sigma :=
  σ ++ [request.toBlock! σ]

toBlock!

def toBlock! (σ : Scontract K₁ K₂ V C Sigma)
             (request : Request K₁ K₂ C Sigma Pi V) : Block K₁ K₂ C Sigma V :=
  match request with
  | .deposit r v            => .deposit r v
  | .transfer a e c s sigma => .transfer a e c s sigma
  | .withdrawal π           => .withdrawal (π.toBalanceF σ)

Request

inductive Request where
  | deposit (recipient : K₂) (amount : V₊)
  | transfer (aggregator : K₁) (extradata : ExtraDataT) (commitment : C) (senders : List K₂) (sigma : Sigma)
  | withdrawal (π : BalanceProof K₁ K₂ C Pi V)

BalanceProof.toBalanceF

def BalanceProof.toBalanceF (π : BalanceProof K₁ K₂ C Pi V)
                            (σ : Scontract K₁ K₂ V C Sigma) : K₁ → V₊ :=
  λ k : K₁ ↦ ⟨Bal π σ k, by admit /- proof elided -/
  ⟩

Bal

def Bal (π : BalanceProof K₁ K₂ C Pi V) (bs : List (Block K₁ K₂ C Sigma V)) : S K₁ K₂ V :=
  fStar (TransactionsInBlocks π bs) (.initial K₁ K₂ V)

TransactionsInBlocks

def TransactionsInBlocks
  (π : BalanceProof K₁ K₂ C Pi V) (bs : List (Block K₁ K₂ C Sigma V)) : List (Τ K₁ K₂ V) :=
  (bs.map (TransactionsInBlock π)).flatten

TransactionsInBlock

def TransactionsInBlock (π : BalanceProof K₁ K₂ C Pi V) (b : Block K₁ K₂ C Sigma V) : List (Τ K₁ K₂ V) :=
  match h : b with
  | .deposit ..    => TransactionsInBlock_deposit ↪b
  | .transfer ..   => TransactionsInBlock_transfer π ↪b
  | .withdrawal .. => TransactionsInBlock_withdrawal ↪b

def TransactionsInBlock_withdrawal
  (b : { b : Block K₁ K₂ C Sigma V // b.isWithdrawalBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .withdrawal withdrawals =>

    let k₁InOrder := { s | s : K₁ }.toFinset.sort (·≤·)
    k₁InOrder.attach.map λ s : K₁ ↦ ⟨(s, .Source, withdrawals s), by admit /- proof elided -/
    ⟩
  | .deposit r v | .transfer .. => by admit /- proof elided -/

Block

inductive Block (K₁ K₂ : Type) (C Sigma : Type) (V : Type) [PreWithZero V] where

  | deposit (recipient : K₂) (amount : V₊)

  | transfer (aggregator : K₁) (extradata : ExtraDataT) (commitment : C) (senders : List K₂) (sigma : Sigma)

  | withdrawal (withdrawals : K₁ → V₊)

isWithdrawalBlock

abbrev isWithdrawalBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.withdrawal _)

attach

noncomputable def attach (α : Type) [Finite α] : UniquelyIndexed α :=
  have := Finite.exists_equiv_fin α
  this.choose_spec.some.toEmbedding

UniquelyIndexed

abbrev UniquelyIndexed (α : Type) [Finite α] : Type := α ↪ !α

UniqueTokenT

abbrev UniqueTokenT (α : Type) [Finite α] : Type := Fin (Finite.exists_equiv_fin α |>.choose)

Τ

abbrev Τ (K₁ K₂ V : Type) [PreWithZero V] := { τ : Τ' K₁ K₂ V // τ.isValid }

Τ'

abbrev Τ' (K₁ K₂ V : Type) [PreWithZero V] := Kbar K₁ K₂ × Kbar K₁ K₂ × Option V₊

Kbar

inductive Kbar (K₁ K₂ : Type) where
  | key (k : Key K₁ K₂)
  | Source
deriving DecidableEq

Injective

class Injective {α ω : Type} (f : α → ω) where
  h : ComputationallyInfeasible (¬ Function.Injective f)

def TransactionsInBlock_transfer
  (π : BalanceProof K₁ K₂ C Pi V) (b : { b : Block K₁ K₂ C Sigma V // b.isTransferBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .transfer _ _ commitment S _ =>

    let senderRecipient : Finset (K₂ × Key K₁ K₂) := { (k₂, k) | (k₂ : K₂) (k : Key K₁ K₂) (_h : k₂ ≠ₖ k) }
    let sorted : List (K₂ × Key K₁ K₂) := senderRecipient.sort Key.lexLe

    let v (s : K₂) (r : Key K₁ K₂) : Option V₊ :=
      if s ∉ S
      then .some 0
      else
        if h : (commitment, s) ∈ π.keys
        then let (_, t) := π[(commitment, s)]
             t r
        else .none
    sorted.attach.map λ ⟨(s, r), h⟩ ↦ ⟨(s, r, v s r), by admit /- proof elided -/
    ⟩
  | .deposit .. | .withdrawal .. => by admit /- proof elided -/

lexLe

def lexLe (a b : K₂ × Key K₁ K₂) : Prop :=
  a.1 < b.1 ∨ (a.1 = b.1 ∧ a.2 ≤ b.2)

isTransferBlock

abbrev isTransferBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.transfer _ _ _ _ _)

keys

def keys (m : Dict α ω) : Set α := { x | Dict.is_mem m x }

def Dict.is_mem (m : Dict α ω) (x : α) : Prop := (m x).isSome

abbrev keys (ct : CommitT C K Pi) := ct.dict.keys

CommitT

structure CommitT (C K Pi : Type) where
  commitment : C
  dict       : Dict K Pi

keysUneq

abbrev keysUneq (k₂ : K₂) (k : Key K₁ K₂) : Prop :=
  match k with
  | .inl _   => True
  | .inr k₂' => k₂ ≠ k₂'

def TransactionsInBlock_deposit
  (b : { b : Block K₁ K₂ C Sigma V // b.isDepositBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .deposit r v => [⟨(.Source, r, v), by admit /- proof elided -/
  ⟩]
  | .withdrawal .. | .transfer .. => by admit /- proof elided -/

isDepositBlock

abbrev isDepositBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.deposit _ _)

fStar

def fStar (Ts : List (Τ K₁ K₂ V)) (s₀ : S K₁ K₂ V) : S K₁ K₂ V :=
  Ts.foldl f s₀

f

def f (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) : S K₁ K₂ V :=
  ⟨
    λ k ↦
      have : InfSet V := infV b T k
      ⨅ x : boundedBelow b T, fc x.1 k,
    by admit /- proof elided -/
  ⟩

infV

def infV (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) (k : Kbar K₁ K₂) :
  InfSet V where
    sInf := λ s ↦ if s = V' b T k
                  then (exists_inf b T).1 k
                  else 0

def exists_inf (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) : { s : S K₁ K₂ V // ∀ k, IsGLB (V' b T k) (s k) } :=
  ⟨
    f' b T,
    λ k ↦
      have f'_codomain : (f' b T) k ∈ V' b T k := by admit /- proof elided -/
  ⟩

fc

def fc (τcXb : Τc K₁ K₂ V × S K₁ K₂ V) : S K₁ K₂ V :=
  ⟨λ k : Kbar K₁ K₂ ↦
    match τcXb with
    | ⟨⟨⟨⟨s, r, v⟩, _⟩, hτ⟩, b⟩ =>
      let v' := v' (v.get hτ) b s
      b k + (e r - e s) k • v',
  by admit /- proof elided -/
  ⟩

e

def e (i : Kbar K₁ K₂) : Kbar K₁ K₂ → ℤ := λ j ↦ if i = j then 1 else 0

S

abbrev S (K₁ K₂ V : Type) [PreWithZero V] := { s : S' K₁ K₂ V // s.isValid }

S'

abbrev S' (K₁ K₂ V : Type) := Kbar K₁ K₂ → V

Τc

abbrev Τc (K₁ K₂ V : Type) [PreWithZero V] : Type := { τ : Τ K₁ K₂ V // τ.isComplete }

boundedBelow

abbrev boundedBelow (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) :=
  { a : Τc K₁ K₂ V × S K₁ K₂ V | (T, b) ≤ (↑a.1, a.2) }

f'

def f' (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) : S K₁ K₂ V :=
  ⟨
    λ k ↦
      match h : T with
      | ⟨(_, _, .some _), hT⟩ => fc (⟨T, by admit /- proof elided -/
      ⟩, b) k
      | ⟨(s, _, .none), _⟩ => if k = s then 0 else b k,
    by admit /- proof elided -/
  ⟩

V'

def V' (b : S K₁ K₂ V) (T : Τ K₁ K₂ V) (k : Kbar K₁ K₂) : Set V :=
  { v : V | v ∈ (fc · k) '' boundedBelow b T }

isComplete

def isComplete (τ : Τ K₁ K₂ V) :=
  match τ with | ⟨(_, _, v), _⟩ => v.isSome

initial

def initial : Scontract K₁ K₂ V C Sigma := []

Scontract

abbrev Scontract (K₁ K₂ V : Type) [PreWithZero V] (C Sigma : Type) :=
  List (Block K₁ K₂ C Sigma V)

Request.isValid

def Request.isValid (request : Request K₁ K₂ C Sigma Pi V) : Bool :=
  match request with

  | deposit .. =>
      true

  | transfer aggregator extradata commitment senders sigma =>
      let isValidSA := SA.Verify senders (commitment, aggregator, extradata) sigma
      let isValidAggregator := aggregator = AgreedUponAggregator
      isValidSA ∧ isValidAggregator

  | withdrawal π =>
      π.Verify (M := (C × K₁ × ExtraDataT))

AgreedUponAggregator

def AgreedUponAggregator {K₁ : Type} [Nonempty K₁] : K₁ := Classical.arbitrary _

SignatureAggregation

class SignatureAggregation (M Kₚ Kₛ Sigma : Type) where
  KeyGen    : SimpleRandom.Seed → Kₚ × Kₛ
  Sign      : Kₛ → M → Sigma
  Aggregate : List (Kₚ × Sigma) → Sigma
  Verify    : List Kₚ → M → Sigma → Bool

  Correctness : ∀ (l : List (Kₚ × Kₛ)) (_ : ∀ pair ∈ l, pair ←ᵣ KeyGen) (m : M),
                  let (kₚs, kₛs) := l.unzip
                  Verify kₚs m (Aggregate (kₚs.zip (kₛs.map (Sign · m)))) = true

  Unforgeability :
    ComputationallyInfeasible <|
      ∃ (k : List (Kₚ × Kₛ)) (m : M) (σ : Sigma),
        let kₚs := k.map Prod.fst
        Verify kₚs m σ = true ∧

        ∃ userIdx : Fin k.length,
          let (honestₚ, honestₛ) := k[userIdx]
          honestₚ ∈ kₚs ∧ ∃ key : Kₛ, key ≠ honestₛ ∧ Sign key m = σ

ADScheme

class ADScheme (K : Type)
               (M : Type)
               (C Pi : Type) where
  Commit : Dict K M → CommitT C K Pi
  Verify : Pi → K → M → C → Bool

  correct_keys_eq : ∀ {dict : Dict K M}, (Commit dict).keys = dict.keys

  correct_consistent :
    ∀ {dict : Dict K M} {key : K} (h : key ∈ dict.keys),
      Verify (Commit dict)[key] key dict[key] (Commit dict).commitment = true

  binding : ComputationallyInfeasible <|
              ∃ (c : C) (k : K) (m₁ m₂ : M) (π₁ π₂ : Pi),
                Verify π₁ k m₁ c = true ∧
                Verify π₂ k m₂ c = true ∧
                m₁ ≠ m₂

Verify

def Verify (π : BalanceProof K₁ K₂ C Pi V)
           [AD : ADScheme K₂ M C Pi] : Bool :=
  ∀ x, (h : x ∈ Dict.keys π) → let ((π', salt), t) := (π x).get (by admit /- proof elided -/
  )
                               AD.Verify π' x.2 (H _ (t, salt)) x.1

noncomputable opaque H {α : Type} (ω : Type) [Nonempty ω] (x : α) : ω := Classical.arbitrary _

opaque ComputationallyInfeasible (p : Prop) : Prop := p

attackGame

def attackGame : Scontract K₁ K₂ V C Sigma :=
  attackGameBlocks' requests []

attackGameBlocks'

def attackGameBlocks' : Scontract K₁ K₂ V C Sigma :=
  requests.foldl Scontract.appendBlock σ

appendBlock

def appendBlock (σ : Scontract K₁ K₂ V C Sigma)
                (request : Request K₁ K₂ C Sigma Pi V) : Scontract K₁ K₂ V C Sigma :=
  (request.toBlock σ).elim σ (σ ++ [·])

toBlock

def toBlock (σ : Scontract K₁ K₂ V C Sigma)
            (request : Request K₁ K₂ C Sigma Pi V) : Option (Block K₁ K₂ C Sigma V) :=
  if ¬request.isValid
  then .none
  else .some <|
  match request with

  | .deposit r v            => .deposit r v

  | .transfer a e c s sigma => .transfer a e c s sigma

  | .withdrawal π           => .withdrawal (π.toBalanceF σ)

isValid

def isValid (s : S' K₁ K₂ V) := ∀ k : Kbar K₁ K₂, k matches .Source ∨ 0 ≤ s k

def isValid (τ : Τ' K₁ K₂ V) :=
  match τ with
  | (s, r, v) => s ≠ r ∧ (s matches .Source → v.isSome)

@[aesop norm (rule_sets := [Intmax.aesop_valid])]

Request.getWithdrawal

def Request.getWithdrawal (request : Request K₁ K₂ C Sigma Pi V) : Option (BalanceProof K₁ K₂ C Pi V) :=
  match request with
  | withdrawal π => .some π
  | transfer .. | deposit .. => .none

adversaryWon

def adversaryWon (blocks : Scontract K₁ K₂ V C Sigma) : Prop :=
  ¬0 ≤ computeBalance blocks

computeBalance

def computeBalance (blocks : Scontract K₁ K₂ V C Sigma) : V :=
  computeBalance' blocks 0

computeBalance'

def computeBalance' (blocks : Scontract K₁ K₂ V C Sigma) (acc : V) : V :=
  blocks.foldl Block.updateBalance acc

Block.updateBalance

def Block.updateBalance (bal : V) (block : Block K₁ K₂ C Sigma V) : V :=
  match block with

  | .deposit _ v  => bal + v

  | .transfer ..  => bal

  | .withdrawal B => bal - ∑ k : K₁, (B k).1

axiom computationallyInfeasible_axiom : ∀ {p : Prop}, ComputationallyInfeasible p → ¬p

isπ

def isπ (requests : List (Request K₁ K₂ C Sigma Pi V)) :=
  ∀ (h₀ : ∀ request ∈ requests, request.isValid)
    (i : Fin (attackGameR requests []).length)
    (h : (attackGameR requests [])[i].isWithdrawalBlock),
    (attackGameR requests [])[i].getWithdrawal h =
    let π := getBalanceProof requests h₀ i h
    let σ := (attackGameR requests []).take i.1
    π.toBalanceF σ

Block.isValid

def Block.isValid (block : Block K₁ K₂ C Sigma V) (π : BalanceProof K₁ K₂ C Pi V) : Bool :=
  match block with

  | .deposit .. => true

  | .transfer aggregator extradata commitment senders sigma =>
      let isValidSA := SA.Verify senders (commitment, aggregator, extradata) sigma
      let isValidAggregator := aggregator = AgreedUponAggregator
      isValidSA ∧ isValidAggregator

  | .withdrawal _ => π.Verify (M := (C × K₁ × ExtraDataT))

BalanceProof.initial

def BalanceProof.initial : BalanceProof K₁ K₂ C Pi V := λ _ ↦ .none

Setoid'

class Setoid' (X : Type) extends Preorder X where
  isEquiv : IsEquivRel (X := X)

IsEquivRel

def IsEquivRel {X : Type} [Preorder X] := ∀ a b : X, a ≤ b ↔ a ≅ b

iso

def iso {X : Type} [Preorder X] (a b : X) := a ≤ b ∧ b ≤ a

trivialPreorder

def trivialPreorder {α : Type} : Preorder α :=
  {
    lt := λ _ _ ↦ False
    le := λ _ _ ↦ True
    le_refl := by admit /- proof elided -/

le

def le (v₁ v₂ : Vector α n) :=
  ∀ x ∈ (v₁.1.zip v₂.1), x.1 ≤ x.2

aggregateWithdrawals'

def aggregateWithdrawals' (σ : Scontract K₁ K₂ V C Sigma) : V :=
  ∑ (i : Fin σ.length × K₁),
    if h : σ[i.1].isWithdrawalBlock
    then (σ[i.1].getWithdrawal h) i.2
    else 0

computeBalanceSum

def computeBalanceSum (σ : Scontract K₁ K₂ V C Sigma) :=
  let v_deposited : V := aggregateDeposits σ
  let v_withdrawn : V := aggregateWithdrawals σ
  v_deposited - v_withdrawn

aggregateWithdrawals

def aggregateWithdrawals (σ : Scontract K₁ K₂ V C Sigma) : V :=
  ∑ i : Fin σ.length,
    if h : σ[i].isWithdrawalBlock
    then ∑ (k : K₁), (σ[i.1].getWithdrawal h) k
    else 0

aggregateDeposits

def aggregateDeposits (σ : Scontract K₁ K₂ V C Sigma) : V :=
  ∑ i : Fin σ.length,
    if h : σ[i].isDepositBlock
    then (σ[i.1].getDeposit h).2.1
    else 0

normalise

def normalise (requests : List (Request K₁ K₂ C Sigma Pi V)) : List (Request K₁ K₂ C Sigma Pi V) :=
  requests.filter Request.isValid

getDeposit

def getDeposit (b : Block K₁ K₂ C Sigma V) (_h : b.isDepositBlock) : K₂ × V₊ :=
  match b with | deposit r v => (r, v)

value

def value (τ : Τ K₁ K₂ V) : Option V₊ := τ.1.2.2

BalFixed

private def BalFixed (bs : List (Block K₁ K₂ C Sigma V)) : BalanceProof K₁ K₂ C Pi V → S K₁ K₂ V :=
  λ π ↦ fStarFixed (s₀ := S.initial K₁ K₂ V) (TransactionsInBlocksFixed π bs)

fStarFixed

private def fStarFixed {n : ℕ}
  (Ts : Vector (Τ K₁ K₂ V) n) (s₀ : S K₁ K₂ V) : S K₁ K₂ V :=
  fStar Ts.1 s₀

TransactionsInBlocksFixed

private def TransactionsInBlocksFixed (π : BalanceProof K₁ K₂ C Pi V) (bs : List (Block K₁ K₂ C Sigma V)) :
  Vector (Τ K₁ K₂ V) (length_of_TransactionsInBlocks (Pi := Pi) bs).1 :=
  ⟨TransactionsInBlocks π bs, by admit /- proof elided -/
  ⟩

private abbrev length_of_TransactionsInBlocks (bs : List (Block K₁ K₂ C Sigma V)) :
  { n : ℕ // n = (TransactionsInBlocks (Classical.arbitrary _ : BalanceProof K₁ K₂ C Pi V) bs).length } :=
  ⟨(TransactionsInBlocks (Classical.arbitrary _ : BalanceProof K₁ K₂ C Pi V) bs).length, rfl⟩

initial

def initial (K₁ K₂ V : Type) [PreWithZero V] : S K₁ K₂ V :=
  ⟨S'.initial K₁ K₂ V, S'.isValid_initial⟩

Bal'

private def Bal' (bs : List (Block K₁ K₂ C Sigma V)) : BalanceProof K₁ K₂ C Pi V → S K₁ K₂ V :=
  fStar (s₀ := S.initial K₁ K₂ V) ∘ TransactionsInBlocks (bs := bs)

BalFixed'

private def BalFixed' (bs : List (Block K₁ K₂ C Sigma V)) : BalanceProof K₁ K₂ C Pi V → S K₁ K₂ V :=
  fStarFixed (n := (length_of_TransactionsInBlocks (Pi := Pi) bs).1)
             (s₀ := S.initial K₁ K₂ V) ∘ TransactionsInBlocksFixed (Pi := Pi) (bs := bs)

v'

def v' (v : V₊) (b : S K₁ K₂ V) (s : Kbar K₁ K₂) : V₊ :=
  match h : s with
  | .Source => v
  | .key _  => ⟨v ⊓ b s, by admit /- proof elided -/
  ⟩

reindex

@[simp]
private def reindex : (a : ℕ) → a ∈ Finset.range (k + 1) \ {0} → ℕ :=
  λ a _ ↦ a.pred

getWithdrawal

def getWithdrawal (b : Block K₁ K₂ C Sigma V) (_h : b.isWithdrawalBlock) : K₁ → V₊ :=
  match b with | .withdrawal B => B

attackGameBlocks!

def attackGameBlocks! (requests : List (Request K₁ K₂ C Sigma Pi V)) : Scontract K₁ K₂ V C Sigma :=
  attackGameBlocks'! requests []

attackGameBlocks'!

def attackGameBlocks'! : Scontract K₁ K₂ V C Sigma :=
  requests.foldl Scontract.appendBlock! σ

attackGameBlocks'!r

def attackGameBlocks'!r (requests : List (Request K₁ K₂ C Sigma Pi V))
                        (σ : Scontract K₁ K₂ V C Sigma) : Scontract K₁ K₂ V C Sigma :=
  match requests with
  | [] => σ
  | hd :: tl => attackGameBlocks'!r tl (σ.appendBlock! hd)

infix:50 " ≠ₖ " => Key.keysUneq

notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

lemma proposition6 [Setoid' Y] {D₁ D₂ : Dict X Y} :
  (∃ join, IsLUB {D₁, D₂} join) ↔ ∀ x, D₁ x ≠ .none ∧ D₂ x ≠ .none → D₁ x ≅ D₂ x

lemma proposition4 [Setoid' X] {x y : Option X} :
  (∃ join : Option X, IsLUB {x, y, .none} join) ↔ (x ≠ .none ∧ y ≠ .none → x ≅ y)

lemma proposition2 [Setoid' X] {x y : X} :
  (∃ join : X, IsLUB {x, y} join) ↔ x ≅ y

@[simp, refl]
lemma iso_rfl : a ≅ a

@[trans]
lemma iso_trans : (a ≅ b) → (b ≅ c) → a ≅ c

lemma proposition2' [Setoid' X] {join x y : X} (h : IsLUB {x, y} join) :
  (x ≅ join) ∧ y ≅ join

lemma proposition3' :
  (∃ join : X, IsLUB {x, y} join) ↔ (∃ join : Option X, IsLUB {.some x, .some y, .none} join)

lemma proposition5 [Preorder Y] {f g : X → Y} {join : X → Y} :
  IsLUB {f, g} join ↔ ∀ x : X, IsLUB {f x, g x} (join x)

lemma proposition6_aux [Setoid' Y] {D₁ D₂ : Dict X Y}
  (h : ∀ k, D₁ k ≠ .none ∧ D₂ k ≠ .none → D₁ k ≅ D₂ k) : IsLUB {D₁, D₂} (Dict.Merge D₁ D₂)

lemma proposition6' [Setoid' Y] {D₁ D₂ join : Dict X Y} (h : IsLUB {D₁, D₂} join) :
  join ≅ Dict.Merge D₁ D₂

@[symm]
lemma iso_symm : (a ≅ b) ↔ b ≅ a

lemma proposition4' [Setoid' X] {join x y : Option X} (h : IsLUB {x, y, .none} join) :
  join ≅ Dict.First x y

lemma proposition5' [Preorder Y] {f g h join' : X → Y}
  (h₀ : IsLUB {f, g} join')
  (h₁ : ∀ x, h x ≅ join' x) :
  join' ≅ h

@[simp]
lemma discretePreorder_eq_equality_Pi_Prod_ExtraDataT {a b : (Pi × ExtraDataT)} : a ≤ b

@[simp]
lemma BalanceProof.snd_discrete {x y : TransactionBatch K₁ K₂ V} :
  @LE.le (TransactionBatch K₁ K₂ V) Preorder.toLE x y ↔ x = y

lemma Merge_assoc {D₃ : Dict α ω} :
  Merge (Merge D₁ D₂) D₃ = Merge D₁ (Merge D₂ D₃)

@[simp]
lemma none_iso_some : (.none ≅ some x) ↔ False

lemma lemma5 (π : BalanceProof K₁ K₂ C Pi V) :
  Bal π σ .Source =
  (∑ (i : Fin σ.length) (k : K₁),
     if h : σ[i].isWithdrawalBlock
     then let w := σ[i].getWithdrawal h
          w k ⊓ Bal π (σ.take i.1) k
     else 0)
  -
  aggregateDeposits σ

private lemma lemma5_aux {len : ℕ} {σ : Scontract K₁ K₂ V C Sigma}
  (hlen : len = σ.length) :
  (Bal π σ) Kbar.Source =
  (∑ x ∈ (Finset.univ : Finset (Fin σ.length)) ×ˢ Finset.univ,
      if h : σ[x.1].isWithdrawalBlock then
        (σ[x.1].getWithdrawal h x.2).1 ⊓ ((Bal π (List.take (x.1.1) σ)) x.2)
      else 0) -
  ∑ i : Fin (List.length σ), if h : σ[i].isDepositBlock then (σ[↑i].getDeposit h).2 else 0

lemma lemma4 (h : π₁ ≤ π₂) : Bal π₁ bs ≤ Bal π₂ bs

private lemma Bal'_eq_Bal : Bal' bs π = Bal π bs

private lemma BalFixed_eq_BalFixed' : BalFixed bs π = BalFixed' bs π

lemma monotone_TransactionsInBlocksFixed :
  Monotone λ (π : BalanceProof K₁ K₂ C Pi V) ↦ TransactionsInBlocksFixed π Bstar

lemma TransactionsInBlocksFixed_le_of_TransactionsInBlocks
  (h : ∀ i : Fin (length_of_TransactionsInBlocks bs).1,
    (TransactionsInBlocks π bs)[i]'(by blast with π i) ≤
    (TransactionsInBlocks π' bs)[i]'(by blast with π' i)) :
  TransactionsInBlocksFixed π bs ≤ TransactionsInBlocksFixed π' bs

lemma v_transactionsInBlocks {s r v v'} {eq₁ eq₂} {i}
  (h : π ≤ π')
  (h₀ : i < (TransactionsInBlocks π Bstar).length)
  (h₁ : (TransactionsInBlocks π Bstar)[i] = ⟨(s, r, v), eq₁⟩)
  (h₂ : (TransactionsInBlocks π' Bstar)[i]'(by blast with π) = ⟨(s, r, v'), eq₂⟩) :
  v ≤ v'

private lemma delta_TransactionsInBlock_transfer
  {b : { b : Block K₁ K₂ C Sigma V // b.isTransferBlock }}
  (h : π ≤ π') :
  ∀ i : ℕ, (hlen : i < (TransactionsInBlock_transfer π b).length) →
    (TransactionsInBlock_transfer π b)[i]'hlen =
    (TransactionsInBlock_transfer π' b)[i]'(by rwa [length_TransactionsInBlock_transfer _ π]) ∨
    ((TransactionsInBlock_transfer π b)[i]'hlen).1.2.2.isNone

lemma senderReceiver_transactionsInBlocks {s r v} {s' r' v'} {eq₁ eq₂} {i}
  (h₀ : i < (TransactionsInBlocks π bs).length)
  (h₁ : (TransactionsInBlocks π bs)[i] = ⟨(s, r, v), eq₁⟩)
  (h₂ : (TransactionsInBlocks π' bs)[i]'(by blast with π) = ⟨(s', r', v'), eq₂⟩) :
  s = s' ∧ r = r'

lemma monotone_fStarFixed :
  Monotone λ (Ts : Vector (Τ K₁ K₂ V) n) ↦ Intmax.fStarFixed Ts (S.initial K₁ K₂ V)

private theorem monotone_fStarFixed_aux (h : v₁ ≤ v₂) (h₂ : b₁ ≤ b₂) :
                                        v₁.1.foldl f b₁ ≤ v₂.1.foldl f b₂

lemma monotone_f (h₁ : b₁ ≤ b₂) (h₂ : T₁ ≤ T₂) : f b₁ T₁ k ≤ f b₂ T₂ k

lemma lemma3 : Bal π bs .Source ≤ 0

private lemma sum_fStar_le_zero_aux (h : ∑ (k : Kbar K₁ K₂), b k ≤ 0) :
  ∑ (k : Kbar K₁ K₂), fStar Tstar b k ≤ 0

lemma sum_f_le_sum : ∑ (k : Kbar K₁ K₂), f b T k ≤ ∑ (k : Kbar K₁ K₂), b k

@[simp]
lemma sum_fc_eq_sum : ∑ (k : Kbar K₁ K₂), fc (Tc, b) k = ∑ (k : Kbar K₁ K₂), b k

lemma aggregateWithdrawals_eq_aggregateWithdrawals' {σ : Scontract K₁ K₂ V C Sigma} :
  aggregateWithdrawals σ = aggregateWithdrawals' σ

lemma keys_Merge_right {x : α}
                       (h₁ : x ∉ D₁) (h₂ : x ∈ D₂) : Merge D₁ D₂ x = D₂ x

lemma mem_iff_isSome {m : Dict α ω} {x : α} : x ∈ m ↔ (m x).isSome

lemma keys_Merge_left {x : α} (h : x ∈ D₁) : Merge D₁ D₂ x = D₁ x

lemma computeBalance_eq_sum : computeBalance σ = computeBalanceSum σ

private lemma computeBalance_eq_sum_aux : computeBalance' σ v = v + computeBalanceSum σ

lemma computeBalance'_eq_zero : computeBalance' σ v = v + computeBalance' σ 0

lemma Block.updateBalance_eq_zero :
  block.updateBalance v = v + block.updateBalance 0

@[simp]
lemma computeBalance'_cons : computeBalance' (hd :: σ) v =
                             computeBalance' σ (Block.updateBalance v hd)

private lemma reindex_mem :
  ∀ (a : ℕ) (ha : a ∈ Finset.range (k + 1) \ {0}), reindex a ha ∈ Finset.range k

private lemma reindex_inj :
  ∀ (a₁ : ℕ) (ha₁ : a₁ ∈ Finset.range (k + 1) \ {0})
    (a₂ : ℕ) (ha₂ : a₂ ∈ Finset.range (k + 1) \ {0}),
  reindex a₁ ha₁ = reindex a₂ ha₂ → a₁ = a₂

lemma mem_dict_iff_mem_keys {dict : Dict α ω} : k ∈ dict ↔ k ∈ dict.keys

theorem Function.injective_of_CryptInjective
  {α ω : Type} [Nonempty ω] {f : α → ω} [inj : Injective f] : Function.Injective f

lemma getElem_Ico_of_lt {m n : ℕ} (h : n < m) : (List.Ico 0 m)[n]'(by simp [h]) = n

lemma attackGame_eq_attackGameBlocks!_normalise :
  attackGame requests = attackGameBlocks! (normalise requests)

lemma attackGameBlocks'_eq_attackGameBlocks'!_normalise :
  attackGameBlocks' requests σ = attackGameBlocks'! (normalise requests) σ

lemma appendBlock_eq_appendBlock!_of_isValid (h : request.isValid) :
  appendBlock σ request = appendBlock! σ request

lemma appendBlock_eq_id_of_not_isValid (h : ¬request.isValid) :
  appendBlock σ request = σ

lemma attackGameBlocks_eq_attackGameR :
  attackGameBlocks! requests = attackGameR requests []

lemma attackGameBlocks'r_eq_attackGameBlocks' :
  attackGameBlocks'! requests σ = attackGameBlocks'!r requests σ

lemma attackGameR_eq_attackGameBlocks' :
  attackGameR requests σ = attackGameBlocks'!r requests σ

lemma appendBlock!_def : σ.appendBlock! request = σ ++ [request.toBlock! σ]

Intmax.BalanceProof.compat

def BalanceProof.compat (π₁ π₂ : BalanceProof K₁ K₂ C Pi V) : Prop :=
  ∀ k, π₁ k ≠ none ∧ π₂ k ≠ none → π₁ k ≅ π₂ k

lemma mergeR''_eq_foldl :
  mergeR'' πs acc = mergeR''' πs acc

@[simp]
lemma mergeR''_cons :
  mergeR'' (π :: πs) acc = Dict.Merge acc (mergeR'' πs π)

@[simp]
lemma mergeR''_append :
  mergeR'' (πs ++ πs') acc = mergeR'' πs' (mergeR'' πs acc)

@[simp]
lemma mergeR''_concat {π} {πs : List (BalanceProof K₁ K₂ C Pi V)} {acc} :
  mergeR'' (πs.concat π) acc = ((mergeR'' πs acc) <+> π)

lemma existsLUB_iff_compat :
  (∃ join, IsLUB {π₁, π₂} join) ↔ π₁ <≅> π₂

lemma compat_comm : (π₁ <≅> π₂) ↔ π₂ <≅> π₁

lemma merge_le (h₁ : π₁ ≤ π₃) (h₂ : π₂ ≤ π₃) : π₁ <+> π₂ ≤ π₃

lemma isLUB_union_Merge_of_isLUB_isLUB_compat {A B : Set (BalanceProof K₁ K₂ C Pi V)}
  (h₁ : IsLUB A j₁) (h₂ : IsLUB B j₂) (h₃ : j₁ <≅> j₂) : IsLUB (A ∪ B) (j₁ <+> j₂)

@[simp]
lemma mergeR''_eq_none' :
  (mergeR'' πs acc) K = none ↔ acc K = none ∧ ∀ π ∈ πs, π K = none

lemma merge_K : (π <+> acc) K = Dict.First (π K) (acc K)

@[simp]
lemma mergeR''_eq_some {x} :
  acc K = some x → (mergeR'' πs acc) K = acc K

lemma iso_K_merge_left_of_ne_none (h : π K ≠ none) : π K ≅ (π <+> acc) K

lemma merge_left_none_eq_right (h : π K = none) : (π <+> acc) K = acc K

lemma verify_merge_of_valid {π₁ π₂ : BalanceProof K₁ K₂ C Pi V}
                            (h₁ : π₁.Verify (M := (C × K₁ × ExtraDataT)))
                            (h₂ : π₂.Verify (M := (C × K₁ × ExtraDataT))) :
                            BalanceProof.Verify (M := (C × K₁ × ExtraDataT)) (Dict.Merge π₁ π₂)

private lemma valid_mergeR''_aux {π : BalanceProof K₁ K₂ C Pi V}
                                 {πs : List (BalanceProof K₁ K₂ C Pi V)}
                                 {n : ℕ}
  (hn : n < πs.length.succ)
  (h₀ : π.Verify (M := (C × K₁ × ExtraDataT)))
  (h : ∀ π ∈ πs, π.Verify (M := (C × K₁ × ExtraDataT))) :
  (mergeR'' (πs.take n) π).Verify (M := (C × K₁ × ExtraDataT))

lemma valid_mergeR'' {πs : List (BalanceProof K₁ K₂ C Pi V)} {n : ℕ}
  (hn : n < πs.length.succ)
  (h : ∀ π ∈ πs, π.Verify (M := (C × K₁ × ExtraDataT))) :
  (mergeR'' (πs.take n) .initial).Verify (M := (C × K₁ × ExtraDataT))

lemma Merge_split (h₀ : 0 < i) (h₁ : i ≤ πs.length) :
  mergeR'' (πs.take i) acc =
  mergeR'' (πs.take (i - 1)) acc <+> πs[i - 1]

private lemma merge_lem_aux :
  mergeR'' (π :: πs) acc = acc <+> π <+> (mergeR'' πs BalanceProof.initial)

lemma merge_lem :
  mergeR'' (π :: πs) BalanceProof.initial = π <+> (mergeR'' πs BalanceProof.initial)

lemma compat_lem {π π' π'': BalanceProof K₁ K₂ C Pi V} :
  π <≅> π' → π <≅> π'' → π <≅> (π' <+> π'')

lemma compat_merge_of_compat :
  (∀ π', π' ∈ πs → π <≅> π') → π <≅> (mergeR'' πs .initial)

private lemma prop6_general_aux :
  (∀ π π' : BalanceProof K₁ K₂ C Pi V, π ∈ πs ∧ π' ∈ πs → π <≅> π') →
     IsLUB {π | π ∈ πs} (mergeR'' πs .initial)

lemma prop6_general (h : ∀ i : Fin πs.length,
                     IsLUB {mergeR'' (πs.take i.1) .initial, πs[i]} (mergeR'' (πs.take (i.1 + 1)) .initial))
  : IsLUB {π | π ∈ πs} (mergeR'' πs .initial)

lemma batch?_neq_of_mem {π₁k π₂k : Option ((Pi × ExtraDataT) × TransactionBatch K₁ K₂ V)}
  (h₀ : π₁k ≠ .none ∧ π₂k ≠ .none)
  (h : ¬(π₁k ≅ π₂k)) : (π₁k.get (Option.isSome_iff_ne_none.2 h₀.1)).2 ≠
                       (π₂k.get (Option.isSome_iff_ne_none.2 h₀.2)).2

omit Hinj in
private theorem not_adversaryWon_attackGame_of_exists_LUB
  (eqrequests : requests! = normalise requests)
  (hValid     : ∀ request ∈ requests!, request.isValid)
  (eqI        : I = (List.finRange (attackGameR requests! []).length).filter ((attackGameR requests! [])[·].isWithdrawalBlock))
  (hI         : ∀ {i : Fin (attackGameR requests! []).length}, i ∈ I ↔ (attackGameR requests! [])[i].isWithdrawalBlock)
  (hgetπ      : getπ =
                λ i : {i : Fin (attackGameR requests! []).length // i ∈ I} ↦
                  (i, getBalanceProof requests! hValid ⟨i.1.1, i.1.2⟩ (hI.1 i.2)))
  (eqπs       : πs = I.attach.map getπ)
  (hlen       : πs.length ≤ n)
  (hπs        : ∀ (i : {i // i ∈ I}), (List.lookup i πs).isSome)
  (eqπproofs  : πproofs = πs.map Prod.snd)
  (πproofslen : πproofs.length = πs.length)
  (isπ        : ∀ (i : Fin (List.length (attackGameR requests! [])))
                  (h : (attackGameR requests! [])[i.1].isWithdrawalBlock),
                  (attackGameR requests! [])[i.1].getWithdrawal h =
                  (getBalanceProof requests! hValid i h).toBalanceF ((attackGameR requests! []).take i.1))
  (contra     : ¬0 ≤ computeBalanceSum (attackGameR requests! []))
  (existsLUB  : ∃ join, IsLUB {π | π ∈ πproofs} join) : False

import FVIntmax.AttackGame

import FVIntmax.Lemma3

import FVIntmax.Lemma4

import FVIntmax.Lemma5

import FVIntmax.Propositions

import FVIntmax.Request

import FVIntmax.Wheels

import FVIntmax.Wheels.AuthenticatedDictionary

import FVIntmax.Wheels.SignatureAggregation

import Mathlib

namespace Intmax

open Classical

noncomputable section Intmax

noncomputable section theorem1

section AttackGame

variable {Sigma Pi M : Type}
         {C : Type} [Nonempty C]
         {V : Type}
         [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         {K₁ : Type} [Nonempty K₁] [Finite K₁] [LinearOrder K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]
         {Kₚ : Type} [Nonempty Kₚ]
         {Kₛ : Type} [Nonempty Kₛ]

def mergeR'' (πs : List (BalanceProof K₁ K₂ C Pi V)) (acc : BalanceProof K₁ K₂ C Pi V) : BalanceProof K₁ K₂ C Pi V :=
  match πs with
  | [] => acc
  | π :: πs => Dict.Merge acc (mergeR'' πs π)

section MergeLemmas

variable {acc π : BalanceProof K₁ K₂ C Pi V} {πs πs : List (BalanceProof K₁ K₂ C Pi V)}

def mergeR''' (πs : List (BalanceProof K₁ K₂ C Pi V)) (acc : BalanceProof K₁ K₂ C Pi V) : BalanceProof K₁ K₂ C Pi V :=
  πs.foldl Dict.Merge acc

end MergeLemmas

def BalanceProof.compat (π₁ π₂ : BalanceProof K₁ K₂ C Pi V) : Prop :=
  ∀ k, π₁ k ≠ none ∧ π₂ k ≠ none → π₁ k ≅ π₂ k

notation:51 π₁:52 " <≅> " π₂:52 => BalanceProof.compat π₁ π₂

notation:65 π₁:65 " <+> " π₂:66 => Dict.Merge π₁ π₂

section Compat

variable {π₁ π₂ π₃ : BalanceProof K₁ K₂ C Pi V}

end Compat

section MergeLemmas

variable {π acc : BalanceProof K₁ K₂ C Pi V}
         {πs : List (BalanceProof K₁ K₂ C Pi V)}

end MergeLemmas

variable [AD : ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]

section MergeLemmas

variable {π acc : BalanceProof K₁ K₂ C Pi V}
         {πs : List (BalanceProof K₁ K₂ C Pi V)}

end MergeLemmas

variable [SA : SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]
         [Hinj : CryptoAssumptions.Injective (H (α := TransactionBatch K₁ K₂ V × ExtraDataT) (ω := (C × K₁ × ExtraDataT)))]
         {requests : List (Request K₁ K₂ C Sigma Pi V)}
         (isπ : isπ (normalise requests))

open Lean.Elab.Tactic Lean.Parser.Tactic in

theorem theorem1 : ¬adversaryWon (attackGame requests) :=

:= λ contra ↦ by
  /-
    PAPER: Suppose an adversary and a challenger have interacted in Attack game 1.
    We will show that either the resulting contract balance is positive (the adver-
    sary lost the game), or the adversary has been able to either break the bind-
    ing property of the authenticated dictionary scheme or found a collision of the
    hash function H.
  -/

  /-
    The attack game plays out the same regardless of validity of requests.
  -/
  rw [attackGame_eq_attackGameBlocks!_normalise, attackGameBlocks_eq_attackGameR] at contra
  set requests! := normalise requests with eqRequests
  /-
    PAPER: Let B∗ = (Bi)i∈[n] be the contract state after the attack game
  -/
  set Bstar := attackGameR requests! [] with eqBstar
  /-
    As such, we can consider a state with only valid requests.
  -/
  have hValid : ∀ request ∈ (normalise requests), request.isValid := by unfold normalise; aesop
  let n := Bstar.length
  have hValidπ {i : Fin n} {h₀} {h₁} {π} (h : (requests![i.1]'h₀).getWithdrawal.get h₁ = π) :
    π.Verify (M := (C × K₁ × ExtraDataT)) := by
    rcases i with ⟨i, hi⟩
    unfold Request.isValid at hValid
    set request := requests![i] with eqRequest
    specialize hValid request (by simp [eqRequest, requests!])
    have hValid_withdrawal {h₀} (h : (requests![i]'h₀).getWithdrawal.isSome) :
      requests![i]'h₀ matches .withdrawal .. := by
      simp [Request.getWithdrawal] at h
      aesop
    aesop
  have hn : n = requests!.length := by simp [n, eqBstar]
  /-
    PAPER: let I ⊆ [n] be the indices of the withdrawal blocks in B∗
  -/
  let I : List (Fin n) := (List.finRange n).filter (Bstar[·].isWithdrawalBlock)
  have hI : ∀ i, i ∈ I ↔ Bstar[i].isWithdrawalBlock := by aesop
  let getπ : {i : Fin n // i ∈ I} → ({i : Fin n // i ∈ I} × BalanceProof K₁ K₂ C Pi V) :=
    λ i ↦
      have lenEq : Bstar.length = n := by simp [n, eqBstar]
      have hi₁ : i.1.1 < Bstar.length := by rw [lenEq]; exact i.1.2
      (i, getBalanceProof requests! hValid ⟨i.1.1, hi₁⟩ ((hI i.1).1 i.2))
  let πs : List ({i : Fin n // i ∈ I} × BalanceProof K₁ K₂ C Pi V) := I.attach.map getπ
  have lenπs : πs.length ≤ n := by
    simp [πs, I, n]
    simp_rw [show Bstar.length = (List.finRange (List.length Bstar)).length by aesop]
    exact List.length_filter_le _ _
  have hπs : ∀ i : {i : Fin n // i ∈ I}, (πs.lookup i).isSome := λ i ↦
    have : i ∈ I.attach := by rcases i with ⟨i, hi⟩; aesop
    by simp [πs, getπ, List.lookup_graph _ this]
  /-
    PAPER: (πi)i∈I be the balance proofs used in the withdrawal request
  -/
  let πproofs := πs.map Prod.snd
  have lenπs': πproofs.length = πs.length := by simp [πproofs]
  have validπs {π : BalanceProof K₁ K₂ C Pi V} (h : π ∈ πproofs) :
               π.Verify (M := (C × K₁ × ExtraDataT)) := by
    simp [πs, πproofs] at h; rcases h with ⟨π, _, hπ⟩
    exact hValidπ hπ
  unfold Intmax.isπ at isπ; specialize isπ hValid; dsimp at isπ
  /-
    PAPER: The resulting contract balance can be computed by adding all deposited amounts and subtracting all withdrawn amounts:
    NB we prove
  -/
  dsimp [adversaryWon] at contra; simp [computeBalance_eq_sum] at contra
  /-
    PAPER: We now have two possibilities, either the balance proofs (πi)i∈I have a join in Π or they don’t.
  -/
  by_cases eq : ∃ join : BalanceProof K₁ K₂ C Pi V, IsLUB {π | π ∈ πproofs} join
  · -- PAPER: Suppose they have a join π ∈ Π. Then we have cf. `not_adversaryWon_attackGame_of_exists_LUB`.
    exact not_adversaryWon_attackGame_of_exists_LUB
            eqRequests
            hValid
            (I := I) (by simp only [Fin.getElem_fin, I])
            (by simp only [hI]; intros; trivial)
            (getπ := getπ) (by simp only [getπ])
            (πs := πs) (by simp only [πs])
            lenπs
            hπs
            (πproofs := πproofs) (by simp only [πproofs])
            lenπs'
            isπ
            contra
            eq
  · /-
      PAPER: Now, suppose the balance proofs (πi)i∈I do not have a join in Π.
    -/
    /-
      PAPER: Let ik be the k′th index in I (so that I = {i1, i2, . . . , im}, where m = |I|).
             Then, let (π′ k)k∈{1,...,m} be the balance proofs defined recursively as π′1 = πi1 and π′
             k = Merge(π′k−1, πik ).

      NB we define `πs'` to be an ordered sequence of balance proofs with the `.initial` balance proof
      at the head position. Note further we use a slightly different merging scheme; one can
      compare `mergeR` and `mergeR''`, where the former is the definition from the paper, while
      the latter is the one we use.
    -/
    let πs' := List.Ico 0 (πs.length + 1) |>.map λ i ↦ mergeR'' (πproofs.take i) .initial
    have lenπs'': πs'.length = πs.length + 1 := by simp [πs', lenπs']
    /-
      PAPER: Clearly, these merged balance proofs are valid, since each of the original bal-
             ance proofs are valid (otherwise they wouldn’t be accepted by the rollup con-
             tract), and since the merge of two valid balance proofs is again valid.

      NB the relevant proof is `valid_mergeR''`.
    -/
    have hπs' : ∀ π ∈ πs', π.Verify (M := (C × K₁ × ExtraDataT)) := by
      simp [πs', πproofs]; intros n hn
      exact valid_mergeR'' (by simp; omega) (λ _ hx ↦ validπs hx)
    have recπs' : ∀ {i : ℕ} (hi : i < πs'.length), πs'[i] = mergeR'' (πproofs.take i) .initial :=
      by simp [πs', πproofs]; intros i hi; rw [List.getElem_Ico_of_lt hi]
    let m := πs'.length.pred
    have hm : m = πproofs.length := by simp [m, lenπs', lenπs'']
    set π'ₘ := πs'[m]'(by simp [m]; omega) with eqπ'ₘ
    simp only [not_exists] at eq
    /-
      With no withdrawal requests, one can derive an immediate contradiction by showing that
      the `.initial` balance proof is the least upper bound, which had been assumed not to exist.
    -/
    by_cases isempty : πs.length = 0
    · have : πproofs = [] := List.map_eq_nil_iff.2 (List.eq_nil_of_length_eq_zero isempty)
      simp_rw [this] at eq
      specialize eq .initial
      simp at eq
    · /-
        PAPER: Now, we argue that there must be an index k ∈ {1, . . . , m} such that π′k is not the join
        of π′k−1 and πik in Π, since if not, the final merged balance proof π′m would
        be a join of (πi)i∈I (by Proposition 6), which we have assumed not to exist.
      -/
      have idx : ∃ i : {n : ℕ // 0 < n ∧ n < πs'.length},
                 ¬IsLUB {
                    πs'[i.1-1],
                    πproofs[i.1-1]'(Nat.sub_one_lt_of_le i.2.1 (Nat.le_of_lt_add_one (by rw [lenπs', lenπs''.symm]; exact i.2.2)))
                  } (πs'[i.1]'i.2.2) := by
        by_contra c; simp at c
        specialize eq π'ₘ; simp only [eqπ'ₘ] at eq
        simp_rw [recπs' (i := m), show List.take m πproofs = πproofs by simp [hm]] at eq
        have : IsLUB {π | π ∈ πproofs} (mergeR'' πproofs .initial) := by
          apply prop6_general
          rintro ⟨i, hi⟩
          simp only
          simp_rw [recπs'] at c; specialize c (i + 1) (by omega); simp at c
          exact c
        exact absurd this eq
      rcases idx with ⟨⟨i, hi₁, hi₂⟩, lubi⟩; simp only at lubi
      /-
        PAPER: It then follows from Proposition 6 that there is a key (C, s) ∈ AD.C × K2 such that π′
        k−1(C, s)̸ ≃ πik (C, s).
      -/
      let π₁! := πs'[i-1]'(by omega)
      let π₂! := πproofs[i-1]'(by simp [hm.symm, m]; omega)
      have eq₁ : ∃ key : {k : C × K₂ // π₁! k ≠ .none ∧ π₂! k ≠ .none}, ¬(((π₁! key.1) ≅ (π₂! key.1))) := by
        simp only [π₁!, π₂!, id_eq, Int.Nat.cast_ofNat_Int, Int.reduceNeg, Nat.pred_eq_sub_one, Int.reduceAdd,
          eq_mpr_eq_cast, Subtype.exists]
        by_contra c; simp only [Int.reduceNeg, not_exists, Decidable.not_not] at c
        apply proposition6_aux at c
        simp_rw [recπs' (i := i)] at lubi
        rw [Merge_split hi₁ (by omega)] at lubi
        nth_rw 2 [recπs' (i := i - 1)] at c
        contradiction
      rcases eq₁ with ⟨⟨key, mem₁, mem₂⟩, hkey⟩
      set π₁ := (π₁! key).get (Option.isSome_iff_ne_none.2 mem₁) with eqπ₁
      set π₂ := (π₂! key).get (Option.isSome_iff_ne_none.2 mem₂) with eqπ₂
      rcases key with ⟨c, s⟩
      rcases π₁ with ⟨⟨π, salt⟩, t⟩
      /-
        PAPER: Also, since both balance proofs are valid, as remarked earlier, we have
        AD.Verify(π, s, H(t, salt), C) and AD.Verify(π′, s, H(t′, salt′), C).
      -/
      have π₁valid : AD.Verify π s (H _ (t, salt)) c := by
        have : π₁!.Verify (M := (C × K₁ × ExtraDataT)) := hπs' _ (by simp [π₁!])
        simp [BalanceProof.Verify] at this; simp_rw [←Dict.mem_dict_iff_mem_keys] at this
        specialize this c s (Option.isSome_iff_ne_none.2 mem₁)
        convert this <;> rw [←eqπ₁]
      rcases π₂ with ⟨⟨π', salt'⟩, t'⟩
      have π₂valid : AD.Verify π' s (H _ (t', salt')) c := by
        have : π₂!.Verify (M := (C × K₁ × ExtraDataT)) := validπs (by simp [π₂!])
        simp [BalanceProof.Verify] at this; simp_rw [←Dict.mem_dict_iff_mem_keys] at this
        specialize this c s (Option.isSome_iff_ne_none.2 mem₂)
        convert this <;> rw [←eqπ₂]
      have tneq : t ≠ t' := by apply batch?_neq_of_mem (by simp; exact ⟨mem₁, mem₂⟩) at hkey; simp [←eqπ₁, ←eqπ₂] at hkey; exact hkey
      by_cases hashEq : H (ω := (C × K₁ × ExtraDataT)) (t, salt) = H _ (t', salt')
      · /-
          PAPER: It follows that that either H(t, salt) = H(t′, salt′)
          meaning that we have found a hash collision

          NB this is shown by contradiction as the hash function had been assumed injective.
        -/
        have : Function.Injective (H (ω := (C × K₁ × ExtraDataT))) :=
          Intmax.CryptoAssumptions.Function.injective_of_CryptInjective (inj := Hinj) -- AXIOMATISED
        have : (t, salt) = (t', salt') := this hashEq
        injection this
        contradiction
      · /-
          PAPER: or H(t, salt)̸ = H(t′, salt′), which means we have broken the binding property
          of the authenticated dictionary scheme

          NB this is shown by contradiction as breaking the binding property of the authenticated dictionary
          had been assumed computationally infeasible and the `computationallyInfeasible_axiom`
          yields the absolute impossibility of this ocurring.
        -/
        have binding := AD.binding
        apply computationallyInfeasible_axiom at binding -- AXIOMATISED
        simp at binding
        specialize binding _ _ _ _ _ _ π₁valid _ _ _ _ π₂valid
        rcases H (C × K₁ × ExtraDataT) (t, salt) with ⟨c, k₁, extra⟩
        set hash₁ := H (C × K₁ × ExtraDataT) (t, salt) with eqhash₁
        set hash₂ := H (C × K₁ × ExtraDataT) (t', salt') with eqhash₂
        rcases hash₁ with ⟨c₁, k₁, ed₁⟩; rcases hash₂ with ⟨c₂, k₂, ed₂⟩
        dsimp at binding hashEq
        simp [binding] at hashEq


notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

BalanceProof

abbrev BalanceProof (K₁ K₂ : Type) [Finite K₁] [Finite K₂]
                    (C Pi V : Type) [PreWithZero V] : Type :=
  Dict (C × K₂) ((Pi × ExtraDataT) × TransactionBatch K₁ K₂ V)

TransactionBatch

abbrev TransactionBatch (K₁ : Type) [Finite K₁]
                        (K₂ : Type) [Finite K₂]
                        (V : Type) [PreWithZero V] :=
  Key K₁ K₂ → V₊

Key

abbrev Key (K₁ K₂ : Type) := K₁ ⊕ K₂

abbrev

class abbrev PreWithZero (α : Type) := Preorder α, Zero α

NonNeg

def NonNeg (α : Type) [PreWithZero α] := { a : α // 0 ≤ a }

ExtraDataT

abbrev ExtraDataT : Type := ℕ

Dict

abbrev Dict (α ω : Type) : Type := α → Option ω

Merge

def Merge (D₁ D₂ : Dict α ω) : Dict α ω := D
  where D := λ x ↦ First (D₁ x) (D₂ x)

First

def First (x₁ x₂ : Option α) : Option α :=
  match x₁, x₂ with
  | .some x, .none => .some x
  | .some x, .some _ => .some x
  | .none, .some y => .some y
  | .none, .none => .none

BalanceProof.initial

def BalanceProof.initial : BalanceProof K₁ K₂ C Pi V := λ _ ↦ .none

Injective

class Injective {α ω : Type} (f : α → ω) where
  h : ComputationallyInfeasible (¬ Function.Injective f)

Setoid'

class Setoid' (X : Type) extends Preorder X where
  isEquiv : IsEquivRel (X := X)

IsEquivRel

def IsEquivRel {X : Type} [Preorder X] := ∀ a b : X, a ≤ b ↔ a ≅ b

iso

def iso {X : Type} [Preorder X] (a b : X) := a ≤ b ∧ b ≤ a

trivialPreorder

def trivialPreorder {α : Type} : Preorder α :=
  {
    lt := λ _ _ ↦ False
    le := λ _ _ ↦ True
    le_refl := by admit /- proof elided -/

le

def le (v₁ v₂ : Vector α n) :=
  ∀ x ∈ (v₁.1.zip v₂.1), x.1 ≤ x.2

postfix:max "₊" => NonNeg

lemma proposition6 [Setoid' Y] {D₁ D₂ : Dict X Y} :
  (∃ join, IsLUB {D₁, D₂} join) ↔ ∀ x, D₁ x ≠ .none ∧ D₂ x ≠ .none → D₁ x ≅ D₂ x

lemma proposition4 [Setoid' X] {x y : Option X} :
  (∃ join : Option X, IsLUB {x, y, .none} join) ↔ (x ≠ .none ∧ y ≠ .none → x ≅ y)

lemma proposition2 [Setoid' X] {x y : X} :
  (∃ join : X, IsLUB {x, y} join) ↔ x ≅ y

@[simp, refl]
lemma iso_rfl : a ≅ a

@[trans]
lemma iso_trans : (a ≅ b) → (b ≅ c) → a ≅ c

lemma proposition2' [Setoid' X] {join x y : X} (h : IsLUB {x, y} join) :
  (x ≅ join) ∧ y ≅ join

lemma proposition3' :
  (∃ join : X, IsLUB {x, y} join) ↔ (∃ join : Option X, IsLUB {.some x, .some y, .none} join)

lemma proposition5 [Preorder Y] {f g : X → Y} {join : X → Y} :
  IsLUB {f, g} join ↔ ∀ x : X, IsLUB {f x, g x} (join x)

lemma proposition6_aux [Setoid' Y] {D₁ D₂ : Dict X Y}
  (h : ∀ k, D₁ k ≠ .none ∧ D₂ k ≠ .none → D₁ k ≅ D₂ k) : IsLUB {D₁, D₂} (Dict.Merge D₁ D₂)

lemma proposition6' [Setoid' Y] {D₁ D₂ join : Dict X Y} (h : IsLUB {D₁, D₂} join) :
  join ≅ Dict.Merge D₁ D₂

@[symm]
lemma iso_symm : (a ≅ b) ↔ b ≅ a

lemma proposition4' [Setoid' X] {join x y : Option X} (h : IsLUB {x, y, .none} join) :
  join ≅ Dict.First x y

lemma proposition5' [Preorder Y] {f g h join' : X → Y}
  (h₀ : IsLUB {f, g} join')
  (h₁ : ∀ x, h x ≅ join' x) :
  join' ≅ h

@[simp]
lemma discretePreorder_eq_equality_Pi_Prod_ExtraDataT {a b : (Pi × ExtraDataT)} : a ≤ b

@[simp]
lemma BalanceProof.snd_discrete {x y : TransactionBatch K₁ K₂ V} :
  @LE.le (TransactionBatch K₁ K₂ V) Preorder.toLE x y ↔ x = y

lemma Merge_assoc {D₃ : Dict α ω} :
  Merge (Merge D₁ D₂) D₃ = Merge D₁ (Merge D₂ D₃)

@[simp]
lemma none_iso_some : (.none ≅ some x) ↔ False

Intmax.BalanceProof.compat

lemma mergeR''_eq_foldl :
  mergeR'' πs acc = mergeR''' πs acc

@[simp]
lemma mergeR''_cons :
  mergeR'' (π :: πs) acc = Dict.Merge acc (mergeR'' πs π)

@[simp]
lemma mergeR''_append :
  mergeR'' (πs ++ πs') acc = mergeR'' πs' (mergeR'' πs acc)

@[simp]
lemma mergeR''_concat {π} {πs : List (BalanceProof K₁ K₂ C Pi V)} {acc} :
  mergeR'' (πs.concat π) acc = ((mergeR'' πs acc) <+> π)

lemma existsLUB_iff_compat :
  (∃ join, IsLUB {π₁, π₂} join) ↔ π₁ <≅> π₂

lemma compat_comm : (π₁ <≅> π₂) ↔ π₂ <≅> π₁

lemma merge_le (h₁ : π₁ ≤ π₃) (h₂ : π₂ ≤ π₃) : π₁ <+> π₂ ≤ π₃

lemma isLUB_union_Merge_of_isLUB_isLUB_compat {A B : Set (BalanceProof K₁ K₂ C Pi V)}
  (h₁ : IsLUB A j₁) (h₂ : IsLUB B j₂) (h₃ : j₁ <≅> j₂) : IsLUB (A ∪ B) (j₁ <+> j₂)

@[simp]
lemma mergeR''_eq_none' :
  (mergeR'' πs acc) K = none ↔ acc K = none ∧ ∀ π ∈ πs, π K = none

lemma merge_K : (π <+> acc) K = Dict.First (π K) (acc K)

@[simp]
lemma mergeR''_eq_some {x} :
  acc K = some x → (mergeR'' πs acc) K = acc K

lemma iso_K_merge_left_of_ne_none (h : π K ≠ none) : π K ≅ (π <+> acc) K

lemma merge_left_none_eq_right (h : π K = none) : (π <+> acc) K = acc K

private lemma merge_lem_aux :
  mergeR'' (π :: πs) acc = acc <+> π <+> (mergeR'' πs BalanceProof.initial)

lemma merge_lem :
  mergeR'' (π :: πs) BalanceProof.initial = π <+> (mergeR'' πs BalanceProof.initial)

lemma compat_lem {π π' π'': BalanceProof K₁ K₂ C Pi V} :
  π <≅> π' → π <≅> π'' → π <≅> (π' <+> π'')

lemma compat_merge_of_compat :
  (∀ π', π' ∈ πs → π <≅> π') → π <≅> (mergeR'' πs .initial)

private lemma prop6_general_aux :
  (∀ π π' : BalanceProof K₁ K₂ C Pi V, π ∈ πs ∧ π' ∈ πs → π <≅> π') →
     IsLUB {π | π ∈ πs} (mergeR'' πs .initial)

import FVIntmax.AttackGame

import FVIntmax.Lemma3

import FVIntmax.Lemma4

import FVIntmax.Lemma5

import FVIntmax.Propositions

import FVIntmax.Request

import FVIntmax.Wheels

import FVIntmax.Wheels.AuthenticatedDictionary

import FVIntmax.Wheels.SignatureAggregation

import Mathlib

namespace Intmax

open Classical

noncomputable section Intmax

noncomputable section theorem1

section AttackGame

variable {Sigma Pi M : Type}
         {C : Type} [Nonempty C]
         {V : Type}
         [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         {K₁ : Type} [Nonempty K₁] [Finite K₁] [LinearOrder K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]
         {Kₚ : Type} [Nonempty Kₚ]
         {Kₛ : Type} [Nonempty Kₛ]

def mergeR'' (πs : List (BalanceProof K₁ K₂ C Pi V)) (acc : BalanceProof K₁ K₂ C Pi V) : BalanceProof K₁ K₂ C Pi V :=
  match πs with
  | [] => acc
  | π :: πs => Dict.Merge acc (mergeR'' πs π)

section MergeLemmas

variable {acc π : BalanceProof K₁ K₂ C Pi V} {πs πs : List (BalanceProof K₁ K₂ C Pi V)}

def mergeR''' (πs : List (BalanceProof K₁ K₂ C Pi V)) (acc : BalanceProof K₁ K₂ C Pi V) : BalanceProof K₁ K₂ C Pi V :=
  πs.foldl Dict.Merge acc

end MergeLemmas

def BalanceProof.compat (π₁ π₂ : BalanceProof K₁ K₂ C Pi V) : Prop :=
  ∀ k, π₁ k ≠ none ∧ π₂ k ≠ none → π₁ k ≅ π₂ k

notation:51 π₁:52 " <≅> " π₂:52 => BalanceProof.compat π₁ π₂

notation:65 π₁:65 " <+> " π₂:66 => Dict.Merge π₁ π₂

section Compat

variable {π₁ π₂ π₃ : BalanceProof K₁ K₂ C Pi V}

end Compat

section MergeLemmas

variable {π acc : BalanceProof K₁ K₂ C Pi V}
         {πs : List (BalanceProof K₁ K₂ C Pi V)}

end MergeLemmas

variable [AD : ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]

section MergeLemmas

variable {π acc : BalanceProof K₁ K₂ C Pi V}
         {πs : List (BalanceProof K₁ K₂ C Pi V)}

lemma prop6_general (h : ∀ i : Fin πs.length,
                     IsLUB {mergeR'' (πs.take i.1) .initial, πs[i]} (mergeR'' (πs.take (i.1 + 1)) .initial))
  : IsLUB {π | π ∈ πs} (mergeR'' πs .initial) :=

:= by
  replace h : ∀ (i : ℕ) (h : i < πs.length),
                IsLUB {mergeR'' (List.take i πs) .initial, πs[↑i]}
                      (mergeR'' (List.take (i + 1) πs) .initial) := λ i hi ↦ h ⟨i, hi⟩
  apply prop6_general_aux
  by_contra contra
  simp at contra
  let min₁ : Finset (Fin πs.length) := {n | ∃ i, n < i ∧ ¬(πs[n] <≅> πs[i])}
  have wa_ne : min₁.Nonempty := by
    rcases contra with ⟨π, ⟨π_in_πs, ⟨π', ⟨π'_in_πs, h⟩⟩⟩⟩
    obtain ⟨π_ind, π_ind_lim, π_in_πs⟩ := List.getElem_of_mem π_in_πs
    obtain ⟨π'_ind, π'_ind_lim, π'_in_πs⟩ := List.getElem_of_mem π'_in_πs
    by_cases h' : π_ind < π'_ind
    · simp_all only [List.getElem_mem, Set.toFinset_setOf, gt_iff_lt, Fin.getElem_fin, min₁]
      rw [Finset.filter_nonempty_iff]; simp only [Finset.mem_univ, true_and]
      use ⟨π_ind, by omega⟩; use ⟨π'_ind, by omega⟩
      aesop
    · rewrite [not_lt] at h'
      rcases eq_or_lt_of_le h' with h' | h'
      · exfalso; aesop
      · simp_all only [List.getElem_mem, Set.toFinset_setOf, gt_iff_lt, Fin.getElem_fin, min₁]
        rw [Finset.filter_nonempty_iff]; simp only [Finset.mem_univ, true_and]
        use ⟨π'_ind, by omega⟩; use ⟨π_ind, by omega⟩
        subst π_in_πs; subst π'_in_πs
        simp [h']; rw [compat_comm]; assumption
  have wa_min : ∃ idx, idx ∈ min₁ ∧ ∀ k ∈ min₁, idx ≤ k := by
    rcases Finset.exists_minimal min₁ wa_ne with ⟨idx, h₁, h₂⟩; use idx; aesop
  rcases wa_min with ⟨idx, idx_min_wa⟩
  let π := πs[idx]
  let min₂ : Finset (Fin πs.length) := {idx' | idx < idx' ∧ ¬(πs[idx'] <≅> πs[idx])}
  have min₂_ne : min₂.Nonempty := by
    rw [Finset.filter_nonempty_iff]; simp_rw [compat_comm]; aesop
  have min₂_min : ∃ idx', idx' ∈ min₂ ∧ ∀ k ∈ min₂, idx' ≤ k := by
    rcases Finset.exists_minimal min₂ min₂_ne with ⟨idx, h₁, h₂⟩; use idx; aesop
  rcases min₂_min with ⟨idx', idx'_min_min₂⟩
  have idx_lt_idx' : idx < idx' := by simp [min₂] at idx'_min_min₂; tauto
  have eq₁' : ∀ i, idx ≤ i ∧ i < idx' → πs[i] <≅> πs[idx] := by
    by_contra h
    simp only [Fin.getElem_fin, and_imp, not_forall, Classical.not_imp] at h
    rcases h with ⟨i, h, h', h''⟩
    have : i ∈ min₂ := by
      dsimp [min₂]
      simp only [Finset.mem_filter, Finset.mem_univ, h'', not_false_eq_true, and_true, true_and]
      rcases eq_or_lt_of_le h <;> aesop
    exact absurd (Fin.lt_of_le_of_lt (idx'_min_min₂.2 i this) h') (lt_irrefl _)
  have eq₁'' : ∀ i, i < idx → πs[i] <≅> πs[idx] := by
    intros i h
    by_contra contra
    have : i ∈ min₁ := by
      dsimp [min₁]
      simp only [gt_iff_lt, Set.toFinset_setOf, Finset.mem_filter, Finset.mem_univ, true_and]
      use idx
      exact ⟨h, contra⟩
    exact absurd (Fin.lt_of_lt_of_le h (idx_min_wa.2 i this)) (lt_irrefl _)
  have eq₁ : ∀ i, i < idx' → πs[i] <≅> πs[idx] := by
    intros i h; by_cases h' : idx ≤ i <;> aesop
  have eq₂ : ¬(πs[idx] <≅> πs[idx']) := by
    rw [compat_comm]; aesop
  have eq₃ : ∃ k : C × K₂, ¬(πs[idx] k ≅ πs[idx'] k) ∧ πs[idx] k ≠ .none ∧ πs[idx'] k ≠ .none := by
    unfold BalanceProof.compat at eq₂
    simp only [Fin.getElem_fin, ne_eq, and_imp, Prod.forall, not_forall, Classical.not_imp] at eq₂
    rcases eq₂ with ⟨k₁, k₂, h₁, h₂, h⟩
    use ⟨k₁, k₂⟩
    exact ⟨h, h₁, h₂⟩
  rcases eq₃ with ⟨k, eq₃⟩
  have eq₄ : ∀ i, i < idx' → πs[idx] k ≅ πs[i] k ∨ πs[i] k = .none := by
    intros i h
    unfold BalanceProof.compat at eq₁ eq₃
    simp only [Fin.getElem_fin] at eq₃
    specialize eq₁ i h k
    rw [iso_symm]
    by_cases h' : πs[i] k = .none <;> tauto
  specialize h idx'.1 (by simp)
  have eq₅ : mergeR'' (πs.take (idx.1 + 1)) .initial k ≅ πs[idx] k := by
    have eq₆' : ∀ i, i < idx.1 + 1 ∧ i < πs.length →
      mergeR'' (List.take i πs) .initial k ≅ (πs[idx]) k ∨ mergeR'' (List.take i πs) .initial k = .none := by
      intros i h
      induction i with
      | zero => right; rfl
      | succ i ih =>
        have : i < πs.length := by linarith
        rw [←List.take_concat_get _ _ this, mergeR''_concat]
        rcases ih ⟨by linarith, by linarith⟩ with ih | ih
        · left
          refine iso_trans ?_ ih
          rw [iso_symm]
          apply iso_K_merge_left_of_ne_none
          by_contra h
          rw [h] at ih
          obtain ⟨_, h⟩ := Option.ne_none_iff_exists.1 eq₃.2.1
          rwa [←h, none_iso_some] at ih
        · rw [merge_left_none_eq_right ih, iso_symm,
              show πs[i] = πs[((⟨i, by linarith⟩) : Fin πs.length)] from rfl]
          apply eq₄
          simp only [Fin.lt_def] at idx_lt_idx' ⊢
          exact lt_trans (by omega) idx_lt_idx'
    rw [←List.take_concat_get (h := idx.2), mergeR''_concat]
    rcases eq₆' idx.1 ⟨by simp only [lt_add_iff_pos_right, zero_lt_one], idx.2⟩ with h | h
    · refine iso_trans ?_ h
      rw [iso_symm]
      apply iso_K_merge_left_of_ne_none
      by_contra h'
      obtain ⟨_, h''⟩ := Option.ne_none_iff_exists.1 eq₃.2.1
      rwa [h', ←h'', none_iso_some] at h
    · rw [merge_left_none_eq_right h]
      rfl
  have eq₆ : mergeR'' (πs.take (idx.1 + 1)) .initial k ≅ mergeR'' (πs.take idx'.1) .initial k := by
    have : idx.1 + 1 ≤ idx'.1 := by
      rw [Fin.lt_def] at idx_lt_idx'
      linarith
    rcases Nat.exists_eq_add_of_le this with ⟨i, h⟩
    rw [h, List.take_add (m := idx.1 + 1), mergeR''_append]
    have : ∃ r, mergeR'' (List.take (idx.1 + 1) πs) BalanceProof.initial k = .some r := by
      by_contra h
      simp at h
      have : mergeR'' (List.take (idx.1 + 1) πs) BalanceProof.initial k = .none := by
        by_contra h'
        have h' := Option.ne_none_iff_exists.1 h'
        rcases h' with ⟨x, h'⟩
        specialize h x.1.1 x.1.2 x.2
        apply h
        rw [←h']
      rw [this] at eq₅
      rcases Option.ne_none_iff_exists.1 eq₃.2.1 with ⟨x, h''⟩
      rw [←h'', none_iso_some] at eq₅
      exact eq₅
    rcases this with ⟨_, h⟩
    rw [mergeR''_eq_some h]
  have eq₇ : (πs[idx]) k ≅ mergeR'' (List.take idx'.1 πs) BalanceProof.initial k :=
    iso_trans (eq₅.symm) eq₆
  have eq₈ : ¬(mergeR'' (πs.take idx'.1) .initial <≅> πs[idx']) := by
    unfold BalanceProof.compat
    simp only [ne_eq, mergeR''_eq_none', not_and, not_forall, Classical.not_imp, Fin.getElem_fin, and_imp]
    use k; simp at eq₃
    simp [eq₃, BalanceProof.initial]
    refine' ⟨_, λ contra' ↦ absurd (iso_trans eq₇ contra') eq₃.1⟩
    use π; simp [π]
    refine' ⟨_, eq₃.2.1⟩
    rw [List.mem_take_iff_getElem]
    simp only [Fin.is_le', inf_of_le_left]
    use idx.1
    simp [min₂] at idx'_min_min₂
    use idx'_min_min₂.1.1
  unfold BalanceProof.compat at eq₈
  rw [←proposition6] at eq₈
  exact absurd (by tauto) eq₈


local macro:max (priority := high) "↪" b:term : term => `(⟨$b, by admit /- proof elided -/
⟩)

TransactionsInBlocks

def TransactionsInBlocks
  (π : BalanceProof K₁ K₂ C Pi V) (bs : List (Block K₁ K₂ C Sigma V)) : List (Τ K₁ K₂ V) :=
  (bs.map (TransactionsInBlock π)).flatten

TransactionsInBlock

def TransactionsInBlock (π : BalanceProof K₁ K₂ C Pi V) (b : Block K₁ K₂ C Sigma V) : List (Τ K₁ K₂ V) :=
  match h : b with
  | .deposit ..    => TransactionsInBlock_deposit ↪b
  | .transfer ..   => TransactionsInBlock_transfer π ↪b
  | .withdrawal .. => TransactionsInBlock_withdrawal ↪b

def TransactionsInBlock_withdrawal
  (b : { b : Block K₁ K₂ C Sigma V // b.isWithdrawalBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .withdrawal withdrawals =>

    let k₁InOrder := { s | s : K₁ }.toFinset.sort (·≤·)
    k₁InOrder.attach.map λ s : K₁ ↦ ⟨(s, .Source, withdrawals s), by admit /- proof elided -/
    ⟩
  | .deposit r v | .transfer .. => by admit /- proof elided -/

Block

inductive Block (K₁ K₂ : Type) (C Sigma : Type) (V : Type) [PreWithZero V] where

  | deposit (recipient : K₂) (amount : V₊)

  | transfer (aggregator : K₁) (extradata : ExtraDataT) (commitment : C) (senders : List K₂) (sigma : Sigma)

  | withdrawal (withdrawals : K₁ → V₊)

isWithdrawalBlock

abbrev isWithdrawalBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.withdrawal _)

ExtraDataT

abbrev ExtraDataT : Type := ℕ

abbrev

class abbrev PreWithZero (α : Type) := Preorder α, Zero α

NonNeg

def NonNeg (α : Type) [PreWithZero α] := { a : α // 0 ≤ a }

attach

noncomputable def attach (α : Type) [Finite α] : UniquelyIndexed α :=
  have := Finite.exists_equiv_fin α
  this.choose_spec.some.toEmbedding

UniquelyIndexed

abbrev UniquelyIndexed (α : Type) [Finite α] : Type := α ↪ !α

UniqueTokenT

abbrev UniqueTokenT (α : Type) [Finite α] : Type := Fin (Finite.exists_equiv_fin α |>.choose)

Τ

abbrev Τ (K₁ K₂ V : Type) [PreWithZero V] := { τ : Τ' K₁ K₂ V // τ.isValid }

Τ'

abbrev Τ' (K₁ K₂ V : Type) [PreWithZero V] := Kbar K₁ K₂ × Kbar K₁ K₂ × Option V₊

Kbar

inductive Kbar (K₁ K₂ : Type) where
  | key (k : Key K₁ K₂)
  | Source
deriving DecidableEq

Key

abbrev Key (K₁ K₂ : Type) := K₁ ⊕ K₂

Injective

class Injective {α ω : Type} (f : α → ω) where
  h : ComputationallyInfeasible (¬ Function.Injective f)

def TransactionsInBlock_transfer
  (π : BalanceProof K₁ K₂ C Pi V) (b : { b : Block K₁ K₂ C Sigma V // b.isTransferBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .transfer _ _ commitment S _ =>

    let senderRecipient : Finset (K₂ × Key K₁ K₂) := { (k₂, k) | (k₂ : K₂) (k : Key K₁ K₂) (_h : k₂ ≠ₖ k) }
    let sorted : List (K₂ × Key K₁ K₂) := senderRecipient.sort Key.lexLe

    let v (s : K₂) (r : Key K₁ K₂) : Option V₊ :=
      if s ∉ S
      then .some 0
      else
        if h : (commitment, s) ∈ π.keys
        then let (_, t) := π[(commitment, s)]
             t r
        else .none
    sorted.attach.map λ ⟨(s, r), h⟩ ↦ ⟨(s, r, v s r), by admit /- proof elided -/
    ⟩
  | .deposit .. | .withdrawal .. => by admit /- proof elided -/

BalanceProof

abbrev BalanceProof (K₁ K₂ : Type) [Finite K₁] [Finite K₂]
                    (C Pi V : Type) [PreWithZero V] : Type :=
  Dict (C × K₂) ((Pi × ExtraDataT) × TransactionBatch K₁ K₂ V)

TransactionBatch

abbrev TransactionBatch (K₁ : Type) [Finite K₁]
                        (K₂ : Type) [Finite K₂]
                        (V : Type) [PreWithZero V] :=
  Key K₁ K₂ → V₊

Dict

abbrev Dict (α ω : Type) : Type := α → Option ω

lexLe

def lexLe (a b : K₂ × Key K₁ K₂) : Prop :=
  a.1 < b.1 ∨ (a.1 = b.1 ∧ a.2 ≤ b.2)

isTransferBlock

abbrev isTransferBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.transfer _ _ _ _ _)

keys

def keys (m : Dict α ω) : Set α := { x | Dict.is_mem m x }

def Dict.is_mem (m : Dict α ω) (x : α) : Prop := (m x).isSome

abbrev keys (ct : CommitT C K Pi) := ct.dict.keys

CommitT

structure CommitT (C K Pi : Type) where
  commitment : C
  dict       : Dict K Pi

keysUneq

abbrev keysUneq (k₂ : K₂) (k : Key K₁ K₂) : Prop :=
  match k with
  | .inl _   => True
  | .inr k₂' => k₂ ≠ k₂'

def TransactionsInBlock_deposit
  (b : { b : Block K₁ K₂ C Sigma V // b.isDepositBlock }) : List (Τ K₁ K₂ V) :=
  match h : b.1 with
  | .deposit r v => [⟨(.Source, r, v), by admit /- proof elided -/
  ⟩]
  | .withdrawal .. | .transfer .. => by admit /- proof elided -/

isDepositBlock

abbrev isDepositBlock (b : Block K₁ K₂ C Sigma V) := b matches (Block.deposit _ _)

v'

def v' (v : V₊) (b : S K₁ K₂ V) (s : Kbar K₁ K₂) : V₊ :=
  match h : s with
  | .Source => v
  | .key _  => ⟨v ⊓ b s, by admit /- proof elided -/
  ⟩

S

abbrev S (K₁ K₂ V : Type) [PreWithZero V] := { s : S' K₁ K₂ V // s.isValid }

S'

abbrev S' (K₁ K₂ V : Type) := Kbar K₁ K₂ → V

infix:50 " ≠ₖ " => Key.keysUneq

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

lemma receiver_transactionsInBlocks {bs : List (Block K₁ K₂ C Sigma V)}
                                    {π₁ π₂ : BalanceProof K₁ K₂ C Pi V} :
  (TransactionsInBlocks π₁ bs).map (λ s ↦ s.1.2.1) =
  (TransactionsInBlocks π₂ bs).map (λ s ↦ s.1.2.1)

lemma receiver_transactionsInBlock :
  (TransactionsInBlock π₁ b).map (λ s ↦ s.1.2.1) =
  (TransactionsInBlock π₂ b).map (λ s ↦ s.1.2.1)

lemma length_transactionsInBlock :
  (TransactionsInBlock π₁ b).length = (TransactionsInBlock π₂ b).length

lemma length_TransactionsInBlock_transfer
  {b : { b : Block K₁ K₂ C Sigma V // b.isTransferBlock }} :
  ∀ (π₁ π₂ : BalanceProof K₁ K₂ C Pi V),
    (TransactionsInBlock_transfer π₁ b).length =
    (TransactionsInBlock_transfer π₂ b).length

lemma length_transactionsInBlocks {bs : List (Block K₁ K₂ C Sigma V)}
                                  {π₁ π₂ : BalanceProof K₁ K₂ C Pi V} :
  (TransactionsInBlocks π₁ bs).length = (TransactionsInBlocks π₂ bs).length

lemma sender_transactionsInBlocks {bs : List (Block K₁ K₂ C Sigma V)}
                                  {π₁ π₂ : BalanceProof K₁ K₂ C Pi V} :
  (TransactionsInBlocks π₁ bs).map (λ s ↦ s.1.1) =
  (TransactionsInBlocks π₂ bs).map (λ s ↦ s.1.1)

lemma sender_transactionsInBlock :
  (TransactionsInBlock π₁ b).map (λ s ↦ s.1.1) =
  (TransactionsInBlock π₂ b).map (λ s ↦ s.1.1)

import FVIntmax.Balance

namespace Intmax

open Mathlib

noncomputable section Lemma4

section HicSuntDracones

section

variable {Pi C Sigma : Type}
         {K₁ : Type} [Finite K₁] [LinearOrder K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]

         {V : Type} [AddCommGroup V] [Lattice V]
         {π π' : BalanceProof K₁ K₂ C Pi V} {bs : List (Block K₁ K₂ C Sigma V)}

section HelperFunctionsToAppeaseLean

open Mathlib

open Lean.Elab.Tactic in

section

variable {Pi C Sigma : Type}
         {K₁ : Type} [Finite K₁] [LinearOrder K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]

         {V : Type}
         [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         {π π' : BalanceProof K₁ K₂ C Pi V} {bs : List (Block K₁ K₂ C Sigma V)}

end

end HelperFunctionsToAppeaseLean

lemma senderReceiver_transactionsInBlocks {s r v} {s' r' v'} {eq₁ eq₂} {i}
  (h₀ : i < (TransactionsInBlocks π bs).length)
  (h₁ : (TransactionsInBlocks π bs)[i] = ⟨(s, r, v), eq₁⟩)
  (h₂ : (TransactionsInBlocks π' bs)[i]'(by blast with π) = ⟨(s', r', v'), eq₂⟩) :
  s = s' ∧ r = r' :=

:= by
  have eq₁ := sender_transactionsInBlocks (Sigma := Sigma) (bs := bs) (π₁ := π) (π₂ := π')
  have eq₂ := receiver_transactionsInBlocks (Sigma := Sigma) (bs := bs) (π₁ := π) (π₂ := π')
  simp [List.ext_get_iff, length_transactionsInBlocks (π₁ := π') (π₂ := π)] at eq₁ eq₂
  specialize eq₁ i h₀ h₀; specialize eq₂ i h₀ h₀
  aesop


notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

BalanceProof

abbrev BalanceProof (K₁ K₂ : Type) [Finite K₁] [Finite K₂]
                    (C Pi V : Type) [PreWithZero V] : Type :=
  Dict (C × K₂) ((Pi × ExtraDataT) × TransactionBatch K₁ K₂ V)

TransactionBatch

abbrev TransactionBatch (K₁ : Type) [Finite K₁]
                        (K₂ : Type) [Finite K₂]
                        (V : Type) [PreWithZero V] :=
  Key K₁ K₂ → V₊

Key

abbrev Key (K₁ K₂ : Type) := K₁ ⊕ K₂

abbrev

class abbrev PreWithZero (α : Type) := Preorder α, Zero α

NonNeg

def NonNeg (α : Type) [PreWithZero α] := { a : α // 0 ≤ a }

ExtraDataT

abbrev ExtraDataT : Type := ℕ

Dict

abbrev Dict (α ω : Type) : Type := α → Option ω

Merge

def Merge (D₁ D₂ : Dict α ω) : Dict α ω := D
  where D := λ x ↦ First (D₁ x) (D₂ x)

First

def First (x₁ x₂ : Option α) : Option α :=
  match x₁, x₂ with
  | .some x, .none => .some x
  | .some x, .some _ => .some x
  | .none, .some y => .some y
  | .none, .none => .none

Setoid'

class Setoid' (X : Type) extends Preorder X where
  isEquiv : IsEquivRel (X := X)

IsEquivRel

def IsEquivRel {X : Type} [Preorder X] := ∀ a b : X, a ≤ b ↔ a ≅ b

iso

def iso {X : Type} [Preorder X] (a b : X) := a ≤ b ∧ b ≤ a

trivialPreorder

def trivialPreorder {α : Type} : Preorder α :=
  {
    lt := λ _ _ ↦ False
    le := λ _ _ ↦ True
    le_refl := by admit /- proof elided -/

le

def le (v₁ v₂ : Vector α n) :=
  ∀ x ∈ (v₁.1.zip v₂.1), x.1 ≤ x.2

postfix:max "₊" => NonNeg

lemma proposition6 [Setoid' Y] {D₁ D₂ : Dict X Y} :
  (∃ join, IsLUB {D₁, D₂} join) ↔ ∀ x, D₁ x ≠ .none ∧ D₂ x ≠ .none → D₁ x ≅ D₂ x

lemma proposition4 [Setoid' X] {x y : Option X} :
  (∃ join : Option X, IsLUB {x, y, .none} join) ↔ (x ≠ .none ∧ y ≠ .none → x ≅ y)

lemma proposition2 [Setoid' X] {x y : X} :
  (∃ join : X, IsLUB {x, y} join) ↔ x ≅ y

@[simp, refl]
lemma iso_rfl : a ≅ a

@[trans]
lemma iso_trans : (a ≅ b) → (b ≅ c) → a ≅ c

lemma proposition2' [Setoid' X] {join x y : X} (h : IsLUB {x, y} join) :
  (x ≅ join) ∧ y ≅ join

lemma proposition3' :
  (∃ join : X, IsLUB {x, y} join) ↔ (∃ join : Option X, IsLUB {.some x, .some y, .none} join)

lemma proposition5 [Preorder Y] {f g : X → Y} {join : X → Y} :
  IsLUB {f, g} join ↔ ∀ x : X, IsLUB {f x, g x} (join x)

lemma proposition6_aux [Setoid' Y] {D₁ D₂ : Dict X Y}
  (h : ∀ k, D₁ k ≠ .none ∧ D₂ k ≠ .none → D₁ k ≅ D₂ k) : IsLUB {D₁, D₂} (Dict.Merge D₁ D₂)

lemma proposition6' [Setoid' Y] {D₁ D₂ join : Dict X Y} (h : IsLUB {D₁, D₂} join) :
  join ≅ Dict.Merge D₁ D₂

@[symm]
lemma iso_symm : (a ≅ b) ↔ b ≅ a

lemma proposition4' [Setoid' X] {join x y : Option X} (h : IsLUB {x, y, .none} join) :
  join ≅ Dict.First x y

lemma proposition5' [Preorder Y] {f g h join' : X → Y}
  (h₀ : IsLUB {f, g} join')
  (h₁ : ∀ x, h x ≅ join' x) :
  join' ≅ h

@[simp]
lemma discretePreorder_eq_equality_Pi_Prod_ExtraDataT {a b : (Pi × ExtraDataT)} : a ≤ b

@[simp]
lemma BalanceProof.snd_discrete {x y : TransactionBatch K₁ K₂ V} :
  @LE.le (TransactionBatch K₁ K₂ V) Preorder.toLE x y ↔ x = y

lemma existsLUB_iff_compat :
  (∃ join, IsLUB {π₁, π₂} join) ↔ π₁ <≅> π₂

lemma merge_le (h₁ : π₁ ≤ π₃) (h₂ : π₂ ≤ π₃) : π₁ <+> π₂ ≤ π₃

import FVIntmax.AttackGame

import FVIntmax.Lemma3

import FVIntmax.Lemma4

import FVIntmax.Lemma5

import FVIntmax.Propositions

import FVIntmax.Request

import FVIntmax.Wheels

import FVIntmax.Wheels.AuthenticatedDictionary

import FVIntmax.Wheels.SignatureAggregation

import Mathlib

namespace Intmax

open Classical

noncomputable section Intmax

noncomputable section theorem1

section AttackGame

variable {Sigma Pi M : Type}
         {C : Type} [Nonempty C]
         {V : Type}
         [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         {K₁ : Type} [Nonempty K₁] [Finite K₁] [LinearOrder K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]
         {Kₚ : Type} [Nonempty Kₚ]
         {Kₛ : Type} [Nonempty Kₛ]

section MergeLemmas

variable {acc π : BalanceProof K₁ K₂ C Pi V} {πs πs : List (BalanceProof K₁ K₂ C Pi V)}

end MergeLemmas

notation:51 π₁:52 " <≅> " π₂:52 => BalanceProof.compat π₁ π₂

notation:65 π₁:65 " <+> " π₂:66 => Dict.Merge π₁ π₂

section Compat

variable {π₁ π₂ π₃ : BalanceProof K₁ K₂ C Pi V}

end Compat

lemma isLUB_union_Merge_of_isLUB_isLUB_compat {A B : Set (BalanceProof K₁ K₂ C Pi V)}
  (h₁ : IsLUB A j₁) (h₂ : IsLUB B j₂) (h₃ : j₁ <≅> j₂) : IsLUB (A ∪ B) (j₁ <+> j₂) :=

:= by
  have h₃'' := h₃
  obtain ⟨j, h₃⟩ := existsLUB_iff_compat.2 h₃
  split_ands
  · simp only [IsLUB, IsLeast, upperBounds, Set.mem_insert_iff, Set.mem_singleton_iff,
    forall_eq_or_imp, forall_eq, Set.mem_setOf_eq, lowerBounds, and_imp, Set.mem_union] at h₁ h₂ h₃ ⊢
    rcases h₁ with ⟨h₁, h₁'⟩
    rcases h₂ with ⟨h₂, h₂'⟩
    rintro D₁ (hD₁ | hD₂)
    · simp [-Prod.forall, (·≤·)]
      intros x
      unfold Dict.Merge Dict.Merge.D Dict.First
      specialize h₁ hD₁
      simp [-Prod.forall, (·≤·)] at h₁
      specialize h₁ x
      set d₁ := D₁ x with eqX
      set d₂ := j₁ x with eqY
      set d₃ := j₂ x with eqZ
      rcases d₁ with _ | d₁ <;> rcases d₂ with _ | d₂ <;> rcases d₃ with _ | d₃ <;> simp
      · simp at h₁
      · simp at h₁
      · simp at h₁
        exact h₁
      · simp at h₁
        exact h₁
    · simp only [LE.le, discretePreorder_eq_equality_Pi_Prod_ExtraDataT, BalanceProof.snd_discrete,]
      intros x
      unfold Dict.Merge Dict.Merge.D Dict.First
      have eq₂ : D₁ ≤ j₂ := h₂ hD₂
      simp [-Prod.forall, (·≤·)] at eq₂
      specialize eq₂ x
      set d₁ := D₁ x with eqX
      set d₂ := j₁ x with eqY
      set d₃ := j₂ x with eqZ
      rcases d₁ with _ | d₁ <;> rcases d₂ with _ | d₂ <;> rcases d₃ with _ | d₃ <;> simp
      · simp at eq₂
      · simp at eq₂
        exact eq₂
      · simp at eq₂
      · simp at eq₂
        specialize h₃'' x
        rw [←eqY, ←eqZ] at h₃''
        simp at h₃''
        exact iso_trans eq₂ h₃''.symm
  · exact λ _ hπ ↦ merge_le (h₁.right λ _ hd ↦ hπ (by tauto))
                            (h₂.right λ _ hd ↦ hπ (by tauto))


theorem List.getElem_append_left{α : Type u_1} {l₁ l₂ : List α} {i : Nat} (hn : i < l₁.length) :\n(l₁ ++ l₂)[i] = l₁[i]

Intmax.Vec.le

import Mathlib.Algebra.Order.Ring.Unbundled.Nonneg

import Mathlib.Data.Finite.Defs

import Mathlib.Data.Finmap

import Mathlib.Data.List.Intervals

import Mathlib.Data.Set.Image

import Mathlib.Logic.Embedding.Basic

import Mathlib.Tactic

import FVIntmax.Wheels.Wheels

namespace Intmax

namespace CryptoAssumptions

section Hashing

class Injective {α ω : Type} (f : α → ω) where
  h : ComputationallyInfeasible (¬ Function.Injective f)

end Hashing

end CryptoAssumptions

section UniquelyIndexed

prefix:max "!" => UniqueTokenT

namespace UniquelyIndexed

end UniquelyIndexed

end UniquelyIndexed

section NonNeg

postfix:max "₊" => NonNeg

section Nonneg

variable {α : Type} [PreWithZero α] {v : α₊}

end Nonneg

end NonNeg

section Order

section VectorPreorder

open Mathlib

variable {α : Type} [Preorder α] {n : ℕ}
         {v₁ v₂ v₃ : Vector α n}

namespace Vec

def le (v₁ v₂ : Vector α n) :=
  ∀ x ∈ (v₁.1.zip v₂.1), x.1 ≤ x.2

lemma le_trans (h₁ : v₁ ≤ v₂) (h₂ : v₂ ≤ v₃) : v₁ ≤ v₃ :=

:= by
  dsimp [(·≤·), le] at *
  rcases v₁ with ⟨l₁, hl₁⟩
  rcases v₂ with ⟨l₂, hl₂⟩
  rcases v₃ with ⟨l₃, hl₃⟩
  simp at *
  induction' l₂ with hd₂ tl₂ ih generalizing l₁ l₃ n
  · rcases l₃; exact h₁; simp_all; omega
  · rcases l₃ with _ | ⟨hd₃, tl₃⟩ <;> [simp; skip]
    rcases l₁ with _ | ⟨hd₁, tl₁⟩ <;> simp at *
    intros a b h
    rcases h with ⟨h₃, h₄⟩ | h
    · transitivity hd₂ <;> tauto
    · specialize @ih tl₁.length tl₁ rfl (by aesop) tl₃ (by aesop)
      aesop