put all image stuff in image.ml, make thumbnail for avatars
This commit is contained in:
parent
7ad84cc1ab
commit
eed9af951c
7 changed files with 240 additions and 186 deletions
|
|
@ -88,3 +88,5 @@ let get_dirs name =
|
|||
let admins = get_dirs "admin"
|
||||
|
||||
let categories = List.sort_uniq compare (get_dirs "category")
|
||||
|
||||
let random_state = Random.State.make_self_init ()
|
||||
|
|
|
|||
106
src/babillard.ml
106
src/babillard.ml
|
|
@ -36,13 +36,6 @@ type post =
|
|||
; citations : string list
|
||||
}
|
||||
|
||||
type image =
|
||||
{ name : string
|
||||
; alt : string
|
||||
; content : string
|
||||
; thumbnail : string
|
||||
}
|
||||
|
||||
type t =
|
||||
| Op of thread_data * post
|
||||
| Post of post
|
||||
|
|
@ -90,22 +83,6 @@ module Q = struct
|
|||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_image_info_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
|
||||
image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE);"
|
||||
|
||||
let create_image_content_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_image_thumbnail_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_post_tags_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
||||
|
|
@ -146,21 +123,6 @@ module Q = struct
|
|||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO thread_post VALUES (?,?);"
|
||||
|
||||
let upload_image_info =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup3 string string string)
|
||||
"INSERT INTO image_info VALUES (?,?,?);"
|
||||
|
||||
let upload_image_content =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_content VALUES (?,?);"
|
||||
|
||||
let upload_image_thumbnail =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_thumbnail VALUES (?,?);"
|
||||
|
||||
let upload_post_reply =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
|
|
@ -189,19 +151,6 @@ module Q = struct
|
|||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT comment FROM post_comment WHERE post_id=?;"
|
||||
|
||||
let get_post_image_content =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_content WHERE post_id=?;"
|
||||
|
||||
let get_post_image_thumbnail =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_thumbnail WHERE post_id=?;"
|
||||
|
||||
let get_post_image_info =
|
||||
Caqti_request.find_opt Caqti_type.string
|
||||
Caqti_type.(tup2 string string)
|
||||
"SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
|
||||
|
||||
let get_post_tags =
|
||||
Caqti_request.collect Caqti_type.string Caqti_type.string
|
||||
"SELECT tag FROM post_tags WHERE post_id=?;"
|
||||
|
|
@ -261,9 +210,6 @@ let () =
|
|||
; Q.create_post_citations_table
|
||||
; Q.create_post_date_table
|
||||
; Q.create_post_comment_table
|
||||
; Q.create_image_info_table
|
||||
; Q.create_image_content_table
|
||||
; Q.create_image_thumbnail_table
|
||||
; Q.create_post_tags_table
|
||||
; Q.create_report_table
|
||||
|]
|
||||
|
|
@ -273,28 +219,6 @@ let () =
|
|||
(Array.map (fun query -> Db.exec query ()) tables)
|
||||
then Dream.error (fun log -> log "can't create babillard's tables")
|
||||
|
||||
let make_thumbnail content =
|
||||
let open Bos in
|
||||
(* jpp *)
|
||||
let ( let* ) o f =
|
||||
Result.fold ~ok:f ~error:(function `Msg s -> Result.error s) o
|
||||
in
|
||||
|
||||
let* image_file = OS.File.tmp "%s" in
|
||||
let* thumb_file = OS.File.tmp "%s_thumb" in
|
||||
let* () = OS.File.write image_file content in
|
||||
let cmd =
|
||||
Cmd.(
|
||||
v "convert" % "-define" % "jpeg:size=700x700" % p image_file
|
||||
% "-auto-orient" % "-thumbnail" % "300x300>" % "-unsharp" % "0x.5"
|
||||
% "-format" % "jpg" % p thumb_file)
|
||||
in
|
||||
let* () = OS.Cmd.run cmd in
|
||||
let* thumbnail = OS.File.read thumb_file in
|
||||
let* () = OS.File.delete image_file in
|
||||
let* () = OS.File.delete thumb_file in
|
||||
Ok thumbnail
|
||||
|
||||
(*TODO switch to markdown !*)
|
||||
(* insert html into the comment, and keep tracks of citations :
|
||||
-wraps lines starting with ">" with a <span class="quote">
|
||||
|
|
@ -354,24 +278,14 @@ let upload_post ~image post =
|
|||
| Op (thread_data, reply) -> (Some thread_data, reply)
|
||||
| Post reply -> (None, reply)
|
||||
in
|
||||
let { id; parent_id; date; user_id; comment; image_info; tags; citations; _ }
|
||||
=
|
||||
reply
|
||||
in
|
||||
let { id; parent_id; date; user_id; comment; tags; citations; _ } = reply in
|
||||
|
||||
let^ () = Db.exec Q.upload_post_id (id, user_id) in
|
||||
let^ () = Db.exec Q.upload_post_comment (id, comment) in
|
||||
let^ () = Db.exec Q.upload_post_date (id, date) in
|
||||
let^ () = Db.exec Q.upload_thread_post (parent_id, id) in
|
||||
let* () =
|
||||
match image with
|
||||
| None -> Ok ()
|
||||
| Some image ->
|
||||
assert (Option.is_some image_info);
|
||||
let^ () = Db.exec Q.upload_image_info (id, image.name, image.alt) in
|
||||
let^ () = Db.exec Q.upload_image_content (id, image.content) in
|
||||
let^ () = Db.exec Q.upload_image_thumbnail (id, image.thumbnail) in
|
||||
Ok ()
|
||||
match image with None -> Ok () | Some image -> Image.upload image id
|
||||
in
|
||||
let^ _unit_list =
|
||||
unwrap_list (fun tag -> Db.exec Q.upload_post_tag (id, tag)) tags
|
||||
|
|
@ -389,7 +303,7 @@ let upload_post ~image post =
|
|||
|
||||
let build_reply ~comment ~image_info ~tag_list ?parent_id user_id =
|
||||
let comment = Dream.html_escape comment in
|
||||
let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
||||
let id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
|
||||
(* parent_id is None if this reply is supposed to be a new thread *)
|
||||
let parent_id = Option.value parent_id ~default:id in
|
||||
if Option.is_none (Uuidm.of_string parent_id) then Error "invalid thread id"
|
||||
|
|
@ -443,9 +357,7 @@ let build_op ~comment ~image_info ~tag_list ~categories ~subject ~lat ~lng
|
|||
Ok op
|
||||
|
||||
let build_image image_input =
|
||||
let* name, alt, content = clean_image image_input in
|
||||
let* thumbnail = make_thumbnail content in
|
||||
let image = { name; alt; content; thumbnail } in
|
||||
let* image = Image.make_image image_input in
|
||||
Ok image
|
||||
|
||||
let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
|
||||
|
|
@ -473,14 +385,6 @@ let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
|
|||
in
|
||||
upload_post ~image post
|
||||
|
||||
let get_post_image_content id =
|
||||
let^? content = Db.find_opt Q.get_post_image_content id in
|
||||
Ok content
|
||||
|
||||
let get_post_image_thumbnail id =
|
||||
let^? content = Db.find_opt Q.get_post_image_thumbnail id in
|
||||
Ok content
|
||||
|
||||
let thread_exist id = Result.is_ok (Db.find Q.get_is_thread id)
|
||||
|
||||
(* true if post is an op too *)
|
||||
|
|
@ -492,7 +396,7 @@ let get_post id =
|
|||
let* nick = User.get_nick user_id in
|
||||
let^ comment = Db.find Q.get_post_comment id in
|
||||
let^ date = Db.find Q.get_post_date id in
|
||||
let^ image_info = Db.find_opt Q.get_post_image_info id in
|
||||
let* image_info = Image.get_info id in
|
||||
|
||||
let^ tags = Db.collect_list Q.get_post_tags id in
|
||||
let^ replies = Db.collect_list Q.get_post_replies id in
|
||||
|
|
|
|||
38
src/db.ml
38
src/db.ml
|
|
@ -11,8 +11,6 @@ let db = Filename.concat db_root "permap.db"
|
|||
|
||||
let db_uri = Format.sprintf "sqlite3://%s" db
|
||||
|
||||
let random_state = Random.State.make_self_init ()
|
||||
|
||||
module Db =
|
||||
(val Caqti_blocking.connect (Uri.of_string db_uri) |> Caqti_blocking.or_fail)
|
||||
|
||||
|
|
@ -34,39 +32,3 @@ let () =
|
|||
| Error _e ->
|
||||
Format.eprintf "db error@\n";
|
||||
exit 1
|
||||
|
||||
let mime =
|
||||
let database = Conan.Process.database ~tree:Conan_light.tree in
|
||||
fun content ->
|
||||
match Conan_string.run ~database content with
|
||||
| Ok m -> Conan.Metadata.mime m
|
||||
| Error _ -> None
|
||||
|
||||
let clean_image image =
|
||||
let max_name = 1000 in
|
||||
let max_alt = 3000 in
|
||||
let max_content = 4200000 in
|
||||
|
||||
let name, alt, content = image in
|
||||
let name =
|
||||
match name with
|
||||
| Some name -> Dream.html_escape name
|
||||
| None ->
|
||||
(* make up random name if no name was given *)
|
||||
Uuidm.to_string (Uuidm.v4_gen random_state ())
|
||||
in
|
||||
let alt = if String.trim alt = "" then name else alt in
|
||||
if String.length name > max_name then
|
||||
Error (Format.sprintf "Image name too long: More than %dB" max_name)
|
||||
else if String.length alt > max_alt then
|
||||
Error (Format.sprintf "Image description too long: More than %dB" max_alt)
|
||||
else if String.length content > max_content then
|
||||
Error (Format.sprintf "Image size too big: More than %dB" max_content)
|
||||
else
|
||||
match mime content with
|
||||
| None -> Error "invalid image type"
|
||||
| Some mime -> (
|
||||
match mime with
|
||||
| "image/jpeg" | "image/png" | "image/webp" -> Ok (name, alt, content)
|
||||
| _unsupported_mime_type ->
|
||||
Error (Format.sprintf "unsupported image type: %s" mime) )
|
||||
|
|
|
|||
1
src/dune
1
src/dune
|
|
@ -9,6 +9,7 @@
|
|||
db
|
||||
delete_page
|
||||
discuss
|
||||
image
|
||||
login
|
||||
permap
|
||||
pp_babillard
|
||||
|
|
|
|||
200
src/image.ml
Normal file
200
src/image.ml
Normal file
|
|
@ -0,0 +1,200 @@
|
|||
open Syntax
|
||||
open Db
|
||||
|
||||
type t =
|
||||
{ name : string
|
||||
; alt : string
|
||||
; content : string
|
||||
; thumbnail : string
|
||||
}
|
||||
|
||||
module Q = struct
|
||||
let create_info_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
|
||||
image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
|
||||
DELETE CASCADE);"
|
||||
|
||||
let create_content_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_thumbnail_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
|
||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
|
||||
|
||||
let upload_info =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup3 string string string)
|
||||
"INSERT INTO image_info VALUES (?,?,?);"
|
||||
|
||||
let upload_content =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_content VALUES (?,?);"
|
||||
|
||||
let upload_thumbnail =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO image_thumbnail VALUES (?,?);"
|
||||
|
||||
let get_post_content =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_content WHERE post_id=?;"
|
||||
|
||||
let get_post_thumbnail =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM image_thumbnail WHERE post_id=?;"
|
||||
|
||||
let get_post_info =
|
||||
Caqti_request.find_opt Caqti_type.string
|
||||
Caqti_type.(tup2 string string)
|
||||
"SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
|
||||
|
||||
(*avatars*)
|
||||
let create_user_content_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS user_image_content (user_id TEXT, content \
|
||||
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);"
|
||||
|
||||
let create_user_thumbnail_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS user_image_thumbnail (user_id TEXT, content \
|
||||
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);"
|
||||
|
||||
let upload_user_content =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO user_image_content VALUES (?,?);"
|
||||
|
||||
let upload_user_thumbnail =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"INSERT INTO user_image_thumbnail VALUES (?,?);"
|
||||
|
||||
let get_user_content =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM user_image_content WHERE user_id=?;"
|
||||
|
||||
let get_user_thumbnail =
|
||||
Caqti_request.find_opt Caqti_type.string Caqti_type.string
|
||||
"SELECT content FROM user_image_thumbnail WHERE user_id=?;"
|
||||
|
||||
let delete_user_content =
|
||||
Caqti_request.exec Caqti_type.string
|
||||
"DELETE FROM user_image_content WHERE user_id=?;"
|
||||
|
||||
let delete_user_thumbnail =
|
||||
Caqti_request.exec Caqti_type.string
|
||||
"DELETE FROM user_image_thumbnail WHERE user_id=?;"
|
||||
end
|
||||
|
||||
let () =
|
||||
let tables =
|
||||
[| Q.create_info_table
|
||||
; Q.create_content_table
|
||||
; Q.create_thumbnail_table
|
||||
; Q.create_user_content_table
|
||||
; Q.create_user_thumbnail_table
|
||||
|]
|
||||
in
|
||||
if
|
||||
Array.exists Result.is_error
|
||||
(Array.map (fun query -> Db.exec query ()) tables)
|
||||
then Dream.error (fun log -> log "can't create images tables")
|
||||
|
||||
let upload image id =
|
||||
let^ () = Db.exec Q.upload_info (id, image.name, image.alt) in
|
||||
let^ () = Db.exec Q.upload_content (id, image.content) in
|
||||
let^ () = Db.exec Q.upload_thumbnail (id, image.thumbnail) in
|
||||
Ok ()
|
||||
|
||||
let get_content id =
|
||||
let^ content = Db.find_opt Q.get_post_content id in
|
||||
Ok content
|
||||
|
||||
let get_thumbnail id =
|
||||
let^ thumbnail = Db.find_opt Q.get_post_thumbnail id in
|
||||
Ok thumbnail
|
||||
|
||||
let get_info id =
|
||||
let^ info = Db.find_opt Q.get_post_info id in
|
||||
Ok info
|
||||
|
||||
let upload_avatar image id =
|
||||
let^ () = Db.exec Q.delete_user_content id in
|
||||
let^ () = Db.exec Q.delete_user_thumbnail id in
|
||||
let^ () = Db.exec Q.upload_user_content (id, image.content) in
|
||||
let^ () = Db.exec Q.upload_user_thumbnail (id, image.thumbnail) in
|
||||
Ok ()
|
||||
|
||||
let get_user_content id =
|
||||
let^ content = Db.find_opt Q.get_user_content id in
|
||||
Ok content
|
||||
|
||||
let get_user_thumbnail id =
|
||||
let^ thumbnail = Db.find_opt Q.get_user_thumbnail id in
|
||||
Ok thumbnail
|
||||
|
||||
let make_thumbnail content =
|
||||
let open Bos in
|
||||
(* jpp *)
|
||||
let ( let* ) o f =
|
||||
Result.fold ~ok:f ~error:(function `Msg s -> Result.error s) o
|
||||
in
|
||||
|
||||
let* image_file = OS.File.tmp "%s" in
|
||||
let* thumb_file = OS.File.tmp "%s_thumb" in
|
||||
let* () = OS.File.write image_file content in
|
||||
let cmd =
|
||||
Cmd.(
|
||||
v "convert" % "-define" % "jpeg:size=700x700" % p image_file
|
||||
% "-auto-orient" % "-thumbnail" % "300x300>" % "-unsharp" % "0x.5"
|
||||
% "-format" % "jpg" % p thumb_file)
|
||||
in
|
||||
let* () = OS.Cmd.run cmd in
|
||||
let* thumbnail = OS.File.read thumb_file in
|
||||
let* () = OS.File.delete image_file in
|
||||
let* () = OS.File.delete thumb_file in
|
||||
Ok thumbnail
|
||||
|
||||
let mime =
|
||||
let database = Conan.Process.database ~tree:Conan_light.tree in
|
||||
fun content ->
|
||||
match Conan_string.run ~database content with
|
||||
| Ok m -> Conan.Metadata.mime m
|
||||
| Error _ -> None
|
||||
|
||||
let make_image image =
|
||||
let max_name = 1000 in
|
||||
let max_alt = 3000 in
|
||||
let max_content = 4200000 in
|
||||
|
||||
let name, alt, content = image in
|
||||
let name =
|
||||
match name with
|
||||
| Some name -> Dream.html_escape name
|
||||
| None ->
|
||||
(* make up random name if no name was given *)
|
||||
Uuidm.to_string (Uuidm.v4_gen App.random_state ())
|
||||
in
|
||||
let alt = if String.trim alt = "" then name else alt in
|
||||
if String.length name > max_name then
|
||||
Error (Format.sprintf "Image name too long: More than %dB" max_name)
|
||||
else if String.length alt > max_alt then
|
||||
Error (Format.sprintf "Image description too long: More than %dB" max_alt)
|
||||
else if String.length content > max_content then
|
||||
Error (Format.sprintf "Image size too big: More than %dB" max_content)
|
||||
else
|
||||
match mime content with
|
||||
| None -> Error "invalid image type"
|
||||
| Some mime -> (
|
||||
match mime with
|
||||
| "image/jpeg" | "image/png" | "image/webp" -> (
|
||||
match make_thumbnail content with
|
||||
| Error e -> Error e
|
||||
| Ok thumbnail -> Ok { name; alt; content; thumbnail } )
|
||||
| _unsupported_mime_type ->
|
||||
Error (Format.sprintf "unsupported image type: %s" mime) )
|
||||
|
|
@ -293,32 +293,33 @@ let profile_post request =
|
|||
| `Wrong_session _ | `Wrong_content_type ->
|
||||
Dream.empty `Bad_Request ) )
|
||||
|
||||
let avatar_image request =
|
||||
let get_post_image ~thumbnail request =
|
||||
let id = Dream.param request "id" in
|
||||
let image =
|
||||
if thumbnail then Image.get_thumbnail id else Image.get_content id
|
||||
in
|
||||
match image with
|
||||
| Error e -> render_unsafe e request
|
||||
| Ok image_opt -> (
|
||||
match image_opt with
|
||||
| None -> Dream.respond ~status:`Not_Found "Image does not exists"
|
||||
| Some image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image )
|
||||
|
||||
let get_avatar_image request =
|
||||
let nick = Dream.param request "user" in
|
||||
match User.get_user_id_from_nick nick with
|
||||
| Error _e -> Dream.respond ~status:`Not_Found "User does not exists"
|
||||
| Ok user_id -> (
|
||||
let avatar = User.get_avatar user_id in
|
||||
let avatar = Image.get_user_content user_id in
|
||||
match avatar with
|
||||
| Ok (Some avatar) ->
|
||||
Dream.respond ~headers:[ ("Content-Type", "image") ] avatar
|
||||
| Ok None | Error _ -> (
|
||||
| Ok None -> (
|
||||
match Content.read "/assets/img/default_avatar.png" with
|
||||
| None -> failwith "can't find default avatar"
|
||||
| Some avatar ->
|
||||
Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) )
|
||||
|
||||
let get_post_image ~thumbnail request =
|
||||
let post_id = Dream.param request "post_id" in
|
||||
if Babillard.post_exist post_id then
|
||||
let image =
|
||||
if thumbnail then Babillard.get_post_image_thumbnail post_id
|
||||
else Babillard.get_post_image_content post_id
|
||||
in
|
||||
match image with
|
||||
| Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
|
||||
| Error _ -> Dream.empty `Not_Found
|
||||
else Dream.respond ~status:`Not_Found "Image does not exists"
|
||||
Dream.respond ~headers:[ ("Content-Type", "image") ] avatar )
|
||||
| Error e -> render_unsafe e request )
|
||||
|
||||
let markers request =
|
||||
let markers = Pp_babillard.get_markers () in
|
||||
|
|
@ -467,8 +468,8 @@ let routes =
|
|||
; get_ "/discuss" Discuss.render
|
||||
; get_ "/discuss/:comrade_id" Discuss.render_one
|
||||
; post "/discuss/:comrade_id" Discuss.post
|
||||
; get_ "/img/:post_id" (get_post_image ~thumbnail:false)
|
||||
; get_ "/img/s/:post_id" (get_post_image ~thumbnail:true)
|
||||
; get_ "/img/:id" (get_post_image ~thumbnail:false)
|
||||
; get_ "/img/s/:id" (get_post_image ~thumbnail:true)
|
||||
; get_ "/login" login_get
|
||||
; post "/login" login_post
|
||||
; get_ "/logout" logout
|
||||
|
|
@ -482,7 +483,7 @@ let routes =
|
|||
; get_ "/thread/:thread_id/feed" thread_feed_get
|
||||
; get_ "/user" user
|
||||
; get_ "/user/:user" user_profile
|
||||
; get_ "/user/:user/avatar" avatar_image
|
||||
; get_ "/user/:user/avatar" get_avatar_image
|
||||
]
|
||||
@
|
||||
if App.open_registration then
|
||||
|
|
|
|||
40
src/user.ml
40
src/user.ml
|
|
@ -7,7 +7,6 @@ type t =
|
|||
; password : string
|
||||
; email : string
|
||||
; bio : string
|
||||
; avatar : string
|
||||
; metadata : (string * string) list
|
||||
}
|
||||
|
||||
|
|
@ -15,7 +14,7 @@ module Q = struct
|
|||
let create_user_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
"CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
|
||||
TEXT, email TEXT, bio TEXT, avatar BLOB, PRIMARY KEY(user_id));"
|
||||
TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id));"
|
||||
|
||||
let create_banished_table =
|
||||
Caqti_request.exec Caqti_type.unit
|
||||
|
|
@ -59,9 +58,8 @@ module Q = struct
|
|||
|
||||
let upload_user =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(
|
||||
tup4 string string string Caqti_type.(tup3 string string string))
|
||||
"INSERT INTO user VALUES (?, ?, ?, ?, ?, ?);"
|
||||
Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
|
||||
"INSERT INTO user VALUES (?, ?, ?, ?, ?);"
|
||||
|
||||
let list_nicks =
|
||||
Caqti_request.collect Caqti_type.unit Caqti_type.string
|
||||
|
|
@ -70,8 +68,7 @@ module Q = struct
|
|||
let get_user =
|
||||
Caqti_request.find Caqti_type.string
|
||||
(* there is no "tup6" *)
|
||||
Caqti_type.(
|
||||
tup4 string string string Caqti_type.(tup3 string string string))
|
||||
Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
|
||||
"SELECT * FROM user WHERE user_id=?;"
|
||||
|
||||
let update_bio =
|
||||
|
|
@ -106,15 +103,6 @@ module Q = struct
|
|||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT email FROM user WHERE user_id=?;"
|
||||
|
||||
let get_avatar =
|
||||
Caqti_request.find Caqti_type.string Caqti_type.string
|
||||
"SELECT avatar FROM user WHERE user_id=?;"
|
||||
|
||||
let upload_avatar =
|
||||
Caqti_request.exec
|
||||
Caqti_type.(tup2 string string)
|
||||
"UPDATE user SET avatar=? WHERE user_id=?;"
|
||||
|
||||
let delete_user =
|
||||
Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE user_id=?;"
|
||||
|
||||
|
|
@ -139,6 +127,8 @@ let () =
|
|||
(Array.map (fun query -> Db.exec query ()) tables)
|
||||
then Dream.error (fun log -> log "can't create user tables")
|
||||
|
||||
let exist id = Result.is_ok (Db.find Q.get_user id)
|
||||
|
||||
let exist_nick nick = Result.is_ok (Db.find Q.get_user_id_from_nick nick)
|
||||
|
||||
let exist_email email = Result.is_ok (Db.find Q.get_user_id_from_email email)
|
||||
|
|
@ -153,11 +143,11 @@ let get_user_id_from_nick nick =
|
|||
Ok user_id
|
||||
|
||||
let get_user user_id =
|
||||
let^? user_id, nick, password, (email, bio, avatar) =
|
||||
let^? user_id, nick, password, (email, bio) =
|
||||
Db.find_opt Q.get_user user_id
|
||||
in
|
||||
let* metadata = get_metadata user_id in
|
||||
Ok { user_id; nick; password; email; bio; avatar; metadata }
|
||||
Ok { user_id; nick; password; email; bio; metadata }
|
||||
|
||||
let is_banished login = Result.is_ok (Db.find Q.get_banished (login, login))
|
||||
|
||||
|
|
@ -210,10 +200,8 @@ let register ~email ~nick ~password =
|
|||
else
|
||||
let^ nb = Db.find Q.is_already_user (nick, email) in
|
||||
if nb = 0 then
|
||||
let user_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
||||
let^ () =
|
||||
Db.exec Q.upload_user (user_id, nick, password, (email, "", ""))
|
||||
in
|
||||
let user_id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
|
||||
let^ () = Db.exec Q.upload_user (user_id, nick, password, (email, "")) in
|
||||
let^ () = Db.exec Q.upload_metadata (user_id, Marshal.to_string [] []) in
|
||||
Ok ()
|
||||
else Error "nick or email already exists"
|
||||
|
|
@ -248,16 +236,12 @@ let get_email user_id =
|
|||
let^ email = Db.find Q.get_email user_id in
|
||||
Ok email
|
||||
|
||||
let get_avatar user_id =
|
||||
let^ avatar = Db.find Q.get_avatar user_id in
|
||||
if String.length avatar = 0 then Ok None else Ok (Some avatar)
|
||||
|
||||
let upload_avatar files user_id =
|
||||
match files with
|
||||
| [] -> Error "No file provided"
|
||||
| [ (name_opt, content) ] ->
|
||||
let* _name, _alt, content = clean_image (name_opt, "avatar", content) in
|
||||
let^ () = Db.exec Q.upload_avatar (content, user_id) in
|
||||
let* image = Image.make_image (name_opt, "avatar", content) in
|
||||
let* () = Image.upload_avatar image user_id in
|
||||
Ok ()
|
||||
| _files -> Error "More than one file provided"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue