-- Examples/StellarConsensus/SCPTheory.lean

import Mathlib.Data.Set.Basic

namespace FBA

def project {α β : Type} (slices : β → Set (Set α)) (S : Set α) : β → Set (Set α) :=
  fun n => { Sl ∩ S | Sl ∈ slices n }

class System (Node : Type) where
   
  W : Set Node
  slices : Node → Set (Set Node)
   
  slices_ne : ∀ p ∈ W, slices p ≠ ∅

variable {Node : Type}

def System.project (sys : System Node) (I : Set Node) : System Node :=
  { W := sys.W
    slices := FBA.project sys.slices I
    slices_ne := by admit /- proof elided -/

variable [inst : System Node]

open System

def quorum (Q : Set Node) : Prop := ∀ p ∈ Q ∩ W, ∃ Sl ∈ slices p, Sl ⊆ Q

def blocks_slices (S : Set Node) (p : Node) : Prop :=
  ∀ Sl ∈ slices p, Sl ∩ S ≠ ∅

structure intertwined (S : Set Node) where
  well_behaved : S ⊆ W
   
  q_inter : (∀ Q Q',
    quorum (inst := inst.project S) Q →
    quorum (inst := inst.project S) Q' →
    Q ∩ S ≠ ∅ → Q' ∩ S ≠ ∅ → Q ∩ Q' ∩ S ≠ ∅)

structure intact (I : Set Node) extends intertwined I where
   
  q_avail : quorum (inst := inst) I

-- Repository definitions used:
content: syntax (name:= assumption) "assumptionDef" : attr

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

-- Local definitions used:
content: def project {α β : Type} (slices : β → Set (Set α)) (S : Set α) : β → Set (Set α) :=
  fun n => { Sl ∩ S | Sl ∈ slices n }

content: class System (Node : Type) where
   
  W : Set Node
  slices : Node → Set (Set Node)
   
  slices_ne : ∀ p ∈ W, slices p ≠ ∅

content: def System.project (sys : System Node) (I : Set Node) : System Node :=
  { W := sys.W
    slices := FBA.project sys.slices I
    slices_ne := by admit /- proof elided -/

content: def quorum (Q : Set Node) : Prop := ∀ p ∈ Q ∩ W, ∃ Sl ∈ slices p, Sl ⊆ Q

content: def blocks_slices (S : Set Node) (p : Node) : Prop :=
  ∀ Sl ∈ slices p, Sl ∩ S ≠ ∅

content: structure intertwined (S : Set Node) where
  well_behaved : S ⊆ W
   
  q_inter : (∀ Q Q',
    quorum (inst := inst.project S) Q →
    quorum (inst := inst.project S) Q' →
    Q ∩ S ≠ ∅ → Q' ∩ S ≠ ∅ → Q ∩ Q' ∩ S ≠ ∅)

content: structure intact (I : Set Node) extends intertwined I where
   
  q_avail : quorum (inst := inst) I

-- Local lemmas used:
content: theorem Set.ne_empty_iff_exists_mem {α : Type u} {s : Set α} : s ≠ ∅ ↔ ∃ a, a ∈ s

content: theorem intact_implies_intertwined : ∀ I, intact (inst := inst) I → intertwined I

content: theorem intertwined_node_is_well_behaved : ∀ n S, intertwined (inst := inst) S → n ∈ S → n ∈ W

content: theorem intact_node_is_well_behaved : ∀ n I, intact (inst := inst) I → n ∈ I → n ∈ W

-- Target theorem and proof:
theorem slice_blocks_ne : ∀ n S I, intact (inst := inst) I → n ∈ I → blocks_slices S n →
    S ∩ I ≠ ∅
:= by
  intro n S I hI hin hblock
  unfold blocks_slices at hblock
  have h := hI.q_avail ; unfold quorum at h
  simp at h ; specialize h _ hin (intact_node_is_well_behaved _ _ hI hin)
  rcases h with ⟨Sl, hSl, h⟩ ; specialize hblock _ hSl
  rw [Set.ne_empty_iff_exists_mem] at hblock ⊢ ; simp at hblock ⊢
  aesop