Theory Reentrancy

section‹Reentrancy›

text ‹
  In the following we use our calculus to verify a contract implementing a simple token.
  The contract is defined by definition *bank* and consist of one state variable and two methods:
   The state variable "balance" is a Mapping which assigns a balance to each address.
   Method "deposit" allows to send money to the contract which is then added to the sender's balance.
   Method "withdraw" allows to withdraw the callers balance.
›

text ‹
  We then verify that the following invariant (defined by *BANK*) is preserved by both methods:
  The difference between
   the Contracts own account-balance and
   the sum of all the balances kept in the Contracts state variable
  is larger than a certain threshold.
›

text ‹
  There are two things to note here:
  First, Solidity implicitly triggers the call of a so-called fallback method whenever we transfer money to a contract.
  In particular if another contract calls "withdraw", this triggers an implicit call to the callee's fallback method.
  This functionality was exploited in the infamous DAO attack which we demonstrate it in terms of an example later on.
  Since we do not know all potential Contracts which call "withdraw", we need to verify our invariant for all possible Solidity programs.
›

text ‹
  The second thing to note is that we were not able to verify that the difference is indeed constant.
  During verification it turned out that this is not the case since in the fallback method a contract could just send us additional money without calling "deposit".
  In such a case the difference would change. In particular it would grow. However, we were able to verify that the difference does never shrink which is what we actually want to ensure.
›

theory Reentrancy
  imports Weakest_Precondition Solidity_Evaluator
begin

subsection‹Example of Re-entrancy›

definition "example_env 
              loadProc (STR ''Attacker'')
                ([],
                ([], SKIP),
                 ITE (LESS (BALANCE THIS) (UINT b256 125))
                   (EXTERNAL (ADDRESS (STR ''BankAddress'')) (STR ''withdraw'') [] (UINT b256 0))
                   SKIP)
              (loadProc (STR ''Bank'')
                ([(STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))),
                (STR ''deposit'', Method ([], True,
                  ASSIGN
                    (Ref (STR ''balance'') [SENDER])
                    (PLUS (LVAL (Ref (STR ''balance'') [SENDER])) VALUE))),
                (STR ''withdraw'', Method ([], True,
                  ITE (LESS (UINT b256 0) (LVAL (Ref (STR ''balance'') [SENDER])))
                    (COMP
                      (TRANSFER SENDER (LVAL (Ref (STR ''balance'') [SENDER])))
                      (ASSIGN (Ref (STR ''balance'') [SENDER]) (UINT b256 0)))
                    SKIP))],
                ([], SKIP),
                SKIP)
                fmempty)"

global_interpretation reentrancy: statement_with_gas costs_ex example_env costs_min
  defines stmt = "reentrancy.stmt"
      and lexp = reentrancy.lexp 
      and expr = reentrancy.expr
      and ssel = reentrancy.ssel
      and rexp = reentrancy.rexp
      and msel = reentrancy.msel
      and load = reentrancy.load
      and eval = reentrancy.eval
  by unfold_locales auto

lemma "eval 1000
          (COMP
            (EXTERNAL (ADDRESS (STR ''BankAddress'')) (STR ''deposit'') [] (UINT b256 10))
            (EXTERNAL (ADDRESS (STR ''BankAddress'')) (STR ''withdraw'') [] (UINT b256 0)))
          (STR ''AttackerAddress'')
          (STR ''Attacker'')
          (STR '''')
          (STR ''0'')
          [(STR ''BankAddress'', STR ''100'', atype.Contract (STR ''Bank''), 0), (STR ''AttackerAddress'', STR ''100'', atype.Contract (STR ''Attacker''), 0)]
          []
  = STR ''BankAddress: balance==70 - Bank(balance[AttackerAddress]==0⏎)⏎AttackerAddress: balance==130 - Attacker()''"
  by eval

subsection‹Definition of contract›

abbreviation myrexp::l
  where "myrexp  Ref (STR ''balance'') [SENDER]"

abbreviation mylval::e
  where "mylval  LVAL myrexp"

abbreviation assign::s
  where "assign  ASSIGN myrexp (UINT b256 0)"

abbreviation transfer::s
  where "transfer  TRANSFER SENDER (LVAL (Id (STR ''bal'')))"

abbreviation comp::s
  where "comp  COMP assign transfer"

abbreviation keep::s
  where "keep  BLOCK (STR ''bal'', Value (TUInt b256), Some mylval) comp"

abbreviation deposit::s
  where "deposit  ASSIGN myrexp (PLUS mylval VALUE)"

abbreviation "banklist  [
          (STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))),
          (STR ''deposit'', Method ([], True, deposit)),
          (STR ''withdraw'', Method ([], True, keep))]"

definition bank::"(Identifier, member) fmap"
  where "bank  fmap_of_list banklist"

subsection‹Verification›

locale Reentrancy = Calculus +
  assumes r0: "cname = STR ''Bank''"
      and r1: "members = bank"
      and r2: "fb = SKIP"
      and r3: "const = ([], SKIP)"
begin

subsubsection‹Method lemmas›
text ‹
  These lemmas are required by @{term vcg_external}.
›

lemma mwithdraw[simp]:
  "members $$ STR ''withdraw'' = Some (Method ([], True, keep))"
  using r1 unfolding bank_def by simp

lemma mdeposit[simp]:
  "members $$ STR ''deposit'' = Some (Method ([], True, deposit))"
  using r1 unfolding bank_def by simp

subsubsection‹Variable lemma›

lemma balance[simp]:
  "members $$ (STR ''balance'') = Some (Var (STMap TAddr (STValue (TUInt b256))))"
  using r1 bank_def fmlookup_of_list[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))), (STR ''deposit'', Method ([], True, ASSIGN myrexp (PLUS mylval VALUE))),
      (STR ''withdraw'', Method ([], True, BLOCK (STR ''bal'', Value (TUInt b256), Some mylval) (COMP (ASSIGN myrexp (UINT b256 0)) Reentrancy.transfer)))]"] by simp

lemma balAcc:
  "members $$ (STR ''bal'') = None"
  using r1 bank_def fmlookup_of_list[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))), (STR ''deposit'', Method ([], True, ASSIGN myrexp (PLUS mylval VALUE))),
      (STR ''withdraw'', Method ([], True, BLOCK (STR ''bal'', Value (TUInt b256), Some mylval) (COMP (ASSIGN myrexp (UINT b256 0)) Reentrancy.transfer)))]"] by simp


subsubsection‹Case lemmas›
text ‹
  These lemmas are required by @{term vcg_transfer}.
›
lemma cases_ext: 
  assumes "members $$ mid = Some (Method (fp,True,f))"
      and "fp = []  f = deposit  P"
      and "fp = []  f = keep  P"
    shows "P"
proof -
  from assms(1) r1 consider (withdraw) "mid = STR ''withdraw''" | (deposit) "mid = STR ''deposit''" using bank_def fmap_of_list_SomeD[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))), (STR ''deposit'', Method ([], True, deposit)), (STR ''withdraw'', Method ([], True, keep))]"] by auto
  then show ?thesis
  proof (cases)
    case withdraw
    then have "f = keep" and "fp = []" using assms(1) bank_def r1 fmlookup_of_list[of banklist] by simp+
    then show ?thesis using assms(3) by simp
  next
    case deposit
    then have "f = deposit" and "fp = []" using assms(1) bank_def r1 fmlookup_of_list[of banklist] by simp+
    then show ?thesis using assms(2) by simp
  qed
qed

lemma cases_int: 
  assumes "members $$ mid = Some (Method (fp,False,f))"
    shows "P"
  using assms r1 bank_def fmap_of_list_SomeD[of "[(STR ''balance'', Var (STMap TAddr (STValue (TUInt b256)))), (STR ''deposit'', Method ([], True, deposit)), (STR ''withdraw'', Method ([], True, keep))]"] by auto

lemma cases_fb: 
  assumes "fb = SKIP  P"
  shows "P"
using assms bank_def r2 by simp

lemma cases_cons:
  assumes "fst const = []  snd const = SKIP  P"
  shows "P"
using assms bank_def r3 by simp

subsubsection‹Definition of Invariant›

abbreviation "SUMM s  (ad,x)|fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x. ReadLint x"

abbreviation "POS s  ad x. fmlookup s (ad + (STR ''.'' + STR ''balance'')) = Some x  ReadLint x  0"

definition "iv s a  a  SUMM s  POS s"

lemma weaken:
  assumes "iv (Storage st ad) (ReadLint (Bal (acc ad)) - ReadLint v)"
      and "ReadLint v 0"
    shows "iv (Storage st ad) (ReadLint (Bal (acc ad)))"
using assms unfolding iv_def by simp

subsubsection‹Additional lemmas›

lemma expr_0:
  assumes "expr (UINT b256 0) ev0 cd0 st0 g0 = Normal ((rv, rt),g''a)"
    shows "is_KValue rv" and "is_Value rt"
  using assms by (auto simp add:expr.simps split:if_split_asm)

lemma load_empty_par:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
    shows "load True [] [] (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
proof -
  have "xe=[]"
  proof (rule ccontr)
    assume "¬ xe=[]"
    then obtain x and xa where "xe=x # xa" by (meson list.exhaust)
    then have "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = throw Err g1" by (simp add:load.simps)
    with assms show False by simp
  qed
  then show ?thesis using assms(1) by simp
qed

lemma lexp_myrexp_decl:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (st0Gas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
      and "decl STR ''bal'' (Value (TUInt b256)) (Some (lv, lt)) False cdl ml (Storage st0 (Address el)) (cdl, ml, kl, el) =  Some (cd', mem', sck', e')"
      and "lexp myrexp e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a) g'a = Normal ((rv,rt), g''a)"
    shows "rv= LStoreloc (Address env + (STR ''.'' + STR ''balance''))" and "rt=type.Storage (STValue (TUInt b256))"
proof -
  have "fmlookup (Denvalue (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" unfolding emptyEnv_def using ffold_init_fmdom by simp
  moreover have el_def: "el = (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using load_empty_par[OF assms(1)] by (simp add:load.simps)
  ultimately have "fmlookup (Denvalue el) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" using assms by auto
  then have *: "fmlookup (Denvalue e') (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" 
    using decl_env[OF assms(2)] 
    using assms(2) decl_env_monotonic by presburger

  moreover obtain g'' where "ssel (STMap TAddr (STValue (TUInt b256))) (STR ''balance'') [SENDER] e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a) g'a = Normal (((Address env) + (STR ''.'' + STR ''balance''), STValue (TUInt b256)), g'')"
  proof -
    have "g'a > costse SENDER e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a)" using assms(3) * by (simp add:expr.simps ssel.simps lexp.simps split:if_split_asm)
    then obtain g'' where "expr SENDER e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a) g'a = Normal ((KValue (Sender e'), Value TAddr), g'')" by (simp add:expr.simps)
    moreover have "Sender el = Address env" using el_def ffold_init_ad_same[of members "(emptyEnv ad cname (Address env) v)" "fmdom members" el] unfolding emptyEnv_def by simp
    then have "Sender e' = Address env" using decl_env[OF assms(2)] by simp
    ultimately show ?thesis using that hash_def by (simp add:ssel.simps)
  qed
  ultimately show "rv= LStoreloc (Address env + (STR ''.'' + STR ''balance''))" and "rt=type.Storage (STValue (TUInt b256))" using assms(3) by (simp add:lexp.simps)+
qed

lemma lexp_myrexp_decl2:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (st0Gas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
      and "decl STR ''bal'' (Value (TUInt b256)) (Some (lv, lt)) False cdl ml (Storage st0 (Address el)) (cdl, ml, kl, el) =  Some (cd', mem', sck', e')"
      and "lexp myrexp e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a) g'a = Normal ((rv,rt), g''a)"
    shows "is_LStoreloc rv" and "(lt. rt = type.Storage lt  is_STValue lt)"
  using lexp_myrexp_decl[OF assms] by auto

lemma expr_bal: 
  assumes "expr (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'') g'' = Normal ((KValue lv, Value t), g''')"
      and "(sck', e') = astack_dup STR ''bal'' (Value (TUInt b256)) (KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s')) (kl, el)"
      and "Denvalue el $$ STR ''bal'' = None"
    shows "(accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'::int) = ReadLint lv" (is ?G1) and "t = TUInt b256"
proof -
  from assms(1)
  have "expr (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'') g'' = rexp ((l.Id STR ''bal'')) e' cd' ((stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'')) (g'' - costse (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g''))" by (simp add:expr.simps split:if_split_asm)
  moreover have "rexp ((l.Id STR ''bal'')) e' cd' ((stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'')) (g'' - costse (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'')) = Normal ((KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'), (Value (TUInt b256))),(g'' - costse (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'')) )"
  proof -
    from assms(2) have "fmlookup (Denvalue e') (STR ''bal'') = Some (Value (TUInt b256), Stackloc Toploc kl)" 
      using assms(3)
      by (simp add:push_def allocate_def updateStore_def option.split)
    moreover have "accessStore (Toploc kl) sck' = Some (KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'))" 
      using assms(2,3) by (simp add:push_def allocate_def updateStore_def accessStore_def)
    ultimately show ?thesis by (simp add:rexp.simps)
  qed
  ultimately have "expr (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'') g'' = Normal ((KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'), (Value (TUInt b256))),(g'' - costse (LVAL (l.Id STR ''bal'')) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := fmupd l v' s'), Gas := g'')))" and "t = TUInt b256" using assms(1) by simp+
  then have "lv = accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'" using assms(1) by (auto)
  with `t = TUInt b256` show ?G1 and "t = TUInt b256" by simp+
qed

lemma lexp_myrexp:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
      and "lexp myrexp el cdl (st'Gas := g2) g2 = Normal ((rv,rt), g2')"
    shows "rv= LStoreloc (Address env + (STR ''.'' + STR ''balance''))" and "rt=type.Storage (STValue (TUInt b256))"
proof -
  have "fmlookup (Denvalue (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" unfolding emptyEnv_def using ffold_init_fmdom by simp
  moreover have el_def: "el = (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using load_empty_par[OF assms(1)] by (simp add:load.simps)
  ultimately have *: "fmlookup (Denvalue el) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" using assms by auto

  moreover obtain g'' where "ssel (STMap TAddr (STValue (TUInt b256))) (STR ''balance'') [SENDER] el cdl (st'Gas := g2) g2 = Normal (((Address env) + (STR ''.'' + STR ''balance''), STValue (TUInt b256)), g'')"
  proof -
    have "g2 > costse SENDER el cdl (st'Gas := g2)" using assms(2) * by (simp add:expr.simps ssel.simps lexp.simps split:if_split_asm)
    then obtain g'' where "expr SENDER el cdl (st'Gas := g2) g2 = Normal ((KValue (Sender el), Value TAddr), g'')" by (simp add: expr.simps)
    moreover have "Sender el = Address env" using el_def ffold_init_ad_same[of members "(emptyEnv ad cname (Address env) v)" "fmdom members" el] unfolding emptyEnv_def by simp
    ultimately show ?thesis using that hash_def by (simp add:ssel.simps)
  qed
  ultimately show "rv= LStoreloc (Address env + (STR ''.'' + STR ''balance''))" and "rt=type.Storage (STValue (TUInt b256))" using assms(2) by (simp add: lexp.simps)+
qed

lemma expr_balance:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
      and "expr (LVAL (Ref (STR ''balance'') [SENDER])) el cdl (stAccounts := acc, Stack := kl, Memory := ml, Gas := g2) g2 = Normal ((va, ta), g'a)"
    shows "va= KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) (Storage st ad))"
      and "ta = Value (TUInt b256)"
proof -
  have "fmlookup (Denvalue (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" unfolding emptyEnv_def using ffold_init_fmdom by simp
  moreover have el_def: "el = (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using load_empty_par[OF assms(1)] by (simp add:load.simps)
  ultimately have *: "fmlookup (Denvalue el) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" using assms by auto

  moreover obtain g'' where "ssel (STMap TAddr (STValue (TUInt b256))) (STR ''balance'') [SENDER] el cdl (stAccounts := acc, Stack := kl, Memory := ml, Gas := g2) g2 = Normal (((Address env) + (STR ''.'' + STR ''balance''), STValue (TUInt b256)), g'')"
  proof -
    have "g2 > costse SENDER el cdl (stAccounts := acc, Stack := kl, Memory := ml, Gas := g2)" using assms(2) * by (simp add: expr.simps ssel.simps rexp.simps split:if_split_asm)
    then obtain g'' where "expr SENDER el cdl (stAccounts := acc, Stack := kl, Memory := ml, Gas := g2) g2 = Normal ((KValue (Sender el), Value TAddr), g'')" by (simp add:expr.simps ssel.simps rexp.simps)
    moreover have "Sender el = Address env" using el_def ffold_init_ad_same[of members "(emptyEnv ad cname (Address env) v)" "fmdom members" el] unfolding emptyEnv_def by simp
    ultimately show ?thesis using that hash_def by (simp add:expr.simps ssel.simps rexp.simps)
  qed
  moreover have "ad = Address el" using el_def ffold_init_ad_same[of members "(emptyEnv ad cname (Address env) v)" "fmdom members" el] unfolding emptyEnv_def by simp
  ultimately show "va= KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) (Storage st ad))" and "ta = Value (TUInt b256)" using assms(2) by (simp add:expr.simps ssel.simps rexp.simps split:if_split_asm)+
qed

lemma expr_plus:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g3) g3 = Normal ((el, cdl, kl, ml), g3')"
      and "expr (PLUS a0 b0) ev0 cd0 st0 g0 = Normal ((xs, t'0), g'0)"
    shows "is_KValue xs" and "is_Value t'0"
  using assms by (auto simp add:expr.simps split:if_split_asm result.split_asm prod.split_asm stackvalue.split_asm type.split_asm option.split_asm)

lemma lexp_myrexp2:
  assumes "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (stGas := g1) g1 = Normal ((el, cdl, kl, ml), g1')"
      and "lexp myrexp el cdl (st'Gas := g2) g2 = Normal ((rv,rt), g2')"
    shows "is_LStoreloc rv" and "x. rt=type.Storage x  is_STValue x"
  using lexp_myrexp[OF assms] by auto

lemma summ_eq_sum:
  "SUMM s' = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr. ReadLint x)
           + ReadLint (accessStorage (TUInt b256) (adr + (STR ''.'' + STR ''balance'')) s')"
proof (cases "fmlookup s' (adr + (STR ''.'' + STR ''balance'')) = None")
  case True
  then have "accessStorage (TUInt b256) (adr + (STR ''.'' + STR ''balance'')) s' = ShowLint 0" unfolding accessStorage_def by simp
  moreover have "{(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x} = {(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
  proof
    show "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
    proof
      fix x
      assume "x  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"
      then show "x  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}" using True by auto
    qed
  next
    show "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x }"
    proof
      fix x
      assume "x  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
      then show "x  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" using True by auto
    qed
  qed
  then have "SUMM s' = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr. ReadLint x)" by simp
  ultimately show ?thesis using Read_ShowL_id by simp
next
  case False
  then obtain val where val_def: "fmlookup s' (adr + (STR ''.'' + STR ''balance'')) = Some val" by auto

  have "inj_on (λ(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s'  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
  then have "finite {(ad, x). (fmlookup s'  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "λad. (ad + (STR ''.'' + STR ''balance''))" s'] by simp
  then have sum1: "finite ({(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr})" using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
  moreover have sum2: "(adr,val)  {(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}" by simp
  moreover from sum1 val_def have "insert (adr,val) {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr} = {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
  ultimately show ?thesis using sum.insert[OF sum1 sum2, of "λ(ad,x). ReadLint x"] val_def unfolding accessStorage_def by simp
qed

lemma sum_eq_update:
  assumes s''_def: "s'' = fmupd (adr + (STR ''.'' + STR ''balance'')) v' s'"
    shows "((ad,x)|fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr. ReadLint x)
          =((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr. ReadLint x)"
proof -
  have "{(ad,x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr} = {(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
  proof
    show "{(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}
        {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
    proof
      fix xx
      assume "xx  {(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
      then obtain ad x where "xx = (ad,x)" and "fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad  adr" by auto
      then have "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x" using String_Cancel[of ad "(STR ''.'' + STR ''balance'')" "adr"] s''_def by (simp split:if_split_asm)
      with `ad  adr` `xx = (ad,x)` show "xx  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}" by simp
    qed
  next
    show "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}
        {(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
    proof
      fix xx
      assume "xx  {(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}"
      then obtain ad x where "xx = (ad,x)" and "fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x" and "ad  adr" by auto
      then have "fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x" using String_Cancel[of ad "(STR ''.'' + STR ''balance'')" "adr"] s''_def by (auto split:if_split_asm)
      with `ad  adr` `xx = (ad,x)` show "xx  {(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  adr}" by simp
    qed
  qed
  thus ?thesis by simp
qed

lemma adapt_deposit:
  assumes "Address env  ad"
      and "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore env cd (st0Gas := g3) g3 = Normal ((el, cdl, kl, ml), g3')"
      and "Accounts.transfer (Address env) ad v a = Some acc"
      and "iv (Storage st0 ad) (ReadLint (Bal (acc ad)) - ReadLint v)"
      and "lexp myrexp el cdl (st0Gas := g'', Accounts := acc, Stack := kl, Memory := ml, Gas := g') g' = Normal ((LStoreloc l, type.Storage (STValue t')), g''a)"
      and "expr (PLUS mylval VALUE) el cdl (st0Gas := g'', Accounts := acc, Stack := kl, Memory := ml, Gas := g) g = Normal ((KValue va, Value ta), g')"
      and "Valuetypes.convert ta t' va = Some v'"
    shows "(ad = Address el  iv (Storage st0 (Address el)(l $$:= v')) Bal (acc (Address el))) 
           (ad  Address el  iv (Storage st0 ad) (ReadLint (Bal (acc ad))))"
proof (rule conjI; rule impI)
  assume "ad = Address el"
  define s' s'' where "s' = Storage st0 (Address el)" and "s'' = Storage st0 (Address el)(l $$:= v')"
  then have "s'' = fmupd l v' s'" by simp
  moreover from lexp_myrexp[OF assms(2) assms(5)] have "l = Address env + (STR ''.'' + STR ''balance'')" and "t'=TUInt b256" by simp+
  ultimately have s''_s': "s'' = s' (Address env + (STR ''.'' + STR ''balance'') $$:= v')" by simp

  have "fmlookup (Denvalue (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" unfolding emptyEnv_def using ffold_init_fmdom by simp
  moreover have "el = (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using load_empty_par[OF assms(2)] by (simp add:load.simps)
  ultimately have "fmlookup (Denvalue el) (STR ''balance'') = Some (type.Storage (STMap TAddr (STValue (TUInt b256))), Storeloc (STR ''balance''))" by simp
  then have va_def: "va = createUInt b256 ((ReadLint (accessStorage (TUInt b256) ((Sender el) + (STR ''.'' + STR ''balance'')) s') + ReadLint (Svalue el)))" 
   and "ta = TUInt b256" 
  using assms(6) Read_ShowL_id unfolding s'_def by (auto split:if_split_asm simp add: expr.simps ssel.simps rexp.simps add_def olift.simps hash_def)

  have "Svalue el = v" and "Sender el = Address env" and "Address el = ad" using ffold_init_ad_same msel_ssel_expr_load_rexp_gas(4)[OF assms(2)] unfolding emptyEnv_def by simp+
  then have a_frame: "iv s' (ReadLint (Bal (acc ad)) - ReadLint v)" using assms(4) unfolding s'_def by simp

  from assms(1) have  "ReadLint (Bal (a ad)) + ReadLint v < 2^256" using transfer_val2[OF assms(3)] by simp
  moreover from `Address env  ad` have "ReadLint (Bal (acc ad)) = ReadLint (Bal (a ad)) + ReadLint v" using transfer_add[OF assms(3)] by simp
  ultimately have a_bal: "ReadLint (Bal (acc ad)) < 2^256" by simp

  moreover have a_bounds:
      "ReadLint (accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s')  + Svalue el < 2 ^ 256 
      ReadLint (accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s')  + Svalue el  0"
  proof (cases "fmlookup s' (Sender el + (STR ''.'' + STR ''balance'')) = None")
    case True
    hence "(accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s') = ShowLint 0" unfolding accessStorage_def by simp
    moreover have "(Svalue el::int) < 2 ^ 256"
    proof -
      from a_frame have "Svalue el + SUMM s'  ReadLint (Bal (acc ad))" unfolding iv_def using `Svalue el = v` by simp
      moreover have "0  SUMM s'"
      using a_frame sum_nonneg[of "{(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "λ(ad,x). ReadLint x"] unfolding iv_def by auto
      ultimately have "Svalue el  ReadLint (Bal (acc ad))" by simp
      then show "(Svalue el::int) < 2 ^ 256" using a_bal by simp
    qed
    moreover have "ReadLint v  0" using transfer_val1[OF assms(3)] by simp
    with `Svalue el = v` have "(Svalue el::int)  0" by simp
    ultimately show ?thesis using Read_ShowL_id by simp
  next
    case False
    then obtain x where x_def: "fmlookup s'  (Sender el + (STR ''.'' + STR ''balance'')) = Some x" by auto
    moreover from a_frame have "Svalue el + SUMM s'  ReadLint (Bal (acc ad))" unfolding iv_def using `Svalue el = v` by simp
    moreover have "(case (Sender el, x) of (ad, x)  x)  ((ad, x){(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}. ReadLint x)"
    proof (cases rule: member_le_sum[of "(Sender el,x)" "{(ad,x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "λ(ad,x). ReadLint x"])
      case 1
      then show ?case using x_def by simp
    next
      case (2 x)
      with a_frame show ?case unfolding iv_def by auto
    next
      case 3
      have "inj_on (λ(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s'  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
      then have "finite {(ad, x). (fmlookup s'  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "λad. (ad + (STR ''.'' + STR ''balance''))" s'] by simp
      then show ?case using finite_subset[of "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}" "{(ad, x). fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
    qed
    then have "ReadLint x  SUMM s'" by simp
    ultimately have "Svalue el + ReadLint x  ReadLint (Bal (acc ad))" by simp
    then have "Svalue el + ReadLint x  ReadLint (Bal (acc ad))" by simp
    with a_bal have "Svalue el + ReadLint x < 2^256" by simp
    then have "Svalue el  Bal (acc ad) - SUMM s'" and lck: "fmlookup s' (Sender el + (STR ''.'' + STR ''balance'')) = Some x"  and "ReadLint x + Svalue el < 2 ^ 256" using a_frame x_def `Svalue el = v` unfolding iv_def by auto
    moreover from lck have "(accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s') = x" unfolding accessStorage_def by simp
    moreover have "Svalue el + ReadLint x  0"
    proof -
      have "ReadLint v  0" using transfer_val1[OF assms(3)] by simp
      with `Svalue el = v` have "(Svalue el::int)  0" by simp
      moreover from a_frame have "ReadLint x  0" unfolding iv_def using x_def by simp
      ultimately show ?thesis by simp
    qed
    ultimately show ?thesis using Read_ShowL_id by simp
  qed
  ultimately have "va = ShowLint (ReadLint (accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s') + ReadLint (Svalue el))" using createUInt_id[where ?v="ReadLint (accessStorage (TUInt b256) (Sender el + (STR ''.'' + STR ''balance'')) s') + ReadLint (Svalue el)"] va_def by simp
  then have v'_def: "v' = ShowLint (ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v)" using `Sender el = Address env` `Svalue el = v` `t'=TUInt b256` `ta = (TUInt b256)` using assms(7) by auto

  have "SUMM s''  Bal (acc ad)"
  proof -
    have "SUMM s'  ReadLint (Bal (acc ad)) - ReadLint v" using a_frame unfolding iv_def by simp
    moreover have "SUMM s'' = SUMM s' + ReadLint v"
    proof -
      from summ_eq_sum have s1: "SUMM s' = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s')" by simp
      have s2: "SUMM s'' = ((ad,x)|fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v"
      proof -
        have "inj_on (λ(ad, x). (ad + (STR ''.'' + STR ''balance''), x)) {(ad, x). (fmlookup s''  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using balance_inj by simp
        then have "finite {(ad, x). (fmlookup s''  (λad. ad + (STR ''.'' + STR ''balance''))) ad = Some x}" using fmlookup_finite[of "λad. (ad + (STR ''.'' + STR ''balance''))" s''] by simp
        then have sum1: "finite ({(ad,x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env})" using finite_subset[of "{(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env}" "{(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x}"] by auto
        moreover have sum2: "(Address env, ShowLint (ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v))  {(ad,x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env}" by simp
        moreover from v'_def s''_s' have "insert (Address env, ShowLint (ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v)) {(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env} = {(ad, x). fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x}" by auto
        then show ?thesis using sum.insert[OF sum1 sum2, of "λ(ad,x). ReadLint x"] Read_ShowL_id by simp
      qed
      from sum_eq_update[OF s''_s'] have s3: "((ad,x)|fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x)
                    =((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x)" by simp
      moreover from s''_s' v'_def have "ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s'') = ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v" using Read_ShowL_id unfolding accessStorage_def by simp
      ultimately have "SUMM s''= SUMM s' + ReadLint v"
      proof -
        from s2 have "SUMM s'' = ((ad,x)|fmlookup s'' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v" by simp
        also from s3 have " = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Address env. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v" by simp
        also from s1 have " = SUMM s' - ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') + ReadLint v" by simp
        finally show ?thesis by simp
      qed
      then show ?thesis by simp
    qed
    ultimately show ?thesis by simp
  qed
  moreover have "POS s''"
  proof (rule allI[OF allI])
    fix x xa
    show "fmlookup s'' (x + (STR ''.'' + STR ''balance'')) = Some xa  0  (xa::int)"
    proof
      assume a_lookup: "fmlookup s'' (x + (STR ''.'' + STR ''balance'')) = Some xa"
      show "0  (xa::int)"
      proof (cases "x = Address env")
        case True
        then show ?thesis using s''_s' a_lookup using Read_ShowL_id v'_def a_bounds `Sender el = Address env` `Svalue el = v` by auto
      next
        case False
        then have "fmlookup s' (x + (STR ''.'' + STR ''balance'')) = Some xa" using s''_s' a_lookup String_Cancel[of "Address env" "(STR ''.'' + STR ''balance'')" x] by (simp split:if_split_asm)
        then show ?thesis using a_frame unfolding iv_def by simp
      qed
    qed
  qed
  ultimately show "iv (Storage st0 (Address el)(l $$:= v')) Bal (acc (Address el))" unfolding iv_def s''_def using `ad = Address el` by simp
next
  assume "ad  Address el"
  moreover have "ad = Address el" using ffold_init_ad_same msel_ssel_expr_load_rexp_gas(4)[OF assms(2)] unfolding emptyEnv_def by simp
  ultimately show "iv (Storage st0 ad) Bal (acc ad)" by simp
qed

lemma adapt_withdraw:
  fixes st acc sck' mem' g''a e' l v' xe
  defines "st'  stAccounts := acc, Stack := sck', Memory := mem', Gas := g''a, Storage := (Storage st) (Address e' := (Storage st (Address e')) (l $$:= v'))"
  assumes "iv (Storage st ad) (ReadLint (Bal (acc ad)) - ReadLint v)"
      and "load True [] xe (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members)) emptyTypedStore
           emptyStore emptyTypedStore env cd (stGas := g') g' = Normal ((el, cdl, kl, ml), g'')"
      and "decl STR ''bal'' (Value (TUInt b256)) (Some (va, ta)) False cdl ml (Storage st (Address el)) (cdl, ml, kl, el) =
           Some (cd', mem', sck', e')"
      and "expr (UINT b256 0) e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := ga) ga =
           Normal ((KValue vb, Value tb), g'b)"
      and "Valuetypes.convert tb t' vb = Some v'"
      and "lexp myrexp e' cd' (stAccounts := acc, Stack := sck', Memory := mem', Gas := g'b) g'b =
           Normal ((LStoreloc l, type.Storage (STValue t')), g''a)"
      and "expr mylval el cdl (stAccounts := acc, Stack := kl, Memory := ml,
           Gas := g'' - costs keep el cdl (stGas := g'', Accounts := acc, Stack := kl, Memory := ml))
           (g'' - costs keep el cdl (stGas := g'', Accounts := acc, Stack := kl, Memory := ml)) = Normal ((va, ta), g'a)"
      and "Accounts.transfer (Address env) ad v (Accounts st) = Some acc"
      and Bal: "expr (LVAL (l.Id STR ''bal'')) e' cd' (st'Gas := g''b) g''b = Normal ((KValue lv, Value t), g''')"
      and con: "Valuetypes.convert t (TUInt b256) lv = Some lv'"
    shows "iv (Storage st' ad) (ReadLint (Bal (Accounts st' ad)) - (ReadLint lv'))"
proof -
  define acca where "acca = Accounts st' ad"
  define s' where "s' = Storage st (Address e')"
  define s'a where "s'a = Storage st' ad"
  moreover have "Address e' = ad"
  proof -
    have "Address e' = Address el" using decl_env[OF assms(4)] by simp
    also have "Address el = Address (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using msel_ssel_expr_load_rexp_gas(4)[OF assms(3)] by simp
    also have " = ad" unfolding emptyEnv_def using ffold_init_ad_same by simp
    finally show ?thesis .
  qed
  ultimately have s'a_def: "s'a = fmupd l v' s'" unfolding s'_def st'_def by simp

  have "Sender e' = Address env"
  proof -
    have "Sender e' = Sender el" using decl_env[OF assms(4)] by simp
    also have "Sender el = Sender (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" using msel_ssel_expr_load_rexp_gas(4)[OF assms(3)] by simp
    also have " = Address env" unfolding emptyEnv_def using ffold_init_ad_same by simp
    finally show ?thesis .
  qed

  have elDef:"el = (ffold (init members) (emptyEnv ad cname (Address env) v) (fmdom members))" 
    using load_empty_par[OF assms(3)] by (simp add:load.simps)

  have balIsNone:"Denvalue el $$ STR ''bal'' = None" 
  proof(rule ccontr)
    assume in1:"Denvalue el $$ STR ''bal''  None"
    then obtain v' where in2:"Denvalue el $$ STR ''bal'' = Some v'" by blast
    then show False using elDef unfolding emptyEnv_def
    using ffold_init_emptyDen[of members ad cname "Address env" v "fmdom members" "STR ''bal''"] 
    unfolding emptyEnv_def using balAcc by fastforce
  qed
    

  have "iv s'a (Bal acca - lv')" unfolding iv_def
  proof intros
    have "SUMM s'  Bal acca"
    proof -
      from `Address e' = ad` have "iv s' (ReadLint (Bal acca) - ReadLint v)" using assms(2,5) unfolding s'_def st'_def acca_def by simp
      then have "SUMM s'  Bal (acca) - v" unfolding iv_def by simp
      moreover have "ReadLint v  0" using transfer_val1[OF assms(9)] by simp
      ultimately show ?thesis by simp
    qed
    moreover have "SUMM s'a = SUMM s' - ReadLint lv'"
    proof -
      from summ_eq_sum have "SUMM s'a = ((ad,x)|fmlookup s'a (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Sender e'. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s'a)" by simp
      moreover from summ_eq_sum have "SUMM s' = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Sender e'. ReadLint x) + ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s')" by simp
      moreover from s'a_def lexp_myrexp_decl(1)[OF assms(3,4) assms(7)] have " s'a = s'((Sender e' + (STR ''.'' + STR ''balance''))$$:= v')" using `Sender e' = Address env` by simp
      with sum_eq_update have "((ad,x)|fmlookup s'a (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Sender e'. ReadLint x) = ((ad,x)|fmlookup s' (ad + (STR ''.'' + STR ''balance'')) = Some x  ad  Sender e'. ReadLint x)"  by simp
      moreover have "ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s'a) = ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s') - ReadLint lv'"
      proof -
        have "ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s') = ReadLint lv'"
        proof -
          from expr_balance[OF assms(3) assms(8)] have "va= KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s')" and "ta = Value (TUInt b256)" using `Address e' = ad` unfolding s'_def by simp+
          then have "(sck',e') =  astack_dup STR ''bal'' (Value (TUInt b256)) (KValue (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s')) (kl, el)" 
            using decl.simps(2) assms(4) by simp
          moreover have "Denvalue el $$ STR ''bal'' = None" 
            using balIsNone by blast
          ultimately have "ReadLint (accessStorage (TUInt b256) (Address env + (STR ''.'' + STR ''balance'')) s') = ReadLint lv" and "t = TUInt b256"
            using Bal unfolding s'_def st'_def using expr_bal(1,2)[of e' cd' _ st l v' "state.Storage st (Address e')" g''a mem' sck' acc lv t g''' env kl el] 
            by  blast+
          moreover from `t = TUInt b256` have "lv = lv'" using con by simp
          ultimately show ?thesis using `Sender e' = Address env` by simp
        qed
        moreover have "ReadLint (accessStorage (TUInt b256) (Sender e' + (STR ''.'' + STR ''balance'')) s'a) = ReadLint (ShowLint 0)"
        proof -
          have "v' = ShowLint 0"
          proof -
            have "vb = createUInt b256 0" and "tb=TUInt b256" using assms(5) by (simp add: expr.simps load.simps split:if_split_asm)+
            moreover have "t'=TUInt b256" using lexp_myrexp_decl(2)[OF assms(3,4) assms(7)] by simp
            ultimately show ?thesis using assms(6) by (simp add: createUInt_id)
          qed
          moreover have "l= (Sender e' + (STR ''.'' + STR ''balance''))" using lexp_myrexp_decl(1)[OF assms(3,4) assms(7)] `Sender e' = Address env` by simp
          ultimately show ?thesis using s'a_def accessStorage_def by simp
        qed
        ultimately show ?thesis using Read_ShowL_id by simp
      qed
      ultimately show ?thesis by simp
    qed
    ultimately show "SUMM s'a  Bal acca - lv'" by simp
  next
    fix ad' x
    assume *: "fmlookup s'a (ad' + (STR ''.'' + STR ''balance'')) = Some x"
    show "0  ReadLint x"
    proof (cases "ad' = Sender e'")
      case True
      moreover have "v' = ShowLint 0"
      proof -
        have "vb = createUInt b256 0" and "tb=TUInt b256" using assms(5) by (simp add:expr.simps split:if_split_asm)+
        moreover have "t'=TUInt b256" using lexp_myrexp_decl(2)[OF assms(3,4) assms(7)] by simp
        ultimately show ?thesis using assms(6) by (simp add: createUInt_id)
      qed
      moreover have "l= (Sender e' + (STR ''.'' + STR ''balance''))" using lexp_myrexp_decl(1)[OF assms(3,4) assms(7)] `Sender e' = Address env` by simp
      ultimately show ?thesis using Read_ShowL_id s'a_def * by auto
    next
      case False
      moreover from `Address e' = ad` have "iv s' (ReadLint (Bal (acc ad)) - ReadLint v)" using assms(2) unfolding s'_def by simp
      then have "POS s'" unfolding iv_def by simp
      moreover have "l= (Sender e' + (STR ''.'' + STR ''balance''))" using lexp_myrexp_decl(1)[OF assms(3,4) assms(7)] `Sender e' = Address env` by simp
      ultimately show ?thesis using s'a_def * String_Cancel by (auto split:if_split_asm)
    qed
  qed
  then show ?thesis unfolding s'a_def s'_def acca_def st'_def `Address e' = ad` by simp
qed

lemma expr_ex:
  assumes "local.expr x ev cd st g = Exception e"
  shows "e = ex.Gas  e = Err"
  using ex.nchotomy by simp

lemma lexp_ex:
  assumes "local.lexp x ev cd st g = Exception e"
  shows "e = ex.Gas  e = Err"
  using ex.nchotomy by simp

lemma wp_deposit[external]:
  assumes "Address ev  ad"
      and "load True [] xe (ffold (init members) (emptyEnv ad cname (Address ev) v) (fmdom members)) emptyTypedStore emptyStore emptyTypedStore ev cd (stGas := g') g' = Normal ((el, cdl, kl, ml), g'')"
      and "Accounts.transfer (Address ev) ad v (Accounts st) = Some acc"
      and "iv (Storage st ad) (ReadLint (Bal (acc ad)) - ReadLint v)"
    shows "wpS deposit
           (λst. (iv (Storage st ad) (ReadLint (Bal (Accounts st ad))))) (λe. e = Gas  e = Err) el cdl
           (stGas := g'', Accounts := acc, Stack := kl, Memory := ml)"
  apply (vcg_assign wp_rule: wp_Assign2 expr_rule: expr_plus[OF assms(2)] lexp_rule: lexp_myrexp2[OF assms(2)])
  by (simp_all add: adapt_deposit[OF assms] expr_ex lexp_ex)

lemma wptransfer:
  fixes st0 acc sck' mem' g''a e' l v'
  defines "st'  st0Accounts := acc, Stack := sck', Memory := mem', Gas := g''a,
        Storage := (Storage st0)(Address e' := Storage st0 (Address e')(l $$:= v'))"
  assumes "Pfe ad iv st'"
      and "Address ev  ad"
      and "load True [] xe (ffold (init members) (emptyEnv ad cname (Address ev) gv') (fmdom members)) emptyTypedStore
           emptyStore emptyTypedStore ev cd (st0Gas := g') g' =
          Normal ((el, cdl, kl, ml), g'')"
      and "Accounts.transfer (Address ev) ad gv' (Accounts st0) = Some acc"
      and "iv (Storage st0 ad) (ReadLint (Bal (acc ad)) - ReadLint gv')"
      and "decl STR ''bal'' (Value (TUInt b256)) (Some (v, t)) False cdl ml (Storage st0 (Address el))
           (cdl, ml, kl, el) =  Some (cd', mem', sck', e')"
      and "Valuetypes.convert ta t' va = Some v'"
      and "lexp myrexp e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := g'a) g'a =
           Normal ((LStoreloc l, type.Storage (STValue t')), g''a)"
      and "expr mylval el cdl (st0Accounts := acc, Stack := kl, Memory := ml,
           Gas := g'' - costs (BLOCK (STR ''bal'', Value (TUInt b256), Some mylval)
           (COMP (ASSIGN myrexp (UINT b256 0)) Reentrancy.transfer)) el cdl (st0Gas := g'', Accounts := acc, Stack := kl, Memory := ml))
           (g'' - costs (BLOCK (STR ''bal'', Value (TUInt b256), Some mylval) (COMP (ASSIGN myrexp (UINT b256 0)) Reentrancy.transfer)) el
           cdl (st0Gas := g'', Accounts := acc, Stack := kl, Memory := ml)) =
           Normal ((v, t), g''')"
      and "expr (UINT b256 0) e' cd' (st0Accounts := acc, Stack := sck', Memory := mem', Gas := ga) ga = Normal ((KValue va, Value ta), g'a)"
    shows "wpS Reentrancy.transfer (λst. iv (Storage st ad) (ReadLint (Bal (Accounts st ad)))) (λe. e = Gas  e = Err) e' cd' st'"
proof (rule meta_eq_to_obj_eq[THEN iffD1, OF Pfe_def assms(2),rule_format], (rule conjI; (rule conjI)?))
  show "Address e' = ad"
  proof -
    have "Address e' = Address el" using decl_env[OF assms(7)] by simp
    also have "Address el = Address (ffold (init members) (emptyEnv ad cname (Address ev) gv') (fmdom members))" using msel_ssel_expr_load_rexp_gas(4)[OF assms(4)] by simp
    also have " = ad" unfolding emptyEnv_def using ffold_init_ad_same by simp
    finally show ?thesis .
  qed
next
  show "adv g. expr SENDER e' cd' (st'Gas := state.Gas st' - costs Reentrancy.transfer e' cd' st') (state.Gas st' - costs Reentrancy.transfer e' cd' st') = Normal ((KValue adv, Value TAddr), g)
     adv  ad"
  proof (intros)
    fix adv g
    assume "expr SENDER e' cd' (st'Gas := state.Gas st' - costs Reentrancy.transfer e' cd' st') (state.Gas st' - costs Reentrancy.transfer e' cd' st') = Normal ((KValue adv, Value TAddr), g)"
    moreover have "Sender e'  ad"
    proof -
      have "Sender e' = Sender el" using decl_env[OF assms(7)] by simp
      also have "Sender el = Sender (ffold (init members) (emptyEnv ad cname (Address ev) gv') (fmdom members))" using msel_ssel_expr_load_rexp_gas(4)[OF assms(4)] by simp
      also have " = Address ev" unfolding emptyEnv_def using ffold_init_ad_same by simp
      finally show ?thesis using assms(3) by simp
    qed
    ultimately show "adv  ad" by (simp add:expr.simps split:result.split_asm if_split_asm prod.split_asm)
  qed
next
  show "adv g v t g' v'.
       local.expr SENDER e' cd' (st'Gas := state.Gas st' - costs Reentrancy.transfer e' cd' st')
        (state.Gas st' - costs Reentrancy.transfer e' cd' st') = Normal ((KValue adv, Value TAddr), g) 
       adv  ad 
       local.expr (LVAL (l.Id STR ''bal'')) e' cd' (st'Gas := g) g = Normal ((KValue v, Value t), g') 
       Valuetypes.convert t (TUInt b256) v = Some v' 
       iv (Storage st' ad) (Bal (Accounts st' ad) - ReadLint v')"
  proof elims
     fix adv lg lv lt lg' lv'
  assume a1:"expr SENDER e' cd' (st'Gas := state.Gas st' - costs Reentrancy.transfer e' cd' st') (state.Gas st' - costs Reentrancy.transfer e' cd' st') =
          Normal ((KValue adv, Value TAddr), lg)"
     and adv_def: "adv  ad"
     and Bal: "expr (LVAL (l.Id STR ''bal'')) e' cd' (st'Gas := lg) lg = Normal ((KValue lv, Value lt), lg')"
     and con: "Valuetypes.convert lt (TUInt b256) lv = Some lv'"
    show "iv (Storage st' ad) (Bal (Accounts st' ad) - ReadLint lv')"
     using adapt_withdraw[where ?acc=acc, OF assms(6) load_empty_par[OF assms(4)] assms(7,11,8,9,10,5)] a1 Bal con unfolding st'_def by simp
  qed
qed

lemma wp_withdraw[external]:
  assumes "st'. state.Gas st'  state.Gas st  Type (Accounts st' ad) = Some (atype.Contract cname)  Pe ad iv st'  Pi ad (λ_ _. True) (λ_ _. True) st'  Pfi ad (λ_. True) (λ_. True) st'  Pfe ad iv st'"
      and "Address ev  ad"
      and "g''  state.Gas st"
      and "Type (acc ad) = Some (atype.Contract cname)"
      and "load True [] xe (ffold (init members) (emptyEnv ad cname (Address ev) v') (fmdom members))
           emptyTypedStore emptyStore emptyTypedStore ev cd (st0Gas := g') g' = Normal ((el, cdl, kl, ml), g'')"
      and "Accounts.transfer (Address ev) ad v' (Accounts st0) = Some acc"
      and "iv (Storage st0 ad) (ReadLint (Bal (acc ad)) - ReadLint v')"
    shows "wpS keep (λst. iv (Storage st ad) (ReadLint (Bal (Accounts st ad)))) (λe. e = Gas  e = Err) el cdl
           (st0Gas := g'', Accounts := acc, Stack := kl, Memory := ml)"
  apply vcg_block_some
  apply vcg_comp
  apply (vcg_assign wp_rule: wp_Assign2 expr_rule: expr_0 lexp_rule: lexp_myrexp_decl2[OF assms(5)])
  apply (rule wptransfer[OF _ assms(2) assms(5-7)])
  apply (drule msel_ssel_expr_load_rexp_gas lexp_gas)+
  using assms(3,4) by (simp_all add: assms(1)[THEN conjunct2,THEN conjunct2,THEN conjunct2] expr_ex lexp_ex)

lemma wp_fallback:
  assumes "Accounts.transfer (Address ev) ad v (Accounts st) = Some acc"
      and "iv (Storage st ad) (ReadLint (Bal (acc ad)) - ReadLint v)"
    shows "wpS SKIP (λst. iv (Storage st ad) (ReadLint (Bal (Accounts st ad)))) (λe. e = Gas  e = Err)
          (ffold (init members) (emptyEnv ad cname (Address ev) v) (fmdom members)) emptyTypedStore
          (stGas := g, Accounts := acc, Stack := emptyStore, Memory := emptyTypedStore)"
  apply vcg_skip
  using weaken[where ?acc=acc, OF assms(2) transfer_val1[OF assms(1)]] by simp

lemma wp_construct:
  fixes ev st
  defines "adv  hash_version (Address ev) Contracts (Accounts st (Address ev))"
  assumes "Accounts.transfer (Address ev) adv v ((Accounts st) (adv := Bal = ShowLint 0, Type = Some (atype.Contract i), Contracts = 0)) = Some acc"
    shows "iv fmempty Bal (acc adv)"
proof -
  have "ReadLint (Bal (((Accounts st) (adv := Bal = ShowLint 0, Type = Some (atype.Contract i), Contracts = 0)) adv)) = 0" using Read_ShowL_id[of 0] by simp
  then have "ReadLint (Bal (acc (hash_version (Address ev) Contracts (Accounts st (Address ev)))))  0" using transfer_mono[OF assms(2)] assms(1) by simp
  then show ?thesis unfolding iv_def assms(1) by simp
qed

lemma wp_true:
  assumes "E Gas"
      and "E Err"
  shows "wpS f (λst. True) E e cd st"
  unfolding wpS_def wp_def using assms ex.nchotomy by (simp split: result.split, metis (full_types))

subsubsection‹Final results›

interpretation vcg:VCG costse ep costs cname members const fb iv "λ_. True" "λ_. True" "λ_ _. True" "λ_ _. True"
by (simp add: VCG.intro Calculus_axioms)

lemma safe_external: "Qe ad iv (st::state)"
  apply (external cases: cases_ext)
  apply (rule wp_deposit;assumption)
  apply vcg_block_some
  apply vcg_comp
  apply (vcg_assign wp_rule: wp_Assign2 expr_rule: expr_0 lexp_rule: lexp_myrexp_decl2)
  apply (vcg.vcg_transfer_ext ad fallback_int: wp_true fallback_ext: wp_fallback cases_ext:cases_ext cases_int:cases_int cases_fb:cases_fb invariant:adapt_withdraw)
  by (simp_all add: expr_ex lexp_ex)

lemma safe_fallback: "Qfe ad iv st"
  apply (fallback cases: cases_fb)
  by (rule wp_fallback, assumption)

lemma safe_constructor: "constructor iv"
  apply (constructor cases: cases_cons)
  apply vcg_skip
  by (simp add:wp_construct)

theorem safe:
  assumes "ad. Type (Accounts st ad) = Some (atype.Contract cname)  iv (Storage st ad) (ReadLint (Bal (Accounts st ad)))"
    shows "(st'::state) ad. stmt f ev cd st = Normal ((), st')  Type (Accounts st' ad) = Some (atype.Contract cname)  Address ev  ad
             iv (Storage st' ad) (ReadLint (Bal (Accounts st' ad)))"
  apply (rule invariant) using assms safe_external safe_fallback safe_constructor by auto

end

end