Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
version=0.26.1
version=0.28.1
parse-docstrings = false
break-cases = fit
break-collection-expressions = fit-or-vertical
break-fun-decl = wrap
Expand Down
5 changes: 3 additions & 2 deletions src/os_comet.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -41,12 +41,13 @@ let%client restart_process () =
Eliom_client.exit_to ~absolute:false
~service:(Eliom_service.static_dir ())
["index.html"] ()
else if (* If cookies do not work,
else if
(* If cookies do not work,
the failed comet is probably due to missing cookies.
In that case we do not restart. This happens for example
if cookies are deactivated of if the app is running in an iframe
and the browser forbids third party cookies. *)
cookies_enabled ()
cookies_enabled ()
then Eliom_client.exit_to ~service:Eliom_service.reload_action () ()

let%client _ =
Expand Down
26 changes: 16 additions & 10 deletions src/os_connect_phone.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@
*)

open%server Lwt.Syntax

type%shared sms_error_core = [`Unknown | `Send | `Limit | `Invalid_number]
type%shared sms_error = [`Ownership | sms_error_core]

Expand Down Expand Up @@ -100,8 +101,8 @@ let%server confirm_code myid code =
let%rpc confirm_code_extra myid (code : string) : bool Lwt.t =
confirm_code myid code

let%server confirm_code_signup_no_connect ~first_name ~last_name ~code ~password
()
let%server
confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ()
=
Lwt.bind (Eliom_reference.get activation_code_ref) (function
| Some (number, code', _) when code = code' ->
Expand All @@ -114,8 +115,13 @@ let%server confirm_code_signup_no_connect ~first_name ~last_name ~code ~password
Lwt.return_some userid
| _ -> Lwt.return_none)

let%rpc confirm_code_signup ~(first_name : string) ~(last_name : string)
~(code : string) ~(password : string) () : bool Lwt.t
let%rpc
confirm_code_signup
~(first_name : string)
~(last_name : string)
~(code : string)
~(password : string)
() : bool Lwt.t
=
Lwt.bind
(confirm_code_signup_no_connect ~first_name ~last_name ~code ~password ())
Expand All @@ -136,16 +142,16 @@ let%rpc confirm_code_recovery (code : string) : bool Lwt.t =
| _ -> Lwt.return_false)

let%rpc connect ~(keepmeloggedin : bool) ~(password : string) (number : string)
: [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set] Lwt.t
: [`Login_ok | `Wrong_password | `No_such_user | `Password_not_set] Lwt.t
=
Lwt.catch
(fun () ->
let* userid = Os_db.User.verify_password_phone ~password ~number in
let* () = Os_session.connect ~expire:(not keepmeloggedin) userid in
Lwt.return `Login_ok)
(function
| Os_db.Empty_password | Os_db.Wrong_password ->
Lwt.return `Wrong_password
| Os_db.No_such_user -> Lwt.return `No_such_user
| Os_db.Password_not_set -> Lwt.return `Password_not_set
| exc -> Lwt.reraise exc)
| Os_db.Empty_password | Os_db.Wrong_password ->
Lwt.return `Wrong_password
| Os_db.No_such_user -> Lwt.return `No_such_user
| Os_db.Password_not_set -> Lwt.return `Password_not_set
| exc -> Lwt.reraise exc)
36 changes: 22 additions & 14 deletions src/os_core_db.ml
Original file line number Diff line number Diff line change
Expand Up @@ -67,26 +67,35 @@ let connect () =
Lwt.catch
(fun () -> init h)
(fun exn ->
let* () = dispose h in
Lwt.fail exn)
let* () = dispose h in
Lwt.fail exn)
in
Lwt.return h
| None -> Lwt.return h

let validate db =
Lwt.catch
(fun () ->
let* () = Lwt_PGOCaml.ping db in
Lwt.return_true)
let* () = Lwt_PGOCaml.ping db in
Lwt.return_true)
(fun _ -> Lwt.return_false)

let pool : (string, bool) Hashtbl.t Lwt_PGOCaml.t Resource_pool.t ref =
ref @@ Resource_pool.create 16 ~validate ~dispose connect

let set_pool_size n = pool := Resource_pool.create n ~validate ~dispose connect

let init ?host ?port ?user ?password ?database ?unix_domain_socket_dir
?pool_size ?init () =
let init
?host
?port
?user
?password
?database
?unix_domain_socket_dir
?pool_size
?init
()
=
host_r := host;
port_r := port;
user_r := user;
Expand All @@ -98,11 +107,10 @@ let init ?host ?port ?user ?password ?database ?unix_domain_socket_dir

let connection_pool () = !pool

type wrapper = {
f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t;
}
type wrapper =
{f : 'a. PGOCaml.pa_pg_data PGOCaml.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t}

let connection_wrapper = ref { f = (fun _ f -> f ()) }
let connection_wrapper = ref {f = (fun _ f -> f ())}
let set_connection_wrapper f = connection_wrapper := f

let use_pool f =
Expand All @@ -128,10 +136,10 @@ let use_pool f =
let transaction_block db f =
Lwt.catch
(fun () ->
Lwt_PGOCaml.begin_work db >>= fun _ ->
let* r = f () in
let* () = Lwt_PGOCaml.commit db in
Lwt.return r)
Lwt_PGOCaml.begin_work db >>= fun _ ->
let* r = f () in
let* () = Lwt_PGOCaml.commit db in
Lwt.return r)
(function
| (Lwt_PGOCaml.Error _ | Lwt.Canceled | Unix.Unix_error _ | End_of_file)
as e ->
Expand Down
7 changes: 4 additions & 3 deletions src/os_date.eliom
Original file line number Diff line number Diff line change
Expand Up @@ -31,10 +31,11 @@ let%client timezone =
(* Use Intl API if available. Revert to using the time zone offset
otherwise. *)
match
if Js.Opt.test Js.Unsafe.global ##. Intl
&& Js.Opt.test Js.Unsafe.global ##. Intl ##. DateTimeFormat
if
Js.Opt.test Js.Unsafe.global##.Intl
&& Js.Opt.test Js.Unsafe.global##.Intl##.DateTimeFormat
then
let f = Js.Unsafe.global ##. Intl ## DateTimeFormat in
let f = Js.Unsafe.global##.Intl##DateTimeFormat in
if Js.Opt.test f##.resolvedOptions
then
let o = f##resolvedOptions in
Expand Down
Loading
Loading