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
f2cadfe4
Commit
f2cadfe4
authored
Mar 21, 2015
by
Stephane Glondu
Browse files
Move election service handlers out of functor
parent
ef197a11
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/web/web_election.ml
View file @
f2cadfe4
...
...
@@ -275,46 +275,58 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
module
Register
(
X
:
EMPTY
)
:
ELECTION_HANDLERS
=
struct
open
Eliom_registration
let
()
=
Auth
.
configure
N
.
auth_config
let
login
service
()
=
let
scope
=
Eliom_common
.
default_session_scope
let
ballot
=
Eliom_reference
.
eref
~
scope
None
let
cast_confirmed
=
Eliom_reference
.
eref
~
scope
None
end
end
end
open
Eliom_registration
let
login
w
service
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
cont
=
Eliom_reference
.
get
Web_services
.
cont
in
Auth
.
Handlers
.
login
service
cont
()
W
.
Auth
.
Handlers
.
login
service
cont
()
let
logout
()
()
=
let
logout
w
()
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
cont
=
Eliom_reference
.
get
Web_services
.
cont
in
Auth
.
Handlers
.
logout
cont
()
W
.
Auth
.
Handlers
.
logout
cont
()
module
T
=
Web_templates
let
if_eligible
acl
f
()
x
=
let
if_eligible
w
acl
f
()
x
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
W
.
Auth
.
Services
.
get_user
()
in
if
acl
W
.
metadata
user
then
f
user
x
else
forbidden
()
let
scope
=
Eliom_common
.
default_session_scope
let
ballot
=
Eliom_reference
.
eref
~
scope
None
let
cast_confirmed
=
Eliom_reference
.
eref
~
scope
None
let
home
=
(
if_eligible
can_read
let
home
w
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
uuid
=
Uuidm
.
to_string
W
.
election
.
e_params
.
e_uuid
in
(
if_eligible
w
can_read
(
fun
user
()
->
Eliom_reference
.
unset
ballot
>>
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
let
cont
()
()
=
Redirection
.
send
(
Eliom_service
.
preapply
election_home
(
W
.
election
.
e_params
.
e_uuid
,
()
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
match_lwt
Eliom_reference
.
get
cast_confirmed
with
match_lwt
Eliom_reference
.
get
W
.
Z
.
cast_confirmed
with
|
Some
result
->
Eliom_reference
.
unset
cast_confirmed
>>
Eliom_reference
.
unset
W
.
Z
.
cast_confirmed
>>
T
.
cast_confirmed
(
module
W
)
~
result
()
>>=
Html5
.
send
|
None
->
lwt
state
=
Web_persist
.
get_election_state
uuid
in
...
...
@@ -322,7 +334,9 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let
admin
site_user
is_featured
=
let
admin
w
site_user
is_featured
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
uuid
=
Uuidm
.
to_string
W
.
election
.
e_params
.
e_uuid
in
(
fun
()
()
->
match
site_user
with
|
Some
u
when
W
.
metadata
.
e_owner
=
Some
u
->
...
...
@@ -335,7 +349,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
|
ESRaw
|
ESKeys
|
ESBallots
->
"application/json"
|
ESCreds
|
ESRecords
->
"text/plain"
let
handle_pseudo_file
u
f
site_user
=
let
handle_pseudo_file
w
u
f
site_user
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
()
=
if
f
=
ESRecords
then
(
match
site_user
with
...
...
@@ -346,7 +361,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let
content_type
=
content_type_of_file
f
in
File
.
send
~
content_type
(
W
.
dir
/
string_of_election_file
f
)
let
election_dir
site_user
=
let
election_dir
w
site_user
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
fun
f
()
->
let
cont
()
()
=
Redirection
.
send
...
...
@@ -355,10 +371,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
(
W
.
election
.
e_params
.
e_uuid
,
f
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
handle_pseudo_file
()
f
site_user
handle_pseudo_file
w
()
f
site_user
)
let
election_update_credential
site_user
=
let
election_update_credential
w
site_user
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
fun
()
()
->
match
site_user
with
|
Some
u
->
...
...
@@ -370,7 +387,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
|
_
->
forbidden
()
)
let
election_update_credential_post
site_user
=
let
election_update_credential_post
w
site_user
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
fun
()
(
old
,
new_
)
->
match
site_user
with
|
Some
u
->
...
...
@@ -387,10 +405,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
|
_
->
forbidden
()
)
let
election_vote
=
(
if_eligible
can_read
let
election_vote
w
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
if_eligible
w
can_read
(
fun
user
()
->
Eliom_reference
.
unset
ballot
>>
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
let
cont
()
()
=
Redirection
.
send
(
Eliom_service
.
preapply
...
...
@@ -407,11 +426,12 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let
election_cast_confirm
()
()
=
match_lwt
Eliom_reference
.
get
ballot
with
let
election_cast_confirm
w
()
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
match_lwt
Eliom_reference
.
get
W
.
Z
.
ballot
with
|
Some
the_ballot
->
begin
Eliom_reference
.
unset
ballot
>>
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
match_lwt
W
.
Auth
.
Services
.
get_user
()
with
|
Some
u
->
let
b
=
check_acl
W
.
metadata
.
e_voters
u
in
...
...
@@ -423,8 +443,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
return
(
`Valid
hash
)
with
Error
e
->
return
(
`Error
e
)
in
Eliom_reference
.
unset
ballot
>>
Eliom_reference
.
set
cast_confirmed
(
Some
result
)
>>
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
Eliom_reference
.
set
W
.
Z
.
cast_confirmed
(
Some
result
)
>>
Redirection
.
send
(
Eliom_service
.
preapply
election_home
(
W
.
election
.
e_params
.
e_uuid
,
()
))
...
...
@@ -433,12 +453,14 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
|
None
->
fail_http
404
let
ballot_received
user
hash
=
let
ballot_received
w
user
hash
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
can_vote
=
can_vote
W
.
metadata
user
in
T
.
cast_confirmation
(
module
W
)
~
can_vote
hash
()
let
election_cast
=
(
if_eligible
can_read
let
election_cast
w
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
if_eligible
w
can_read
(
fun
user
()
->
let
cont
()
()
=
Redirection
.
send
...
...
@@ -446,14 +468,15 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
election_cast
(
W
.
election
.
e_params
.
e_uuid
,
()
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
match_lwt
Eliom_reference
.
get
ballot
with
|
Some
b
->
ballot_received
user
(
sha256_b64
b
)
>>=
Html5
.
send
match_lwt
Eliom_reference
.
get
W
.
Z
.
ballot
with
|
Some
b
->
ballot_received
w
user
(
sha256_b64
b
)
>>=
Html5
.
send
|
None
->
T
.
cast_raw
(
module
W
)
()
>>=
Html5
.
send
)
)
let
election_cast_post
=
(
if_eligible
can_read
let
election_cast_post
w
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
if_eligible
w
can_read
(
fun
user
(
ballot_raw
,
ballot_file
)
->
lwt
the_ballot
=
match
ballot_raw
,
ballot_file
with
|
Some
ballot
,
None
->
return
ballot
...
...
@@ -468,7 +491,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
Web_services
.
election_cast
(
W
.
election
.
e_params
.
e_uuid
,
()
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
Eliom_reference
.
set
ballot
(
Some
the_ballot
)
>>
Eliom_reference
.
set
W
.
Z
.
ballot
(
Some
the_ballot
)
>>
match
user
with
|
None
->
Redirection
.
send
...
...
@@ -479,7 +502,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let
election_pretty_ballots
start
()
=
let
election_pretty_ballots
w
start
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
W
.
Auth
.
Services
.
get_user
()
in
if
can_read
W
.
metadata
user
then
(
lwt
res
,
_
=
...
...
@@ -492,7 +516,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
in
T
.
pretty_ballots
(
module
W
)
res
()
>>=
Html5
.
send
)
else
forbidden
()
let
election_pretty_ballot
hash
()
=
let
election_pretty_ballot
w
hash
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
W
.
Auth
.
Services
.
get_user
()
in
if
can_read
W
.
metadata
user
then
(
lwt
ballot
=
...
...
@@ -507,9 +532,3 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
String
.
send
(
b
,
"application/json"
)
>>=
(
fun
x
->
return
@@
cast_unknown_content_kind
x
)
)
else
forbidden
()
end
end
end
src/web/web_election.mli
View file @
f2cadfe4
...
...
@@ -40,3 +40,17 @@ module type REGISTRABLE = sig
end
module
Make
(
D
:
ELECTION_DATA
)
(
P
:
WEB_PARAMS
)
:
REGISTRABLE
val
login
:
(
module
WEB_ELECTION
)
->
string
option
->
unit
->
content
val
logout
:
(
module
WEB_ELECTION
)
->
unit
->
unit
->
content
val
home
:
(
module
WEB_ELECTION
)
->
unit
->
unit
->
content
val
admin
:
(
module
WEB_ELECTION
)
->
user
option
->
bool
->
unit
->
unit
->
content
val
election_dir
:
(
module
WEB_ELECTION
)
->
user
option
->
Web_common
.
election_file
->
unit
->
content
val
election_update_credential
:
(
module
WEB_ELECTION
)
->
user
option
->
unit
->
unit
->
content
val
election_update_credential_post
:
(
module
WEB_ELECTION
)
->
user
option
->
unit
->
string
*
string
->
content
val
election_vote
:
(
module
WEB_ELECTION
)
->
unit
->
unit
->
content
val
election_cast
:
(
module
WEB_ELECTION
)
->
unit
->
unit
->
content
val
election_cast_post
:
(
module
WEB_ELECTION
)
->
unit
->
string
option
*
Eliom_lib
.
file_info
option
->
content
val
election_cast_confirm
:
(
module
WEB_ELECTION
)
->
unit
->
unit
->
content
val
election_pretty_ballots
:
(
module
WEB_ELECTION
)
->
int
->
unit
->
content
val
election_pretty_ballot
:
(
module
WEB_ELECTION
)
->
string
->
unit
->
content
src/web/web_signatures.mli
View file @
f2cadfe4
...
...
@@ -64,20 +64,8 @@ type content =
module
type
ELECTION_HANDLERS
=
sig
val
login
:
string
option
->
unit
->
content
val
logout
:
unit
->
unit
->
content
val
home
:
unit
->
unit
->
content
val
admin
:
user
option
->
bool
->
unit
->
unit
->
content
val
election_dir
:
user
option
->
Web_common
.
election_file
->
unit
->
content
val
election_update_credential
:
user
option
->
unit
->
unit
->
content
val
election_update_credential_post
:
user
option
->
unit
->
string
*
string
->
content
val
election_vote
:
unit
->
unit
->
content
val
election_cast
:
unit
->
unit
->
content
val
election_cast_post
:
unit
->
string
option
*
Eliom_lib
.
file_info
option
->
content
val
election_cast_confirm
:
unit
->
unit
->
content
val
election_pretty_ballots
:
int
->
unit
->
content
val
election_pretty_ballot
:
string
->
unit
->
content
val
ballot
:
string
option
Eliom_reference
.
eref
val
cast_confirmed
:
[
`Error
of
Web_common
.
error
|
`Valid
of
string
]
option
Eliom_reference
.
eref
end
module
type
AUTH_HANDLERS_RAW
=
...
...
src/web/web_site.ml
View file @
f2cadfe4
...
...
@@ -670,8 +670,7 @@ let () =
(
fun
(
uuid
,
()
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
home
()
()
)
Web_election
.
home
w
()
()
)
let
()
=
Any
.
register
...
...
@@ -691,10 +690,9 @@ let () =
(
fun
(
uuid
,
()
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
Web_site_auth
.
get_user
()
in
lwt
is_featured
=
Web_persist
.
is_featured_election
uuid_s
in
W
.
Z
.
admin
user
is_featured
()
()
)
W
eb_election
.
admin
w
user
is_featured
()
()
)
let
()
=
Any
.
register
...
...
@@ -716,8 +714,7 @@ let () =
(
fun
((
uuid
,
()
)
,
service
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
login
service
()
)
Web_election
.
login
w
service
()
)
let
()
=
Any
.
register
...
...
@@ -725,8 +722,7 @@ let () =
(
fun
(
uuid
,
()
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
logout
()
()
)
Web_election
.
logout
w
()
()
)
let
()
=
Any
.
register
...
...
@@ -734,9 +730,8 @@ let () =
(
fun
(
uuid
,
()
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
Web_site_auth
.
get_user
()
in
W
.
Z
.
election_update_credential
user
()
()
)
W
eb_election
.
election_update_credential
w
user
()
()
)
let
()
=
Any
.
register
...
...
@@ -744,9 +739,8 @@ let () =
(
fun
(
uuid
,
()
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
Web_site_auth
.
get_user
()
in
W
.
Z
.
election_update_credential_post
user
()
x
)
W
eb_election
.
election_update_credential_post
w
user
()
x
)
let
()
=
Any
.
register
...
...
@@ -754,8 +748,7 @@ let () =
(
fun
(
uuid
,
()
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_vote
()
x
)
Web_election
.
election_vote
w
()
x
)
let
()
=
Any
.
register
...
...
@@ -763,8 +756,7 @@ let () =
(
fun
(
uuid
,
()
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_cast
()
x
)
Web_election
.
election_cast
w
()
x
)
let
()
=
Any
.
register
...
...
@@ -772,8 +764,7 @@ let () =
(
fun
(
uuid
,
()
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_cast_post
()
x
)
Web_election
.
election_cast_post
w
()
x
)
let
()
=
Any
.
register
...
...
@@ -781,8 +772,7 @@ let () =
(
fun
(
uuid
,
()
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_cast_confirm
()
x
)
Web_election
.
election_cast_confirm
w
()
x
)
let
()
=
Any
.
register
...
...
@@ -790,8 +780,7 @@ let () =
(
fun
((
uuid
,
()
)
,
start
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_pretty_ballots
start
()
)
Web_election
.
election_pretty_ballots
w
start
()
)
let
()
=
Any
.
register
...
...
@@ -799,8 +788,7 @@ let () =
(
fun
((
uuid
,
()
)
,
hash
)
()
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_pretty_ballot
hash
()
)
Web_election
.
election_pretty_ballot
w
hash
()
)
let
()
=
Any
.
register
...
...
@@ -808,6 +796,5 @@ let () =
(
fun
(
uuid
,
f
)
x
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
Web_site_auth
.
get_user
()
in
W
.
Z
.
election_dir
user
f
x
)
W
eb_election
.
election_dir
w
user
f
x
)
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