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
0
Merge Requests
0
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
325e4f4a
Commit
325e4f4a
authored
Nov 29, 2019
by
Stephane Glondu
Committed by
Stéphane Glondu
Nov 29, 2019
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use uuid instead of url as parameter to the booth
parent
2734d8d7
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
26 additions
and
31 deletions
+26
-31
src/tool/tool_js_booth.ml
src/tool/tool_js_booth.ml
+20
-14
src/web/web_templates.ml
src/web/web_templates.ml
+6
-17
No files found.
src/tool/tool_js_booth.ml
View file @
325e4f4a
...
...
@@ -315,28 +315,34 @@ let get_prefix str =
let
n
=
String
.
length
str
in
if
n
>=
4
then
String
.
sub
str
0
(
n
-
4
)
else
str
let
get_u
rl
x
=
let
get_u
uid
x
=
let
n
=
String
.
length
x
in
if
n
<=
1
||
String
.
sub
x
0
1
<>
"#"
then
None
else
let
args
=
Url
.
decode_arguments
(
String
.
sub
x
1
(
n
-
1
))
in
List
.
assoc_opt
"u
rl
"
args
List
.
assoc_opt
"u
uid
"
args
let
load_u
rl
url
=
let
load_u
uid
uuid
=
let
open
Lwt_xmlHttpRequest
in
Lwt
.
async
(
fun
()
->
let
%
lwt
raw
=
get
(
url
^
"election.json"
)
in
let
()
=
set_textarea
"election_params"
raw
.
content
in
let
%
lwt
raw
=
let
%
lwt
x
=
Printf
.
ksprintf
get
"elections/%s/election.json"
uuid
in
if
x
.
code
=
404
then
(
let
%
lwt
x
=
Printf
.
ksprintf
get
"draft/preview/%s/election.json"
uuid
in
Lwt
.
return
x
.
content
)
else
Lwt
.
return
x
.
content
in
let
()
=
set_textarea
"election_params"
raw
in
Lwt
.
return
(
run_handler
loadElection
()
)
)
let
load_u
rl
_handler
_
=
(
match
get_textarea_opt
"u
rl
"
with
|
Some
u
rl
->
let
encoded
=
Url
.
encode_arguments
[
"u
rl"
,
url
]
in
let
load_u
uid
_handler
_
=
(
match
get_textarea_opt
"u
uid
"
with
|
Some
u
uid
->
let
encoded
=
Url
.
encode_arguments
[
"u
uid"
,
uuid
]
in
Dom_html
.
window
##.
location
##.
hash
:=
Js
.
string
encoded
;
load_u
rl
url
load_u
uid
uuid
|
None
->
()
);
Js
.
_false
...
...
@@ -351,19 +357,19 @@ let load_params_handler _ =
let
onload_handler
_
=
let
()
=
document
##
getElementById
(
Js
.
string
"load_u
rl
"
)
>>==
fun
e
->
e
##.
onclick
:=
Dom_html
.
handler
load_u
rl
_handler
document
##
getElementById
(
Js
.
string
"load_u
uid
"
)
>>==
fun
e
->
e
##.
onclick
:=
Dom_html
.
handler
load_u
uid
_handler
in
let
()
=
document
##
getElementById
(
Js
.
string
"load_params"
)
>>==
fun
e
->
e
##.
onclick
:=
Dom_html
.
handler
load_params_handler
;
in
let
()
=
match
get_u
rl
(
Js
.
to_string
Dom_html
.
window
##.
location
##.
hash
)
with
match
get_u
uid
(
Js
.
to_string
Dom_html
.
window
##.
location
##.
hash
)
with
|
None
->
set_element_display
"wait_div"
"none"
;
set_element_display
"election_loader"
"block"
;
|
Some
u
rl
->
load_url
url
|
Some
u
uid
->
load_uuid
uuid
in
Js
.
_false
let
()
=
Dom_html
.
window
##.
onload
:=
Dom_html
.
handler
onload_handler
src/web/web_templates.ml
View file @
325e4f4a
...
...
@@ -362,13 +362,7 @@ let election_draft_pre () =
base
~
title
~
login_box
~
content
()
let
preview_booth
uuid
=
let
url
=
Eliom_uri
.
make_string_uri
~
service
:
election_draft_preview
~
absolute
:
true
(
uuid
,
()
)
|>
rewrite_prefix
|>
(
fun
x
->
Filename
.
chop_suffix
x
"election.json"
)
in
let
hash
=
Netencoding
.
Url
.
mk_url_encoded_parameters
[
"url"
,
url
]
in
let
hash
=
Netencoding
.
Url
.
mk_url_encoded_parameters
[
"uuid"
,
raw_string_of_uuid
uuid
]
in
let
service
=
Eliom_uri
.
make_string_uri
~
service
:
election_vote
~
absolute
:
true
()
|>
rewrite_prefix
...
...
@@ -1730,12 +1724,7 @@ let election_home election state () =
in
div
~
a
:
[
a_style
"text-align:center;"
]
[
div
[
let
url
=
Eliom_uri
.
make_string_uri
~
service
:
election_home
~
absolute
:
true
(
uuid
,
()
)
|>
rewrite_prefix
in
let
hash
=
Netencoding
.
Url
.
mk_url_encoded_parameters
[
"url"
,
url
]
in
let
hash
=
Netencoding
.
Url
.
mk_url_encoded_parameters
[
"uuid"
,
raw_string_of_uuid
uuid
]
in
make_button
~
service
:
election_vote
~
hash
~
disabled
L
.
start
;
];
div
[
...
...
@@ -2869,11 +2858,11 @@ let booth () =
div
~
a
:
[
a_id
"election_loader"
;
a_style
"display:none;"
]
[
h1
[
pcdata
L
.
belenios_booth
];
br
()
;
pcdata
"Load an election
by giving its URL
:"
;
div
[
unsafe_textarea
"u
rl
"
""
];
div
[
button_no_value
~
button_type
:
`Button
~
a
:
[
a_id
"load_u
rl"
]
[
pcdata
"Load URL
"
]];
pcdata
"Load an election
on this server by giving its UUID
:"
;
div
[
unsafe_textarea
"u
uid
"
""
];
div
[
button_no_value
~
button_type
:
`Button
~
a
:
[
a_id
"load_u
uid"
]
[
pcdata
"Load from UUID
"
]];
br
()
;
pcdata
"Load an election by giving its parameters:"
;
pcdata
"Load an
y
election by giving its parameters:"
;
div
[
unsafe_textarea
"election_params"
""
];
div
[
button_no_value
~
button_type
:
`Button
~
a
:
[
a_id
"load_params"
]
[
pcdata
"Load parameters"
]];
]
...
...
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