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
belenios
belenios
Commits
696f5158
Commit
696f5158
authored
Jun 20, 2013
by
Stephane Glondu
Browse files
Move contents of Ocsipersist_ballotbox to Common
parent
895d8bab
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/web/common.ml
View file @
696f5158
...
...
@@ -108,3 +108,66 @@ let load_elections_and_votes dirname =
|
None
->
assert
false
)
else
Lwt
.
return
None
)
module
MakeLwtRandom
(
G
:
Signatures
.
GROUP
)
=
struct
type
'
a
t
=
'
a
Lwt
.
t
let
return
=
Lwt
.
return
let
bind
=
Lwt
.
bind
let
fail
=
Lwt
.
fail
let
prng
=
Lwt_preemptive
.
detach
(
fun
()
->
Cryptokit
.
Random
.(
pseudo_rng
(
string
secure_rng
16
))
)
()
let
random
q
=
let
size
=
Z
.
size
q
*
Sys
.
word_size
/
8
in
lwt
prng
=
prng
in
let
r
=
Cryptokit
.
Random
.
string
prng
size
in
return
Z
.(
of_bits
r
mod
q
)
end
exception
Serialization
of
exn
exception
ProofCheck
module
type
LWT_ELECTION
=
Signatures
.
ELECTION
with
type
elt
=
Z
.
t
and
type
'
a
m
=
'
a
Lwt
.
t
module
MakeBallotBox
(
E
:
LWT_ELECTION
)
=
struct
let
suffix
=
"_"
^
String
.
map
(
function
|
'
-
'
->
'
_'
|
c
->
c
)
(
Uuidm
.
to_string
E
.
election_params
.
e_uuid
)
let
ballot_table
=
Ocsipersist
.
open_table
(
"ballots"
^
suffix
)
let
record_table
=
Ocsipersist
.
open_table
(
"records"
^
suffix
)
type
ballot
=
string
type
record
=
string
*
Serializable_builtin_t
.
datetime
let
cast
rawballot
(
user
,
date
)
=
lwt
ballot
=
try
Lwt
.
return
(
Serializable_j
.
ballot_of_string
Serializable_builtin_j
.
read_number
rawballot
)
with
e
->
Lwt
.
fail
(
Serialization
e
)
in
if
E
.
check_ballot
ballot
then
(
Ocsipersist
.
add
ballot_table
(
sha256_b64
rawballot
)
rawballot
>>
Ocsipersist
.
add
record_table
user
date
)
else
(
Lwt
.
fail
ProofCheck
)
let
fold_ballots
f
x
=
Ocsipersist
.
fold_step
(
fun
k
v
x
->
f
v
x
)
ballot_table
x
let
fold_records
f
x
=
Ocsipersist
.
fold_step
(
fun
k
v
x
->
f
(
k
,
v
)
x
)
record_table
x
let
turnout
=
Ocsipersist
.
length
ballot_table
end
src/web/common.mli
View file @
696f5158
...
...
@@ -29,3 +29,35 @@ type election_data = {
val
load_elections_and_votes
:
string
->
(
election_data
*
(
string
*
Z
.
t
ballot
)
Lwt_stream
.
t
)
Lwt_stream
.
t
module
MakeLwtRandom
(
G
:
Signatures
.
GROUP
)
:
sig
(** {2 Monadic definitions} *)
include
Signatures
.
MONAD
with
type
'
a
t
=
'
a
Lwt
.
t
(** {2 Random number generation} *)
val
random
:
Z
.
t
->
Z
.
t
t
(** [random q] returns a random number modulo [q]. It uses a secure
random number generator initialized by a 128-bit seed. *)
end
(** Lwt-compatible random number generation. *)
exception
Serialization
of
exn
exception
ProofCheck
module
type
LWT_ELECTION
=
Signatures
.
ELECTION
with
type
elt
=
Z
.
t
and
type
'
a
m
=
'
a
Lwt
.
t
module
MakeBallotBox
(
E
:
LWT_ELECTION
)
:
sig
(** {2 Ballot box management} *)
include
Signatures
.
BALLOT_BOX
with
type
'
a
m
:=
'
a
Lwt
.
t
and
type
ballot
=
string
and
type
record
=
string
*
Serializable_builtin_t
.
datetime
end
(** This ballot box stores ballots and records in Ocsipersist tables. *)
src/web/ocsipersist_ballotbox.ml
deleted
100644 → 0
View file @
895d8bab
open
Util
open
Serializable_t
module
MakeLwtRandom
(
G
:
Signatures
.
GROUP
)
=
struct
type
'
a
t
=
'
a
Lwt
.
t
let
return
=
Lwt
.
return
let
bind
=
Lwt
.
bind
let
fail
=
Lwt
.
fail
let
prng
=
Lwt_preemptive
.
detach
(
fun
()
->
Cryptokit
.
Random
.(
pseudo_rng
(
string
secure_rng
16
))
)
()
let
random
q
=
let
size
=
Z
.
size
q
*
Sys
.
word_size
/
8
in
lwt
prng
=
prng
in
let
r
=
Cryptokit
.
Random
.
string
prng
size
in
return
Z
.(
of_bits
r
mod
q
)
end
exception
Serialization
of
exn
exception
ProofCheck
module
type
LWT_ELECTION
=
Signatures
.
ELECTION
with
type
elt
=
Z
.
t
and
type
'
a
m
=
'
a
Lwt
.
t
module
MakeBallotBox
(
E
:
LWT_ELECTION
)
=
struct
let
suffix
=
"_"
^
String
.
map
(
function
|
'
-
'
->
'
_'
|
c
->
c
)
(
Uuidm
.
to_string
E
.
election_params
.
e_uuid
)
let
ballot_table
=
Ocsipersist
.
open_table
(
"ballots"
^
suffix
)
let
record_table
=
Ocsipersist
.
open_table
(
"records"
^
suffix
)
type
ballot
=
string
type
record
=
string
*
Serializable_builtin_t
.
datetime
let
cast
rawballot
(
user
,
date
)
=
lwt
ballot
=
try
Lwt
.
return
(
Serializable_j
.
ballot_of_string
Serializable_builtin_j
.
read_number
rawballot
)
with
e
->
Lwt
.
fail
(
Serialization
e
)
in
if
E
.
check_ballot
ballot
then
(
Ocsipersist
.
add
ballot_table
(
sha256_b64
rawballot
)
rawballot
>>
Ocsipersist
.
add
record_table
user
date
)
else
(
Lwt
.
fail
ProofCheck
)
let
fold_ballots
f
x
=
Ocsipersist
.
fold_step
(
fun
k
v
x
->
f
v
x
)
ballot_table
x
let
fold_records
f
x
=
Ocsipersist
.
fold_step
(
fun
k
v
x
->
f
(
k
,
v
)
x
)
record_table
x
let
turnout
=
Ocsipersist
.
length
ballot_table
end
src/web/ocsipersist_ballotbox.mli
deleted
100644 → 0
View file @
895d8bab
(** Ocsipersist-based ballot box *)
module
MakeLwtRandom
(
G
:
Signatures
.
GROUP
)
:
sig
(** {2 Monadic definitions} *)
include
Signatures
.
MONAD
with
type
'
a
t
=
'
a
Lwt
.
t
(** {2 Random number generation} *)
val
random
:
Z
.
t
->
Z
.
t
t
(** [random q] returns a random number modulo [q]. It uses a secure
random number generator initialized by a 128-bit seed. *)
end
(** Lwt-compatible random number generation. *)
exception
Serialization
of
exn
exception
ProofCheck
module
type
LWT_ELECTION
=
Signatures
.
ELECTION
with
type
elt
=
Z
.
t
and
type
'
a
m
=
'
a
Lwt
.
t
module
MakeBallotBox
(
E
:
LWT_ELECTION
)
:
sig
(** {2 Ballot box management} *)
include
Signatures
.
BALLOT_BOX
with
type
'
a
m
:=
'
a
Lwt
.
t
and
type
ballot
=
string
and
type
record
=
string
*
Serializable_builtin_t
.
datetime
end
(** This ballot box stores ballots and records in Ocsipersist tables. *)
src/web/server.mllib
View file @
696f5158
...
...
@@ -5,5 +5,4 @@ Common
Election
Services
Templates
Ocsipersist_ballotbox
Registration
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