put all image stuff in image.ml, make thumbnail for avatars

src/app.ml

@@ -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 ()

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; _ }
+  let { id; parent_id; date; user_id; comment; tags; citations; _ } = reply in
-      =
-    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
+    match image with None -> Ok () | Some image -> Image.upload image id
-    | 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 ()
   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* image = Image.make_image image_input in
-  let* thumbnail = make_thumbnail content in
-  let image = { name; alt; content; thumbnail } 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

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) )

src/dune

@@ -9,6 +9,7 @@
   db
   delete_page
   discuss
+  image
   login
   permap
   pp_babillard

src/image.ml

@@ -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) )

src/permap.ml

@@ -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 ) )
+        Dream.respond ~headers:[ ("Content-Type", "image") ] avatar )
-
+    | Error e -> render_unsafe e request )
-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"
 
 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/:id" (get_post_image ~thumbnail:false)
-  ; get_ "/img/s/:post_id" (get_post_image ~thumbnail:true)
+  ; 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

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.(
+      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
-        tup4 string string string Caqti_type.(tup3 string string string))
+      "INSERT INTO user VALUES (?, ?, ?, ?, ?);"
-      "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.(
+      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
-        tup4 string string string Caqti_type.(tup3 string 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 user_id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
-      let^ () =
+      let^ () = Db.exec Q.upload_user (user_id, nick, password, (email, "")) in
-        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* image = Image.make_image (name_opt, "avatar", content) in
-    let^ () = Db.exec Q.upload_avatar (content, user_id) in
+    let* () = Image.upload_avatar image user_id in
     Ok ()
   | _files -> Error "More than one file provided"