Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
belenios
belenios
Commits
d8467999
Commit
d8467999
authored
Feb 26, 2014
by
Stephane Glondu
Browse files
Rename BALLOT_BOX into MONADIC_MAP_RO
It is used for ballots as well as records...
parent
02259d1f
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/bin/election_tool.ml
View file @
d8467999
...
...
@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
match
ballots
with
|
None
->
failwith
"ballots.jsons is missing"
|
Some
_
->
M
.
fold
_ballots
(
fun
()
b
t
->
M
.
fold
(
fun
()
b
t
->
M
.
return
(
E
.
combine_ciphertexts
(
E
.
extract_ciphertext
b
)
t
)
)
(
E
.
neutral_ciphertext
e
)
()
)
...
...
@@ -292,7 +292,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
|
Some
factors
->
let
tally
=
Lazy
.
force
encrypted_tally
in
assert
(
Array
.
forall2
(
E
.
check_factor
tally
)
pks
factors
);
let
result
=
E
.
combine_factors
(
M
.
turnout
()
)
tally
factors
in
let
result
=
E
.
combine_factors
(
M
.
cardinal
()
)
tally
factors
in
assert
(
E
.
check_result
e
result
);
if
do_finalize
then
(
save_to
"result.json"
(
...
...
src/lib/election.ml
View file @
d8467999
...
...
@@ -109,10 +109,10 @@ module MakeSimpleMonad (G : GROUP) = struct
let
r
=
Cryptokit
.
Random
.
string
(
Lazy
.
force
prng
)
size
in
Z
.(
of_bits
r
mod
q
)
type
ballo
t
=
G
.
t
Serializable_t
.
ballot
type
el
t
=
G
.
t
Serializable_t
.
ballot
let
cast
x
()
=
ballots
:=
x
::
!
ballots
let
fold
_ballots
f
x
()
=
List
.
fold_left
(
fun
accu
b
->
f
()
b
accu
()
)
x
!
ballots
let
turnout
()
=
List
.
length
!
ballots
let
fold
f
x
()
=
List
.
fold_left
(
fun
accu
b
->
f
()
b
accu
()
)
x
!
ballots
let
cardinal
()
=
List
.
length
!
ballots
end
(** Distributed key generation *)
...
...
src/lib/election.mli
View file @
d8467999
...
...
@@ -57,12 +57,12 @@ module MakeSimpleMonad (G : GROUP) : sig
(** {2 Ballot box management} *)
include
Signatures
.
BALLOT_BOX
include
Signatures
.
MONADIC_MAP_RO
with
type
'
a
m
:=
'
a
t
and
type
ballo
t
=
G
.
t
Serializable_t
.
ballot
and
type
receipt
:=
unit
and
type
el
t
=
G
.
t
Serializable_t
.
ballot
and
type
key
:=
unit
val
cast
:
ballo
t
->
unit
t
val
cast
:
el
t
->
unit
t
end
(** Simple election monad that keeps all ballots in memory. *)
...
...
src/lib/signatures.mli
View file @
d8467999
...
...
@@ -86,27 +86,23 @@ module type RANDOM = sig
(** [random q] returns a random number modulo [q]. *)
end
(**
Ballot box
. *)
module
type
BALLOT_BOX
=
sig
(**
Read operations of a monadic map
. *)
module
type
MONADIC_MAP_RO
=
sig
type
'
a
m
(** The type of monadic values. *)
(** {2 Election-specific operations} *)
type
ballot
(** The type of ballots. The monad is supposed to keep track of all
cast ballots (e.g. in a database). *)
type
elt
(** The type of map values. *)
type
receipt
(** The type of receipts. This is something the voter gets after
casting a ballot to check his vote later. *)
type
key
(** The type of map keys. *)
val
fold
_ballots
:
(
receipt
->
ballo
t
->
'
a
->
'
a
m
)
->
'
a
->
'
a
m
(** [fold
_ballots
f a] computes [(f
r
N
b
N ... (f
r
2
b
2 (f
r
1
b
1 a))...)],
where [
r1,b
1 ...
rN,b
N] are all
cast ballot
s. *)
val
fold
:
(
key
->
el
t
->
'
a
->
'
a
m
)
->
'
a
->
'
a
m
(** [fold f a] computes [(f
k
N
v
N ... (f
k
2
v
2 (f
k
1
v
1 a))...)],
where [
k1/v
1 ...
kN/v
N] are all
key/value pair
s. *)
val
turnout
:
int
m
(**
Number of cast ballot
s. *)
val
cardinal
:
int
m
(**
Return the number of binding
s. *)
end
(** Parameters for an election. *)
...
...
@@ -231,6 +227,10 @@ module type ELECTION_BUNDLE = sig
end
module
type
BALLOT_BOX_BUNDLE
=
sig
type
receipt
type
ballot
include
ELECTION_BUNDLE
include
BALLOT_BOX
with
type
'
a
m
=
'
a
E
.
m
include
MONADIC_MAP_RO
with
type
'
a
m
=
'
a
E
.
m
and
type
elt
:=
ballot
and
type
key
:=
receipt
end
src/web/registration.ml
View file @
d8467999
...
...
@@ -539,7 +539,7 @@ let f_ballots uuid election user () =
let
open
Web_common
in
let
module
X
=
(
val
election
.
modules
:
WEB_BALLOT_BOX_BUNDLE
with
type
elt
=
Z
.
t
)
in
(* TODO: streaming *)
lwt
ballots
=
X
.
B
.
Ballots
.
fold
_ballots
(
fun
_
x
xs
->
lwt
ballots
=
X
.
B
.
Ballots
.
fold
(
fun
_
x
xs
->
return
((
x
^
"
\n
"
)
::
xs
)
)
[]
in
let
s
=
List
.
map
(
fun
b
()
->
...
...
@@ -552,7 +552,7 @@ let f_records uuid election user () =
let
open
Web_common
in
let
module
X
=
(
val
election
.
modules
:
WEB_BALLOT_BOX_BUNDLE
with
type
elt
=
Z
.
t
)
in
(* TODO: streaming *)
lwt
ballots
=
X
.
B
.
Records
.
fold
_ballots
(
fun
u
(
d
,
_
)
xs
->
lwt
ballots
=
X
.
B
.
Records
.
fold
(
fun
u
(
d
,
_
)
xs
->
let
x
=
Printf
.
sprintf
"%s %S
\n
"
(
Serializable_builtin_j
.
string_of_datetime
d
)
u
in
return
(
x
::
xs
)
...
...
src/web/web_common.ml
View file @
d8467999
...
...
@@ -158,14 +158,14 @@ let security_log s =
)
ic
module
type
WEB_BALLOT_BOX
=
sig
module
Ballots
:
Signatures
.
BALLOT_BOX
module
Ballots
:
Signatures
.
MONADIC_MAP_RO
with
type
'
a
m
=
'
a
Lwt
.
t
and
type
ballo
t
=
string
and
type
receipt
=
string
module
Records
:
Signatures
.
BALLOT_BOX
and
type
el
t
=
string
and
type
key
=
string
module
Records
:
Signatures
.
MONADIC_MAP_RO
with
type
'
a
m
=
'
a
Lwt
.
t
and
type
ballo
t
=
Serializable_builtin_t
.
datetime
*
string
and
type
receipt
=
string
and
type
el
t
=
Serializable_builtin_t
.
datetime
*
string
and
type
key
=
string
val
cast
:
string
->
string
*
datetime
->
string
Lwt
.
t
val
inject_creds
:
SSet
.
t
->
unit
Lwt
.
t
...
...
@@ -214,20 +214,20 @@ let make_web_election raw_election e_meta election_web =
module
Ballots
=
struct
type
'
a
m
=
'
a
Lwt
.
t
type
ballo
t
=
string
type
receipt
=
string
type
el
t
=
string
type
key
=
string
let
table
=
Ocsipersist
.
open_table
(
"ballots"
^
suffix
)
let
turnout
=
Ocsipersist
.
length
table
let
fold
_ballots
f
x
=
Ocsipersist
.
fold_step
f
table
x
let
cardinal
=
Ocsipersist
.
length
table
let
fold
f
x
=
Ocsipersist
.
fold_step
f
table
x
end
module
Records
=
struct
type
'
a
m
=
'
a
Lwt
.
t
type
ballo
t
=
Serializable_builtin_t
.
datetime
*
string
type
receipt
=
string
type
el
t
=
Serializable_builtin_t
.
datetime
*
string
type
key
=
string
let
table
=
Ocsipersist
.
open_table
(
"records"
^
suffix
)
let
turnout
=
Ocsipersist
.
length
table
let
fold
_ballots
f
x
=
Ocsipersist
.
fold_step
f
table
x
let
cardinal
=
Ocsipersist
.
length
table
let
fold
f
x
=
Ocsipersist
.
fold_step
f
table
x
end
let
cred_table
=
Ocsipersist
.
open_table
(
"creds"
^
suffix
)
...
...
src/web/web_common.mli
View file @
d8467999
...
...
@@ -76,14 +76,14 @@ exception Error of error
val
explain_error
:
error
->
string
module
type
WEB_BALLOT_BOX
=
sig
module
Ballots
:
Signatures
.
BALLOT_BOX
module
Ballots
:
Signatures
.
MONADIC_MAP_RO
with
type
'
a
m
=
'
a
Lwt
.
t
and
type
ballo
t
=
string
and
type
receipt
=
string
module
Records
:
Signatures
.
BALLOT_BOX
and
type
el
t
=
string
and
type
key
=
string
module
Records
:
Signatures
.
MONADIC_MAP_RO
with
type
'
a
m
=
'
a
Lwt
.
t
and
type
ballo
t
=
Serializable_builtin_t
.
datetime
*
string
and
type
receipt
=
string
and
type
el
t
=
Serializable_builtin_t
.
datetime
*
string
and
type
key
=
string
val
cast
:
string
->
string
*
datetime
->
string
Lwt
.
t
val
inject_creds
:
SSet
.
t
->
unit
Lwt
.
t
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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