Commit e3fb201d authored by Jakob Botsch Nielsen's avatar Jakob Botsch Nielsen

Add a lemma to simplify proofs about single contracts

This new lemma, contract_centric, restates proofs about single contracts
over some other sufficient lemmas involving strongly typed versions of
deployment info, state and messages. This makes proving those kind of
theorems much easier.
parent 7a4b0a47
Pipeline #14229 passed with stage
in 8 minutes and 50 seconds
......@@ -106,3 +106,10 @@ Ltac specialize_hypotheses :=
match goal with
| [H: _ -> _ |- _] => specialize (H ltac:(auto))
end.
Ltac unset_all :=
repeat
match goal with
| [var := ?body : ?T |- _] =>
pose proof (eq_refl : var = body); clearbody var
end.
This diff is collapsed.
This diff is collapsed.
......@@ -377,33 +377,40 @@ Section Theories.
Definition unpacked_exploit_example : Address * LocalChainBuilderDepthFirst :=
unpack_option exploit_example.
Definition num_acts_created_in_proposals (txs : list Tx) :=
let count tx :=
match tx_body tx with
| tx_call (Some msg) =>
match deserialize msg : option Msg with
| Some (create_proposal acts) => length acts
| _ => 0
end
Definition num_acts_created_in_proposals (calls : list (ContractCallInfo Msg)) :=
let count call :=
match call_msg call with
| Some (create_proposal acts) => length acts
| _ => 0
end in
sumnat count txs.
sumnat count calls.
(* Now we prove that this version of the contract is buggy, i.e. it does not satisfy the
property we proved for the other version of the Congress. We filter out transactions
from the congress to the congress as we have those now (due to self calls). *)
Theorem congress_is_buggy :
exists state addr (trace : ChainTrace empty_state state),
env_contracts state addr = Some (contract : WeakContract) /\
length (filter (fun tx => negb (tx_to tx =? addr)%address) (outgoing_txs trace addr)) >
num_acts_created_in_proposals (incoming_txs trace addr).
exists bstate caddr (trace : ChainTrace empty_state bstate)
(inc_calls : list (ContractCallInfo Msg)),
env_contracts bstate caddr = Some (contract : WeakContract) /\
incoming_calls trace caddr = Some inc_calls /\
length (filter (fun tx => negb (tx_to tx =? caddr)%address)
(outgoing_txs trace caddr)) >
num_acts_created_in_proposals inc_calls.
Proof.
exists (build_chain_state (snd unpacked_exploit_example) []).
exists (fst unpacked_exploit_example).
exists (builder_trace (snd unpacked_exploit_example)).
split.
set (inc_calls := unpack_option
(incoming_calls (Msg := Msg)
(builder_trace (snd unpacked_exploit_example))
(fst unpacked_exploit_example))).
vm_compute in inc_calls.
exists inc_calls.
split; [|split].
- reflexivity.
- reflexivity.
- vm_compute.
clear inc_calls.
lia.
Qed.
End Theories.
......@@ -203,3 +203,59 @@ Proof.
subst f'.
split; apply forall_respects_permutation; auto; symmetry; auto.
Qed.
Lemma Forall_false_filter_nil {A : Type} (pred : A -> bool) (l : list A) :
Forall (fun a => pred a = false) l -> filter pred l = [].
Proof.
intros all.
induction l as [|hd tl IH]; auto.
inversion_clear all as [|? ? head_false tail_false].
cbn.
now rewrite head_false, IH.
Qed.
Lemma filter_app {A} (pred : A -> bool) (l l' : list A) :
filter pred (l ++ l') = filter pred l ++ filter pred l'.
Proof.
induction l as [|hd tl IH]; auto.
cbn.
rewrite IH.
destruct (pred hd); auto.
Qed.
Lemma filter_map {A B : Type} (f : A -> B) (pred : B -> bool) (l : list A) :
filter pred (map f l) =
map f (filter (fun a => pred (f a)) l).
Proof.
induction l as [|hd tl IH]; auto.
cbn.
rewrite IH.
destruct (pred (f hd)); auto.
Qed.
Lemma filter_false {A : Type} (l : list A) :
filter (fun _ => false) l = [].
Proof. induction l; auto. Qed.
Lemma filter_true {A : Type} (l : list A) :
filter (fun _ => true) l = l.
Proof.
induction l as [|? ? IH]; auto.
cbn.
now rewrite IH.
Qed.
Lemma Permutation_filter {A : Type} (pred : A -> bool) (l l' : list A) :
Permutation l l' ->
Permutation (filter pred l) (filter pred l').
Proof.
intros perm.
induction perm; auto.
- cbn.
destruct (pred x); auto.
- cbn.
destruct (pred x), (pred y); auto.
constructor.
- rewrite IHperm1; auto.
Qed.
......@@ -160,17 +160,21 @@ Hint Resolve congress_txs_after_block : core.
Lemma congress_txs_after_local_chain_block
(prev new : LocalChainBuilderDepthFirst) header acts :
builder_add_block prev header acts = Some new ->
forall addr,
env_contracts new addr = Some (Congress.contract : WeakContract) ->
length (outgoing_txs (builder_trace new) addr) <=
num_acts_created_in_proposals (incoming_txs (builder_trace new) addr).
forall caddr,
env_contracts new caddr = Some (Congress.contract : WeakContract) ->
exists inc_calls,
incoming_calls (builder_trace new) caddr = Some inc_calls /\
length (outgoing_txs (builder_trace new) caddr) <=
num_acts_created_in_proposals inc_calls.
Proof. eauto. Qed.
(* And of course, it is satisfied for the breadth first chain as well. *)
Lemma congress_txs_after_local_chain_bf_block
(prev new : LocalChainBuilderBreadthFirst) header acts :
builder_add_block prev header acts = Some new ->
forall addr,
env_contracts new addr = Some (Congress.contract : WeakContract) ->
length (outgoing_txs (builder_trace new) addr) <=
num_acts_created_in_proposals (incoming_txs (builder_trace new) addr).
forall caddr,
env_contracts new caddr = Some (Congress.contract : WeakContract) ->
exists inc_calls,
incoming_calls (builder_trace new) caddr = Some inc_calls /\
length (outgoing_txs (builder_trace new) caddr) <=
num_acts_created_in_proposals inc_calls.
Proof. eauto. Qed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment