-- FVIntmax/Theorem1.lean

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)}

-- Repository definitions used:
content: notation:51 (priority := high) a:52 " ≅ " b:52 => iso a b

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

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

content: 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) 

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

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

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

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

content: abbrev ExtraDataT : Type := ℕ

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

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

content: 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

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

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

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

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

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

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

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

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

content: postfix:max "₊" => NonNeg

-- Repository lemmas used:
content: 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

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

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

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

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

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

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

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

content: 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₂)

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

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

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

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

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

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

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

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

-- Local definitions used:
content: 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 π)

content: 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

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

-- Local lemmas used:
content: lemma mergeR''_eq_foldl :
  mergeR'' πs acc = mergeR''' πs acc

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

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

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

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

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

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

content: 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₂)

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

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

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

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

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

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

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

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

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

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

-- Target theorem and proof:
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₈