Skip to content

Commit 1ecf98c

Browse files
FixissFixiss
committed
feat: add confirmation password on moodle account and add module for server_config
1 parent 0da0be2 commit 1ecf98c

File tree

6 files changed

+179
-61
lines changed

6 files changed

+179
-61
lines changed

‎src/app/learnocaml_upgrade_main.ml‎

Lines changed: 92 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,97 @@
66
* included LICENSE file for details. *)
77

88
open Js_utils
9+
open Lwt
910
open Learnocaml_common
11+
open Learnocaml_api
12+
13+
module El = struct
14+
let id s = s, find_component s
15+
module Login_overlay = struct
16+
let login_overlay_id, login_overlay = id "login-overlay"
17+
let login_new_id, login_new = id "login-new"
18+
19+
let upgrade_email_id, upgrade_email = id "upgrade-email-input"
20+
let upgrade_password_id, upgrade_password = id "upgrade-password-input"
21+
let upgrade_confirmation_id, upgrade_confirmation = id "upgrade-confirmation-input"
22+
let upgrade_button_id, upgrade_button = id "upgrade-button"
23+
end
24+
end
25+
26+
let check_email_js email =
27+
let re = Regexp.regexp Learnocaml_data.email_regexp_js in
28+
Learnocaml_data.email_check_length email
29+
&& match Regexp.string_match re email 0 with
30+
| Some _ -> true
31+
| None -> false
32+
33+
let init_token_dialog () =
34+
let open El.Login_overlay in
35+
Manip.SetCss.display login_overlay "block";
36+
let got_token = match Lwt.task () with
37+
|(_,got_tok) -> got_tok in
38+
let create_token () =
39+
let email = Manip.value upgrade_email and
40+
password = Manip.value upgrade_password and
41+
password_confirmation = Manip.value upgrade_confirmation in
42+
let email_criteria = not (check_email_js email) and
43+
passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and
44+
passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) and
45+
passwd_crit3 = not (password = password_confirmation) in
46+
Manip.SetCss.borderColor upgrade_email "";
47+
Manip.SetCss.borderColor upgrade_password "";
48+
Manip.SetCss.borderColor upgrade_confirmation "";
49+
if email_criteria || passwd_crit1 || passwd_crit2 || passwd_crit3 then
50+
begin
51+
if email_criteria then
52+
Manip.SetCss.borderColor upgrade_email "#f44";
53+
if passwd_crit1 || passwd_crit2 then
54+
Manip.SetCss.borderColor upgrade_password "#f44";
55+
if passwd_crit3 then
56+
Manip.SetCss.borderColor upgrade_confirmation "#f44";
57+
if email_criteria then begin
58+
cb_alert ~title:[%i"ERROR"]
59+
[%i"The entered e-mail was invalid."]
60+
(fun () -> Manip.focus upgrade_email)
61+
end
62+
else if passwd_crit1 then begin
63+
cb_alert ~title:[%i"ERROR"]
64+
[%i"Password must be at least 8 characters long"]
65+
(fun () -> Manip.focus upgrade_password)
66+
end
67+
else if passwd_crit2 then begin
68+
cb_alert ~title:[%i"ERROR"]
69+
[%i"Password must contain at least one digit, \
70+
one lower and upper letter, \
71+
and one non-alphanumeric char."]
72+
(fun () -> Manip.focus upgrade_password)
73+
end
74+
else if passwd_crit3 then begin
75+
cb_alert ~title:[%i"ERROR"]
76+
[%i"The password and its confirmation are not the same"]
77+
(fun () -> Manip.focus upgrade_confirmation)
78+
end;
79+
Lwt.return_none
80+
end
81+
else
82+
let token = Learnocaml_data.Token.to_string (Learnocaml_local_storage.(retrieve sync_token)) in
83+
retrieve (Learnocaml_api.Upgrade
84+
("email="^email^"&passwd="^password^"&token="^token))
85+
(*body exemple ->
86+
email=&passwd=&confirmation=&csrf=Bfkxd/2TjpMAkq4bFGIs1hp9oxeBTZIKioMlQMUDlpk=&token=ZGB-GDD-SNB-41M*)
87+
>>= fun _ -> cb_alert ~title:[%i"VALIDATION REQUIRED"]
88+
[%i"A confirmation e-mail has been sent to your address."]
89+
Js_utils.reload;
90+
Lwt.return_none
91+
in
92+
let handler f t = fun _ ->
93+
Lwt.async (fun () ->
94+
f () >|= function
95+
| Some token -> Lwt.wakeup got_token token
96+
| None -> ());
97+
t
98+
in
99+
Manip.Ev.onclick upgrade_button (handler create_token false)
10100

11101
let set_string_translations =
12102
List.iter
@@ -28,6 +118,7 @@ let () =
28118
"txt_upgrade_password_confirmation", [%i"Confirm password"];
29119
"txt_do_upgrade", [%i"Upgrade"];
30120
"txt_info", [%i"An e-mail will be sent to your address to confirm it."];
31-
]
121+
];
122+
init_token_dialog ()
32123
with Not_found ->
33124
Learnocaml_common.alert ~title:[%i"NO TOKEN"] [%i"You are not logged in"]

‎src/main/learnocaml_client.ml‎

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1089,6 +1089,33 @@ module Exercise_list = struct
10891089
Term.info ~man ~doc:doc "exercise-list"
10901090
end
10911091

1092+
module Server_config = struct
1093+
let doc = "Get a structured json containing an information about the use_password compatibility"
1094+
1095+
let server_config o = (*get_config_o ~allow_static:true o
1096+
>>= fun {ConfigFile.server;token} ->
1097+
fetch server (Learnocaml_api.Server_config)
1098+
>>= (fun index->
1099+
let open Json_encoding in
1100+
let ezjsonm = (Json_encoding.construct
1101+
(tup2 Exercise.Index.enc (assoc float))
1102+
index)
1103+
in
1104+
let json =
1105+
match ezjsonm with
1106+
| `O _ | `A _ as json -> json
1107+
| _ -> assert false
1108+
in
1109+
Ezjsonm.to_channel ~minify:false stdout json;*)
1110+
Lwt.return 0(**)
1111+
1112+
let man = man doc
1113+
1114+
let cmd =
1115+
use_global server_config,
1116+
Term.info ~man ~doc:doc "server-config"
1117+
end
1118+
10921119
module Main = struct
10931120
let man =
10941121
man
@@ -1111,7 +1138,8 @@ let () =
11111138
; Print_server.cmd
11121139
; Template.cmd
11131140
; Create_token.cmd
1114-
; Exercise_list.cmd]
1141+
; Exercise_list.cmd
1142+
; Server_config.cmd]
11151143
with
11161144
| exception Failure msg ->
11171145
Printf.eprintf "[ERROR] %s\n" msg;

‎src/server/learnocaml_server.ml‎

Lines changed: 16 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -935,39 +935,27 @@ module Request_handler = struct
935935
let params = Uri.query_of_encoded body
936936
|> List.map (fun (a, b) -> a, String.concat "," b) in
937937
let token = Token.parse @@ List.assoc "token" params in
938-
Token_index.UserIndex.emails_of_token !sync_dir token >>=
939-
(function
940-
| None ->
941-
let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make
942-
~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in
943-
let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and
944-
email = List.assoc "email" params and
945-
password = List.assoc "passwd" params and
946-
confirmation = List.assoc "confirmation" params in
947-
Token_index.UserIndex.exists !sync_dir email >>= fun exists ->
948-
if exists then lwt_fail (`Forbidden, "E-mail already used")
949-
else if not (Learnocaml_data.passwd_check_length password)
950-
|| not (Learnocaml_data.passwd_check_strength password)
951-
|| not (check_email_ml email)
952-
|| not (password = confirmation) then
953-
lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies }
954-
else
955-
let cookies = make_cookie ("token", Token.to_string token) :: cookies in
956-
Token_index.UserIndex.upgrade !sync_dir token email password >>= fun () ->
957-
Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle ->
958-
get_nickname token >>= fun nick ->
959-
Learnocaml_sendmail.confirm_email
960-
~nick
961-
~url:(req.Api.host ^ "/confirm/" ^ handle)
962-
email;
963-
lwt_ok @@ Redirect { code=`See_other; url="/"; cookies }
964-
| Some _ -> lwt_fail (`Forbidden, "Already an account."))
965-
938+
let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make
939+
~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in
940+
let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and
941+
email = List.assoc "email" params and
942+
password = List.assoc "passwd" params in
943+
let cookies = make_cookie ("token", Token.to_string token) :: cookies in
944+
Token_index.UserIndex.upgrade !sync_dir token email password >>= fun () ->
945+
Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle ->
946+
get_nickname token >>= fun nick ->
947+
Learnocaml_sendmail.confirm_email
948+
~nick
949+
~url:(req.Api.host ^ "/confirm/" ^ handle)
950+
email;
951+
lwt_ok @@ Redirect { code=`See_other; url="/"; cookies }
966952
| Api.Upgrade_form _ ->
967953
lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.")
968954
| Api.Upgrade _ ->
969955
lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.")
970956

957+
| Api.Server_config _ ->
958+
lwt_fail (`Forbidden, "pas encore fait")
971959
| Api.Invalid_request body ->
972960
lwt_fail (`Bad_request, body)
973961

‎src/state/learnocaml_api.ml‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -112,6 +112,8 @@ type _ request =
112112
string -> string request
113113
| Upgrade:
114114
string -> string request
115+
| Server_config:
116+
unit -> bool request
115117

116118
| Invalid_request:
117119
string -> string request
@@ -217,6 +219,8 @@ module Conversions (Json: JSON_CODEC) = struct
217219
| Upgrade_form _ -> str
218220
| Upgrade _ -> str
219221

222+
| Server_config () -> json J.bool
223+
220224
| Invalid_request _ ->
221225
str
222226

@@ -362,8 +366,11 @@ module Conversions (Json: JSON_CODEC) = struct
362366

363367
| Upgrade_form _ ->
364368
assert false (* Reserved for a link *)
365-
| Upgrade _ ->
366-
assert false (* Reserved for a form *)
369+
| Upgrade body ->
370+
post ["do_upgrade"] body
371+
372+
| Server_config () ->
373+
get ["get_server_config"]
367374

368375
| Invalid_request s ->
369376
failwith ("Error request "^s)
@@ -547,7 +554,10 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct
547554
| `POST body, ["upgrade"], _ ->
548555
Upgrade_form body |> k
549556
| `POST body, ["do_upgrade"], _ ->
550-
Upgrade body |> k
557+
Upgrade body |> k
558+
559+
| `GET, ["get_server_config"], _ ->
560+
Server_config () |> k
551561

552562
| `GET, ["teacher"; "exercise-status.json"], Some token
553563
when Token.is_teacher token ->

‎src/state/learnocaml_api.mli‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -126,6 +126,9 @@ type _ request =
126126
| Upgrade:
127127
string -> string request
128128

129+
| Server_config:
130+
unit -> bool request
131+
129132
| Invalid_request:
130133
string -> string request
131134
(** Only for server-side handling: bound to requests not matching any case

‎static/upgrade.html‎

Lines changed: 26 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -19,34 +19,32 @@
1919
</head>
2020
<body>
2121
<div id="login-overlay">
22-
<form method="post" action="/do_upgrade">
23-
<div id="login-new">
24-
<h4 id="txt_upgrade"><!-- Upgrade account --></h4>
25-
<div id="txt_info"><!-- An email will be sent to your address to confirm it. --></div>
26-
<div>
27-
<div id="txt_upgrade_email"><!-- Email address --></div>
28-
<div class="filler_h"></div>
29-
<input id="upgrade-email-input" name="email" type="email" minlength="5" autocomplete="off">
30-
</div>
31-
<div>
32-
<div id="txt_upgrade_password"><!-- Password --></div>
33-
<div class="filler_h"></div>
34-
<input id="upgrade-password-input" name="passwd" type="password" minlength="8">
35-
</div>
36-
<div>
37-
<div id="txt_upgrade_password_confirmation"><!-- Confirmation --></div>
38-
<div class="filler_h"></div>
39-
<input id="upgrade-confirmation-input" name="confirmation" type="password" minlength="8">
40-
</div>
41-
<ul>
42-
<li><div id="txt_password_length"><!-- remark 1 --></div></li>
43-
<li><div id="txt_password_strength"><!-- remark 2 --></div></li>
44-
</ul>
45-
<input type="hidden" name="csrf">
46-
<input id="input-token" type="hidden" name="token">
47-
<button id="upgrade-button"><span id="txt_do_upgrade"><!-- Upgrade --></span></button>
48-
</div>
49-
</form>
22+
<div id="login-new">
23+
<h4 id="txt_upgrade"><!-- Upgrade account --></h4>
24+
<div id="txt_info"><!-- An email will be sent to your address to confirm it. --></div>
25+
<div>
26+
<div id="txt_upgrade_email"><!-- Email address --></div>
27+
<div class="filler_h"></div>
28+
<input id="upgrade-email-input" name="email" type="email" minlength="5" autocomplete="off">
29+
</div>
30+
<div>
31+
<div id="txt_upgrade_password"><!-- Password --></div>
32+
<div class="filler_h"></div>
33+
<input id="upgrade-password-input" name="passwd" type="password" minlength="8">
34+
</div>
35+
<div>
36+
<div id="txt_upgrade_password_confirmation"><!-- Confirmation --></div>
37+
<div class="filler_h"></div>
38+
<input id="upgrade-confirmation-input" name="confirmation" type="password" minlength="8">
39+
</div>
40+
<ul>
41+
<li><div id="txt_password_length"><!-- remark 1 --></div></li>
42+
<li><div id="txt_password_strength"><!-- remark 2 --></div></li>
43+
</ul>
44+
<input type="hidden" name="csrf">
45+
<input id="input-token" type="hidden" name="token">
46+
<button id="upgrade-button"><span id="txt_do_upgrade"><!-- Upgrade --></span></button>
47+
</div>
5048
</div>
5149
</body>
5250
</html>

0 commit comments

Comments
 (0)