1+ open Eio.Std
2+
13(* Ocsigen Start
24 * http://www.ocsigen.org/ocsigen-start
35 *
1820 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1921 *)
2022
21- open % server Lwt. Syntax
22-
2323type % shared sms_error_core = [`Unknown | `Send | `Limit | `Invalid_number ]
2424type % shared sms_error = [`Ownership | sms_error_core]
2525
@@ -46,112 +46,99 @@ let send_sms_handler =
4646 Printf. printf
4747 " INFO: send SMS %s to %s\n You have not defined an SMS handler.\n Please see Os_connect_phone.set_send_sms_handler\n %!"
4848 message number;
49- Lwt. return ( Error `Send )
49+ Error `Send
5050
5151let set_send_sms_handler = ( := ) send_sms_handler
5252
53- let send_sms ~number message : (unit, sms_error_core) result Lwt.t =
53+ let send_sms ~number message : (unit, sms_error_core) result =
5454 ! send_sms_handler ~number message
5555
5656let % server request_code reference number =
57- Lwt. catch
58- (fun () ->
59- let * attempt =
60- Lwt. bind (Eliom_reference. get reference) (function
61- | Some (_ , _ , attempt ) -> Lwt. return attempt
62- | None -> Lwt. return 0 )
63- in
64- if attempt < = 3
65- then
66- let attempt = attempt + 1 and code = activation_code () in
67- let * () =
68- Eliom_reference. set reference (Some (number, code, attempt))
69- in
70- Lwt. catch
71- (fun () -> (send_sms ~number code :> (unit , sms_error) result Lwt. t))
72- (fun _ -> Lwt. return (Error `Send ))
73- else Lwt. return (Error `Limit ))
74- (fun _ -> Lwt. return (Error `Unknown ))
57+ try
58+ let attempt =
59+ match Eliom_reference. get reference with
60+ | Some (_ , _ , attempt ) -> attempt
61+ | None -> 0
62+ in
63+ if attempt < = 3
64+ then
65+ let attempt = attempt + 1 and code = activation_code () in
66+ let () = Eliom_reference. set reference (Some (number, code, attempt)) in
67+ try (send_sms ~number code :> (unit , sms_error) result Promise. t)
68+ with _ -> Error `Send
69+ else Error `Limit
70+ with _ -> Error `Unknown
7571
7672let % server request_wrapper number f =
7773 if Re.Str. string_match Os_lib. phone_regexp number 0
7874 then f number
79- else Lwt. return ( Error `Invalid_number )
75+ else Error `Invalid_number
8076
81- let % rpc request_recovery_code (number : string ) : (unit , sms_error) result Lwt. t
82- =
77+ let % rpc request_recovery_code (number : string ) : (unit , sms_error) result =
8378 request_wrapper number @@ fun number ->
84- let * b = Os_db.Phone. exists number in
85- if not b
86- then Lwt. return (Error `Ownership )
87- else request_code recovery_code_ref number
79+ let b = Os_db.Phone. exists number in
80+ if not b then Error `Ownership else request_code recovery_code_ref number
8881
89- let % rpc request_code (number : string ) : (unit , sms_error) result Lwt. t =
82+ let % rpc request_code (number : string ) : (unit , sms_error) result =
9083 request_wrapper number @@ fun number ->
91- let * b = Os_db.Phone. exists number in
92- if b
93- then Lwt. return (Error `Ownership )
94- else request_code activation_code_ref number
84+ let b = Os_db.Phone. exists number in
85+ if b then Error `Ownership else request_code activation_code_ref number
9586
9687let % server confirm_code myid code =
97- Lwt. bind ( Eliom_reference. get activation_code_ref) ( function
98- | Some (number , code' , _ ) when code = code' -> Os_db.Phone. add myid number
99- | _ -> Lwt. return_false)
88+ match Eliom_reference. get activation_code_ref with
89+ | Some (number , code' , _ ) when code = code' -> Os_db.Phone. add myid number
90+ | _ -> false
10091
101- let % rpc confirm_code_extra myid (code : string ) : bool Lwt. t =
102- confirm_code myid code
92+ let % rpc confirm_code_extra myid (code : string ) : bool = confirm_code myid code
10393
10494let % server
10595 confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ()
10696 =
107- Lwt. bind ( Eliom_reference. get activation_code_ref) ( function
108- | Some (number , code' , _ ) when code = code' ->
109- let * () = Eliom_reference. set activation_code_ref None in
110- let * user =
111- Os_user. create ~password ~firstname: first_name ~lastname: last_name ()
112- in
113- let userid = Os_user. userid_of_user user in
114- let * _ = Os_db.Phone. add userid number in
115- Lwt. return_some userid
116- | _ -> Lwt. return_none)
97+ match Eliom_reference. get activation_code_ref with
98+ | Some (number , code' , _ ) when code = code' ->
99+ let () = Eliom_reference. set activation_code_ref None in
100+ let user =
101+ Os_user. create ~password ~firstname: first_name ~lastname: last_name ()
102+ in
103+ let userid = Os_user. userid_of_user user in
104+ let _ = Os_db.Phone. add userid number in
105+ Some userid
106+ | _ -> None
117107
118108let % rpc
119109 confirm_code_signup
120110 ~(first_name : string )
121111 ~(last_name : string )
122112 ~(code : string )
123113 ~(password : string )
124- () : bool Lwt. t
114+ () : bool
125115 =
126- Lwt. bind
127- (confirm_code_signup_no_connect ~first_name ~last_name ~code ~password () )
128- (function
129- | None -> Lwt. return_false
116+ match
117+ confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ()
118+ with
119+ | None -> false
120+ | Some userid ->
121+ let () = Os_session. connect userid in
122+ true
123+
124+ let % rpc confirm_code_recovery (code : string ) : bool =
125+ match Eliom_reference. get recovery_code_ref with
126+ | Some (number , code' , _ ) when code = code' -> (
127+ match Os_db.Phone. userid number with
130128 | Some userid ->
131- let * () = Os_session. connect userid in
132- Lwt. return_true)
133-
134- let % rpc confirm_code_recovery (code : string ) : bool Lwt. t =
135- Lwt. bind (Eliom_reference. get recovery_code_ref) (function
136- | Some (number , code' , _ ) when code = code' ->
137- Lwt. bind (Os_db.Phone. userid number) (function
138- | Some userid ->
139- let * () = Os_session. connect userid in
140- Lwt. return_true
141- | None -> Lwt. return_false)
142- | _ -> Lwt. return_false)
129+ let () = Os_session. connect userid in
130+ true
131+ | None -> false )
132+ | _ -> false
143133
144134let % rpc connect ~(keepmeloggedin : bool ) ~(password : string ) (number : string )
145- : [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set ] Lwt. t
135+ : [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set ]
146136 =
147- Lwt. catch
148- (fun () ->
149- let * userid = Os_db.User. verify_password_phone ~password ~number in
150- let * () = Os_session. connect ~expire: (not keepmeloggedin) userid in
151- Lwt. return `Login_ok )
152- (function
153- | Os_db. Empty_password | Os_db. Wrong_password ->
154- Lwt. return `Wrong_password
155- | Os_db. No_such_user -> Lwt. return `No_such_user
156- | Os_db. Password_not_set -> Lwt. return `Password_not_set
157- | exc -> Lwt. reraise exc)
137+ try
138+ let userid = Os_db.User. verify_password_phone ~password ~number in
139+ let () = Os_session. connect ~expire: (not keepmeloggedin) userid in
140+ `Login_ok
141+ with
142+ | Os_db. Empty_password | Os_db. Wrong_password -> `Wrong_password
143+ | Os_db. No_such_user -> `No_such_user
144+ | Os_db. Password_not_set -> `Password_not_set
0 commit comments