use let* in user.ml

src/babillard.ml

@@ -54,7 +54,7 @@ type post =
 let ( let** ) o f =
   match o with
   | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-  | Ok None -> Error (Format.sprintf "db error: value not found")
+  | Ok None -> Error "db error"
   | Ok (Some x) -> f x
 
 (* ('a, string) result *)

src/permap.ml

@@ -62,9 +62,19 @@ let login_post request =
     render_unsafe (Login.f ~nick ~password request) request
   | _ -> assert false
 
-let user request = render_unsafe (User.list ()) request
+let user request =
+  render_unsafe
+    ( match User.list () with
+    | Ok s -> s
+    | Error _ -> "" )
+    request
 
-let user_profile request = render_unsafe (User.public_profile request) request
+let user_profile request =
+  render_unsafe
+    ( match User.public_profile request with
+    | Ok s -> s
+    | Error e -> e )
+    request
 
 let logout request =
   let _ = Dream.invalidate_session request in
@@ -87,13 +97,13 @@ let profile_post request =
   | None -> render_unsafe "Not logged in" request
   | Some nick -> (
     match%lwt Dream.form request with
-    | `Ok [ ("bio", bio) ] ->
+    | `Ok [ ("bio", bio) ] -> (
-      let res =
+      match User.update_bio bio nick with
-        match User.update_bio bio nick with
+      | Ok () ->
-        | Ok () -> "Bio updated!"
+        Dream.respond ~status:`See_Other
-        | Error e -> e
+          ~headers:[ ("Location", "/profile") ]
-      in
+          "Your bio was updated!"
-      render_unsafe res request
+      | Error e -> render_unsafe e request )
     | `Ok _
     | `Many_tokens _
     | `Missing_token _
@@ -102,13 +112,13 @@ let profile_post request =
     | `Expired _
     | `Wrong_content_type -> (
       match%lwt Dream.multipart request with
-      | `Ok [ ("file", file) ] ->
+      | `Ok [ ("file", file) ] -> (
-        let res =
+        match User.upload_avatar file nick with
-          match User.upload_avatar file nick with
+        | Ok () ->
-          | Ok () -> "Avatar was uploaded!"
+          Dream.respond ~status:`See_Other
-          | Error e -> e
+            ~headers:[ ("Location", "/profile") ]
-        in
+            "Your avatar was updated!"
-        render_unsafe res request
+        | Error e -> render_unsafe e request )
       | `Ok _ -> Dream.empty `Bad_Request
       | `Expired _
       | `Many_tokens _
@@ -190,7 +200,7 @@ let newthread_post ~board request =
               Format.asprintf "/%a/%s" Babillard.pp_board board thread_id
             in
             Dream.respond ~status:`See_Other ~headers:[ ("Location", adress) ]
-              "Your thread was posted on the babillard!"
+              "Your thread was posted!"
           | Error e -> render_unsafe e request ) ) )
     | `Ok _ -> Dream.empty `Bad_Request
     | `Expired _
@@ -244,7 +254,7 @@ let reply_post request =
       | Ok post_id ->
         let adress = Format.sprintf "/babillard/%s#%s" parent_id post_id in
         Dream.respond ~status:`See_Other ~headers:[ ("Location", adress) ]
-          "Your thread was posted on the babillard!"
+          "Your reply was posted!"
       | Error e -> render_unsafe e request )
     | `Ok _ -> Dream.empty `Bad_Request
     | `Expired _

src/user.ml

@@ -8,6 +8,19 @@ type t =
   ; avatar : string
   }
 
+(* ('a option, string) result *)
+let ( let** ) o f =
+  match o with
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+  | Ok None -> Error "db error"
+  | Ok (Some x) -> f x
+
+(* ('a, string) result *)
+let ( let* ) o f =
+  match o with
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+  | Ok x -> f x
+
 module Q = struct
   let create_user_table =
     Caqti_request.exec Caqti_type.unit
@@ -71,21 +84,15 @@ let () =
     Dream.warning (fun log -> log "can't create table")
 
 let login ~nick ~password request =
-  let good_password = Db.find_opt Q.get_password nick in
+  let** good_password = Db.find_opt Q.get_password nick in
-  match good_password with
+  if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then
-  | Ok foo -> (
+    let _ =
-    match foo with
+      let%lwt () = Dream.invalidate_session request in
-    | Some good_password ->
+      Dream.put_session "nick" nick request
-      if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then
+    in
-        let _ =
+    Ok ()
-          let%lwt () = Dream.invalidate_session request in
+  else
-          Dream.put_session "nick" nick request
+    Error "wrong password"
-        in
-        Ok ()
-      else
-        Error "wrong password"
-    | None -> Error (Format.sprintf "user `%s` doesn't exist" nick) )
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
 let register ~email ~nick ~password =
   (* TODO: remove bad characters (e.g. delthas) *)
@@ -113,51 +120,32 @@ let register ~email ~nick ~password =
   if not valid then
     Error "Something is wrong"
   else
-    let unique = Db.find_opt Q.is_already_user (nick, email) in
+    let** nb = Db.find_opt Q.is_already_user (nick, email) in
-    match unique with
+    match nb with
-    | Ok unique -> (
+    | 0 ->
-      match unique with
+      let* () = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in
-      | Some nb -> (
+      Ok ()
-        match nb with
+    | _ -> Error "nick or email already exists"
-        | 0 -> (
-          let res =
-            Db.exec Q.inser_new_user (nick, password, email, ("", ""))
-          in
-          match res with
-          | Ok res -> Ok res
-          | Error e ->
-            Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
-        | _ -> Error "nick or email already exists" )
-      | None -> Error "db error" )
-    | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
 let list () =
-  let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in
+  let* users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in
-  match users with
+  Ok
-  | Ok users ->
+    (Format.asprintf "<ul>%a</ul>"
-    Format.asprintf "<ul>%a</ul>"
+       (Format.pp_print_list (fun fmt -> function
-      (Format.pp_print_list (fun fmt -> function
+          | s -> Format.fprintf fmt {|<li><a href="/user/%s">%s</a></li>|} s s )
-         | s -> Format.fprintf fmt {|<li><a href="/user/%s">%s</a></li>|} s s )
+       )
-      )
+       users )
-      users
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
 
 let public_profile request =
   let nick = Dream.param "user" request in
-  let user = Db.find_opt Q.get_user nick in
+  let** nick, password, email, (bio, _) = Db.find_opt Q.get_user nick in
-  match user with
+  let user_info =
-  | Ok user -> (
+    Format.sprintf
-    match user with
+      {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
-    | Some (nick, password, email, (bio, _)) ->
-      let user_info =
-        Format.sprintf
-          {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
     <img src="/user/%s/avatar" class="img-thumbnail" alt="Your avatar picture">|}
-          nick password email (Dream.html_escape bio) nick
+      nick password email (Dream.html_escape bio) nick
-      in
+  in
-      user_info
+  Ok user_info
-    | None -> "incoherent db answer" )
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
 
 let profile request =
   match Dream.session "nick" request with
@@ -170,42 +158,27 @@ let update_bio bio nick =
   if not valid then
     Error "Not biologic"
   else
-    let res = Db.exec Q.update_bio (bio, nick) in
+    let* () = Db.exec Q.update_bio (bio, nick) in
-    match res with
+    Ok ()
-    | Ok _ -> Ok ()
-    | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
 let get_bio nick =
-  let res = Db.find_opt Q.get_bio nick in
+  let** bio = Db.find_opt Q.get_bio nick in
-  match res with
+  Ok bio
-  | Ok bio -> (
-    match bio with
-    | Some bio -> Ok bio
-    | None -> Error "incoherent db result" )
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
 let get_avatar nick =
-  let res = Db.find_opt Q.get_avatar nick in
+  let** avatar = Db.find_opt Q.get_avatar nick in
-  match res with
+  if String.length avatar = 0 then
-  | Ok avatar -> (
+    Ok None
-    match avatar with
+  else
-    | Some avatar ->
+    Ok (Some avatar)
-      if String.length avatar = 0 then
-        Ok None
-      else
-        Ok (Some avatar)
-    | None -> Error "db error:" )
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
 let upload_avatar files nick =
   match files with
   | [] -> Error "No file provided"
-  | [ (_, content) ] -> (
+  | [ (_, content) ] ->
     if not (is_valid_image content) then
       Error "Invalid image"
     else
-      let res = Db.exec Q.upload_avatar (content, nick) in
+      let* () = Db.exec Q.upload_avatar (content, nick) in
-      match res with
+      Ok ()
-      | Ok _ -> Ok ()
-      | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
   | _files -> Error "More than one file provided"