Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
B
belenios
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
belenios
belenios
Commits
190bd86c
Commit
190bd86c
authored
Jun 19, 2018
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Create List and Option submodules in Common
parent
2a50dddd
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
54 additions
and
43 deletions
+54
-43
src/lib/common.ml
src/lib/common.ml
+26
-20
src/lib/common.mli
src/lib/common.mli
+9
-4
src/tool/tool_cmdline.ml
src/tool/tool_cmdline.ml
+1
-1
src/tool/tool_election.ml
src/tool/tool_election.ml
+6
-6
src/web/web_site.ml
src/web/web_site.ml
+5
-5
src/web/web_templates.ml
src/web/web_templates.ml
+7
-7
No files found.
src/lib/common.ml
View file @
190bd86c
...
...
@@ -144,26 +144,32 @@ module String = struct
xn
>=
sn
&&
String
.
sub
x
0
sn
=
s
end
let
rec
list_join
sep
=
function
|
[]
->
[]
|
[
x
]
->
[
x
]
|
x
::
xs
->
x
::
sep
::
list_join
sep
xs
let
rec
list_filter_map
f
=
function
|
[]
->
[]
|
x
::
xs
->
let
ys
=
list_filter_map
f
xs
in
match
f
x
with
|
None
->
ys
|
Some
y
->
y
::
ys
let
option_get
x
default_value
=
match
x
with
|
None
->
default_value
|
Some
x
->
x
let
option_map
f
=
function
|
Some
x
->
Some
(
f
x
)
|
None
->
None
module
List
=
struct
include
List
let
rec
join
sep
=
function
|
[]
->
[]
|
[
x
]
->
[
x
]
|
x
::
xs
->
x
::
sep
::
join
sep
xs
let
rec
filter_map
f
=
function
|
[]
->
[]
|
x
::
xs
->
let
ys
=
filter_map
f
xs
in
match
f
x
with
|
None
->
ys
|
Some
y
->
y
::
ys
end
module
Option
=
struct
let
get
x
default_value
=
match
x
with
|
None
->
default_value
|
Some
x
->
x
let
map
f
=
function
|
Some
x
->
Some
(
f
x
)
|
None
->
None
end
let
save_to
filename
writer
x
=
let
oc
=
open_out
filename
in
...
...
src/lib/common.mli
View file @
190bd86c
...
...
@@ -48,11 +48,16 @@ module String : sig
val
startswith
:
string
->
string
->
bool
end
val
list_join
:
'
a
->
'
a
list
->
'
a
list
val
list_filter_map
:
(
'
a
->
'
b
option
)
->
'
a
list
->
'
b
list
module
List
:
sig
include
module
type
of
List
val
join
:
'
a
->
'
a
list
->
'
a
list
val
filter_map
:
(
'
a
->
'
b
option
)
->
'
a
list
->
'
b
list
end
val
option_get
:
'
a
option
->
'
a
->
'
a
val
option_map
:
(
'
a
->
'
b
)
->
'
a
option
->
'
b
option
module
Option
:
sig
val
get
:
'
a
option
->
'
a
->
'
a
val
map
:
(
'
a
->
'
b
)
->
'
a
option
->
'
b
option
end
val
save_to
:
string
->
(
Bi_outbuf
.
t
->
'
a
->
unit
)
->
'
a
->
unit
...
...
src/tool/tool_cmdline.ml
View file @
190bd86c
...
...
@@ -302,7 +302,7 @@ module Election : CMDLINER_MODULE = struct
let
get_public_keys
()
=
load_from_file
(
fun
x
->
x
)
(
X
.
dir
/
"public_keys.jsons"
)
|>
option_
map
Array
.
of_list
Option
.
map
Array
.
of_list
let
get_public_creds
()
=
let
file
=
"public_creds.txt"
in
...
...
src/tool/tool_election.ml
View file @
190bd86c
...
...
@@ -77,7 +77,7 @@ module Make (P : PARSED_PARAMS) : S = struct
let
public_keys_with_pok
=
match
threshold
with
|
None
->
get_public_keys
()
|>
option_
map
@@
get_public_keys
()
|>
Option
.
map
@@
Array
.
map
(
trustee_public_key_of_string
G
.
read
)
|
Some
t
->
Some
t
.
t_verification_keys
...
...
@@ -90,7 +90,7 @@ module Make (P : PARSED_PARAMS) : S = struct
|
_
->
()
let
public_keys
=
option_
map
(
Option
.
map
(
Array
.
map
(
fun
pk
->
pk
.
trustee_public_key
)
)
public_keys_with_pok
...
...
@@ -103,7 +103,7 @@ module Make (P : PARSED_PARAMS) : S = struct
module
GSet
=
Map
.
Make
(
G
)
let
public_creds
=
lazy
(
get_public_creds
()
|>
option_
map
(
fun
creds
->
get_public_creds
()
|>
Option
.
map
(
fun
creds
->
let
res
=
ref
GSet
.
empty
in
Stream
.
iter
(
fun
x
->
res
:=
GSet
.
add
(
G
.
of_string
x
)
false
!
res
)
creds
;
res
...
...
@@ -111,7 +111,7 @@ module Make (P : PARSED_PARAMS) : S = struct
)
let
ballots
=
lazy
(
get_ballots
()
|>
option_
map
(
fun
ballots
->
get_ballots
()
|>
Option
.
map
(
fun
ballots
->
let
res
=
ref
[]
in
Stream
.
iter
(
fun
x
->
res
:=
(
ballot_of_string
G
.
read
x
,
sha256_b64
x
)
::
!
res
...
...
@@ -140,7 +140,7 @@ module Make (P : PARSED_PARAMS) : S = struct
else
Printf
.
ksprintf
failwith
"ballot %s failed tests"
hash
let
ballots_check
=
lazy
(
Lazy
.
force
ballots
|>
option_
map
(
List
.
iter
cast
)
Lazy
.
force
ballots
|>
Option
.
map
(
List
.
iter
cast
)
)
let
encrypted_tally
=
...
...
@@ -156,7 +156,7 @@ module Make (P : PARSED_PARAMS) : S = struct
let
vote
privcred
ballot
=
let
sk
=
privcred
|>
option_
map
(
fun
cred
->
privcred
|>
Option
.
map
(
fun
cred
->
let
module
CD
=
Credential
.
MakeDerive
(
G
)
in
CD
.
derive
election
.
e_params
.
e_uuid
cred
)
...
...
src/web/web_site.ml
View file @
190bd86c
...
...
@@ -247,7 +247,7 @@ let validate_election uuid se =
(
match
metadata
.
e_auth_config
with
|
Some
[{
auth_system
=
"password"
;
_
}]
->
let
db
=
list_
filter_map
(
fun
v
->
List
.
filter_map
(
fun
v
->
let
_
,
login
=
split_identity
v
.
sv_id
in
match
v
.
sv_password
with
|
Some
(
salt
,
hashed
)
->
Some
[
login
;
salt
;
hashed
]
...
...
@@ -2117,17 +2117,17 @@ let extract_automatic_data_validated uuid_s =
match
state
with
|
`Open
|
`Closed
|
`EncryptedTally
_
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Validation
uuid
in
let
t
=
option_
get
t
default_validation_date
in
let
t
=
Option
.
get
t
default_validation_date
in
let
next_t
=
datetime_add
t
(
day
days_to_delete
)
in
return
@@
Some
(
`Delete
,
uuid
,
next_t
,
name
,
contact
)
|
`Tallied
_
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Tally
uuid
in
let
t
=
option_
get
t
default_tally_date
in
let
t
=
Option
.
get
t
default_tally_date
in
let
next_t
=
datetime_add
t
(
day
days_to_archive
)
in
return
@@
Some
(
`Archive
,
uuid
,
next_t
,
name
,
contact
)
|
`Archived
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Archive
uuid
in
let
t
=
option_
get
t
default_archive_date
in
let
t
=
Option
.
get
t
default_archive_date
in
let
next_t
=
datetime_add
t
(
day
days_to_delete
)
in
return
@@
Some
(
`Delete
,
uuid
,
next_t
,
name
,
contact
)
...
...
@@ -2146,7 +2146,7 @@ let get_next_actions_draft () =
let
name
=
se
.
se_questions
.
t_name
in
let
contact
=
se
.
se_metadata
.
e_contact
in
let
%
lwt
t
=
Web_persist
.
get_election_date
`Creation
uuid
in
let
t
=
option_
get
t
default_creation_date
in
let
t
=
Option
.
get
t
default_creation_date
in
let
next_t
=
datetime_add
t
(
day
days_to_delete
)
in
return
((
`Destroy
se
,
uuid
,
next_t
,
name
,
contact
)
::
accu
)
)
election_stable
[]
...
...
src/web/web_templates.ml
View file @
190bd86c
...
...
@@ -78,7 +78,7 @@ let make_login_box ~site auth links =
List
.
map
(
fun
name
->
a
~
a
:
[
a_id
(
"login_"
^
name
)]
~
service
:
(
L
.
login
(
Some
name
))
[
pcdata
name
]
()
)
|>
list_
join
(
pcdata
", "
)
)
|>
List
.
join
(
pcdata
", "
)
in
div
(
[
pcdata
"Log in: ["
]
@
auth_systems
@
[
pcdata
"]"
]
...
...
@@ -549,7 +549,7 @@ let election_draft uuid se () =
a
~
service
:
election_draft_confirm
[
pcdata
"Create election"
]
uuid
;
]
in
let
form_destroy
=
let
t
=
option_
get
se
.
se_creation_date
default_creation_date
in
let
t
=
Option
.
get
se
.
se_creation_date
default_creation_date
in
let
t
=
datetime_add
t
(
day
365
)
in
post_form
~
service
:
election_draft_destroy
...
...
@@ -1902,7 +1902,7 @@ let election_admin election metadata state get_tokens_decrypt () =
let
%
lwt
archive_date
=
match
state
with
|
`Tallied
_
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Tally
uuid
in
let
t
=
datetime_add
(
option_
get
t
default_tally_date
)
(
day
days_to_archive
)
in
let
t
=
datetime_add
(
Option
.
get
t
default_tally_date
)
(
day
days_to_archive
)
in
return
@@
div
[
pcdata
"This election will be automatically archived after "
;
...
...
@@ -1929,15 +1929,15 @@ let election_admin election metadata state get_tokens_decrypt () =
|
`Open
|
`Closed
|
`EncryptedTally
_
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Validation
uuid
in
let
dt
=
day
days_to_delete
in
return
@@
datetime_add
(
option_
get
t
default_validation_date
)
dt
return
@@
datetime_add
(
Option
.
get
t
default_validation_date
)
dt
|
`Tallied
_
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Tally
uuid
in
let
dt
=
day
(
days_to_archive
+
days_to_delete
)
in
return
@@
datetime_add
(
option_
get
t
default_tally_date
)
dt
return
@@
datetime_add
(
Option
.
get
t
default_tally_date
)
dt
|
`Archived
->
let
%
lwt
t
=
Web_persist
.
get_election_date
`Archive
uuid
in
let
dt
=
day
days_to_delete
in
return
@@
datetime_add
(
option_
get
t
default_archive_date
)
dt
return
@@
datetime_add
(
Option
.
get
t
default_archive_date
)
dt
in
let
div_delete
=
div
[
...
...
@@ -2416,7 +2416,7 @@ let login_choose auth_systems service () =
auth_systems
|>
List
.
map
(
fun
name
->
a
~
service
:
(
service
name
)
[
pcdata
name
]
()
)
|>
list_
join
(
pcdata
", "
)
)
|>
List
.
join
(
pcdata
", "
)
in
let
content
=
[
div
[
p
(
...
...
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