Theory Voting

theory Voting
  imports Solidity_Main
begin

section ‹Voting Contract›

text ‹
  In the following we verify the Voting contract from the official Solidity documentation:
  🌐‹https://docs.soliditylang.org/en/v0.8.25/solidity-by-example.html#voting›.
›

lemma kdequals_true[wpdrules]:
  assumes "kdequals (rvalue.Value (Uint w)) (rvalue.Value (Uint x)) = Some (rvalue.Value (Bool True))"
  shows "w = x"
  using assms unfolding kdequals_def by simp

subsection ‹Specification›

abbreviation TT::"((String.literal  'a storage_data) × nat)  bool" where "TT a  True"

context Solidity
begin

abbreviation Voter where "Voter  storage_data.Array [storage_data.Value (Uint 0),storage_data.Value (Bool False),storage_data.Value (Address null),storage_data.Value (Uint 0::'a valtype)]"
abbreviation "weight  return (rvalue.Value ((Uint 0)::'a valtype))"
abbreviation "voted  1::nat"
abbreviation "sdelegate  2::nat"
abbreviation "svote  3::nat"

abbreviation "Proposal name voteCount  storage_data.Array [name::'a valtype storage_data, voteCount]"
abbreviation "name  0::nat"
abbreviation "voteCount  1::nat"

end

text ‹
  The contract can now be specified using the "contract" command.
  This command requires the following:
   A sequence of member variables
   A constructor
   A sequence of methods
›

context Solidity
begin

abbreviation "SUMM (x::('a valtype  'a valtype storage_data))  ad|v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). (THE y. v. x (Address ad) = storage_data.Array v  y=unat (valtype.uint (storage_data.vt (v ! 0))))"
abbreviation "SUMM2 (x::'a valtype storage_data list)  i<length x. (THE y. p. x ! i = storage_data.Array p  y=unat (valtype.uint (storage_data.vt (p ! 1))))"

definition inv':: "(id  'a valtype storage_data)  bool"
  where "inv' s  (x y. s (STR ''voters'') = storage_data.Map x
                        s (STR ''proposals'') = storage_data.Array y
                             (SUMM2 y  SUMM x))"

end

contract Ballot
  for "STR ''chairperson''": "SType.TValue TAddress"
  and "STR ''voters''": "SType.TMap (SType.TValue TAddress) (SType.TEnum [SType.TValue TSint, SType.TValue TBool, SType.TValue TAddress, SType.TValue TSint])"
  and "STR ''proposals''": "SType.DArray (SType.TEnum [SType.TValue (TBytes 32), SType.TValue TSint])"

constructor payable
  memory "STR ''proposalNames''": "SType.DArray (SType.TValue (TBytes 32))"
where
  "do {
    assign_storage_monad (STR ''chairperson'') [] sender_monad;
    assign_storage_monad (STR ''voters'') [stackLookup (STR ''chairperson'') [], weight] (sint_monad 1);
    init (Uint 0) (STR ''i'');
    while_monad (less_monad (stackLookup (STR ''i'') []) (arrayLength (STR ''proposalNames'') []))
      (do {
        allocate (STR ''proposals'') [] (Proposal (storage_data.Value (Bytes (array 32 (CHR 0x00)))) (storage_data.Value (Uint 0)));
        assign_storage_monad (STR ''proposals'') [storeArrayLength (STR ''proposals'') [], sint_monad 0] (stackLookup (STR ''proposalNames'') [stackLookup (STR ''i'') []]);
        assign_storage_monad (STR ''proposals'') [storeArrayLength (STR ''proposals'') [], sint_monad 1] (sint_monad 0);
        assign_stack_monad (STR ''i'') [] (plus_monad (stackLookup (STR ''i'') []) (sint_monad 1))
      })
   }"

cfunction giveRightToVote external payable
  param "STR ''voter''": "SType.TValue TAddress"
where
  "do {
    require_monad (equals_monad sender_monad (storeLookup (STR ''chairperson'') []));
    require_monad (not_monad (storeLookup (STR ''voters'') [stackLookup (STR ''voter'') [], sint_monad 1]));
    require_monad (equals_monad (storeLookup (STR ''voters'') [stackLookup (STR ''voter'') [], sint_monad 0]) (sint_monad 0));
    assign_storage_monad (STR ''voters'') [stackLookup (STR ''voter'') [], sint_monad 0] (sint_monad 1)
  }",

cfunction delegate external payable
  param "STR ''to''": "SType.TValue TAddress"
where
  "do {
    sdecl (SType.TEnum [SType.TValue TSint, SType.TValue TBool, SType.TValue TAddress, SType.TValue TSint]) (STR ''sender'');
    assign_stack_monad (STR ''sender'') [] (storeLookup (STR ''voters'') [sender_monad]);
    require_monad (not_monad (equals_monad (stackLookup (STR ''sender'') [sint_monad 0]) (sint_monad 0)));
    require_monad (not_monad (stackLookup (STR ''sender'') [sint_monad 1]));
    require_monad (not_monad (equals_monad (stackLookup (STR ''to'') []) sender_monad));
    while_monad (equals_monad (storeLookup (STR ''voters'') [stackLookup (STR ''to'') [], sint_monad 2]) (address_monad null))
      (do {
        assign_stack_monad (STR ''to'') [] (storeLookup (STR ''voters'') [stackLookup (STR ''to'') [], sint_monad 2]);
        require_monad (not_monad (equals_monad (stackLookup (STR ''to'') []) sender_monad))
      });
    sdecl (SType.TEnum [SType.TValue TSint, SType.TValue TBool, SType.TValue TAddress, SType.TValue TSint]) (STR ''delegate_'');
    assign_stack_monad (STR ''delegate_'') [] (storeLookup (STR ''voters'') [stackLookup (STR ''to'') []]);
    require_monad (not_monad (less_monad (stackLookup (STR ''delegate_'') [sint_monad 0]) (sint_monad 1)));
    assign_stack_monad (STR ''sender'') [sint_monad 1] (true_monad);
    assign_stack_monad (STR ''delegate_'') [sint_monad 2] (stackLookup (STR ''to'') []);
    require_monad (not_monad (stackLookup (STR ''delegate_'') [sint_monad 1]));
    cond_monad (stackLookup (STR ''delegate_'') [sint_monad 1])
      (assign_storage_monad (STR ''proposals'') [stackLookup (STR ''delegate_'') [sint_monad 3], sint_monad 1] (plus_monad_safe (storeLookup (STR ''proposals'') [stackLookup (STR ''delegate_'') [sint_monad 3], sint_monad 1]) (stackLookup (STR ''sender'') [sint_monad 0])))
      (assign_stack_monad (STR ''delegate_'') [sint_monad 0] (plus_monad_safe (stackLookup (STR ''delegate_'') [sint_monad 0]) (stackLookup (STR ''sender'') [sint_monad 0])))
  }",

cfunction vote external payable
  param "STR ''proposal''": "SType.TValue TSint"
where
  "do {
    sdecl (SType.TEnum [SType.TValue TSint, SType.TValue TBool, SType.TValue TAddress, SType.TValue TSint]) (STR ''sender'');
    assign_stack_monad (STR ''sender'') [] (storeLookup (STR ''voters'') [sender_monad]);
    require_monad (not_monad (equals_monad (stackLookup (STR ''sender'') [sint_monad 0]) (sint_monad 0)));
    require_monad (not_monad (stackLookup (STR ''sender'') [sint_monad 1]));
    assign_stack_monad (STR ''sender'') [sint_monad 1] (true_monad);
    assign_stack_monad (STR ''sender'') [sint_monad 4] (stackLookup (STR ''proposal'') []);
    assign_storage_monad (STR ''proposals'') [stackLookup (STR ''proposal'') [], sint_monad 1] (plus_monad_safe (storeLookup (STR ''proposals'') [stackLookup (STR ''proposal'') [], sint_monad 1]) (stackLookup (STR ''sender'') [sint_monad 0]))
  }",

cfunction winningProposal external payable
  param "STR ''winningProposalu''": "SType.TValue TSint"
where
  "do {
    init (Uint 0) (STR ''winningVoteCount'');
    init (Uint 0) (STR ''p'');
    while_monad (less_monad (stackLookup (STR ''p'') []) (storeArrayLength (STR ''proposals'') []))
      (do {
        cond_monad (less_monad (stackLookup (STR ''winningVoteCount'') []) (storeLookup (STR ''proposals'') [stackLookup (STR ''p'') [], sint_monad 1]))
          (do {
            assign_stack_monad (STR ''winningVoteCount'') [] (storeLookup (STR ''proposals'') [stackLookup (STR ''p'') [], sint_monad 1]);
            assign_stack_monad (STR ''winningProposalu'') [] (stackLookup (STR ''p'') [])
          })
          (skip_monad)
      })
  }"

invariant sum_votes s
  where "inv' (fst s)"
  for "Ballot"

context ballot
begin

lemma obtain_props:
  assumes "ya < length a. ema. a ! ya = storage_data.Array ema  (bt sib. ema = [storage_data.Value (Bytes bt), storage_data.Value (Uint sib)])"
      and "unat ya < length a"
  obtains bt sib where "a ! unat ya = storage_data.Array [storage_data.Value (Bytes bt), storage_data.Value (Uint sib)]"
  using assms by fastforce

lemma obtain_voters:
  assumes "x. em. voters x = storage_data.Array em  (w t d v. em =
    [storage_data.Value (Uint w), storage_data.Value (Bool t), storage_data.Value (Address d), storage_data.Value (Uint v)])"
  obtains w t d v where "voters x =
    storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool t), storage_data.Value (Address d), storage_data.Value (Uint v)]"
  using assms by blast

lemma kdequals_true[wpdrules]:
  assumes "kdequals (rvalue.Value (Address x)) (rvalue.Value (Address y)) = Some (rvalue.Value (Bool True))"
  shows "x = y"
  using assms unfolding kdequals_def by simp

lemma kdequals_false:
  assumes "kdequals (rvalue.Value (Address x)) (rvalue.Value (Address y)) = Some (rvalue.Value (Bool False))"
  shows "x  y"
  using assms unfolding kdequals_def by simp

lemma kdnot[wpdrules]:
  assumes "kdnot (rvalue.Value (Bool t)) = Some (rvalue.Value (Bool True))"
  shows "¬ t"
  using assms unfolding kdnot_def vtnot_def by simp

lemma inv_0:
  assumes "state.Storage s this STR ''voters'' = Map voters"
     and  "state.Storage s this STR ''proposals'' = storage_data.Array proposals"
     and "inv' (state.Storage s this)"
     and "voters (Address x) = storage_data.Array [storage_data.Value (Uint 0), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)]"
   shows "inv' (state.Storage
            (storage_update STR ''voters'' (Map (voters (Address x := storage_data.Array [storage_data.Value (Uint 1), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)])))
            (stack_update STR ''voter'' (kdata.Value (Address x))
            (balance_update (Balances s this + unat msg_value)
            sStack := {$$}, Memory := [], Calldata := {$$}))) this)"
  unfolding inv'_def
proof ((rule allI | rule impI)+, erule conjE)
  fix xa y
  define sum1 where "sum1 = (λ(y::'a valtype storage_data list) i . THE ya. p. y ! i = storage_data.Array p  ya = unat (valtype.uint (storage_data.vt (p ! 1))))"
  define sum2 where "sum2 = (λ(xa::'a valtype  'a valtype storage_data) ad. THE y. v. xa (Address ad) = storage_data.Array v  y = unat (valtype.uint (storage_data.vt (v ! 0))))"
  assume *:"state.Storage (storage_update STR ''voters'' (Map (voters(Address x := storage_data.Array [storage_data.Value (Uint 1), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)])))
             (stack_update STR ''voter'' (kdata.Value (Address x))
             (balance_update (Balances s this + unat msg_value)
             sStack := {$$}, Memory := [], Calldata := {$$})))
            this STR ''voters'' = Map xa"
     and **: "state.Storage (storage_update STR ''voters'' (Map (voters(Address x := storage_data.Array [storage_data.Value (Uint 1), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)])))
               (stack_update STR ''voter'' (kdata.Value (Address x))
               (balance_update (Balances s this + unat msg_value)
               sStack := {$$}, Memory := [], Calldata := {$$})))
              this STR ''proposals'' = storage_data.Array y"
  show "(i < length y. sum1 y i)  (ad | v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 xa ad)"
  proof -
    from assms have "(i < length proposals. sum1 proposals i)  (ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad)" unfolding inv'_def sum1_def sum2_def by simp
    moreover have "(i < length proposals. sum1 proposals i) = (i < length y. sum1 y i)" using assms ** unfolding sum1_def by (simp add:wpsimps)
    moreover have "(ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad) = (ad | v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 xa ad)"
    proof -
      from assms have " v. voters (Address x) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))" by simp
      then have "(ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad) = 
                 (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x. sum2 voters ad)" using sum_addr3[of x "{ad.  v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))}" "sum2 voters"] by simp
      moreover have "¬ (v. xa (Address x) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))" using * by (auto simp add:wpsimps)
      then have "(ad | v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 xa ad) = 
                 (ad | (v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x. sum2 xa ad)" using sum_addr3[of x "{ad.  v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))}" "sum2 xa"] by simp
      moreover have "(ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x. sum2 voters ad)
                   = (ad | (v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x. sum2 xa ad)"
      proof (rule sum.mono_neutral_cong_right)
        show "finite {ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x}" using finite finite_subset subset_UNIV by blast
        show "{ad. (v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x}
         {ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x}" using * by (auto simp add:wpsimps)
        show " i{ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x} -
        {ad. (v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x}.
         sum2 voters i = 0" using * by (auto simp add:wpsimps)
        show " xb. xb  {ad. (v. xa (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  x}  sum2 voters xb = sum2 xa xb"  using * unfolding sum2_def by (auto simp add:wpsimps)
      qed
      ultimately show ?thesis by simp
    qed
    ultimately show ?thesis by simp
  qed
qed

lemma inv_1:
  assumes "state.Storage s this STR ''voters'' = Map voters"
      and "state.Storage s this STR ''proposals'' = storage_data.Array proposals"
      and "inv' (state.Storage s this)"
      and "voters (Address msg_sender) = storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)]"
      and "state.Storage sa this STR ''proposals'' = storage_data.Array proposals"
      and "xa  msg_sender"
      and "voters (Address xa) = storage_data.Array [storage_data.Value (Uint wb), storage_data.Value (Bool False), storage_data.Value (Address da), storage_data.Value (Uint va)]"
      shows "inv' (state.Storage
          (storage_update STR ''voters'' (Map (voters
                  (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
                   Address xa := storage_data.Array [storage_data.Value (Uint (wb + w)), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
          (storage_update STR ''voters'' (Map (voters
                  (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
                   Address xa := storage_data.Array [storage_data.Value (Uint wb), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
          (storage_update STR ''voters'' (Map (voters
                (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)])))
          (stack_update STR ''delegate_'' (kdata.Storage (Some Location=STR ''voters'', Offset= [Address xa])) (stack_update STR ''delegate_'' (kdata.Storage None)
          sa))))) this)"
  unfolding inv'_def
proof ((rule allI | rule impI)+, erule conjE)
  fix x y
  define sum1 where "sum1 = (λ(y::'a valtype storage_data list) i . THE ya. p. y ! i = storage_data.Array p  ya = unat (valtype.uint (storage_data.vt (p ! 1))))"
  define sum2 where "sum2 = (λ(xa::'a valtype  'a valtype storage_data) ad. THE y. v. xa (Address ad) = storage_data.Array v  y = unat (valtype.uint (storage_data.vt (v ! 0))))"
  assume *:"state.Storage
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
               Address xa := storage_data.Array [storage_data.Value (Uint (wb + w)), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
               Address xa := storage_data.Array [storage_data.Value (Uint wb), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)])))
            (stack_update STR ''delegate_'' (kdata.Storage (Some Location=STR ''voters'', Offset= [Address xa]))
            (stack_update STR ''delegate_'' (kdata.Storage None)
            sa))))) this STR ''voters'' = Map x"
    and **: " state.Storage
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
               Address xa := storage_data.Array [storage_data.Value (Uint (wb + w)), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
               Address xa := storage_data.Array [storage_data.Value (Uint wb), storage_data.Value (Bool False), storage_data.Value (Address xa), storage_data.Value (Uint va)])))
            (storage_update STR ''voters'' (Map (voters
              (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)])))
            (stack_update STR ''delegate_'' (kdata.Storage (Some Location=STR ''voters'', Offset= [Address xa]))
            (stack_update STR ''delegate_'' (kdata.Storage None)
            sa))))) this STR ''proposals'' = storage_data.Array y"
  show "(i < length y. sum1 y i)  (ad | v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 x ad)"
  proof -
    from assms have "(i < length proposals. sum1 proposals i)  (ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad)" unfolding inv'_def sum1_def sum2_def by simp
    moreover have "(i < length y. sum1 y i) = (i < length proposals. sum1 proposals i)"
      using * ** assms by (simp add:wpsimps)
    moreover have "(ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad)  (ad | v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 x ad)"
    proof -
      have "(ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender. sum2 x ad) = (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender. sum2 voters ad)"
      proof (rule sum.mono_neutral_cong_right)
        show "finite {ad. (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender}"  using finite finite_subset subset_UNIV by blast
        show "{ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender}
               {ad. (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender}" using * by (auto simp add:wpsimps)
        show "i{ad. (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender} -
              {ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender}.
              sum2 x i = 0"  using * by (auto simp add:wpsimps)
        show "x'. x'  {ad. (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender}  sum2 x x' = sum2 voters x'"  using * unfolding sum2_def by (auto simp add:wpsimps)
      qed
      moreover have "(ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender. sum2 x ad)
                     = (ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 x ad)" using * ** by (auto simp add:wpsimps)
      moreover have "(ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))  ad  xa)  ad  msg_sender. sum2 voters ad)
                     = (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 voters ad)" using assms(7) apply (simp add:wpsimps) unfolding sum2_def
        by (metis (no_types, lifting) nth_Cons_0 nth_Cons_Suc storage_data.inject(2) storage_data.sel(1) valtype.sel(1))
      ultimately have "(ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 x ad)
                    = (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 voters ad)" by simp
      moreover have "sum2 voters msg_sender = sum2 x msg_sender" using * assms unfolding sum2_def by (auto simp add:wpsimps)
      moreover have "(ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad)
                      = (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 voters ad)"
      proof -
        have "¬ (v. voters (Address msg_sender) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))" using assms by (auto simp add:wpsimps)
        then have "(ad | v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 voters ad) = 
                 (ad | (v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 voters ad)" using sum_addr3[of msg_sender "{ad.  v. voters (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))}" "sum2 voters"] by simp
        then show ?thesis by simp
      qed
      moreover have "(ad | v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 x ad)
                      = (ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 x ad) + sum2 x msg_sender"
      proof -
        have "(v. x (Address msg_sender) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))" using assms * by (auto simp add:wpsimps)
        then have "(ad | v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)). sum2 x ad) = 
                   (ad | (v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1)))  ad  msg_sender. sum2 x ad) + sum2 x msg_sender" using sum_addr2[of msg_sender "{ad.  v. x (Address ad) = storage_data.Array v  valtype.bool (storage_data.vt (v ! 1))}" "sum2 x"] by simp
        then show ?thesis by simp
      qed
      ultimately show ?thesis by simp
    qed
    ultimately show ?thesis by simp
  qed
qed

lemma wp_assign_storage[wprules]:
  assumes "y. updateStore is (K (storage_data.Value v)) (state.Storage s this i) = Some y  P Empty (storage_update i y s)"
      and "updateStore ([] @ is) (K (storage_data.Value v)) (state.Storage s this i) = None  E Err s"
    shows "wp (assign_storage i is (rvalue.Value v)) P E s"
  apply vcg using assms by auto

lemma slookup_some[wpdrules]:
  assumes "proposals $ x  slookup [Uint 1] = Some yp"
  shows "x < length proposals  slookup [Uint 1] (proposals ! x) = Some yp"
  using assms unfolding nth_safe_def by (auto split:if_split_asm simp add:wpsimps)
    
lemma kdplus_safe_storage_none[wpsimps]:
  shows "kdplus_safe x (rvalue.Storage p) = None"
  unfolding kdplus_safe_def by simp

lemma kdplus_safe_storage_some_false[wpdrules]:
  assumes "kdplus_safe x (rvalue.Storage p) = Some a"
  shows "False"
  using assms by (simp add:wpsimps)

lemma kdequals2[wpdrules]:
  assumes "kdequals x y = Some (rvalue.Value (Bool True))"
  shows "x = y"
  using assms
  apply (cases x;simp add: kdequals_def)
  apply (cases y;simp add: kdequals_def)
  by (case_tac x4;case_tac x4a;simp add: kdequals_def split: if_split_asm)

lemma kdequals3[wpdrules]:
  assumes "kdequals x y = Some (rvalue.Value (Bool False))"
  shows "¬ x = y"
  using assms
  apply (cases x;simp add: kdequals_def)
  apply (cases y;simp add: kdequals_def)
  by (case_tac x4;case_tac x4a;simp add: kdequals_def split: if_split_asm)

lemma wp_less_monad[wprules]:
  assumes "wp lm (λa. wp (rm  (λrv. option Err (K (kdless a rv))  return)) P E) E s"
  shows "wp (less_monad lm rm) P E s"
  unfolding less_monad_def apply (rule wp_lift_op_monad) using assms .

lemma kdnot_true[wpdrules]:
  assumes "kdnot y = Some (rvalue.Value (Bool True))"
  shows "y=rvalue.Value (Bool False)"
  using assms apply (cases y;simp add:assms kdnot_def)
  by (case_tac x4;simp add:assms vtnot_def)

lemma list_update_safe_simps1[wpsimps]:
  assumes "i < length xs"
  shows "list_update_safe xs i a = Some (list_update xs i a)"
  unfolding list_update_safe_def using assms by simp
end

lemma notwp[wperules]: "¬ wp m P E s  wp m P E s  R" using notE by simp
method solve methods m = (m ; fail)

context ballot
begin

declare sum_votesI[wprules del]

end

verification sum_votes:
  sum_votes
  giveRightToVote and
  delegate and
  vote and
  winningProposal
  for "Ballot"
proof -
  show
    "call.
      (x h r. effect (call x) h r  vcond x h r)
       da. ar = adata.Array da  (y<length da. bt. da ! y = adata.Value (Bytes bt))
       effect (constructor call ar) s r
       post s r (K (K (inv_state sum_votes))) (K True)"
    unfolding constructor_def
    apply (erule post_exc_true, erule_tac post_wp)
    unfolding  inv_state_def
    by (vcg wprules: sum_votesI | auto)+

  show
    "call voter.
      (x h r. effect (call x) h r  vcond x h r)
       effect (giveRightToVote call voter) s r
       inv_state sum_votes s
       post s r (K (K (inv_state sum_votes))) (K True)"
    unfolding giveRightToVote_def
    apply (erule post_exc_true, erule_tac post_wp)
    unfolding inv_state_def
    apply (vcg | solveauto simp add:wpsimps)+
                        apply (auto simp add:wpsimps intro!: wpthrow)
       apply (rule_tac voters=mp and x="Address voter" in obtain_voters, assumption)
       apply (wp | auto simp add:wpsimps)+
       apply (rule_tac mp="mp(Address voter := storage_data.Array [storage_data.Value (Uint 1), storage_data.Value (Bool False), storage_data.Value (Address d), storage_data.Value (Uint v)])" in sum_votesI)
          apply (wp | auto simp add:wpsimps dest:sym)+
      apply (rule inv_0;assumption)
     apply (wp | auto simp add:wpsimps)+
    done

  show
    "call to.
      (x h r. effect (call x) h r  vcond x h r)
       effect (delegate call to) s r
       inv_state sum_votes s
       post s r (K (K (inv_state sum_votes))) (K True)"
    unfolding delegate_def
    apply (erule post_exc_true, erule_tac post_wp)
    unfolding  inv_state_def
    apply wp
    apply wp
    apply wp
    apply (rule_tac voters=mp and x="Address msg_sender" in obtain_voters, blast)
    apply (vcg | solveauto simp add:wpsimps)+
                        apply (rule_tac iv ="λs'. state.Storage s' this STR ''voters'' = state.Storage s this STR ''voters'' 
                                                  state.Storage s' this STR ''proposals'' = state.Storage s this STR ''proposals'' 
                                                  state.Storage s' this STR ''chairperson'' = state.Storage s this STR ''chairperson'' 
                                                  state.Stack s' $$ (STR ''sender'') = Some (kdata.Storage (Some Location=STR ''voters'', Offset= [Address msg_sender])) 
                                                  (x. (Stack s' $$ STR ''to'' = Some (kdata.Value (Address x))  x  msg_sender))" in wpwhile)
                        apply (vcg | solveauto simp add:wpsimps)+
                        apply (safe)[1]
                        apply (auto simp add:wpsimps intro!: wpthrow)
      apply (vcg | solveauto simp add:wpsimps)+
                    apply (auto simp add:wpsimps intro!: wpthrow)
      apply (auto simp add:wpsimps dest: sym)[1]
     apply (vcg | solveauto simp add:wpsimps)+
                        apply (auto simp add:wpsimps intro!: wpthrow)
         apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
         apply (auto simp add:wpsimps)[1]
         apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
         apply (auto simp add:wpsimps)[1]
         apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
         apply (auto simp add:wpsimps)[1]
         apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
         apply (auto simp add:wpsimps)[1]
         apply (vcg | solveauto simp add:wpsimps)+
                apply (auto simp add:wpsimps intro!: wpthrow)
         apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
         apply (auto simp add:wpsimps)[1]
         apply (rule_tac mp="mp
                (Address msg_sender := storage_data.Array [storage_data.Value (Uint w), storage_data.Value (Bool True), storage_data.Value (Address d), storage_data.Value (Uint v)],
                 Address x := storage_data.Array [storage_data.Value (Uint (wa + w)), storage_data.Value (Bool False), storage_data.Value (Address x), storage_data.Value (Uint va)])" in sum_votesI)
            apply (auto simp add:wpsimps intro!: wpthrow)
         apply (rule inv_1;assumption)
        apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
        apply (auto simp add:wpsimps)[1]
       apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
       apply (auto simp add:wpsimps)[1]
      apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
      apply (auto simp add:wpsimps)[1]
     apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
     apply (auto simp add:wpsimps)[1]
    apply (rule_tac voters=mp and x="Address x" in obtain_voters, assumption)
    apply (auto simp add:wpsimps)[1]
    done

  show
    "call proposal.
      (x h r. effect (call x) h r  vcond x h r)
       effect (vote call proposal) s r
       inv_state sum_votes s
       post s r (K (K (inv_state sum_votes))) (K True)"
    unfolding vote_def
    apply (erule post_exc_true, erule_tac post_wp)
    unfolding  inv_state_def
    apply (wp)
    apply (wp)
    apply (wp)
    apply (rule_tac voters=mp and x="Address msg_sender" in obtain_voters, blast)
    by (auto simp add:wpsimps intro!: wprules)+

  show
    "call winningProposalu.
      (x h r. effect (call x) h r  vcond x h r)
       effect (winningProposal call winningProposalu) s r
       inv_state sum_votes s
       post s r (K (K (inv_state sum_votes))) (K True)"
    unfolding winningProposal_def
    apply (erule post_exc_true, erule_tac post_wp)
    unfolding  inv_state_def
    apply (wp)
    apply (wp)
    apply (wp)
    apply (rule_tac voters=mp and x="Address msg_sender" in obtain_voters, blast)
    apply (auto simp add:wpsimps intro!:wprules dest!:wpdrules elim!:wperules)
    apply (rule_tac iv ="λs'. state.Storage s' = state.Storage s
                   (x. (Stack s' $$ STR ''p'' = Some (kdata.Value (Uint x))))
                   (x. (Stack s' $$ STR ''winningVoteCount'' = Some (kdata.Value (Uint x))))
                   (x. (Stack s' $$ STR ''winningProposalu'' = Some (kdata.Value (Uint x))))" in wpwhile)
     apply (vcg | solveauto simp add:wpsimps)+
            apply (auto simp add:wpsimps intro!: wpthrow)
     apply vcg
                        apply (rule_tac ya=x in obtain_props, assumption)
                        apply (auto simp add:wpsimps intro!: wpthrow)
        apply (vcg | solveauto simp add:wpsimps)+
    apply (rule_tac mp=mp and da=a in sum_votesI)
       apply (auto simp add:wpsimps intro!: wpthrow)
    done
qed

context ballot_external
begin
  thm sum_votes
  thm vcond_def
end

end