-- 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ₛ]

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

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

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

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

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

-- Local definitions used:

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

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

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