84 lines
2.7 KiB
OCaml
84 lines
2.7 KiB
OCaml
open Syntax
|
|
open Types
|
|
open Err
|
|
|
|
let get_post id =
|
|
let* opt = Db_post.find_post id in
|
|
match opt with None -> Error (Not_found_post id) | Some v -> Ok v
|
|
|
|
let get_thread id =
|
|
let* opt = Db_post.find_thread id in
|
|
match opt with None -> Error (Not_found_thread id) | Some v -> Ok v
|
|
|
|
let get_thread_w_reply id =
|
|
let* opt = Db_post.find_thread_w_reply id in
|
|
match opt with None -> Error (Not_found_thread id) | Some v -> Ok v
|
|
|
|
let get_catalog () = Db_post.get_catalog ()
|
|
|
|
(* todo id type is string here.. *)
|
|
let get_thumbnail_data id =
|
|
let* opt = Db_image.P.thumbnail_data id in
|
|
match opt with None -> Error (Not_found_image id) | Some image -> Ok image
|
|
|
|
let get_image_data id =
|
|
let* opt = Db_image.P.data id in
|
|
match opt with None -> Error (Not_found_image id) | Some image -> Ok image
|
|
|
|
let get_image_info id =
|
|
let* opt = Db_image.P.info id in
|
|
match opt with None -> Error (Not_found_image id) | Some image -> Ok image
|
|
|
|
let delete ~user id =
|
|
let* post = get_post id in
|
|
if user.user_is_admin || String.equal post.poster_id user.user_id then
|
|
Db_post.delete id
|
|
else Error Forbidden
|
|
|
|
let not_empty image_opt comment =
|
|
if Option.is_some image_opt || String.length comment <> 0 then Ok ()
|
|
else Error (Unprocessable "Your post must contain an image or a comment")
|
|
|
|
let build_image image_data =
|
|
match image_data with
|
|
| None -> Ok None
|
|
| Some (name_opt, alt, content) ->
|
|
let name = Option.value ~default:"" name_opt in
|
|
let+ image = Image.build ~name ~alt content in
|
|
Some image
|
|
|
|
let build_comment comment =
|
|
(* todo: move validation to Comment.parse *)
|
|
let* _comment = Validate_str.comment comment in
|
|
let+ comment =
|
|
Comment.of_string comment
|
|
|> Result.map_error (fun s -> Unprocessable (Fmt.str "comment: %s" s))
|
|
in
|
|
comment
|
|
|
|
let make_post ~comment ~image_data ~parent_thread user =
|
|
let* () = not_empty image_data comment in
|
|
let* thread_id =
|
|
match parent_thread.bump_status with
|
|
| Dead -> Error (Unprocessable "This thread is dead, you cannot reply.")
|
|
| Locked _rank ->
|
|
Error (Unprocessable "This thread is locked, you cannot reply.")
|
|
| Alive _rank -> Ok parent_thread.op.id
|
|
in
|
|
let* comment = build_comment comment in
|
|
let* image = build_image image_data in
|
|
let+ post = Db_post.add_post ~thread_id ~user ~image ~comment in
|
|
post
|
|
|
|
let make_thread ~comment ~image_data ~subject ~lat ~lng user =
|
|
let* () = not_empty image_data comment in
|
|
let* subject = Validate_str.subject subject in
|
|
let* () =
|
|
(* TODO latlng validation *)
|
|
let is_valid_latlng = true in
|
|
if is_valid_latlng then Ok () else Error (Unprocessable "Invalid coordinate")
|
|
in
|
|
let* comment = build_comment comment in
|
|
let* image = build_image image_data in
|
|
let+ thread = Db_post.add_thread ~subject ~lat ~lng ~user ~image ~comment in
|
|
thread
|