Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
belenios
belenios
Commits
82b4db59
Commit
82b4db59
authored
Jun 01, 2018
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Record more dates for data retention policy
parent
1f3fffec
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
57 additions
and
14 deletions
+57
-14
src/web/web_common.ml
src/web/web_common.ml
+2
-0
src/web/web_common.mli
src/web/web_common.mli
+1
-0
src/web/web_persist.ml
src/web/web_persist.ml
+32
-9
src/web/web_persist.mli
src/web/web_persist.mli
+8
-2
src/web/web_serializable.atd
src/web/web_serializable.atd
+5
-1
src/web/web_site.ml
src/web/web_site.ml
+9
-2
No files found.
src/web/web_common.ml
View file @
82b4db59
...
...
@@ -272,3 +272,5 @@ let write_file ?uuid x lines =
)
let
default_contact
=
"Name <user@example.org>"
let
default_finalization_date
=
datetime_of_string
"
\"
2015-10-01 00:00:00.000000
\"
"
src/web/web_common.mli
View file @
82b4db59
...
...
@@ -109,3 +109,4 @@ val read_file : ?uuid:uuid -> string -> string list option Lwt.t
val
write_file
:
?
uuid
:
uuid
->
string
->
string
list
->
unit
Lwt
.
t
val
default_contact
:
string
val
default_finalization_date
:
datetime
src/web/web_persist.ml
View file @
82b4db59
...
...
@@ -51,18 +51,41 @@ let get_election_state x =
let
set_election_state
x
s
=
Ocsipersist
.
add
election_states
(
raw_string_of_uuid
x
)
s
let
past
=
datetime_of_string
"
\"
2015-10-01 00:00:00.000000
\"
"
type
election_date
=
[
`Creation
|
`Finalization
|
`Tally
|
`Archive
]
let
set_election_date
uuid
d
=
let
dates
=
string_of_election_dates
{
e_finalization
=
d
}
in
let
get_election_dates
uuid
=
match
%
lwt
read_file
~
uuid
"dates.json"
with
|
Some
[
x
]
->
return
(
election_dates_of_string
x
)
|
_
->
return
{
e_creation
=
None
;
e_finalization
=
None
;
e_tally
=
None
;
e_archive
=
None
;
}
let
set_election_date
kind
uuid
d
=
let
%
lwt
dates
=
get_election_dates
uuid
in
let
dates
=
match
kind
with
|
`Creation
->
{
dates
with
e_creation
=
Some
d
}
|
`Finalization
->
{
dates
with
e_finalization
=
Some
d
}
|
`Tally
->
{
dates
with
e_tally
=
Some
d
}
|
`Archive
->
{
dates
with
e_archive
=
Some
d
}
in
let
dates
=
string_of_election_dates
dates
in
write_file
~
uuid
"dates.json"
[
dates
]
let
get_election_date
uuid
=
match
%
lwt
read_file
~
uuid
"dates.json"
with
|
Some
[
x
]
->
let
dates
=
election_dates_of_string
x
in
return
dates
.
e_finalization
|
_
->
return
past
let
get_election_date
kind
uuid
=
let
%
lwt
dates
=
get_election_dates
uuid
in
match
kind
with
|
`Creation
->
return
dates
.
e_creation
|
`Finalization
->
return
dates
.
e_finalization
|
`Tally
->
return
dates
.
e_tally
|
`Archive
->
return
dates
.
e_archive
let
election_pds
=
Ocsipersist
.
open_table
"election_pds"
...
...
src/web/web_persist.mli
View file @
82b4db59
...
...
@@ -33,8 +33,14 @@ type election_state =
val
get_election_state
:
uuid
->
election_state
Lwt
.
t
val
set_election_state
:
uuid
->
election_state
->
unit
Lwt
.
t
val
get_election_date
:
uuid
->
datetime
Lwt
.
t
val
set_election_date
:
uuid
->
datetime
->
unit
Lwt
.
t
type
election_date
=
[
`Creation
|
`Finalization
|
`Tally
|
`Archive
]
val
get_election_date
:
election_date
->
uuid
->
datetime
option
Lwt
.
t
val
set_election_date
:
election_date
->
uuid
->
datetime
->
unit
Lwt
.
t
val
get_partial_decryptions
:
uuid
->
(
int
*
string
)
list
Lwt
.
t
val
set_partial_decryptions
:
uuid
->
(
int
*
string
)
list
->
unit
Lwt
.
t
...
...
src/web/web_serializable.atd
View file @
82b4db59
...
...
@@ -56,7 +56,10 @@ type metadata = {
} <ocaml field_prefix="e_">
type election_dates = {
finalization : datetime;
?creation : datetime option;
?finalization : datetime option;
?tally : datetime option;
?archive : datetime option;
} <ocaml field_prefix="e_">
(** {1 Types related to elections being prepared} *)
...
...
@@ -96,6 +99,7 @@ type setup_election = {
?threshold_trustees <ocaml mutable> : setup_threshold_trustee list option;
?threshold_parameters <ocaml mutable> : string option;
?threshold_error <ocaml mutable> : string option;
?creation_date : datetime option;
} <ocaml field_prefix="se_">
(** {1 OpenID Connect-related types} *)
...
...
src/web/web_site.ml
View file @
82b4db59
...
...
@@ -274,7 +274,7 @@ let finalize_election uuid se =
|
_
->
return_unit
)
>>
(* finish *)
Web_persist
.
set_election_state
uuid
`Open
>>
Web_persist
.
set_election_date
uuid
(
now
()
)
Web_persist
.
set_election_date
`Finalization
uuid
(
now
()
)
let
cleanup_table
?
uuid_s
table
=
let
table
=
Ocsipersist
.
open_table
table
in
...
...
@@ -303,6 +303,7 @@ let archive_election uuid =
let
%
lwt
()
=
cleanup_table
(
"ballots_"
^
uuid_u
)
in
let
%
lwt
()
=
cleanup_file
(
!
spool_dir
/
uuid_s
/
"private_key.json"
)
in
let
%
lwt
()
=
cleanup_file
(
!
spool_dir
/
uuid_s
/
"private_keys.jsons"
)
in
let
%
lwt
()
=
Web_persist
.
set_election_date
`Archive
uuid
(
now
()
)
in
return_unit
let
()
=
Any
.
register
~
service
:
home
...
...
@@ -317,7 +318,11 @@ let get_finalized_elections_by_owner u =
Lwt_list
.
fold_left_s
(
fun
accu
uuid
->
let
%
lwt
w
=
find_election
uuid
in
let
%
lwt
state
=
Web_persist
.
get_election_state
uuid
in
let
%
lwt
date
=
Web_persist
.
get_election_date
uuid
in
let
%
lwt
date
=
Web_persist
.
get_election_date
`Finalization
uuid
in
let
date
=
match
date
with
|
None
->
default_finalization_date
|
Some
x
->
x
in
let
elections
,
tallied
,
archived
=
accu
in
match
state
with
|
`Tallied
_
->
return
(
elections
,
(
date
,
w
)
::
tallied
,
archived
)
...
...
@@ -430,6 +435,7 @@ let create_new_election owner cred auth =
se_threshold_trustees
=
None
;
se_threshold_parameters
=
None
;
se_threshold_error
=
None
;
se_creation_date
=
Some
(
now
()
);
}
in
let
%
lwt
()
=
set_setup_election
uuid
se
in
let
%
lwt
()
=
Ocsipersist
.
add
election_credtokens
token
uuid_s
in
...
...
@@ -1603,6 +1609,7 @@ let handle_election_tally_release (uuid, ()) () =
write_file
~
uuid
(
string_of_election_file
ESResult
)
[
result
]
in
let
%
lwt
()
=
Web_persist
.
set_election_state
uuid
(
`Tallied
result
.
result
)
in
let
%
lwt
()
=
Web_persist
.
set_election_date
`Tally
uuid
(
now
()
)
in
let
%
lwt
()
=
Ocsipersist
.
remove
election_tokens_decrypt
uuid_s
in
redir_preapply
election_home
(
uuid
,
()
)
()
)
else
forbidden
()
...
...
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