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
6cde86d2
Commit
6cde86d2
authored
Mar 23, 2015
by
Stephane Glondu
Browse files
Move ballot and cast_confirmed to Web_services, drop WEB_ELECTION_
parent
fefc7315
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/web/web_election.ml
View file @
6cde86d2
...
...
@@ -33,8 +33,8 @@ open Web_services
let
(
/
)
=
Filename
.
concat
module
type
REGISTRATION
=
sig
module
W
:
WEB_ELECTION
_
module
Register
(
X
:
EMPTY
)
:
E
LECTION_HANDLERS
module
W
:
WEB_ELECTION
module
Register
(
X
:
EMPTY
)
:
E
MPTY
end
module
type
REGISTRABLE
=
sig
...
...
@@ -258,16 +258,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
module
Register
(
X
:
EMPTY
)
:
E
LECTION_HANDLERS
=
struct
module
Register
(
X
:
EMPTY
)
:
E
MPTY
=
struct
let
()
=
Auth
.
configure
N
.
auth_config
let
scope
=
Eliom_common
.
default_session_scope
let
ballot
=
Eliom_reference
.
eref
~
scope
None
let
cast_confirmed
=
Eliom_reference
.
eref
~
scope
None
end
end
...
...
src/web/web_election.mli
View file @
6cde86d2
...
...
@@ -26,8 +26,8 @@ open Web_serializable_t
open
Web_signatures
module
type
REGISTRATION
=
sig
module
W
:
WEB_ELECTION
_
module
Register
(
X
:
EMPTY
)
:
E
LECTION_HANDLERS
module
W
:
WEB_ELECTION
module
Register
(
X
:
EMPTY
)
:
E
MPTY
end
module
type
REGISTRABLE
=
sig
...
...
src/web/web_services.ml
View file @
6cde86d2
...
...
@@ -74,3 +74,9 @@ let scope = Eliom_common.default_session_scope
let
cont
:
(
unit
->
service_handler
)
Eliom_reference
.
eref
=
Eliom_reference
.
eref
~
scope
(
fun
()
()
->
Eliom_registration
.
Redirection
.
send
home
)
let
ballot
:
string
option
Eliom_reference
.
eref
=
Eliom_reference
.
eref
~
scope
None
let
cast_confirmed
:
[
`Error
of
Web_common
.
error
|
`Valid
of
string
]
option
Eliom_reference
.
eref
=
Eliom_reference
.
eref
~
scope
None
src/web/web_signatures.mli
View file @
6cde86d2
...
...
@@ -62,12 +62,6 @@ end
type
content
=
Eliom_registration
.
browser_content
Eliom_registration
.
kind
Lwt
.
t
module
type
ELECTION_HANDLERS
=
sig
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
=
sig
val
login
:
string
option
->
unit
->
content
...
...
@@ -110,7 +104,7 @@ module type WEB_PARAMS = sig
val
dir
:
string
end
module
type
WEB_ELECTION
_
=
sig
module
type
WEB_ELECTION
=
sig
include
ELECTION_DATA
include
WEB_PARAMS
module
E
:
ELECTION
with
type
elt
=
G
.
t
...
...
@@ -121,11 +115,6 @@ module type WEB_ELECTION_ = sig
end
end
module
type
WEB_ELECTION
=
sig
include
WEB_ELECTION_
module
Z
:
ELECTION_HANDLERS
end
type
election_files
=
{
f_election
:
string
;
f_metadata
:
string
;
...
...
src/web/web_site.ml
View file @
6cde86d2
...
...
@@ -93,11 +93,7 @@ let register_election params web_params =
(* starting from here, we do side-effects on the running server *)
let
module
R
=
R
.
Register
(
struct
end
)
in
let
module
W
=
R
.
W
in
let
module
X
:
ELECTION_HANDLERS
=
R
.
Register
(
T
)
in
let
module
W
=
struct
include
W
module
Z
=
X
end
in
let
module
X
:
EMPTY
=
R
.
Register
(
T
)
in
let
election
=
(
module
W
:
WEB_ELECTION
)
in
election_table
:=
SMap
.
add
uuid
election
!
election_table
;
election
...
...
@@ -698,16 +694,16 @@ let () =
let
uuid
=
Uuidm
.
to_string
W
.
election
.
e_params
.
e_uuid
in
(
if_eligible
w
can_read
(
fun
user
()
->
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
Eliom_reference
.
unset
W
eb_services
.
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
W
.
Z
.
cast_confirmed
with
match_lwt
Eliom_reference
.
get
W
eb_services
.
cast_confirmed
with
|
Some
result
->
Eliom_reference
.
unset
W
.
Z
.
cast_confirmed
>>
Eliom_reference
.
unset
W
eb_services
.
cast_confirmed
>>
T
.
cast_confirmed
(
module
W
)
~
result
()
>>=
Html5
.
send
|
None
->
lwt
state
=
Web_persist
.
get_election_state
uuid
in
...
...
@@ -826,7 +822,7 @@ let () =
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
(
if_eligible
w
can_read
(
fun
user
()
->
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
Eliom_reference
.
unset
W
eb_services
.
ballot
>>
let
cont
()
()
=
Redirection
.
send
(
Eliom_service
.
preapply
...
...
@@ -863,7 +859,7 @@ let () =
election_cast
(
W
.
election
.
e_params
.
e_uuid
,
()
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
match_lwt
Eliom_reference
.
get
W
.
Z
.
ballot
with
match_lwt
Eliom_reference
.
get
W
eb_services
.
ballot
with
|
Some
b
->
ballot_received
w
user
(
sha256_b64
b
)
>>=
Html5
.
send
|
None
->
T
.
cast_raw
(
module
W
)
()
>>=
Html5
.
send
)
...
...
@@ -891,7 +887,7 @@ let () =
Web_services
.
election_cast
(
W
.
election
.
e_params
.
e_uuid
,
()
))
in
Eliom_reference
.
set
Web_services
.
cont
cont
>>
Eliom_reference
.
set
W
.
Z
.
ballot
(
Some
the_ballot
)
>>
Eliom_reference
.
set
W
eb_services
.
ballot
(
Some
the_ballot
)
>>
match
user
with
|
None
->
Redirection
.
send
...
...
@@ -909,10 +905,10 @@ let () =
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
match_lwt
Eliom_reference
.
get
W
.
Z
.
ballot
with
match_lwt
Eliom_reference
.
get
W
eb_services
.
ballot
with
|
Some
the_ballot
->
begin
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
Eliom_reference
.
unset
W
eb_services
.
ballot
>>
match_lwt
W
.
Auth
.
Services
.
get_user
()
with
|
Some
u
->
let
b
=
check_acl
W
.
metadata
.
e_voters
u
in
...
...
@@ -924,8 +920,8 @@ let () =
return
(
`Valid
hash
)
with
Error
e
->
return
(
`Error
e
)
in
Eliom_reference
.
unset
W
.
Z
.
ballot
>>
Eliom_reference
.
set
W
.
Z
.
cast_confirmed
(
Some
result
)
>>
Eliom_reference
.
unset
W
eb_services
.
ballot
>>
Eliom_reference
.
set
W
eb_services
.
cast_confirmed
(
Some
result
)
>>
Redirection
.
send
(
Eliom_service
.
preapply
election_home
(
W
.
election
.
e_params
.
e_uuid
,
()
))
...
...
src/web/web_templates.ml
View file @
6cde86d2
...
...
@@ -497,7 +497,7 @@ let election_setup_trustee token uuid se () =
let
election_login_box
w
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
auth
=
(
module
W
.
Auth
.
Services
:
AUTH_SERVICES
)
in
let
module
L
=
struct
let
login
x
=
...
...
@@ -513,13 +513,13 @@ let election_login_box w =
fun
()
->
make_login_box
""
auth
links
let
file
w
x
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
Eliom_service
.
preapply
election_dir
(
W
.
election
.
e_params
.
e_uuid
,
x
)
let
election_home
w
state
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
W
.
Auth
.
Services
.
get_user
()
in
let
params
=
W
.
election
.
e_params
and
m
=
W
.
metadata
in
lwt
permissions
=
...
...
@@ -644,7 +644,7 @@ let election_home w state () =
base
~
title
:
params
.
e_name
~
login_box
~
content
~
footer
()
let
election_admin
w
~
is_featured
state
auth
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
title
=
W
.
election
.
e_params
.
e_name
^
" — Administration"
in
let
feature_form
=
post_form
~
service
:
election_set_featured
(
fun
featured
->
[
...
...
@@ -682,7 +682,7 @@ let election_admin w ~is_featured state auth () =
base
~
title
~
login_box
~
content
()
let
update_credential
w
auth
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
params
=
W
.
election
.
e_params
in
let
form
=
post_form
~
service
:
election_update_credential_post
(
fun
(
old
,
new_
)
->
...
...
@@ -723,7 +723,7 @@ let update_credential w auth () =
base
~
title
:
params
.
e_name
~
login_box
~
content
()
let
cast_raw
w
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
params
=
W
.
election
.
e_params
in
let
form_rawballot
=
post_form
~
service
:
election_cast_post
(
fun
(
name
,
_
)
->
...
...
@@ -756,7 +756,7 @@ let cast_raw w () =
base
~
title
:
params
.
e_name
~
login_box
~
content
()
let
cast_confirmation
w
~
can_vote
hash
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
lwt
user
=
W
.
Auth
.
Services
.
get_user
()
in
let
params
=
W
.
election
.
e_params
in
let
name
=
params
.
e_name
in
...
...
@@ -818,7 +818,7 @@ let cast_confirmation w ~can_vote hash () =
base
~
title
:
name
~
login_box
~
content
()
let
cast_confirmed
w
~
result
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
params
=
W
.
election
.
e_params
in
let
name
=
params
.
e_name
in
let
progress
=
div
~
a
:
[
a_style
"text-align:center;margin-bottom:20px;"
]
[
...
...
@@ -863,7 +863,7 @@ let cast_confirmed w ~result () =
base
~
title
:
name
~
login_box
~
content
()
let
pretty_ballots
w
hashes
()
=
let
module
W
=
(
val
w
:
WEB_ELECTION
_
)
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
let
params
=
W
.
election
.
e_params
in
let
title
=
params
.
e_name
^
" — Accepted ballots"
in
let
nballots
=
ref
0
in
...
...
src/web/web_templates.mli
View file @
6cde86d2
...
...
@@ -35,13 +35,13 @@ val election_setup_questions : Uuidm.t -> Web_common.setup_election -> (module A
val
election_setup_credentials
:
string
->
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_trustee
:
string
->
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_home
:
(
module
WEB_ELECTION
_
)
->
[
`Open
|
`Closed
]
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_admin
:
(
module
WEB_ELECTION
_
)
->
is_featured
:
bool
->
[
`Open
|
`Closed
]
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
update_credential
:
(
module
WEB_ELECTION
_
)
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_raw
:
(
module
WEB_ELECTION
_
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_confirmation
:
(
module
WEB_ELECTION
_
)
->
can_vote
:
bool
->
string
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_confirmed
:
(
module
WEB_ELECTION
_
)
->
result
:
[
<
`Error
of
Web_common
.
error
|
`Valid
of
string
]
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
pretty_ballots
:
(
module
WEB_ELECTION
_
)
->
string
list
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_home
:
(
module
WEB_ELECTION
)
->
[
`Open
|
`Closed
]
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_admin
:
(
module
WEB_ELECTION
)
->
is_featured
:
bool
->
[
`Open
|
`Closed
]
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
update_credential
:
(
module
WEB_ELECTION
)
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_raw
:
(
module
WEB_ELECTION
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_confirmation
:
(
module
WEB_ELECTION
)
->
can_vote
:
bool
->
string
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
cast_confirmed
:
(
module
WEB_ELECTION
)
->
result
:
[
<
`Error
of
Web_common
.
error
|
`Valid
of
string
]
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
pretty_ballots
:
(
module
WEB_ELECTION
)
->
string
list
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
dummy
:
service
:
(
unit
,
'
a
,
[
<
Eliom_service
.
post_service_kind
]
,
...
...
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