Commit 71ea5d00 authored by Jakob Botsch Nielsen's avatar Jakob Botsch Nielsen
Browse files

Specify and prove an initial blockchain semantics

This specifies an initial version of blockchain semantics. The semantics
are specified as several relations:

ChainStep :
  Environment -> Action -> Tx ->
  Environment -> list Action ->
  Prop.

This relation captures the semantics of a single step/action in the
chain. Such an action can either be a transfer, contract deployment or
contract call. It specifies that when an action is executed in some
starting environment, then the blockchain records a transaction (Tx) on
the chain and performs certain updates to the environment. Finally, the
step also results in possible new actions to be executed due to contract
execution.

An environment is for now simply a Chain (which contracts can interact
with) and a collection of contracts that have been deployed to some
addresses. The Chain contains various useful operations for contracts
such as the current block number or ability to query transactions and
user balances.

For example, for a simple transfer action we may have ChainStep pre act
tx post []. Then the ChainStep relation will capture that the only thing
that has changed in the post environment is that tx has been added to
the chain (so that the appropriate account balances have been updated),
but for instance also that no new contracts have appeared. Since this is
just a transfer, there also cannot be any new actions to execute.

The semantics of the environment updates are captured in an abstract
manner to allow for different implementations of blockchains.
Specifically, we use an equivalence relation
EnvironmentEquiv : Environment -> Environment -> Prop and just require
that the environment is equivalent (under this relation) to an obvious
implementation of an environment. We implement an obvious blockchain,
LocalBlockchain, which uses finite maps with log n access times rather
than the linear maps used in the default semantics.

A single block, when added to a blockchain, consists of a list of these
actions to execute. In each block this list of actions must then be
executed (in a correct manner) until no more actions are left. This is
captured in
BlockTrace :
  Environment -> list Action ->
  Environment -> list Action -> Prop.
For all intents and purposes this can be seen as just a transitive
reflexive closure of the ChainStep relation above. Right now it only
allows blocks to reduce steps in a depth-first order, but this relation
should be simple to update to other or more general orders of reduction.
Note that ChainStep and BlockTrace say nothing about new blocks, but
only about execution within blocks. The semantics of how blocks are
added to the chain is captured in
ChainTrace : Environment -> Environment -> Prop.

This is a collection of block traces and representing additions of
blocks. At each block added, ChainTrace also captures that the
environment must be updated accordingly so that contracts can access
information about block numbers correctly.

Finally, a blockchain must always be able to prove that there is a
ChainTrace from its initial environment (the genesis blockchain) to its
current environment.

There are several TODOs left in the semantics:
1. We need to account for gas and allow execution failures
2. We need to put restrictions on when contracts can appear as the
source of actions
3. We need to capture soundness of the add_block function in blockchain
implementations

We also provide to sanity checks for these semantics:
1. We prove them for a simple block chain (LocalBlockchain.v).
2. We prove a "circulation" theorem for any blockchain satisfying the
semantics. That is, we show the following theorem:

Theorem chain_trace_circulation
      {env_start env_end : Environment}
      (trace : ChainTrace env_start env_end)
  : circulation env_end =
    (circulation env_start +
     coins_created
       (block_height (block_header env_start))
       (block_height (block_header env_end)))%Z.
parent 99b27297
Pipeline #12077 failed with stage
in 5 minutes and 54 seconds
......@@ -3,5 +3,6 @@
.*.aux
*.v.d
.coqdeps.d
*.cache
CoqMakefile
CoqMakefile.conf
-R src SmartContracts
src/Automation.v
src/Blockchain.v
src/BoundedN.v
src/Congress.v
src/Containers.v
src/Extras.v
src/Finite.v
src/LocalBlockchain.v
src/LocalBlockchainTests.v
src/Monads.v
......
From Coq Require Import Eqdep List Omega Permutation.
Import ListNotations.
Set Implicit Arguments.
Ltac inject H := injection H; clear H; intros; try subst.
Ltac appHyps f :=
match goal with
| [ H : _ |- _ ] => f H
end.
Ltac inList x ls :=
match ls with
| x => idtac
| (_, x) => idtac
| (?LS, _) => inList x LS
end.
Ltac app f ls :=
match ls with
| (?LS, ?X) => f X || app f LS || fail 1
| _ => f ls
end.
Ltac all f ls :=
match ls with
| (?LS, ?X) => f X; all f LS
| (_, _) => fail 1
| _ => f ls
end.
(** Workhorse tactic to simplify hypotheses for a variety of proofs.
* Argument [invOne] is a tuple-list of predicates for which we always do inversion automatically. *)
Ltac simplHyp invOne :=
(** Helper function to do inversion on certain hypotheses, where [H] is the hypothesis and [F] its head symbol *)
let invert H F :=
(** We only proceed for those predicates in [invOne]. *)
inList F invOne;
(** This case covers an inversion that succeeds immediately, meaning no constructors of [F] applied. *)
(inversion H; fail)
(** Otherwise, we only proceed if inversion eliminates all but one constructor case. *)
|| (inversion H; [idtac]; clear H; try subst) in
match goal with
(** Eliminate all existential hypotheses. *)
| [ H : ex _ |- _ ] => destruct H
(** Find opportunities to take advantage of injectivity of data constructors, for several different arities. *)
| [ H : ?F ?X = ?F ?Y |- ?G ] =>
(** This first branch of the [||] fails the whole attempt iff the arguments of the constructor applications are already easy to prove equal. *)
(assert (X = Y); [ assumption | fail 1 ])
(** If we pass that filter, then we use injection on [H] and do some simplification as in [inject].
* The odd-looking check of the goal form is to avoid cases where [injection] gives a more complex result because of dependent typing, which we aren't equipped to handle here. *)
|| (injection H;
match goal with
| [ |- X = Y -> G ] =>
try clear H; intros; try subst
end)
| [ H : ?F ?X ?U = ?F ?Y ?V |- ?G ] =>
(assert (X = Y); [ assumption
| assert (U = V); [ assumption | fail 1 ] ])
|| (injection H;
match goal with
| [ |- U = V -> X = Y -> G ] =>
try clear H; intros; try subst
end)
(** Consider some different arities of a predicate [F] in a hypothesis that we might want to invert. *)
| [ H : ?F _ |- _ ] => invert H F
| [ H : ?F _ _ |- _ ] => invert H F
| [ H : ?F _ _ _ |- _ ] => invert H F
| [ H : ?F _ _ _ _ |- _ ] => invert H F
| [ H : ?F _ _ _ _ _ |- _ ] => invert H F
| [ H : Some _ = Some _ |- _ ] => injection H; clear H
end.
(** Find some hypothesis to rewrite with, ensuring that [auto] proves all of the extra subgoals added by [rewrite]. *)
Ltac rewriteHyp :=
match goal with
| [ H : _ |- _ ] => rewrite H by solve [ auto ]
end.
(** Combine [autorewrite] with automatic hypothesis rewrites. *)
Ltac rewriterP := repeat (rewriteHyp; autorewrite with core in *).
Ltac rewriter := autorewrite with core in *; rewriterP.
Hint Rewrite app_ass.
Hint Rewrite app_comm_cons.
Ltac prove' invOne :=
let sintuition :=
simpl in *; intuition auto; try subst;
repeat (simplHyp invOne; intuition auto; try subst); try congruence in
let rewriter := autorewrite with core in *;
repeat (match goal with
| [ H : ?P |- _ ] => rewrite H by prove' invOne
end; autorewrite with core in *) in
do 3 (sintuition; autounfold; rewriter); try omega; try (elimtype False; omega).
Ltac prove := prove' fail.
Lemma Permutation_app_middle {A : Type} (xs l1 l2 l3 l4 : list A) :
Permutation (l1 ++ l2) (l3 ++ l4) ->
Permutation (l1 ++ xs ++ l2) (l3 ++ xs ++ l4).
Proof.
Hint Rewrite <- Permutation_middle.
intros perm.
induction xs; prove.
Qed.
(* Change all x :: l into [x] ++ l *)
Ltac appify :=
match goal with
| [|- context[?e :: ?l]] =>
match l with
| nil => fail 1
| _ => change (e :: l) with ([e] ++ l)
end
end.
Local Ltac reassoc_right :=
match goal with
| [|- Permutation _ (?l1 ++ ?l2 ++ ?l3)] => rewrite (app_assoc l1 l2 l3)
end.
Local Ltac reassoc_left :=
match goal with
| [|- Permutation (?l1 ++ ?l2 ++ ?l3) _] => rewrite (app_assoc l1 l2 l3)
end.
Local Ltac unassoc_right :=
repeat
match goal with
| [|- Permutation _ ((?l1 ++ ?l2) ++ ?l3)] => rewrite <- (app_assoc l1 l2 l3)
end.
Local Ltac simplify_perm_once :=
let rec aux :=
apply Permutation_app_middle ||
tryif reassoc_right
then aux
else (unassoc_right; reassoc_left; aux) in
repeat rewrite <- app_assoc;
aux.
Local Ltac simplify_perm_round :=
simpl;
repeat appify;
(* Change into [] ++ l ++ [] *)
match goal with
| [|- Permutation ?l1 ?l2] => change l1 with ([] ++ l1);
change l2 with ([] ++ l2);
rewrite <- (app_nil_r l1), <- (app_nil_r l2)
end;
repeat simplify_perm_once;
simpl;
repeat rewrite <- app_assoc;
repeat rewrite app_nil_r;
repeat
match goal with
| [H: Permutation ?l1 ?l2|-_] => rewrite H
end.
Ltac simplify_perm :=
repeat simplify_perm_round;
simpl;
try apply Permutation_refl.
Ltac case_match :=
match goal with
| [H: context [ match ?x with _ => _ end ] |- _] => destruct x eqn:?
| [|- context [ match ?x with _ => _ end ]] => destruct x eqn:?
end.
Ltac destruct_units :=
repeat
match goal with
| [u: unit |- _] => destruct u
end.
From Coq Require Import Arith ZArith.
From Coq Require Import List.
From Coq Require Import Psatz.
From Coq Require Import Permutation.
From Coq Require Import Morphisms.
From Coq Require Import Setoid.
From SmartContracts Require Import Oak.
From SmartContracts Require Import Monads.
From SmartContracts Require Import Extras.
From SmartContracts Require Import Automation.
From RecordUpdate Require Import RecordUpdate.
From stdpp Require countable.
Import ListNotations.
Definition Version := nat.
Definition Amount := Z.
Bind Scope Z_scope with Amount.
Class ChainBaseTypes :=
build_chain_base_types {
Address : Type;
address_eqb : Address -> Address -> bool;
address_eqb_spec : forall (a b : Address), Bool.reflect (a = b) (address_eqb a b);
address_eqdec :> stdpp.base.EqDecision Address;
address_countable :> countable.Countable Address;
address_ote :> OakTypeEquivalence Address;
compute_block_reward : nat -> Amount;
}.
Global Opaque Address address_eqb address_eqb_spec
address_eqdec address_countable
address_ote
compute_block_reward.
Definition Address := nat.
Delimit Scope address_scope with address.
Bind Scope address_scope with Address.
Infix "=?" := address_eqb (at level 70) : address_scope.
Module Address.
Definition eqb := Nat.eqb.
End Address.
Global Ltac destruct_address_eq :=
repeat
match goal with
| [|- context[(?a =? ?b)%address]] => destruct (address_eqb_spec a b)
end.
Infix "=?" := Address.eqb (at level 70) : address_scope.
Definition Amount := nat.
Definition BlockId := nat.
Definition Version := nat.
Section Blockchain.
Context {BaseTypes : ChainBaseTypes}.
Record ContractDeployment :=
build_contract_deployment {
deployment_version : Version;
(* todo: model any type/constraints so we can have this. Right now the
problem is that Congress messages can contain _any_ oak value (for
the congress to send out), so there is no bijection from its message type
to oak type.
problem is that Congress messages can contain _any_ oak value (for
the congress to send out), so there is no bijection from its message type
to oak type.
deployment_msg_ty : OakType;
deployment_state_ty : OakType; *)
deployment_setup : OakValue;
......@@ -44,79 +75,80 @@ Record Tx :=
Record BlockHeader :=
build_block_header {
block_number : BlockId;
block_height : nat;
slot_number : nat;
finalized_height : nat;
}.
Record Block :=
build_block {
(* This represents the view of the blockchain that a contract
can access and interact with. *)
Record Chain :=
build_chain {
block_header : BlockHeader;
block_txs : list Tx;
}.
(* The ChainInterface is an interface that allows different implementations
of chains. This represents the view of the blockchain that a contract
can access and interact with. This does not contain all information of
the chain (and it can't for positivity reasons).
*)
Record ChainInterface :=
build_chain_interface {
(* Would be nice to encapsulate ChainInterface somewhat here
and avoid these ugly prefixed names *)
ci_type : Type;
ci_chain_at : ci_type -> BlockId -> option ci_type;
(* Last finished block. During contract execution, this is the previous
block, i.e. this block does _not_ contain the transaction that caused
the contract to be called *)
ci_head_block : ci_type -> Block;
ci_incoming_txs : ci_type -> Address -> list Tx;
ci_outgoing_txs : ci_type -> Address -> list Tx;
ci_contract_state : ci_type -> Address -> option OakValue;
incoming_txs : Address -> list Tx;
outgoing_txs : Address -> list Tx;
blocks_baked : Address -> list nat;
contract_state : Address -> option OakValue;
}.
(* An actual chain interface together with a value of the chain.
For example, one obvious chain implementation could be as a list
of blocks and some operations on such a list. Then, the value is
simply the list of blocks.
This avoids having to either
1. Import an actual instance of ChainInterface when taking a chain, or
2. Abstracting over any implementation of ChainInterface when taking
a chain. *)
Record Chain :=
build_chain {
chain_ci : ChainInterface;
chain_val : chain_ci.(ci_type);
Record ChainEquiv (c1 c2 : Chain) : Prop :=
build_chain_equiv {
header_eq : block_header c1 = block_header c2;
incoming_txs_eq : forall addr, incoming_txs c1 addr = incoming_txs c2 addr;
outgoing_txs_eq : forall addr, outgoing_txs c1 addr = outgoing_txs c2 addr;
blocks_baked_eq : forall addr, blocks_baked c1 addr = blocks_baked c2 addr;
contract_state_eq : forall addr, contract_state c1 addr = contract_state c2 addr;
}.
Section ChainAccessors.
Context (chain : Chain).
Let g {A : Type} (p : forall chain : ChainInterface, ci_type chain -> A)
:= p chain.(chain_ci) chain.(chain_val).
Definition chain_at (bid : BlockId) : option Chain :=
do x <- chain.(chain_ci).(ci_chain_at) chain.(chain_val) bid;
Some {| chain_val := x |}.
Definition head_block := g ci_head_block.
Definition incoming_txs := g ci_incoming_txs.
Definition outgoing_txs := g ci_outgoing_txs.
Definition contract_state := g ci_contract_state.
Definition account_balance (addr : Address) : Amount :=
let sum := fold_right Nat.add 0 in
let sum_amounts txs := sum (map tx_amount txs) in
sum_amounts (incoming_txs addr) - sum_amounts (outgoing_txs addr).
Definition contract_deployment (addr : Address) : option ContractDeployment :=
let to_dep tx := match tx.(tx_body) with
| tx_deploy dep => Some dep
| _ => None
end in
find_first to_dep (incoming_txs addr).
End ChainAccessors.
Inductive ContractCallContext :=
build_contract_call_ctx {
(* Chain *)
ctx_chain : Chain;
Global Program Instance chain_equiv_equivalence : Equivalence ChainEquiv.
Next Obligation.
intros x; apply build_chain_equiv; reflexivity.
Qed.
Next Obligation.
intros x y eq.
destruct eq; apply build_chain_equiv; congruence.
Qed.
Next Obligation.
intros x y z eq_xy eq_yz.
destruct eq_xy, eq_yz; apply build_chain_equiv; congruence.
Qed.
Global Instance chain_equiv_header_proper :
Proper (ChainEquiv ==> eq) block_header.
Proof. intros x y. apply header_eq. Qed.
Global Instance chain_equiv_incoming_txs_proper :
Proper (ChainEquiv ==> eq ==> eq) incoming_txs.
Proof. intros x y eq a b eq'; subst; apply incoming_txs_eq; assumption. Qed.
Global Instance chain_equiv_outgoing_txs_proper :
Proper (ChainEquiv ==> eq ==> eq) outgoing_txs.
Proof. intros x y eq a b eq'; subst; apply outgoing_txs_eq; assumption. Qed.
Global Instance chain_equiv_blocks_backes_proper :
Proper (ChainEquiv ==> eq ==> eq) blocks_baked.
Proof. intros x y eq a b eq'; subst; apply blocks_baked_eq; assumption. Qed.
Global Instance chain_equiv_contract_state_proper :
Proper (ChainEquiv ==> eq ==> eq) contract_state.
Proof. intros x y eq a b eq'; subst; apply contract_state_eq; assumption. Qed.
Section Accessors.
Local Open Scope Z.
Definition account_balance (chain : Chain) (addr : Address)
: Amount :=
let sum_amounts txs := sumZ tx_amount txs in
sum_amounts (incoming_txs chain addr) - sum_amounts (outgoing_txs chain addr) +
sumZ compute_block_reward (blocks_baked chain addr).
Definition contract_deployment (chain : Chain) (addr : Address)
: option ContractDeployment :=
let to_dep tx := match tx.(tx_body) with
| tx_deploy dep => Some dep
| _ => None
end in
find_first to_dep (incoming_txs chain addr).
End Accessors.
Record ContractCallContext :=
build_ctx {
(* Address sending the funds *)
ctx_from : Address;
(* Address of the contract being called *)
......@@ -125,12 +157,13 @@ Inductive ContractCallContext :=
ctx_amount : Amount;
}.
(* Operations that a contract can return that allows it to perform
different actions as a result of its execution. *)
Inductive ChainAction :=
(* Operations that a contract can return or that a user can use
to interact with a chain. *)
Inductive ActionBody :=
| act_transfer (to : Address) (amount : Amount)
| act_call (to : Address) (amount : Amount) (msg : OakValue)
| act_deploy (amount : Amount) (c : WeakContract) (setup : OakValue)
(* Since one operation is the possibility to deploy a new contract,
this represents an instance of a contract. Note that the act of deploying
a contract has to be a separate thing to the contract deployment a contract
......@@ -145,75 +178,143 @@ where Address -> WeakContract would be some operation that the chain provides
to allow access to contracts in deployments.
*)
with WeakContract :=
| build_weak_contract
(version : Version)
(init : ContractCallContext -> OakValue -> option OakValue)
(receive : ContractCallContext -> OakValue (* state *) ->
option OakValue (* message *) ->
option (OakValue * list ChainAction)).
| build_weak_contract
(version : Version)
(init : Chain ->
ContractCallContext ->
OakValue ->
option OakValue)
(init_proper :
Proper (ChainEquiv ==> eq ==> eq ==> eq) init)
(receive :
Chain ->
ContractCallContext ->
OakValue (* state *) ->
option OakValue (* message *) ->
option (OakValue * list ActionBody))
(receive_proper :
Proper (ChainEquiv ==> eq ==> eq ==> eq ==> eq) receive).
Definition wc_version (wc : WeakContract) : Version :=
let (v, _, _, _, _) := wc in v.
Definition wc_init (wc : WeakContract) :=
let (_, i, _, _, _) := wc in i.
Definition wc_init_proper (wc : WeakContract) :=
match wc return
Proper (ChainEquiv ==> eq ==> eq ==> eq) (wc_init wc) with
| build_weak_contract _ _ ip _ _ => ip
end.
Definition wc_receive (wc : WeakContract) :=
let (_, _, _, r, _) := wc in r.
Definition wc_receive_proper (wc : WeakContract) :=
match wc return
Proper (ChainEquiv ==> eq ==> eq ==> eq ==> eq) (wc_receive wc) with
| build_weak_contract _ _ _ _ rp => rp
end.
Record Action :=
build_act {
act_from : Address;
act_body : ActionBody;
}.
(* Represents a strongly-typed contract. This is what user's will primarily
use and interact with when they want deployment. We keep the weak contract
only "internally" for blockchains, while any strongly-typed contract can
be converted to and from *)
Record Contract
(setup_ty msg_ty state_ty : Type)
`{OakTypeEquivalence setup_ty}
`{OakTypeEquivalence msg_ty}
`{OakTypeEquivalence state_ty} :=
(setup_ty msg_ty state_ty : Type)
`{setup_eq : OakTypeEquivalence setup_ty}
`{msg_eq : OakTypeEquivalence msg_ty}
`{state_eq : OakTypeEquivalence state_ty} :=
build_contract {
version : Version;
init : ContractCallContext -> setup_ty -> option state_ty;
init :
Chain ->
ContractCallContext ->
setup_ty ->
option state_ty;
init_proper :
Proper (ChainEquiv ==> eq ==> eq ==> eq) init;
receive :
ContractCallContext -> state_ty ->
option msg_ty -> option (state_ty * list ChainAction);
Chain ->
ContractCallContext ->
state_ty ->
option msg_ty ->
option (state_ty * list ActionBody);
receive_proper :
Proper (ChainEquiv ==> eq ==> eq ==> eq ==> eq) receive;
}.
Arguments version {_ _ _ _ _ _} contract : rename.
Arguments init {_ _ _ _ _ _} contract ctx setup : rename.
Arguments receive {_ _ _ _ _ _} contract ctx state msg : rename.
Arguments version {_ _ _ _ _ _}.
Arguments init {_ _ _ _ _ _}.
Arguments receive {_ _ _ _ _ _}.
Arguments build_contract {_ _ _ _ _ _}.
Definition contract_to_weak_contract
{setup_ty msg_ty state_ty : Type}
`{OakTypeEquivalence setup_ty}
`{OakTypeEquivalence msg_ty}
`{OakTypeEquivalence state_ty}
(c : Contract setup_ty msg_ty state_ty) : WeakContract :=
let weak_init ctx oak_setup :=
do setup <- deserialize oak_setup;
do state <- c.(init) ctx setup;
Some (serialize state) in
let weak_recv ctx oak_state oak_msg_opt :=
do state <- deserialize oak_state;
match oak_msg_opt with
| Some oak_msg =>
do msg <- deserialize oak_msg;
do '(new_state, acts) <- c.(receive) ctx state (Some msg);
Some (serialize new_state, acts)
| None =>
do '(new_state, acts) <- c.(receive) ctx state None;
Some (serialize new_state, acts)
end in
build_weak_contract c.(version) weak_init weak_recv.
Program Definition contract_to_weak_contract
{setup_ty msg_ty state_ty : Type}
`{setup_eq : OakTypeEquivalence setup_ty}
`{msg_eq : OakTypeEquivalence msg_ty}
`{state_eq : OakTypeEquivalence state_ty}
(c : Contract setup_ty msg_ty state_ty) : WeakContract :=
let weak_init chain ctx oak_setup :=
do setup <- deserialize oak_setup;
do state <- c.(init) chain ctx setup;
Some (serialize state) in
let weak_recv chain ctx oak_state oak_msg_opt :=
do state <- deserialize oak_state;
match oak_msg_opt with
| Some oak_msg =>
do msg <- deserialize oak_msg;
do '(new_state, acts) <- c.(receive) chain ctx state (Some msg);
Some (serialize new_state, acts)
| None =>
do '(new_state, acts) <- c.(receive) chain ctx state None;
Some (serialize new_state, acts)
end in
build_weak_contract c.(version) weak_init _ weak_recv _.
Next Obligation.
intros.
intros c1 c2 eq_chains ctx1 ctx2 eq_ctx setup1 setup2 eq_setups.
subst ctx2 setup2.
subst weak_init.
simpl.
destruct (deserialize setup1); auto; simpl.
now rewrite init_proper.
Qed.
Next Obligation.
intros.
intros c1 c2 eq_chains ctx1 ctx2 eq_ctx state1 state2 eq_states msg1 msg2 eq_msgs.