Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
concordium
smart-contract-interactions
Commits
81647d05
Commit
81647d05
authored
May 24, 2019
by
Jakob Botsch Nielsen
Browse files
Minimize Congress vs Congress_Buggy diff
parent
a97bd87b
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Congress.v
View file @
81647d05
...
...
@@ -73,146 +73,7 @@ Record State :=
Instance
state_settable
:
Settable
_
:=
settable
!
build_state
<
owner
;
state_rules
;
proposals
;
next_proposal_id
;
members
>
.
Definition
version
:
Version
:=
1
%
nat
.
Definition
validate_rules
(
rules
:
Rules
)
:
bool
:=
(
rules
.(
min_vote_count_permille
)
>=?
0
)
&&
(
rules
.(
min_vote_count_permille
)
<=?
1000
)
&&
(
rules
.(
margin_needed_permille
)
>=?
0
)
&&
(
rules
.(
margin_needed_permille
)
<=?
1000
)
&&
(
0
<=?
rules
.(
debating_period_in_blocks
))
%
nat
.
Definition
init
(
chain
:
Chain
)
(
ctx
:
ContractCallContext
)
(
setup
:
Setup
)
:
option
State
:=
if
validate_rules
setup
.(
setup_rules
)
then
Some
{|
owner
:=
ctx
.(
ctx_from
);
state_rules
:=
setup
.(
setup_rules
);
proposals
:=
FMap
.
empty
;
next_proposal_id
:=
1
%
nat
;
members
:=
FMap
.
empty
|}
else
None
.
Definition
add_proposal
(
actions
:
list
CongressAction
)
(
chain
:
Chain
)
(
state
:
State
)
:
State
:=
let
id
:=
state
.(
next_proposal_id
)
in
let
slot_num
:=
chain
.(
block_header
).(
slot_number
)
in
let
proposal
:=
{|
actions
:=
actions
;
votes
:=
FMap
.
empty
;
vote_result
:=
0
;
proposed_in
:=
slot_num
|}
in
let
new_proposals
:=
FMap
.
add
id
proposal
state
.(
proposals
)
in
state
<|
proposals
:=
new_proposals
|><|
next_proposal_id
:=
(
id
+
1
)
%
nat
|>
.
Definition
vote_on_proposal
(
voter
:
Address
)
(
pid
:
ProposalId
)
(
vote
:
Z
)
(
state
:
State
)
:
option
State
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
let
old_vote
:=
match
FMap
.
find
voter
proposal
.(
votes
)
with
|
Some
old
=>
old
|
None
=>
0
end
in
let
new_votes
:=
FMap
.
add
voter
vote
proposal
.(
votes
)
in
let
new_vote_result
:=
proposal
.(
vote_result
)
-
old_vote
+
vote
in
let
new_proposal
:=
proposal
<|
votes
:=
new_votes
|><|
vote_result
:=
new_vote_result
|>
in
Some
(
state
<|
proposals
::=
FMap
.
add
pid
new_proposal
|>
).
Definition
do_retract_vote
(
voter
:
Address
)
(
pid
:
ProposalId
)
(
state
:
State
)
:
option
State
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
do
old_vote
<-
FMap
.
find
voter
proposal
.(
votes
);
let
new_votes
:=
FMap
.
remove
voter
proposal
.(
votes
)
in
let
new_vote_result
:=
proposal
.(
vote_result
)
-
old_vote
in
let
new_proposal
:=
proposal
<|
votes
:=
new_votes
|><|
vote_result
:=
new_vote_result
|>
in
Some
(
state
<|
proposals
::=
FMap
.
add
pid
new_proposal
|>
).
Definition
congress_action_to_chain_action
(
act
:
CongressAction
)
:
ActionBody
:=
match
act
with
|
cact_transfer
to
amt
=>
act_transfer
to
amt
|
cact_call
to
amt
msg
=>
act_call
to
amt
msg
end
.
Definition
do_finish_proposal
(
pid
:
ProposalId
)
(
state
:
State
)
(
chain
:
Chain
)
:
option
(
State
*
list
ActionBody
)
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
let
rules
:=
state
.(
state_rules
)
in
let
debate_end
:=
(
proposal
.(
proposed_in
)
+
rules
.(
debating_period_in_blocks
))
%
nat
in
let
cur_slot
:=
chain
.(
block_header
).(
slot_number
)
in
if
(
cur_slot
<?
debate_end
)
%
nat
then
None
else
let
new_state
:=
state
<|
proposals
::=
FMap
.
remove
pid
|>
in
let
total_votes_for_proposal
:=
Z
.
of_nat
(
FMap
.
size
proposal
.(
votes
))
in
let
total_members
:=
Z
.
of_nat
(
FMap
.
size
state
.(
members
))
in
let
aye_votes
:=
(
proposal
.(
vote_result
)
+
total_votes_for_proposal
)
/
2
in
let
vote_count_permille
:=
total_votes_for_proposal
*
1000
/
total_members
in
let
aye_permille
:=
aye_votes
*
1000
/
total_votes_for_proposal
in
let
enough_voters
:=
vote_count_permille
>=?
rules
.(
min_vote_count_permille
)
in
let
enough_ayes
:=
aye_permille
>=?
rules
.(
margin_needed_permille
)
in
let
response_acts
:=
if
(
enough_voters
&&
enough_ayes
)
%
bool
then
proposal
.(
actions
)
else
[]
in
let
response_chain_acts
:=
map
congress_action_to_chain_action
response_acts
in
Some
(
new_state
,
response_chain_acts
).
Definition
receive
(
chain
:
Chain
)
(
ctx
:
ContractCallContext
)
(
state
:
State
)
(
maybe_msg
:
option
Msg
)
:
option
(
State
*
list
ActionBody
)
:=
let
sender
:=
ctx
.(
ctx_from
)
in
let
is_from_owner
:=
(
sender
=?
state
.(
owner
))
%
address
in
let
is_from_member
:=
FMap
.
mem
sender
state
.(
members
)
in
let
without_actions
:=
option_map
(
fun
new_state
=>
(
new_state
,
[]))
in
match
maybe_msg
,
is_from_owner
,
is_from_member
with
|
Some
(
transfer_ownership
new_owner
),
true
,
_
=>
Some
(
state
<|
owner
:=
new_owner
|>
,
[])
|
Some
(
change_rules
new_rules
),
true
,
_
=>
if
validate_rules
new_rules
then
Some
(
state
<|
state_rules
:=
new_rules
|>
,
[])
else
None
|
Some
(
add_member
new_member
),
true
,
_
=>
Some
(
state
<|
members
::=
FMap
.
add
new_member
tt
|>
,
[])
|
Some
(
remove_member
old_member
),
true
,
_
=>
Some
(
state
<|
members
::=
FMap
.
remove
old_member
|>
,
[])
|
Some
(
create_proposal
actions
),
_
,
true
=>
Some
(
add_proposal
actions
chain
state
,
[])
|
Some
(
vote_for_proposal
pid
),
_
,
true
=>
without_actions
(
vote_on_proposal
sender
pid
1
state
)
|
Some
(
vote_against_proposal
pid
),
_
,
true
=>
without_actions
(
vote_on_proposal
sender
pid
(
-
1
)
state
)
|
Some
(
retract_vote
pid
),
_
,
true
=>
without_actions
(
do_retract_vote
sender
pid
state
)
|
Some
(
finish_proposal
pid
),
_
,
_
=>
do_finish_proposal
pid
state
chain
|
_
,
_
,
_
=>
None
end
.
Section
Equivalences
.
Definition
deserialize_rules
(
v
:
OakValue
)
:
option
Rules
:=
do
'
((
a
,
b
),
c
)
<-
deserialize
v
;
...
...
@@ -335,6 +196,153 @@ Next Obligation.
destruct
x
;
repeat
(
simpl
;
rewrite
deserialize_serialize
);
reflexivity
.
Qed
.
End
Equivalences
.
Definition
version
:
Version
:=
1
%
nat
.
Definition
validate_rules
(
rules
:
Rules
)
:
bool
:=
(
rules
.(
min_vote_count_permille
)
>=?
0
)
&&
(
rules
.(
min_vote_count_permille
)
<=?
1000
)
&&
(
rules
.(
margin_needed_permille
)
>=?
0
)
&&
(
rules
.(
margin_needed_permille
)
<=?
1000
)
&&
(
0
<=?
rules
.(
debating_period_in_blocks
))
%
nat
.
Definition
init
(
chain
:
Chain
)
(
ctx
:
ContractCallContext
)
(
setup
:
Setup
)
:
option
State
:=
if
validate_rules
setup
.(
setup_rules
)
then
Some
{|
owner
:=
ctx
.(
ctx_from
);
state_rules
:=
setup
.(
setup_rules
);
proposals
:=
FMap
.
empty
;
next_proposal_id
:=
1
%
nat
;
members
:=
FMap
.
empty
|}
else
None
.
Definition
add_proposal
(
actions
:
list
CongressAction
)
(
chain
:
Chain
)
(
state
:
State
)
:
State
:=
let
id
:=
state
.(
next_proposal_id
)
in
let
slot_num
:=
chain
.(
block_header
).(
slot_number
)
in
let
proposal
:=
{|
actions
:=
actions
;
votes
:=
FMap
.
empty
;
vote_result
:=
0
;
proposed_in
:=
slot_num
|}
in
let
new_proposals
:=
FMap
.
add
id
proposal
state
.(
proposals
)
in
state
<|
proposals
:=
new_proposals
|><|
next_proposal_id
:=
(
id
+
1
)
%
nat
|>
.
Definition
vote_on_proposal
(
voter
:
Address
)
(
pid
:
ProposalId
)
(
vote
:
Z
)
(
state
:
State
)
:
option
State
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
let
old_vote
:=
match
FMap
.
find
voter
proposal
.(
votes
)
with
|
Some
old
=>
old
|
None
=>
0
end
in
let
new_votes
:=
FMap
.
add
voter
vote
proposal
.(
votes
)
in
let
new_vote_result
:=
proposal
.(
vote_result
)
-
old_vote
+
vote
in
let
new_proposal
:=
proposal
<|
votes
:=
new_votes
|><|
vote_result
:=
new_vote_result
|>
in
Some
(
state
<|
proposals
::=
FMap
.
add
pid
new_proposal
|>
).
Definition
do_retract_vote
(
voter
:
Address
)
(
pid
:
ProposalId
)
(
state
:
State
)
:
option
State
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
do
old_vote
<-
FMap
.
find
voter
proposal
.(
votes
);
let
new_votes
:=
FMap
.
remove
voter
proposal
.(
votes
)
in
let
new_vote_result
:=
proposal
.(
vote_result
)
-
old_vote
in
let
new_proposal
:=
proposal
<|
votes
:=
new_votes
|><|
vote_result
:=
new_vote_result
|>
in
Some
(
state
<|
proposals
::=
FMap
.
add
pid
new_proposal
|>
).
Definition
congress_action_to_chain_action
(
act
:
CongressAction
)
:
ActionBody
:=
match
act
with
|
cact_transfer
to
amt
=>
act_transfer
to
amt
|
cact_call
to
amt
msg
=>
act_call
to
amt
msg
end
.
Definition
proposal_passed
(
proposal
:
Proposal
)
(
state
:
State
)
:
bool
:=
let
rules
:=
state
.(
state_rules
)
in
let
total_votes_for_proposal
:=
Z
.
of_nat
(
FMap
.
size
proposal
.(
votes
))
in
let
total_members
:=
Z
.
of_nat
(
FMap
.
size
state
.(
members
))
in
let
aye_votes
:=
(
proposal
.(
vote_result
)
+
total_votes_for_proposal
)
/
2
in
let
vote_count_permille
:=
total_votes_for_proposal
*
1000
/
total_members
in
let
aye_permille
:=
aye_votes
*
1000
/
total_votes_for_proposal
in
let
enough_voters
:=
vote_count_permille
>=?
rules
.(
min_vote_count_permille
)
in
let
enough_ayes
:=
aye_permille
>=?
rules
.(
margin_needed_permille
)
in
enough_voters
&&
enough_ayes
.
Definition
do_finish_proposal
(
pid
:
ProposalId
)
(
state
:
State
)
(
chain
:
Chain
)
:
option
(
State
*
list
ActionBody
)
:=
do
proposal
<-
FMap
.
find
pid
state
.(
proposals
);
let
rules
:=
state
.(
state_rules
)
in
let
debate_end
:=
(
proposal
.(
proposed_in
)
+
rules
.(
debating_period_in_blocks
))
%
nat
in
let
cur_slot
:=
chain
.(
block_header
).(
slot_number
)
in
if
(
cur_slot
<?
debate_end
)
%
nat
then
None
else
let
response_acts
:=
if
proposal_passed
proposal
state
then
proposal
.(
actions
)
else
[]
in
let
response_chain_acts
:=
map
congress_action_to_chain_action
response_acts
in
let
new_state
:=
state
<|
proposals
::=
FMap
.
remove
pid
|>
in
Some
(
new_state
,
response_chain_acts
).
Definition
receive
(
chain
:
Chain
)
(
ctx
:
ContractCallContext
)
(
state
:
State
)
(
maybe_msg
:
option
Msg
)
:
option
(
State
*
list
ActionBody
)
:=
let
sender
:=
ctx
.(
ctx_from
)
in
let
is_from_owner
:=
(
sender
=?
state
.(
owner
))
%
address
in
let
is_from_member
:=
FMap
.
mem
sender
state
.(
members
)
in
let
without_actions
:=
option_map
(
fun
new_state
=>
(
new_state
,
[]))
in
match
maybe_msg
,
is_from_owner
,
is_from_member
with
|
Some
(
transfer_ownership
new_owner
),
true
,
_
=>
Some
(
state
<|
owner
:=
new_owner
|>
,
[])
|
Some
(
change_rules
new_rules
),
true
,
_
=>
if
validate_rules
new_rules
then
Some
(
state
<|
state_rules
:=
new_rules
|>
,
[])
else
None
|
Some
(
add_member
new_member
),
true
,
_
=>
Some
(
state
<|
members
::=
FMap
.
add
new_member
tt
|>
,
[])
|
Some
(
remove_member
old_member
),
true
,
_
=>
Some
(
state
<|
members
::=
FMap
.
remove
old_member
|>
,
[])
|
Some
(
create_proposal
actions
),
_
,
true
=>
Some
(
add_proposal
actions
chain
state
,
[])
|
Some
(
vote_for_proposal
pid
),
_
,
true
=>
without_actions
(
vote_on_proposal
sender
pid
1
state
)
|
Some
(
vote_against_proposal
pid
),
_
,
true
=>
without_actions
(
vote_on_proposal
sender
pid
(
-
1
)
state
)
|
Some
(
retract_vote
pid
),
_
,
true
=>
without_actions
(
do_retract_vote
sender
pid
state
)
|
Some
(
finish_proposal
pid
),
_
,
_
=>
do_finish_proposal
pid
state
chain
|
_
,
_
,
_
=>
None
end
.
Ltac
solve_contract_proper
:=
repeat
match
goal
with
...
...
src/Congress_Buggy.v
View file @
81647d05
...
...
@@ -476,8 +476,8 @@ Section Theories.
do
chain
<-
builder_add_block
chain
baker
acts
(
next_num
chain
)
0
;
Some
(
congress
,
chain
).
Definition
final
:
Address
*
LocalChainBuilderDepthFirst
:=
unpack_option
exploit_example
.
Definition
final
:=
(
unpack_option
exploit_example
)
<:
(
@
Address
LocalChainBase
)
*
LocalChainBuilderDepthFirst
.
(
*
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
...
...
@@ -496,5 +496,5 @@ Section Theories.
-
reflexivity
.
-
vm_compute
.
lia
.
Qed
.
Qed
.
End
Theories
.
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment