add avatar upload

src/permap.ml

@@ -45,7 +45,14 @@ let register_post request =
   match%lwt Dream.form request with
   | `Ok [ ("email", email); ("nick", nick); ("password", password) ] ->
     render_unsafe (Register.f ~nick ~email ~password request) request
-  | _ -> assert false
+  | `Ok _
+  | `Many_tokens _
+  | `Missing_token _
+  | `Invalid_token _
+  | `Wrong_session _
+  | `Expired _
+  | `Wrong_content_type ->
+    assert false
 
 let login_get request = render_unsafe (Login.f request) request
 
@@ -64,12 +71,65 @@ let logout request =
   let content = "Logged out !" in
   render_unsafe content request
 
-let profile_get request = render_unsafe (User_profile.f request) request
+let profile_get request =
+  match Dream.session "nick" request with
+  | None -> render_unsafe "Not logged in" request
+  | Some nick ->
+    let bio =
+      match User.get_bio nick with
+      | Ok bio -> bio
+      | Error e -> e
+    in
+    render_unsafe (User_profile.f nick bio request) request
 
 let profile_post request =
+  match Dream.session "nick" request with
+  | None -> render_unsafe "Not logged in" request
+  | Some nick -> (
     match%lwt Dream.form request with
-  | `Ok [ ("bio", bio) ] -> render_unsafe (User_profile.f ~bio request) request
-  | _ -> assert false
+    | `Ok [ ("bio", bio) ] ->
+      let res =
+        match User.update_bio bio nick with
+        | Ok () -> "Bio updated!"
+        | Error e -> e
+      in
+      render_unsafe res request
+    | `Ok _
+    | `Many_tokens _
+    | `Missing_token _
+    | `Invalid_token _
+    | `Wrong_session _
+    | `Expired _
+    | `Wrong_content_type -> (
+      match%lwt Dream.multipart request with
+      | `Ok [ ("files", files) ] ->
+        let res =
+          match User.upload_avatar files nick with
+          | Ok () -> "Avatar was uploaded!"
+          | Error e -> e
+        in
+        render_unsafe res request
+      | `Ok _ -> Dream.empty `Bad_Request
+      | `Expired _
+      | `Many_tokens _
+      | `Missing_token _
+      | `Invalid_token _
+      | `Wrong_session _
+      | `Wrong_content_type ->
+        Dream.empty `Bad_Request ) )
+
+let avatar_image request =
+  let nick = Dream.param "user" request in
+  let avatar = User.get_avatar nick in
+  match avatar with
+  | Ok (Some avatar) ->
+    Dream.respond ~headers:[ ("Content-Type", "image") ] avatar
+  | Ok None
+  | Error _ -> (
+    match Content.read "/assets/img/default_avatar.png" with
+    | None -> Dream.empty `Not_Found
+    | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar
+    )
 
 let () =
   Dream.run @@ Dream.logger @@ Dream.memory_sessions
@@ -82,6 +142,7 @@ let () =
        ; Dream.post "/login" login_post
        ; Dream.get "/user" user
        ; Dream.get "/user/:user" user_profile
+       ; Dream.get "/user/:user/avatar" avatar_image
        ; Dream.get "/logout" logout
        ; Dream.get "/profile" profile_get
        ; Dream.post "/profile" profile_post

src/user.ml

@@ -3,6 +3,7 @@ type t =
   ; password : string
   ; email : string (* TODO: make email optional ? *)
   ; bio : string
+  ; avatar : string
   }
 
 let () =
@@ -11,7 +12,7 @@ let () =
     Db.with_db (fun db ->
         exec0 db
           "CREATE TABLE IF NOT EXISTS user (nick TEXT, password TEXT, email \
-           TEXT, bio TEXT);" )
+           TEXT, bio TEXT, avatar BLOB);" )
   in
   match res with
   | Ok () -> ()
@@ -78,11 +79,12 @@ let register ~email ~nick ~password =
     | Ok [ [| Data.INT 0L |] ] -> (
       let res =
         Db.with_db (fun db ->
-            exec_raw_args db "INSERT INTO user VALUES (?, ?, ?, ?);"
+            exec_raw_args db "INSERT INTO user VALUES (?, ?, ?, ?, ?);"
               [| Data.TEXT nick
                ; Data.TEXT password
                ; Data.TEXT email
                ; Data.TEXT ""
+               ; Data.BLOB ""
               |]
               ~f:Cursor.to_list )
       in
@@ -118,10 +120,18 @@ let public_profile request =
   in
   match user with
   | Ok
-      [ [| Data.TEXT nick; Data.TEXT password; Data.TEXT email; Data.TEXT bio |]
+      [ [| Data.TEXT nick
+         ; Data.TEXT password
+         ; Data.TEXT email
+         ; Data.TEXT bio
+         ; Data.BLOB _
+        |]
       ] ->
-    Format.sprintf "nick = `%s`; password = `%s`; email = `%s`; bio = '%s'" nick
-      password email (Dream.html_escape bio)
+    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
   | Ok _ -> "incoherent db answer"
   | Error e -> Format.sprintf "db error: %s" (Rc.to_string e)
 
@@ -158,3 +168,42 @@ let get_bio nick =
   | Ok [ [| Data.TEXT bio |] ] -> Ok bio
   | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e))
   | Ok _ -> Error "incoherent db result"
+
+let get_avatar nick =
+  let open Sqlite3_utils in
+  let res =
+    Db.with_db (fun db ->
+        exec_raw_args db "SELECT avatar FROM user WHERE nick=?;"
+          [| Data.TEXT nick |] ~f:Cursor.to_list )
+  in
+  match res with
+  | Ok [ [| Data.BLOB avatar |] ] ->
+    if String.length avatar = 0 then
+      (* TODO default avatar *)
+      Ok None
+    else
+      Ok (Some avatar)
+  | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e))
+  | Ok _ -> Error "incoherent db result"
+
+let upload_avatar files nick =
+  match files with
+  | [] -> Error "No file provided"
+  | [ (_, content) ] -> (
+    (* TODO validate image data with konan etc*)
+    (* TODO file_name in db??*)
+    let valid = true in
+    if not valid then
+      Error "Invalid image"
+    else
+      let open Sqlite3_utils in
+      let res =
+        Db.with_db (fun db ->
+            exec_raw_args db "UPDATE user SET avatar=? WHERE nick=?;"
+              [| Data.BLOB content; Data.TEXT nick |]
+              ~f:Cursor.to_list )
+      in
+      match res with
+      | Ok _ -> Ok ()
+      | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e)) )
+  | _files -> Error "More than one file provided"

src/user_profile.eml.html

@@ -1,14 +1,4 @@
-let f ?bio request =
-% begin match Dream.session "nick" request with
-% | None ->
-not logged in
-% | Some nick ->
-%begin match bio with
-%   | None ->
-% let bio = match User.get_bio nick with
-%    | Ok bio -> bio
-%    | Error e -> e
-%in
+let f nick bio request =
 <%s  Format.sprintf "Hello %s !" nick %>
     <%s! Dream.form_tag ~action:"/profile" request %>
       <div class="mb-3">
@@ -18,12 +8,9 @@ not logged in
       </div>
       <button type="submit" class="btn btn-primary">Save</button>
     </form>
-%   | Some bio ->
-% begin match User.update_bio bio nick with
-%    | Ok () ->
-    Bio updated !
-%    | Error e ->
-    <%s e %>
-%    end;
-%   end;
-%end;
+
+    <img src="/user/<%s nick %>/avatar" class="img-thumbnail" alt="Your avatar picture">
+    <%s! Dream.form_tag ~action:"/profile" ~enctype:`Multipart_form_data request %>
+      <input name="files" type="file" multiple>
+      <button>Submit!</button>
+    </form>