diff --git a/src/babillard.ml b/src/babillard.ml index 0fabd3f..acb9bc1 100644 --- a/src/babillard.ml +++ b/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 *) diff --git a/src/permap.ml b/src/permap.ml index 100557e..b85bd41 100644 --- a/src/permap.ml +++ b/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) ] -> - let res = - match User.update_bio bio nick with - | Ok () -> "Bio updated!" - | Error e -> e - in - render_unsafe res request + | `Ok [ ("bio", bio) ] -> ( + match User.update_bio bio nick with + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/profile") ] + "Your bio was updated!" + | 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) ] -> - let res = - match User.upload_avatar file nick with - | Ok () -> "Avatar was uploaded!" - | Error e -> e - in - render_unsafe res request + | `Ok [ ("file", file) ] -> ( + match User.upload_avatar file nick with + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/profile") ] + "Your avatar was updated!" + | 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 _ diff --git a/src/user.ml b/src/user.ml index 6dd8f8e..a6f453c 100644 --- a/src/user.ml +++ b/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 - match good_password with - | Ok foo -> ( - match foo with - | Some good_password -> - if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then - let _ = - let%lwt () = Dream.invalidate_session request in - Dream.put_session "nick" nick request - 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** good_password = Db.find_opt Q.get_password nick in + if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then + let _ = + let%lwt () = Dream.invalidate_session request in + Dream.put_session "nick" nick request + in + Ok () + else + Error "wrong password" 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 - match unique with - | Ok unique -> ( - match unique with - | Some nb -> ( - match nb with - | 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** nb = Db.find_opt Q.is_already_user (nick, email) in + match nb with + | 0 -> + let* () = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in + Ok () + | _ -> Error "nick or email already exists" let list () = - let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in - match users with - | Ok users -> - Format.asprintf "