import FVIntmax.Wheels.Dictionary
import FVIntmax.Wheels
import FVIntmax.Balance

local macro:max (priority := high) "↪" b:term : term => `(⟨$b, 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₊

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 ω

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

le

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

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 le_of_ext_le {α : Type} [Preorder α] {v₁ v₂ : Vector α n}
  (h : ∀ i : Fin n, v₁.1[i] ≤ v₂.1[i]) : v₁ ≤ v₂

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

lemma eq_of_BalanceProof_le (h : π ≤ π') (h₁ : k ∈ π) (h₂ : k ∈ π') :
  ((π k).get h₁).2 = ((π' k).get h₂).2

lemma mem_of_BalanceProof_le (h : π ≤ π') (h₁ : k ∈ π) : k ∈ π'

lemma notin_of_BalanceProof_le_notin (h : π ≤ π') (h₁ : k ∉ π') : k ∉ π

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_transactionsInBlock :
  (TransactionsInBlock π₁ b).length = (TransactionsInBlock π₂ b).length

lemma map_join_unnecessarily_specific
  {α β γ δ Pi : Type}
  [LE δ]
  [LE Pi]
  {l : List α}
  {P : (β × γ × δ) → Prop}
  {π π' : Pi}
  {f : Pi → α → List (Subtype P)}
  {i : ℕ}
  (h₀ : (List.length ∘ f π) = (List.length ∘ f π'))
  (h₁ : ∀ (a : α)
          (i : ℕ) (h : i < (f π a).length),
          (f π a)[i].1.2.2 ≤ ((f π' a)[i]'(by apply congr_fun at h₀; aesop)).1.2.2)
  (h) :
  ((List.map (f π) l).flatten[i]'h).1.2.2 ≤
  ((List.map (f π') l).flatten[i]'(by aesop)).1.2.2

lemma map_eq_project_triple {β γ δ : Type}
                            {s : β} {r : γ} {v : δ}
                            {i : ℕ}
                            {P : (β × γ × δ) → Prop}
                            {l : List (Subtype P)}
                            {h₀}
                            {h : i < l.length} :
  l[i]'h = ⟨(s, r, v), h₀⟩ → (l[i]'h).1.2.2 = v

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

Intmax.TransactionsInBlocksFixed

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

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

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

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⟩

open Lean.Elab.Tactic in

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 -/
  ⟩

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

end

section

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

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

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

:= by
  intros π π' h
  dsimp
  apply TransactionsInBlocksFixed_le_of_TransactionsInBlocks; rintro ⟨i, hi⟩; simp
  generalize eq : (TransactionsInBlocks π Bstar)[i]'(by blast with π) = Tstar
  generalize eq' : (TransactionsInBlocks π' Bstar)[i]'(by clear eq; blast with π') = Tstar'
  rcases Tstar with ⟨⟨s, r, v⟩, h₁⟩
  rcases Tstar' with ⟨⟨s', r', v'⟩, h₂⟩
  obtain ⟨⟨⟩, ⟨⟩⟩ := senderReceiver_transactionsInBlocks _ eq eq'; simp
  exact v_transactionsInBlocks h _ eq eq'


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)

postfix:max "₊" => NonNeg

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

Intmax.BalanceProof.compat

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} :
  π <≅> π' → π <≅> π'' → π <≅> (π' <+> π'')

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

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 compat_merge_of_compat :
  (∀ π', π' ∈ πs → π <≅> π') → π <≅> (mergeR'' πs .initial) :=

:= by
  induction πs generalizing π with
  | nil =>
    intros π
    unfold BalanceProof.compat BalanceProof.initial
    simp
  | cons π πs ih =>
    intros π_1 h
    rw [merge_lem]
    apply compat_lem <;> aesop


Scontract

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

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

ExtraDataT

abbrev ExtraDataT : Type := ℕ

isDepositBlock

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

getDeposit

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

postfix:max "₊" => NonNeg

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

Intmax.reindex

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₂

import FVIntmax.Wheels.AuthenticatedDictionary

import FVIntmax.Wheels.SignatureAggregation

import FVIntmax.BalanceProof

import FVIntmax.Block

import FVIntmax.Request

import FVIntmax.Wheels

namespace Intmax

noncomputable section Intmax

section RollupContract

open Classical

section

variable {C : Type} [Nonempty C]

         {V : Type} [Lattice V] [AddCommGroup V]

         {K₁ : Type} [Finite K₁] [Nonempty K₁]
         {K₂ : Type} [Finite K₂]
         {Sigma : Type}
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SA : SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

end

section

variable {C : Type}
         {V : Type} [Lattice V] [AddCommGroup V]
         {K₁ : Type} [Finite K₁]
         {K₂ : Type}
         {Sigma : Type}
         {block : Block K₁ K₂ C Sigma V}
         {v : V}

section Lemmas

end Lemmas

namespace Scontract

section

variable [LinearOrder K₁] [Nonempty K₁]
         [LinearOrder K₂] [Finite K₂]
         [Nonempty C]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

section appendBlock

variable {σ : Scontract K₁ K₂ V C Sigma} {request : Request K₁ K₂ C Sigma Pi V}

end appendBlock

end

section

variable [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]
         {σ : Scontract K₁ K₂ V C Sigma}
         {request : Request K₁ K₂ C Sigma Pi V}
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

end

end Scontract

end

end RollupContract

section AttackGameDefs

variable {K₁ : Type} [Finite K₁] [LinearOrder K₁] [Nonempty K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]

         {V : Type} [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

         {Sigma : Type}
         {C : Type} [Nonempty C]

         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

         (requests : List (Request K₁ K₂ C Sigma Pi V))
         (σ : Scontract K₁ K₂ V C Sigma)

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

end AttackGameDefs

section AttackGameLemmas

variable {K₁ K₂ Sigma C : Type}
         {V : Type} [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]

section computeBalanceSum

variable {k : ℕ}

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

end computeBalanceSum

@[simp]
lemma aggregateDeposits_cons {hd} {tl : List (Block K₁ K₂ C Sigma V)} :
  aggregateDeposits (hd :: tl) =
  (if h : hd.isDepositBlock
   then (hd.getDeposit h).2.1
   else 0) +
  aggregateDeposits tl :=

:= by
  simp [aggregateDeposits]
  rw [
    Finset.sum_fin_eq_sum_range,
    Finset.sum_eq_sum_diff_singleton_add (i := 0),
    dif_pos (show 0 < tl.length + 1 by omega)
  ]
  simp_rw [List.getElem_cons_zero (h := _)]; case h => exact Finset.mem_range.2 (by omega)
  let F : ℕ → V := λ i ↦
    if h : i < tl.length
    then if h_1 : tl[i].isDepositBlock = true
         then (tl[i].getDeposit h_1).2
         else 0
    else 0
  rw [Finset.sum_bij (t := Finset.range tl.length)
                     (g := F)
                     (i := reindex)
                     (hi := reindex_mem)
                     (i_inj := reindex_inj)
                     (i_surj := λ b hb ↦ by use b.succ; simp; exact Finset.mem_range.1 hb)
                     (h := λ n hn ↦ by simp at hn; simp [hn]
                                       rcases n with _ | n <;> [omega; simp [F, reindex]]
                                       nth_rw 2 [dif_pos (by rcases hn with ⟨hn, _⟩; omega)])]
  unfold F
  rw [Finset.sum_dite_of_true (λ _ ↦ (Finset.mem_range.1 ·)), Finset.sum_fin_eq_sum_range, Finset.univ_eq_attach]
  nth_rw 2 [Finset.sum_dite_of_true]; case h => exact λ _ ↦ (Finset.mem_range.1 ·)
  rw [add_comm]; simp


lemma f_transfer_source''
  (h : b.isTransferBlock) (h₁ : T ∈ TransactionsInBlock π b) :
  (f σ T) .Source = σ .Source := f_transfer_source ⟨⟨b, h⟩, h₁⟩

import FVIntmax.BalanceProof
import FVIntmax.Wheels
import FVIntmax.Propositions
import Mathlib
import FVIntmax.Key
import FVIntmax.Block
import Mathlib.Algebra.Group.Int
import FVIntmax.Wheels.Dictionary
import FVIntmax.State
import FVIntmax.Transaction

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

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)

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₂'

isDepositBlock

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

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 }

isComplete

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

value

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

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

Intmax.f

private lemma V'_eq_range {b : S K₁ K₂ V} {T : Τ K₁ K₂ V} {k : Kbar K₁ K₂} :
  V' b T k =
  Set.range λ (x : { x : (Τc K₁ K₂ V × S K₁ K₂ V) // (T, b) ≤ (↑x.1, x.2) }) ↦ fc ↑x k

lemma f_eq_f' : f = f' (K₁ := K₁) (K₂ := K₂) (V := V)

lemma f_transfer_source
  (h : ∃ block : {b : Block K₁ K₂ C Sigma V // b.isTransferBlock},
         T ∈ TransactionsInBlock π block.1) :
  (f σ T) .Source = σ .Source

import Mathlib

import Mathlib.Algebra.Group.Int

import FVIntmax.BalanceProof

import FVIntmax.Block

import FVIntmax.Key

import FVIntmax.Propositions

import FVIntmax.State

import FVIntmax.Transaction

import FVIntmax.Wheels

import FVIntmax.Wheels.Dictionary

namespace Intmax

noncomputable section

open Classical

section Balance

variable {Pi K₁ K₂ V C Sigma : Type}

section Extraction

section Deposit

variable [PreWithZero V]

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

end Deposit

section Transfer

variable [Finite K₁] [Finite K₂]
         [LinearOrder K₁] [LinearOrder K₂] [PreWithZero V]

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

end Transfer

section Withdrawal

variable [LinearOrder K₁] [Finite K₁] [PreWithZero V]

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

end Withdrawal

variable [Finite K₁] [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]
         [PreWithZero V]
         {b : Block K₁ K₂ C Sigma V}
         {bs : List (Block K₁ K₂ C Sigma V)}
         {π₁ π₂ : BalanceProof K₁ K₂ C Pi V}

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

end Extraction

section e

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

variable {i j : Kbar K₁ K₂}

end e

section WithStructuredTypes

section v'

variable [Zero V] [Lattice V] -- NB `PreWithZero V` is implied as `CompleteLattice V` gives `Preorder V`.

variable {v : V₊} {b : S K₁ K₂ V} {s : Kbar K₁ K₂}

end v'

section Fc

variable [Lattice V]
         [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

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 -/
  ⟩

variable {τc : Τc K₁ K₂ V} {b : S K₁ K₂ V}

end Fc

section Order

variable [Lattice V] [AddCommGroup V]

end Order

section BoundedBelow

variable [Lattice V] [AddCommGroup V]

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

end BoundedBelow

section LGroup

variable [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

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 }

section 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 -/
  ⟩

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 -/
  ⟩

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 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 -/
  ⟩

end f

section fStar

variable {s : S K₁ K₂ V}

end fStar

variable [Finite K₁] [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]

section LocalProperties

variable {σ : S K₁ K₂ V}
         {π : BalanceProof K₁ K₂ C Pi V}
         {T : Τ K₁ K₂ V}
         {b : Block K₁ K₂ C Sigma V}
         {Sigma : Type}


isComplete

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

Τ

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₂

abbrev

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

NonNeg

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

Τc

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

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

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

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 -/
  ⟩

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 -/
  ⟩

Injective

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

postfix:max "₊" => NonNeg

lemma f_IsGLB_of_V' {b : S K₁ K₂ V} {T : Τ K₁ K₂ V} {k : Kbar K₁ K₂} :
  IsGLB (V' b T k) (f b T k)

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

import FVIntmax.Balance

namespace Intmax

section Lemma3

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

variable {Tc : Τc K₁ K₂ V} {T : Τ K₁ K₂ V} {b : S K₁ K₂ V} {Tstar : List (Τ K₁ K₂ V)}

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

:= by
  by_cases eq : T.isComplete
  · conv_rhs => rw [←sum_fc_eq_sum (Tc := ⟨T, eq⟩)]
    refine' Finset.sum_le_sum (λ k _ ↦ _)
    have fcInV' : fc (⟨T, eq⟩, b) k ∈ V' b T k := by
      dsimp [V']
      rw [Set.mem_image]
      use (⟨T, eq⟩, b)
      simp
    exact f_IsGLB_of_V'.1 fcInV'
  · rcases T with ⟨⟨s, r, v⟩, h⟩
    let Tc : Τc K₁ K₂ V := ⟨⟨(s, r, some 0), by valid⟩, by simp⟩
    conv_rhs => rw [←sum_fc_eq_sum (Tc := Tc)]
    refine' (Finset.sum_le_sum (λ k _ ↦ _))
    have fcInV' : fc (Tc, b) k ∈ V' b ⟨(s, r, v), h⟩ k := by
      dsimp [V']
      rw [Set.mem_image]
      use (⟨⟨(s, r, some 0), by valid⟩, by valid⟩, b)
      have : v = none := by aesop
      simp [this, (·≤·)]
    exact f_IsGLB_of_V'.1 fcInV'


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

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 -/
  ⟩

Key

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

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

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

isWithdrawalBlock

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

ExtraDataT

abbrev ExtraDataT : Type := ℕ

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₊

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

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

lemma eq_of_BalanceProof_le (h : π ≤ π') (h₁ : k ∈ π) (h₂ : k ∈ π') :
  ((π k).get h₁).2 = ((π' k).get h₂).2

lemma mem_of_BalanceProof_le (h : π ≤ π') (h₁ : k ∈ π) : k ∈ π'

lemma notin_of_BalanceProof_le_notin (h : π ≤ π') (h₁ : k ∉ π') : k ∉ π

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_transactionsInBlock :
  (TransactionsInBlock π₁ b).length = (TransactionsInBlock π₂ b).length

lemma map_join_unnecessarily_specific
  {α β γ δ Pi : Type}
  [LE δ]
  [LE Pi]
  {l : List α}
  {P : (β × γ × δ) → Prop}
  {π π' : Pi}
  {f : Pi → α → List (Subtype P)}
  {i : ℕ}
  (h₀ : (List.length ∘ f π) = (List.length ∘ f π'))
  (h₁ : ∀ (a : α)
          (i : ℕ) (h : i < (f π a).length),
          (f π a)[i].1.2.2 ≤ ((f π' a)[i]'(by apply congr_fun at h₀; aesop)).1.2.2)
  (h) :
  ((List.map (f π) l).flatten[i]'h).1.2.2 ≤
  ((List.map (f π') l).flatten[i]'(by aesop)).1.2.2

lemma map_eq_project_triple {β γ δ : Type}
                            {s : β} {r : γ} {v : δ}
                            {i : ℕ}
                            {P : (β × γ × δ) → Prop}
                            {l : List (Subtype P)}
                            {h₀}
                            {h : i < l.length} :
  l[i]'h = ⟨(s, r, v), h₀⟩ → (l[i]'h).1.2.2 = 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

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

end

section

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

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

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

:= by
  unfold TransactionsInBlocks at h₁ h₂
  apply List.map_eq_project_triple at h₁
  apply List.map_eq_project_triple at h₂
  rw [←h₁, ←h₂]
  apply List.map_join_unnecessarily_specific (by ext x; simp; rw [length_transactionsInBlock])
  intros b i h₃
  unfold TransactionsInBlock
  match h' : b with
  | Block.transfer .. =>
    rcases delta_TransactionsInBlock_transfer (b := ⟨b, by aesop⟩) h i (by aesop) <;>
           [aesop; (simp [(·≤·)]; aesop)]
  | Block.deposit .. | Block.withdrawal .. => simp


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

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

Kbar

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

Key

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

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

abbrev

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

Τc

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

Τ

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₊

NonNeg

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

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 -/
  ⟩

Injective

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

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

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

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)

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

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)

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)

initial

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

lemma f_IsGLB_of_V' {b : S K₁ K₂ V} {T : Τ K₁ K₂ V} {k : Kbar K₁ K₂} :
  IsGLB (V' b T k) (f b T k)

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

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

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

import FVIntmax.Balance

namespace Intmax

section Lemma3

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

variable {Tc : Τc K₁ K₂ V} {T : Τ K₁ K₂ V} {b : S K₁ K₂ V} {Tstar : List (Τ K₁ K₂ V)}

variable [LinearOrder K₁] [LinearOrder K₂]
         {π : BalanceProof K₁ K₂ C Pi V}
         {bs : List (Block K₁ K₂ C Sigma V)}

:= by
  dsimp [Bal]
  generalize eq : TransactionsInBlocks π _ = blocks
  generalize eq₁ : S.initial K₁ K₂ V = s₀
  generalize eq₂ : fStar blocks s₀ = f
  have : ∑ x ∈ {Kbar.Source}, f x =
         ∑ x : Kbar K₁ K₂, f x - ∑ x ∈ Finset.univ \ {Kbar.Source}, f x := by simp
  rw [←Finset.sum_singleton (a := Kbar.Source) (f := f), this, sub_nonpos]
  have := sum_fStar_le_zero_aux (Tstar := blocks) (b := s₀)
  have eq₃ : ∑ x : Kbar K₁ K₂, f x ≤ 0 := by aesop
  have eq₄ : 0 ≤ ∑ x ∈ Finset.univ \ {Kbar.Source}, f x := Finset.sum_nonneg λ i ↦ by rcases i <;> aesop
  exact le_trans eq₃ eq₄


import Mathlib.Order.Bounds.Basic
import FVIntmax.Wheels.Dictionary
import Aesop
import Mathlib.Order.Bounds.Defs
import Mathlib.Order.Defs

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

Intmax.Setoid'

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

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

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

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)

import Mathlib.Order.Bounds.Basic

import Mathlib.Order.Bounds.Defs

import Mathlib.Order.Defs

import Aesop

import FVIntmax.Wheels.Dictionary

namespace Intmax

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

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

section iso

variable {X : Type} [Preorder X]
         {a b c : X}

end iso

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

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

section Automation

variable {α : Type} [Preorder α]
         {x y : α}

end Automation

section Propositions

variable {X Y : Type}

section proposition3

variable [Preorder X]
         {x? y? join? join'? : Option X}
         {x y join join' : X}

end proposition3

section Automation

variable {X : Type} [Setoid' X]
         {x y : X}
         {x? y? : Option X}

end Automation

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

:= by
  refine' Iff.intro (λ h ⟨h₁, h₂⟩ ↦ _) (λ h ↦ _)
  · rcases x with _ | x <;> rcases y with _ | y <;> [rfl; simp at h₁; simp at h₂; skip]
    simp
    rw [←proposition3'] at h
    rcases h with ⟨join, h⟩
    obtain ⟨h₁, h₂⟩ := proposition2' h
    exact iso_trans h₁ h₂.symm
  · rcases x with _ | x <;> rcases y with _ | y
    · use .none; simp
    · use .some y; simp
    · use .some x; simp
    · simp at h
      simp_rw [←proposition3']
      exact proposition2.2 h


local macro:max (priority := high) "↪" b:term : term => `(⟨$b, 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)

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₂'

isDepositBlock

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

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

Intmax.TransactionsInBlock

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_transactionsInBlock :
  (TransactionsInBlock π₁ b).length = (TransactionsInBlock π₂ b).length

import Mathlib

import Mathlib.Algebra.Group.Int

import FVIntmax.BalanceProof

import FVIntmax.Block

import FVIntmax.Key

import FVIntmax.Propositions

import FVIntmax.State

import FVIntmax.Transaction

import FVIntmax.Wheels

import FVIntmax.Wheels.Dictionary

namespace Intmax

noncomputable section

open Classical

section Balance

variable {Pi K₁ K₂ V C Sigma : Type}

section Extraction

section Deposit

variable [PreWithZero V]

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

end Deposit

section Transfer

variable [Finite K₁] [Finite K₂]
         [LinearOrder K₁] [LinearOrder K₂] [PreWithZero V]

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

end Transfer

section Withdrawal

variable [LinearOrder K₁] [Finite K₁] [PreWithZero V]

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

end Withdrawal

variable [Finite K₁] [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]
         [PreWithZero V]
         {b : Block K₁ K₂ C Sigma V}
         {bs : List (Block K₁ K₂ C Sigma V)}
         {π₁ π₂ : BalanceProof K₁ K₂ C Pi V}

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

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

:= by
  apply List.ext_get (by simp; rw [length_transactionsInBlock])
  intros n h₁ h₂
  simp; unfold TransactionsInBlock
  match b with
  | Block.deposit ..    => simp [TransactionsInBlock_deposit]
  | Block.transfer ..   => simp [TransactionsInBlock_transfer]
  | Block.withdrawal .. => simp [TransactionsInBlock_withdrawal]


local macro:max (priority := high) "↪" b:term : term => `(⟨$b, 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)

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₂'

isDepositBlock

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

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

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

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

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

Intmax.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

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_transactionsInBlock :
  (TransactionsInBlock π₁ b).length = (TransactionsInBlock π₂ b).length

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


local macro:max (priority := high) "↪" b:term : term => `(⟨$b, 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)

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₂'

isDepositBlock

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

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 }

isComplete

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

getWithdrawal

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

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

prefix:max "!" => UniqueTokenT

postfix:max "₊" => NonNeg

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

Intmax.f

@[simp]
lemma e_def : e i = λ j ↦ if i = j then 1 else 0

@[simp]
lemma v'_key_eq_meet {k : Key K₁ K₂} : v' v b (Kbar.key k) = ⟨v ⊓ b k, by simp⟩

private lemma V'_eq_range {b : S K₁ K₂ V} {T : Τ K₁ K₂ V} {k : Kbar K₁ K₂} :
  V' b T k =
  Set.range λ (x : { x : (Τc K₁ K₂ V × S K₁ K₂ V) // (T, b) ≤ (↑x.1, x.2) }) ↦ fc ↑x k

lemma f_eq_f' : f = f' (K₁ := K₁) (K₂ := K₂) (V := V)

omit [Finite K₂] [LinearOrder K₂] in
private lemma f_withdrawal_block_source_aux {l : List K₁}
  (h₀ : l.Nodup) (h : b.isWithdrawalBlock) :
  (List.foldl f' σ
    (List.map (λ s : K₁ ↦ ⟨(s, Kbar.Source, some (b.getWithdrawal h s)), by unfold Τ'.isValid; aesop⟩) l)).1
                            .Source = σ .Source + ∑ x : K₁, if x ∈ l then (↑(b.getWithdrawal h x) ⊓ σ x) else 0

import Mathlib

import Mathlib.Algebra.Group.Int

import FVIntmax.BalanceProof

import FVIntmax.Block

import FVIntmax.Key

import FVIntmax.Propositions

import FVIntmax.State

import FVIntmax.Transaction

import FVIntmax.Wheels

import FVIntmax.Wheels.Dictionary

namespace Intmax

noncomputable section

open Classical

section Balance

variable {Pi K₁ K₂ V C Sigma : Type}

section Extraction

section Deposit

variable [PreWithZero V]

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

end Deposit

section Transfer

variable [Finite K₁] [Finite K₂]
         [LinearOrder K₁] [LinearOrder K₂] [PreWithZero V]

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

end Transfer

section Withdrawal

variable [LinearOrder K₁] [Finite K₁] [PreWithZero V]

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

end Withdrawal

variable [Finite K₁] [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]
         [PreWithZero V]
         {b : Block K₁ K₂ C Sigma V}
         {bs : List (Block K₁ K₂ C Sigma V)}
         {π₁ π₂ : BalanceProof K₁ K₂ C Pi V}

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

end Extraction

section e

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

variable {i j : Kbar K₁ K₂}

end e

section WithStructuredTypes

section v'

variable [Zero V] [Lattice V] -- NB `PreWithZero V` is implied as `CompleteLattice V` gives `Preorder 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 -/
  ⟩

variable {v : V₊} {b : S K₁ K₂ V} {s : Kbar K₁ K₂}

end v'

section Fc

variable [Lattice V]
         [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

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 -/
  ⟩

variable {τc : Τc K₁ K₂ V} {b : S K₁ K₂ V}

end Fc

section Order

variable [Lattice V] [AddCommGroup V]

end Order

section BoundedBelow

variable [Lattice V] [AddCommGroup V]

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

end BoundedBelow

section LGroup

variable [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

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 }

section 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 -/
  ⟩

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 -/
  ⟩

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 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 -/
  ⟩

end f

section fStar

variable {s : S K₁ K₂ V}

end fStar

variable [Finite K₁] [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]

section LocalProperties

variable {σ : S K₁ K₂ V}
         {π : BalanceProof K₁ K₂ C Pi V}
         {T : Τ K₁ K₂ V}
         {b : Block K₁ K₂ C Sigma V}
         {Sigma : Type}

lemma f_withdrawal_block_source (h : b.isWithdrawalBlock) :
  ((TransactionsInBlock π b).foldl f σ) .Source = σ .Source + ∑ k : K₁, (b.getWithdrawal h k).1 ⊓ σ k :=

:= by
  simp only [TransactionsInBlock]
  split <;> [simp at h; simp at h; skip]
  next B =>
  simp only [f_eq_f', TransactionsInBlock_withdrawal, List.pure_def, List.bind_eq_flatMap,
    exists_eq, Set.setOf_true, Set.toFinset_univ, Finset.mem_sort, Finset.mem_univ, forall_const,
    List.flatMap_subtype, List.unattach_attach, List.flatMap_singleton', Block.getWithdrawal]
  have : (Block.withdrawal B).getWithdrawal h = B := by ext k; simp [Block.getWithdrawal]
  simp_rw [←this]
  rw [f_withdrawal_block_source_aux (by simp)]
  simp [Finset.mem_sort]


Kbar

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

Key

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

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

abbrev

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

Τc

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

Τ

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₊

NonNeg

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

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 -/
  ⟩

Injective

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

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

postfix:max "₊" => NonNeg

lemma V'_sset_V'_of_le {b₁ b₂ : S K₁ K₂ V} {T₁ T₂ : Τ K₁ K₂ V} {k : Kbar K₁ K₂}
  (h : b₁ ≤ b₂) (h₁ : T₁ ≤ T₂) :
  V' b₂ T₂ k ⊆ V' b₁ T₁ k

lemma boundedBelow_sset_boundedBelow_of_le {b₁ b₂ : S K₁ K₂ V} {T₁ T₂ : Τ K₁ K₂ V}
  (h : b₁ ≤ b₂) (h₁ : T₁ ≤ T₂) : boundedBelow b₂ T₂ ⊆ boundedBelow b₁ T₁

lemma f_IsGLB_of_V' {b : S K₁ K₂ V} {T : Τ K₁ K₂ V} {k : Kbar K₁ K₂} :
  IsGLB (V' b T k) (f b T k)

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

end

section

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

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

end

end HicSuntDracones

section

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

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

section Monotone

variable {b₁ b₂ : S K₁ K₂ V}
         {T₁ T₂ : Τ K₁ K₂ V}
         {k : Kbar K₁ K₂}
         {v₁ v₂ : Vector (Τ K₁ K₂ V) n}

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

:= by
  obtain ⟨inf₁, -⟩ := f_IsGLB_of_V' (b := b₁) (T := T₁) (k := k)
  have inf₂ := f_IsGLB_of_V' (b := b₂) (T := T₂) (k := k)
  have := V'_sset_V'_of_le (k := k) h₁ h₂
  rw [le_isGLB_iff inf₂, mem_lowerBounds]
  aesop


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

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

Dict

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

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

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

Intmax.iso

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

Intmax.IsEquivRel

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

Intmax.Setoid'

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

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

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

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

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 proposition4 [Setoid' X] {x y : Option X} :
  (∃ join : Option X, IsLUB {x, y, .none} join) ↔ (x ≠ .none ∧ y ≠ .none → x ≅ y)

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₂ : Dict X Y} :
  (∃ join, IsLUB {D₁, D₂} join) ↔ ∀ x, D₁ x ≠ .none ∧ D₂ x ≠ .none → D₁ x ≅ D₂ x :=

:= by
  refine' ⟨λ h ↦ _, λ h ↦ _⟩
  simp_rw [proposition5] at h
  simp_rw [←proposition4]
  aesop
  use D₁.Merge D₂
  exact proposition6_aux h


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

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

@[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

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

:= by
  unfold Dict.Merge Dict.Merge.D
  apply proposition5' (h₀ := h)
  intros x
  rw [iso_symm]
  apply proposition4'
  revert x
  rw [proposition5] at h
  simpa


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

Scontract

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

ExtraDataT

abbrev ExtraDataT : Type := ℕ

abbrev

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

NonNeg

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

postfix:max "₊" => NonNeg

Intmax.computeBalance'

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

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

import FVIntmax.Wheels.AuthenticatedDictionary

import FVIntmax.Wheels.SignatureAggregation

import FVIntmax.BalanceProof

import FVIntmax.Block

import FVIntmax.Request

import FVIntmax.Wheels

namespace Intmax

noncomputable section Intmax

section RollupContract

open Classical

section

variable {C : Type} [Nonempty C]

         {V : Type} [Lattice V] [AddCommGroup V]

         {K₁ : Type} [Finite K₁] [Nonempty K₁]
         {K₂ : Type} [Finite K₂]
         {Sigma : Type}
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SA : SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

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

end

section

variable {C : Type}
         {V : Type} [Lattice V] [AddCommGroup V]
         {K₁ : Type} [Finite K₁]
         {K₂ : Type}
         {Sigma : Type}
         {block : Block K₁ K₂ C Sigma V}
         {v : V}

section Lemmas

end Lemmas

namespace Scontract

section

variable [LinearOrder K₁] [Nonempty K₁]
         [LinearOrder K₂] [Finite K₂]
         [Nonempty C]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

section appendBlock

variable {σ : Scontract K₁ K₂ V C Sigma} {request : Request K₁ K₂ C Sigma Pi V}

end appendBlock

end

section

variable [LinearOrder K₁]
         [Finite K₂] [LinearOrder K₂]
         {σ : Scontract K₁ K₂ V C Sigma}
         {request : Request K₁ K₂ C Sigma Pi V}
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

end

end Scontract

end

end RollupContract

section AttackGameDefs

variable {K₁ : Type} [Finite K₁] [LinearOrder K₁] [Nonempty K₁]
         {K₂ : Type} [Finite K₂] [LinearOrder K₂]

         {V : Type} [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [CovariantClass V V (Function.swap (· + ·)) (· ≤ ·)]

         {Sigma : Type}
         {C : Type} [Nonempty C]

         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]
         [SignatureAggregation (C × K₁ × ExtraDataT) K₂ KₛT Sigma]

         (requests : List (Request K₁ K₂ C Sigma Pi V))
         (σ : Scontract K₁ K₂ V C Sigma)

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

end AttackGameDefs

section AttackGameLemmas

variable {K₁ K₂ Sigma C : Type}
         {V : Type} [Lattice V] [AddCommGroup V]
         [CovariantClass V V (· + ·) (· ≤ ·)]
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]

section computeBalanceSum

variable {k : ℕ}

end computeBalanceSum

variable [Finite K₁]

end AttackGameLemmas

section ComputeLemmas

variable {K₁ : Type} [Finite K₁] {K₂ Sigma C : Type}
         {V : Type} [Lattice V] [AddCommGroup V]
         {σ : Scontract K₁ K₂ V C Sigma}
         [ADScheme K₂ (C × K₁ × ExtraDataT) C Pi]

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

:= by
  induction' σ with hd tl ih generalizing v
  · simp
  · rw [computeBalance'_cons, computeBalance'_cons, ih, Block.updateBalance_eq_zero]
    nth_rw 2 [ih]
    exact add_assoc v _ _


scoped syntax num : embedded

scoped syntax num : embedded

instantiateComp

def instantiateComp (what : Value) (comp : Computation) : Computation :=
  instantiateComputationLvl what 0 comp

instantiateComputationLvl

def instantiateComputationLvl (what : Value) (level : Nat) : Computation → Computation
| .ret v => .ret <| instantiateValueLvl what level v
| .opCall op v c => .opCall op (instantiateValueLvl what level v) (instantiateComputationLvl what (level+1) c)
| .bind c₁ c₂ => .bind (instantiateComputationLvl what level c₁) (instantiateComputationLvl what (level+1) c₂)
| .ite v c₁ c₂ => .ite (instantiateValueLvl what level v) (instantiateComputationLvl what level c₁) (instantiateComputationLvl what level c₂)
| .app v₁ v₂ => .app (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .handle v c => .handle (instantiateValueLvl what level v) (instantiateComputationLvl what level c)
| .join v₁ v₂ => .join (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .fst v => .fst (instantiateValueLvl what level v)
| .snd v => .snd (instantiateValueLvl what level v)
| .add v₁ v₂ => .add (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .sub v₁ v₂ => .sub (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .max v₁ v₂ => .max (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .lt v₁ v₂ => .lt (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .mul v₁ v₂ => .mul (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .eq v₁ v₂ => .eq (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
termination_by c => sizeOf c
decreasing_by
  all_goals simp
  all_goals grind

instantiateValueLvl

def instantiateValueLvl (what : Value) (level : Nat) : Value → Value
| var@(.var (.bvar bvarLevel)) => if bvarLevel = level then what else var
| .lam c => .lam <| instantiateComputationLvl what (level + 1) c
| .hdl h => .hdl <| instantiateHandlerLvl what level h
| .pair v₁ v₂ => .pair (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .recfun c => .recfun <| instantiateComputationLvl what (level + 2) c
| .string s => .string s
| .bool b => .bool b
| .unit => .unit
| .var v => .var v
| .num n => .num n
termination_by v => sizeOf v
decreasing_by
  all_goals simp
  all_goals grind

instantiateHandlerLvl

def instantiateHandlerLvl (what : Value) (level : Nat) : Handler → Handler
| ⟨ret, ops'⟩ =>
    ⟨instantiateComputationLvl what (level+1) ret, instantiateOps what level ops'⟩
termination_by h => sizeOf h
decreasing_by
  all_goals simp
  all_goals grind

instantiateOps

def instantiateOps (what : Value) (level : Nat) : List OpClause → List OpClause
| [] => []
| ⟨op, body⟩ :: ls =>
  ⟨op, instantiateComputationLvl what (level+2) body⟩ :: instantiateOps what level ls
termination_by l => sizeOf l

OpClause

structure OpClause where
  op : Name

  body : Computation
deriving Repr, BEq

Computation

inductive Computation where
| ret : Value → Computation

| opCall : Name → Value → Computation → Computation

| bind : Computation → Computation → Computation
| ite (val : Value) (trueBranch falseBranch : Computation)
| app : Value → Value → Computation

| handle : Value → Computation → Computation
| join : Value → Value → Computation
| fst : Value → Computation
| snd : Value → Computation
| add : Value → Value → Computation
| sub : Value → Value → Computation
| mul : Value → Value → Computation
| max : Value → Value → Computation
| lt : Value → Value → Computation
| eq : Value → Value → Computation
deriving BEq

Value

inductive Value where
| var : Var → Value
| bool : Bool → Value
| string : String → Value
| num : Int → Value
| unit : Value
| pair : Value → Value → Value

| lam : Computation → Value

| recfun : Computation → Value
| hdl : Handler → Value
deriving BEq

Handler

structure Handler where

  ret : Computation
  ops : List OpClause
deriving Repr, BEq

Var

inductive Var where
| fvar : Name → Var
| bvar : Nat → Var
deriving Repr, DecidableEq

Name

abbrev Name := String

Step

@[grind cases]
inductive Step : Computation → Computation → Prop

| beta v body : Step (.app (.lam body) v) (instantiateComp v body)

| recBeta v body : Step (.app (.recfun body) v) (instantiate2 (.recfun body) v body)

| iteTrue c₁ c₂ : Step (.ite (.bool true) c₁ c₂) c₁

| iteFalse c₁ c₂ : Step (.ite (.bool false) c₁ c₂) c₂

| bindStep c₁ c₁' c₂ (h : Step c₁ c₁') : Step (.bind c₁ c₂) (.bind c₁' c₂)

| bindReturn v c : Step (.bind (.ret v) c) (instantiateComp v c)

| bindOp op v body c : Step (.bind (.opCall op v body) c) (.opCall op v (.bind body c))

| handleInner h c₁ c₂ (h₁ : Step c₁ c₂) : Step (.handle (.hdl h) c₁) (.handle (.hdl h) c₂)

| handleReturn h v :
  Step (.handle (.hdl h) (.ret v)) (instantiateComp v h.ret)

| handleOpHit h op v body c (hop : h.lookup op = some ⟨op, c⟩) :
  Step (.handle (.hdl h) (.opCall op v body))
    (instantiate2 v (.lam (.handle (.hdl h) body)) c)

| handleOpMiss h op v body (hop : h.lookup op = none) :
  Step (.handle (.hdl h) (.opCall op v body)) (.opCall op v (.handle (.hdl h) body))

| join s₁ s₂ : Step (.join (.string s₁) (.string s₂)) (.ret (.string (strAppend s₁ s₂)))

| fstStep v₁ v₂ : Step (.fst (.pair v₁ v₂)) (.ret v₁)

| sndStep v₁ v₂ : Step (.snd (.pair v₁ v₂)) (.ret v₂)
| add v₁ v₂ : Step (.add (.num v₁) (.num v₂)) (.ret (.num (v₁ + v₂)))
| sub v₁ v₂ : Step (.sub (.num v₁) (.num v₂)) (.ret (.num (v₁ - v₂)))
| max v₁ v₂ : Step (.max (.num v₁) (.num v₂)) (.ret (.num (Max.max v₁ v₂)))
| lt v₁ v₂ : Step (.lt (.num v₁) (.num v₂)) (.ret (.bool (v₁ < v₂)))
| mul v₁ v₂ : Step (.mul (.num v₁) (.num v₂)) (.ret (.num (v₁ * v₂)))
| eq v₁ v₂ : Step (.eq v₁ v₂) (.ret (.bool (v₁ == v₂)))

def instantiate2 (arg cont : Value) (body : Computation) : Computation :=
  instantiateComputationLvl arg 1 (instantiateComputationLvl cont 0 body)

strAppend

def strAppend : String → String → String
| "", s => s
| s, "" => s
| s₁, s₂ => s₁ ++ " " ++ s₂

StepStar

@[grind cases]
inductive StepStar : Computation → Computation → Prop
| refl (c) : StepStar c c
| trans : Step c₁ c₂ → StepStar c₂ c₃ → StepStar c₁ c₃

Handler.lookup

def Handler.lookup (hdl : Handler) (name : Name) :=
  hdl.ops.find? (·.op == name)

infix:50 " ⤳ " => Step

infix:50 " ⤳⋆ " => StepStar

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

evalFuel

theorem evalSingleStep_sound {c c' : Computation} :
    evalSingleStep c = some c' → c ⤳ c'

import IntroEffects.SmallStep

def evalSingleStep : Computation → Option Computation

| .app (.lam body) v => some <| instantiateComp v body

| .app (.recfun body) v => some <| instantiate2 (.recfun body) v body
| .ite (.bool true) c₁ _ => some c₁
| .ite (.bool false) _ c₂ => some c₂

| .bind (.ret v) c => some <| instantiateComp v c

| .bind (.opCall op v body) c => some <| .opCall op v (.bind body c)
| .bind c₁ c₂ => (evalSingleStep c₁).map (fun c₁' => .bind c₁' c₂)

| .handle (.hdl h) (.ret v) => some <| instantiateComp v h.ret
| .handle (.hdl h) (.opCall op v body) =>
  match h.lookup op with

  | some ⟨_, c⟩ =>
    let cont := .lam (.handle (.hdl h) body)
    some <| instantiate2 v cont c

  | none => some <| .opCall op v (.handle (.hdl h) body)
| .handle (.hdl h) c =>
  (evalSingleStep c).map (fun c' => .handle (.hdl h) c')
| .join (.string s₁) (.string s₂) => some <| .ret (.string (strAppend s₁ s₂))
| .fst (.pair v₁ _) => some <| .ret v₁
| .snd (.pair _ v₂) => some <| .ret v₂
| .add (.num v₁) (.num v₂) => some <| .ret (.num (v₁ + v₂))
| .sub (.num v₁) (.num v₂) => some <| .ret (.num (v₁ - v₂))
| .max (.num v₁) (.num v₂) => some <| .ret (.num (Max.max v₁ v₂))
| .lt (.num v₁) (.num v₂) => some <| .ret (.bool (v₁ < v₂))
| .mul (.num v₁) (.num v₂) => some <| .ret (.num (v₁ * v₂))
| .eq v₁ v₂ => some <| .ret (.bool (v₁ == v₂))
| _ => none

def evalFuel : Nat → Computation → Option Computation
| 0, _ => none
| _+1, .ret v => some <| .ret v
| _+1, .opCall n v c => some <| .opCall n v c
| n+1, c =>
  match evalSingleStep c with
  | some c' => evalFuel n c'
  | none => none

theorem evalFuel_sound  : evalFuel n c = some v → c ⤳⋆ v :=

:= by
  induction h : n generalizing c with
  | zero => simp [evalFuel]
  | succ n ih =>
    cases hstep : evalSingleStep c with
    | none =>
      cases c <;> try grind [evalFuel]
      all_goals
      ( simp [evalFuel]
        intro h; rw [←h]; constructor)
    | some c' =>
      cases c with
      | ret | opCall =>
        simp [evalFuel]
        intro h; rw [←h]; constructor
      | _ =>
        simp [evalFuel, hstep]
        intro h
        exact StepStar.trans (evalSingleStep_sound hstep) (evalFuel_sound h)


scoped syntax num : embedded

scoped syntax num : embedded

instantiateComp

def instantiateComp (what : Value) (comp : Computation) : Computation :=
  instantiateComputationLvl what 0 comp

instantiateComputationLvl

def instantiateComputationLvl (what : Value) (level : Nat) : Computation → Computation
| .ret v => .ret <| instantiateValueLvl what level v
| .opCall op v c => .opCall op (instantiateValueLvl what level v) (instantiateComputationLvl what (level+1) c)
| .bind c₁ c₂ => .bind (instantiateComputationLvl what level c₁) (instantiateComputationLvl what (level+1) c₂)
| .ite v c₁ c₂ => .ite (instantiateValueLvl what level v) (instantiateComputationLvl what level c₁) (instantiateComputationLvl what level c₂)
| .app v₁ v₂ => .app (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .handle v c => .handle (instantiateValueLvl what level v) (instantiateComputationLvl what level c)
| .join v₁ v₂ => .join (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .fst v => .fst (instantiateValueLvl what level v)
| .snd v => .snd (instantiateValueLvl what level v)
| .add v₁ v₂ => .add (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .sub v₁ v₂ => .sub (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .max v₁ v₂ => .max (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .lt v₁ v₂ => .lt (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .mul v₁ v₂ => .mul (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .eq v₁ v₂ => .eq (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
termination_by c => sizeOf c
decreasing_by
  all_goals simp
  all_goals grind

instantiateValueLvl

def instantiateValueLvl (what : Value) (level : Nat) : Value → Value
| var@(.var (.bvar bvarLevel)) => if bvarLevel = level then what else var
| .lam c => .lam <| instantiateComputationLvl what (level + 1) c
| .hdl h => .hdl <| instantiateHandlerLvl what level h
| .pair v₁ v₂ => .pair (instantiateValueLvl what level v₁) (instantiateValueLvl what level v₂)
| .recfun c => .recfun <| instantiateComputationLvl what (level + 2) c
| .string s => .string s
| .bool b => .bool b
| .unit => .unit
| .var v => .var v
| .num n => .num n
termination_by v => sizeOf v
decreasing_by
  all_goals simp
  all_goals grind

instantiateHandlerLvl

def instantiateHandlerLvl (what : Value) (level : Nat) : Handler → Handler
| ⟨ret, ops'⟩ =>
    ⟨instantiateComputationLvl what (level+1) ret, instantiateOps what level ops'⟩
termination_by h => sizeOf h
decreasing_by
  all_goals simp
  all_goals grind

instantiateOps

def instantiateOps (what : Value) (level : Nat) : List OpClause → List OpClause
| [] => []
| ⟨op, body⟩ :: ls =>
  ⟨op, instantiateComputationLvl what (level+2) body⟩ :: instantiateOps what level ls
termination_by l => sizeOf l

OpClause

structure OpClause where
  op : Name

  body : Computation
deriving Repr, BEq

Computation

inductive Computation where
| ret : Value → Computation

| opCall : Name → Value → Computation → Computation

| bind : Computation → Computation → Computation
| ite (val : Value) (trueBranch falseBranch : Computation)
| app : Value → Value → Computation

| handle : Value → Computation → Computation
| join : Value → Value → Computation
| fst : Value → Computation
| snd : Value → Computation
| add : Value → Value → Computation
| sub : Value → Value → Computation
| mul : Value → Value → Computation
| max : Value → Value → Computation
| lt : Value → Value → Computation
| eq : Value → Value → Computation
deriving BEq

Value

inductive Value where
| var : Var → Value
| bool : Bool → Value
| string : String → Value
| num : Int → Value
| unit : Value
| pair : Value → Value → Value

| lam : Computation → Value

| recfun : Computation → Value
| hdl : Handler → Value
deriving BEq

Handler

structure Handler where

  ret : Computation
  ops : List OpClause
deriving Repr, BEq

Var

inductive Var where
| fvar : Name → Var
| bvar : Nat → Var
deriving Repr, DecidableEq

Name

abbrev Name := String

Step

@[grind cases]
inductive Step : Computation → Computation → Prop

| beta v body : Step (.app (.lam body) v) (instantiateComp v body)

| recBeta v body : Step (.app (.recfun body) v) (instantiate2 (.recfun body) v body)

| iteTrue c₁ c₂ : Step (.ite (.bool true) c₁ c₂) c₁

| iteFalse c₁ c₂ : Step (.ite (.bool false) c₁ c₂) c₂

| bindStep c₁ c₁' c₂ (h : Step c₁ c₁') : Step (.bind c₁ c₂) (.bind c₁' c₂)

| bindReturn v c : Step (.bind (.ret v) c) (instantiateComp v c)

| bindOp op v body c : Step (.bind (.opCall op v body) c) (.opCall op v (.bind body c))

| handleInner h c₁ c₂ (h₁ : Step c₁ c₂) : Step (.handle (.hdl h) c₁) (.handle (.hdl h) c₂)

| handleReturn h v :
  Step (.handle (.hdl h) (.ret v)) (instantiateComp v h.ret)

| handleOpHit h op v body c (hop : h.lookup op = some ⟨op, c⟩) :
  Step (.handle (.hdl h) (.opCall op v body))
    (instantiate2 v (.lam (.handle (.hdl h) body)) c)

| handleOpMiss h op v body (hop : h.lookup op = none) :
  Step (.handle (.hdl h) (.opCall op v body)) (.opCall op v (.handle (.hdl h) body))

| join s₁ s₂ : Step (.join (.string s₁) (.string s₂)) (.ret (.string (strAppend s₁ s₂)))

| fstStep v₁ v₂ : Step (.fst (.pair v₁ v₂)) (.ret v₁)

| sndStep v₁ v₂ : Step (.snd (.pair v₁ v₂)) (.ret v₂)
| add v₁ v₂ : Step (.add (.num v₁) (.num v₂)) (.ret (.num (v₁ + v₂)))
| sub v₁ v₂ : Step (.sub (.num v₁) (.num v₂)) (.ret (.num (v₁ - v₂)))
| max v₁ v₂ : Step (.max (.num v₁) (.num v₂)) (.ret (.num (Max.max v₁ v₂)))
| lt v₁ v₂ : Step (.lt (.num v₁) (.num v₂)) (.ret (.bool (v₁ < v₂)))
| mul v₁ v₂ : Step (.mul (.num v₁) (.num v₂)) (.ret (.num (v₁ * v₂)))
| eq v₁ v₂ : Step (.eq v₁ v₂) (.ret (.bool (v₁ == v₂)))

def instantiate2 (arg cont : Value) (body : Computation) : Computation :=
  instantiateComputationLvl arg 1 (instantiateComputationLvl cont 0 body)

strAppend

def strAppend : String → String → String
| "", s => s
| s, "" => s
| s₁, s₂ => s₁ ++ " " ++ s₂

StepStar

@[grind cases]
inductive StepStar : Computation → Computation → Prop
| refl (c) : StepStar c c
| trans : Step c₁ c₂ → StepStar c₂ c₃ → StepStar c₁ c₃

infix:50 " ⤳ " => Step

infix:50 " ⤳⋆ " => StepStar

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

evalSingleStep

def evalSingleStep : Computation → Option Computation

| .app (.lam body) v => some <| instantiateComp v body

| .app (.recfun body) v => some <| instantiate2 (.recfun body) v body
| .ite (.bool true) c₁ _ => some c₁
| .ite (.bool false) _ c₂ => some c₂

| .bind (.ret v) c => some <| instantiateComp v c

| .bind (.opCall op v body) c => some <| .opCall op v (.bind body c)
| .bind c₁ c₂ => (evalSingleStep c₁).map (fun c₁' => .bind c₁' c₂)

| .handle (.hdl h) (.ret v) => some <| instantiateComp v h.ret
| .handle (.hdl h) (.opCall op v body) =>
  match h.lookup op with

  | some ⟨_, c⟩ =>
    let cont := .lam (.handle (.hdl h) body)
    some <| instantiate2 v cont c

  | none => some <| .opCall op v (.handle (.hdl h) body)
| .handle (.hdl h) c =>
  (evalSingleStep c).map (fun c' => .handle (.hdl h) c')
| .join (.string s₁) (.string s₂) => some <| .ret (.string (strAppend s₁ s₂))
| .fst (.pair v₁ _) => some <| .ret v₁
| .snd (.pair _ v₂) => some <| .ret v₂
| .add (.num v₁) (.num v₂) => some <| .ret (.num (v₁ + v₂))
| .sub (.num v₁) (.num v₂) => some <| .ret (.num (v₁ - v₂))
| .max (.num v₁) (.num v₂) => some <| .ret (.num (Max.max v₁ v₂))
| .lt (.num v₁) (.num v₂) => some <| .ret (.bool (v₁ < v₂))
| .mul (.num v₁) (.num v₂) => some <| .ret (.num (v₁ * v₂))
| .eq v₁ v₂ => some <| .ret (.bool (v₁ == v₂))
| _ => none

evalFuel

def evalFuel : Nat → Computation → Option Computation
| 0, _ => none
| _+1, .ret v => some <| .ret v
| _+1, .opCall n v c => some <| .opCall n v c
| n+1, c =>
  match evalSingleStep c with
  | some c' => evalFuel n c'
  | none => none

theorem evalSingleStep_complete {c c' : Computation} :
    c ⤳ c' → evalSingleStep c = (some c')

theorem evalFuel_step (h : c ⤳ c') : evalFuel (n + 1) c = evalFuel n c'

theorem evalFuelRet_complete_aux (h : c ⤳⋆ r) :
    ∀v, r= .ret v → ∃n, evalFuel n c = some (.ret v) :=

:= by
  induction h with
  | refl c' =>
    intro v hv
    exact ⟨1, by grind [evalFuel]⟩
  | @trans c1 c2 c3 hStep hTail ih =>
    intro v hv
    obtain ⟨n, ihFuel⟩ := ih v hv
    refine ⟨n+1, ?_⟩
    simp [evalFuel_step hStep, ihFuel]