open caqti_type; use Q module for discuss
This commit is contained in:
parent
613d901bca
commit
0632a713c7
5 changed files with 115 additions and 162 deletions
|
|
@ -42,154 +42,135 @@ type t =
|
||||||
|
|
||||||
module Q = struct
|
module Q = struct
|
||||||
open Caqti_request.Infix
|
open Caqti_request.Infix
|
||||||
|
open Caqti_type
|
||||||
|
|
||||||
let create_post_user_table =
|
let create_post_user_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \
|
"CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \
|
||||||
PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
||||||
DELETE CASCADE)"
|
DELETE CASCADE)"
|
||||||
|
|
||||||
(* one row for each thread, with thread's data *)
|
(* one row for each thread, with thread's data *)
|
||||||
let create_thread_info_table =
|
let create_thread_info_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \
|
"CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \
|
||||||
lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
|
lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \
|
||||||
post_user(post_id) ON DELETE CASCADE)"
|
post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
(* map thread and reply to the thread *)
|
(* map thread and reply to the thread *)
|
||||||
let create_thread_post_table =
|
let create_thread_post_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \
|
"CREATE TABLE IF NOT EXISTS thread_post (thread_id TEXT, post_id TEXT, \
|
||||||
FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
FOREIGN KEY(thread_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_post_replies_table =
|
let create_post_replies_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_replies (post_id TEXT, reply_id TEXT, \
|
"CREATE TABLE IF NOT EXISTS post_replies (post_id TEXT, reply_id TEXT, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||||
FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_post_citations_table =
|
let create_post_citations_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_citations (post_id TEXT, cited_id TEXT, \
|
"CREATE TABLE IF NOT EXISTS post_citations (post_id TEXT, cited_id TEXT, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE, \
|
||||||
FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_post_date_table =
|
let create_post_date_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, FOREIGN \
|
"CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, FOREIGN \
|
||||||
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_post_comment_table =
|
let create_post_comment_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
"CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_post_tags_table =
|
let create_post_tags_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
"CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
|
||||||
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_report_table =
|
let create_report_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \
|
"CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \
|
||||||
FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) \
|
FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) \
|
||||||
ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \
|
||||||
DELETE CASCADE)"
|
DELETE CASCADE)"
|
||||||
|
|
||||||
let upload_report =
|
let upload_report =
|
||||||
(Caqti_type.(tup4 string string float string) ->. Caqti_type.unit)
|
(tup4 string string float string ->. unit)
|
||||||
"INSERT INTO report VALUES (?,?,?,?)"
|
"INSERT INTO report VALUES (?,?,?,?)"
|
||||||
|
|
||||||
let ignore_report =
|
let ignore_report = (string ->. unit) "DELETE FROM report WHERE post_id=?"
|
||||||
(Caqti_type.string ->. Caqti_type.unit) "DELETE FROM report WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_reports =
|
let get_reports =
|
||||||
(Caqti_type.unit ->* Caqti_type.(tup4 string string float string))
|
(unit ->* tup4 string string float string) "SELECT * FROM report"
|
||||||
"SELECT * FROM report"
|
|
||||||
|
|
||||||
let upload_post_id =
|
let upload_post_id =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO post_user VALUES (?,?)"
|
||||||
"INSERT INTO post_user VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_thread_info =
|
let upload_thread_info =
|
||||||
(Caqti_type.(tup4 string string float float) ->. Caqti_type.unit)
|
(tup4 string string float float ->. unit)
|
||||||
"INSERT INTO thread_info VALUES (?,?,?,?)"
|
"INSERT INTO thread_info VALUES (?,?,?,?)"
|
||||||
|
|
||||||
let upload_thread_post =
|
let upload_thread_post =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO thread_post VALUES (?,?)"
|
||||||
"INSERT INTO thread_post VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_post_reply =
|
let upload_post_reply =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO post_replies VALUES (?,?)"
|
||||||
"INSERT INTO post_replies VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_post_comment =
|
let upload_post_comment =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO post_comment VALUES (?,?)"
|
||||||
"INSERT INTO post_comment VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_post_tag =
|
let upload_post_tag =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO post_tags VALUES (?,?)"
|
||||||
"INSERT INTO post_tags VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_post_date =
|
let upload_post_date =
|
||||||
(Caqti_type.(tup2 string float) ->. Caqti_type.unit)
|
(tup2 string float ->. unit) "INSERT INTO post_date VALUES (?,?)"
|
||||||
"INSERT INTO post_date VALUES (?,?)"
|
|
||||||
|
|
||||||
let get_post_user_id =
|
let get_post_user_id =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT user_id FROM post_user WHERE post_id=?"
|
||||||
"SELECT user_id FROM post_user WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_comment =
|
let get_post_comment =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT comment FROM post_comment WHERE post_id=?"
|
||||||
"SELECT comment FROM post_comment WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_tags =
|
let get_post_tags =
|
||||||
(Caqti_type.string ->* Caqti_type.string)
|
(string ->* string) "SELECT tag FROM post_tags WHERE post_id=?"
|
||||||
"SELECT tag FROM post_tags WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_date =
|
let get_post_date =
|
||||||
(Caqti_type.string ->! Caqti_type.float)
|
(string ->! float) "SELECT date FROM post_date WHERE post_id=?"
|
||||||
"SELECT date FROM post_date WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_citations =
|
let get_post_citations =
|
||||||
(Caqti_type.string ->* Caqti_type.string)
|
(string ->* string) "SELECT post_id FROM post_citations WHERE post_id=?"
|
||||||
"SELECT post_id FROM post_citations WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_replies =
|
let get_post_replies =
|
||||||
(Caqti_type.string ->* Caqti_type.string)
|
(string ->* string) "SELECT reply_id FROM post_replies WHERE post_id=?"
|
||||||
"SELECT reply_id FROM post_replies WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_thread_posts =
|
let get_thread_posts =
|
||||||
(Caqti_type.string ->* Caqti_type.string)
|
(string ->* string) "SELECT post_id FROM thread_post WHERE thread_id=?"
|
||||||
"SELECT post_id FROM thread_post WHERE thread_id=?"
|
|
||||||
|
|
||||||
let count_thread_posts =
|
let count_thread_posts =
|
||||||
(Caqti_type.string ->! Caqti_type.int)
|
(string ->! int) "SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?"
|
||||||
"SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?"
|
|
||||||
|
|
||||||
let get_is_thread =
|
let get_is_thread =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string)
|
||||||
"SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1"
|
"SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1"
|
||||||
|
|
||||||
let get_is_post =
|
let get_is_post =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT post_id FROM post_user WHERE post_id=? LIMIT 1"
|
||||||
"SELECT post_id FROM post_user WHERE post_id=? LIMIT 1"
|
|
||||||
|
|
||||||
let get_post_thread =
|
let get_post_thread =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string)
|
||||||
"SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1"
|
"SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1"
|
||||||
|
|
||||||
let get_thread_info =
|
let get_thread_info =
|
||||||
(Caqti_type.string ->! Caqti_type.(tup3 string float float))
|
(string ->! tup3 string float float)
|
||||||
"SELECT subject,lat,lng FROM thread_info WHERE thread_id=?"
|
"SELECT subject,lat,lng FROM thread_info WHERE thread_id=?"
|
||||||
|
|
||||||
let get_threads =
|
let get_threads = (unit ->* string) "SELECT thread_id FROM thread_info"
|
||||||
(Caqti_type.unit ->* Caqti_type.string) "SELECT thread_id FROM thread_info"
|
|
||||||
|
|
||||||
let delete_post =
|
let delete_post = (string ->. unit) "DELETE FROM post_user WHERE post_id=?"
|
||||||
(Caqti_type.string ->. Caqti_type.unit)
|
|
||||||
"DELETE FROM post_user WHERE post_id=?"
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
|
||||||
|
|
@ -18,14 +18,14 @@ module Db =
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let set_foreign_keys_on =
|
let set_foreign_keys_on =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit) "PRAGMA foreign_keys = ON"
|
Caqti_type.(unit ->. unit) "PRAGMA foreign_keys = ON"
|
||||||
in
|
in
|
||||||
if Result.is_error (Db.exec set_foreign_keys_on ()) then
|
if Result.is_error (Db.exec set_foreign_keys_on ()) then
|
||||||
Dream.error (fun log -> log "can't set foreign_keys on")
|
Dream.error (fun log -> log "can't set foreign_keys on")
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let query =
|
let query =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
Caqti_type.(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \
|
"CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \
|
||||||
TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL)"
|
TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL)"
|
||||||
in
|
in
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
open Db
|
open Db
|
||||||
open Caqti_request.Infix
|
|
||||||
|
|
||||||
(** Creating the table of all messages.
|
(** Creating the table of all messages.
|
||||||
|
|
||||||
|
|
@ -11,44 +10,51 @@ open Caqti_request.Infix
|
||||||
- some text (msg)
|
- some text (msg)
|
||||||
|
|
||||||
TODO: add date ? *)
|
TODO: add date ? *)
|
||||||
let () =
|
|
||||||
|
module Q = struct
|
||||||
|
open Caqti_request.Infix
|
||||||
|
open Caqti_type
|
||||||
|
|
||||||
let create_msg_table =
|
let create_msg_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS msg ( msg_id TEXT, from_id TEXT, to_id TEXT, \
|
"CREATE TABLE IF NOT EXISTS msg ( msg_id TEXT, from_id TEXT, to_id TEXT, \
|
||||||
msg TEXT, PRIMARY KEY(msg_id), FOREIGN KEY(from_id) REFERENCES \
|
msg TEXT, PRIMARY KEY(msg_id), FOREIGN KEY(from_id) REFERENCES \
|
||||||
user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \
|
user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \
|
||||||
user(user_id) ON DELETE CASCADE)"
|
user(user_id) ON DELETE CASCADE)"
|
||||||
in
|
|
||||||
match Db.exec create_msg_table () with
|
let find_comrades =
|
||||||
|
(tup2 string string ->* tup2 string string)
|
||||||
|
"SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?"
|
||||||
|
|
||||||
|
let find_messages =
|
||||||
|
(tup2 (tup2 string string) (tup2 string string) ->* tup2 string string)
|
||||||
|
"SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \
|
||||||
|
(from_id=? AND to_id=?)"
|
||||||
|
|
||||||
|
let insert_msg =
|
||||||
|
(tup3 string string string ->. unit)
|
||||||
|
"INSERT INTO msg VALUES (NULL, ?, ?, ?)"
|
||||||
|
end
|
||||||
|
|
||||||
|
let () =
|
||||||
|
match Db.exec Q.create_msg_table () with
|
||||||
| Ok () -> ()
|
| Ok () -> ()
|
||||||
| Error _e -> Dream.error (fun log -> log "can't create msg table")
|
| Error _e -> Dream.error (fun log -> log "can't create msg table")
|
||||||
|
|
||||||
(** let's find who the user is talking to so we can know if they're dangerous *)
|
(** let's find who the user is talking to so we can know if they're dangerous *)
|
||||||
let find_comrades =
|
let find_comrades user_id =
|
||||||
let find_comrades =
|
let open Syntax in
|
||||||
(Caqti_type.(tup2 string string) ->* Caqti_type.(tup2 string string))
|
let^ comrades = Db.collect_list Q.find_comrades (user_id, user_id) in
|
||||||
"SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?"
|
let comrades =
|
||||||
|
List.map (fun (l, r) -> if l = user_id then r else l) comrades
|
||||||
in
|
in
|
||||||
fun user_id ->
|
Ok (List.sort_uniq String.compare comrades)
|
||||||
let open Syntax in
|
|
||||||
let^ comrades = Db.collect_list find_comrades (user_id, user_id) in
|
|
||||||
let comrades =
|
|
||||||
List.map (fun (l, r) -> if l = user_id then r else l) comrades
|
|
||||||
in
|
|
||||||
Ok (List.sort_uniq String.compare comrades)
|
|
||||||
|
|
||||||
(** find all messages between two товарищи *)
|
(** find all messages between two товарищи *)
|
||||||
let find_messages =
|
let find_messages k1 k2 =
|
||||||
let find_messages =
|
let open Syntax in
|
||||||
( Caqti_type.(tup2 (tup2 string string) (tup2 string string))
|
let^ comrades = Db.collect_list Q.find_messages ((k1, k2), (k2, k1)) in
|
||||||
->* Caqti_type.(tup2 string string) )
|
Ok comrades
|
||||||
"SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \
|
|
||||||
(from_id=? AND to_id=?)"
|
|
||||||
in
|
|
||||||
fun k1 k2 ->
|
|
||||||
let open Syntax in
|
|
||||||
let^ comrades = Db.collect_list find_messages ((k1, k2), (k2, k1)) in
|
|
||||||
Ok comrades
|
|
||||||
|
|
||||||
(** display the list of discussions *)
|
(** display the list of discussions *)
|
||||||
let render request =
|
let render request =
|
||||||
|
|
@ -133,15 +139,10 @@ let render_one request =
|
||||||
Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] ""
|
Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] ""
|
||||||
| Some user_id -> pp_discussion (request, user_id, comrade_id)
|
| Some user_id -> pp_discussion (request, user_id, comrade_id)
|
||||||
|
|
||||||
let insert_msg =
|
let insert_msg from_id to_id msg =
|
||||||
let insert_msg =
|
let open Syntax in
|
||||||
(Caqti_type.(tup3 string string string) ->. Caqti_type.unit)
|
let^ () = Db.exec Q.insert_msg (from_id, to_id, msg) in
|
||||||
"INSERT INTO msg VALUES (NULL, ?, ?, ?)"
|
Ok ()
|
||||||
in
|
|
||||||
fun from_id to_id msg ->
|
|
||||||
let open Syntax in
|
|
||||||
let^ () = Db.exec insert_msg (from_id, to_id, msg) in
|
|
||||||
Ok ()
|
|
||||||
|
|
||||||
(** handle posts *)
|
(** handle posts *)
|
||||||
let post request =
|
let post request =
|
||||||
|
|
|
||||||
44
src/image.ml
44
src/image.ml
|
|
@ -10,81 +10,73 @@ type t =
|
||||||
|
|
||||||
module Q = struct
|
module Q = struct
|
||||||
open Caqti_request.Infix
|
open Caqti_request.Infix
|
||||||
|
open Caqti_type
|
||||||
|
|
||||||
let create_info_table =
|
let create_info_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
|
"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 \
|
image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
|
||||||
DELETE CASCADE)"
|
DELETE CASCADE)"
|
||||||
|
|
||||||
let create_content_table =
|
let create_content_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
|
"CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_thumbnail_table =
|
let create_thumbnail_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
|
"CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \
|
||||||
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let upload_info =
|
let upload_info =
|
||||||
(Caqti_type.(tup3 string string string) ->. Caqti_type.unit)
|
(tup3 string string string ->. unit) "INSERT INTO image_info VALUES (?,?,?)"
|
||||||
"INSERT INTO image_info VALUES (?,?,?)"
|
|
||||||
|
|
||||||
let upload_content =
|
let upload_content =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO image_content VALUES (?,?)"
|
||||||
"INSERT INTO image_content VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_thumbnail =
|
let upload_thumbnail =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO image_thumbnail VALUES (?,?)"
|
||||||
"INSERT INTO image_thumbnail VALUES (?,?)"
|
|
||||||
|
|
||||||
let get_post_content =
|
let get_post_content =
|
||||||
(Caqti_type.string ->? Caqti_type.string)
|
(string ->? string) "SELECT content FROM image_content WHERE post_id=?"
|
||||||
"SELECT content FROM image_content WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_thumbnail =
|
let get_post_thumbnail =
|
||||||
(Caqti_type.string ->? Caqti_type.string)
|
(string ->? string) "SELECT content FROM image_thumbnail WHERE post_id=?"
|
||||||
"SELECT content FROM image_thumbnail WHERE post_id=?"
|
|
||||||
|
|
||||||
let get_post_info =
|
let get_post_info =
|
||||||
(Caqti_type.string ->? Caqti_type.(tup2 string string))
|
(string ->? tup2 string string)
|
||||||
"SELECT image_name,image_alt FROM image_info WHERE post_id=?"
|
"SELECT image_name,image_alt FROM image_info WHERE post_id=?"
|
||||||
|
|
||||||
(*avatars*)
|
(*avatars*)
|
||||||
let create_user_content_table =
|
let create_user_content_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS user_image_content (user_id TEXT, content \
|
"CREATE TABLE IF NOT EXISTS user_image_content (user_id TEXT, content \
|
||||||
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let create_user_thumbnail_table =
|
let create_user_thumbnail_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS user_image_thumbnail (user_id TEXT, content \
|
"CREATE TABLE IF NOT EXISTS user_image_thumbnail (user_id TEXT, content \
|
||||||
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
TEXT, FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let upload_user_content =
|
let upload_user_content =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO user_image_content VALUES (?,?)"
|
||||||
"INSERT INTO user_image_content VALUES (?,?)"
|
|
||||||
|
|
||||||
let upload_user_thumbnail =
|
let upload_user_thumbnail =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit)
|
||||||
"INSERT INTO user_image_thumbnail VALUES (?,?)"
|
"INSERT INTO user_image_thumbnail VALUES (?,?)"
|
||||||
|
|
||||||
let get_user_content =
|
let get_user_content =
|
||||||
(Caqti_type.string ->? Caqti_type.string)
|
(string ->? string) "SELECT content FROM user_image_content WHERE user_id=?"
|
||||||
"SELECT content FROM user_image_content WHERE user_id=?"
|
|
||||||
|
|
||||||
let get_user_thumbnail =
|
let get_user_thumbnail =
|
||||||
(Caqti_type.string ->? Caqti_type.string)
|
(string ->? string)
|
||||||
"SELECT content FROM user_image_thumbnail WHERE user_id=?"
|
"SELECT content FROM user_image_thumbnail WHERE user_id=?"
|
||||||
|
|
||||||
let delete_user_content =
|
let delete_user_content =
|
||||||
(Caqti_type.string ->. Caqti_type.unit)
|
(string ->. unit) "DELETE FROM user_image_content WHERE user_id=?"
|
||||||
"DELETE FROM user_image_content WHERE user_id=?"
|
|
||||||
|
|
||||||
let delete_user_thumbnail =
|
let delete_user_thumbnail =
|
||||||
(Caqti_type.string ->. Caqti_type.unit)
|
(string ->. unit) "DELETE FROM user_image_thumbnail WHERE user_id=?"
|
||||||
"DELETE FROM user_image_thumbnail WHERE user_id=?"
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
|
||||||
69
src/user.ml
69
src/user.ml
|
|
@ -12,101 +12,80 @@ type t =
|
||||||
|
|
||||||
module Q = struct
|
module Q = struct
|
||||||
open Caqti_request.Infix
|
open Caqti_request.Infix
|
||||||
|
open Caqti_type
|
||||||
|
|
||||||
let create_user_table =
|
let create_user_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
|
"CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
|
||||||
TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id))"
|
TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id))"
|
||||||
|
|
||||||
let create_banished_table =
|
let create_banished_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT)"
|
"CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT)"
|
||||||
|
|
||||||
let create_metadata_table =
|
let create_metadata_table =
|
||||||
(Caqti_type.unit ->. Caqti_type.unit)
|
(unit ->. unit)
|
||||||
"CREATE TABLE IF NOT EXISTS user_metadata (user_id TEXT, metadata TEXT, \
|
"CREATE TABLE IF NOT EXISTS user_metadata (user_id TEXT, metadata TEXT, \
|
||||||
FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE)"
|
||||||
|
|
||||||
let get_metadata =
|
let get_metadata =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT metadata FROM user_metadata WHERE user_id=?"
|
||||||
"SELECT metadata FROM user_metadata WHERE user_id=?"
|
|
||||||
|
|
||||||
let upload_metadata =
|
let upload_metadata =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO user_metadata VALUES (?, ?)"
|
||||||
"INSERT INTO user_metadata VALUES (?, ?)"
|
|
||||||
|
|
||||||
let delete_metadata =
|
let delete_metadata =
|
||||||
(Caqti_type.string ->. Caqti_type.unit)
|
(string ->. unit) "DELETE FROM user_metadata WHERE user_id=?"
|
||||||
"DELETE FROM user_metadata WHERE user_id=?"
|
|
||||||
|
|
||||||
let get_user_id_from_nick =
|
let get_user_id_from_nick =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT user_id FROM user WHERE nick=?"
|
||||||
"SELECT user_id FROM user WHERE nick=?"
|
|
||||||
|
|
||||||
let get_user_id_from_email =
|
let get_user_id_from_email =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT user_id FROM user WHERE email=?"
|
||||||
"SELECT user_id FROM user WHERE email=?"
|
|
||||||
|
|
||||||
let get_password =
|
let get_password =
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
(string ->! string) "SELECT password FROM user WHERE user_id=?"
|
||||||
"SELECT password FROM user WHERE user_id=?"
|
|
||||||
|
|
||||||
let is_already_user =
|
let is_already_user =
|
||||||
(Caqti_type.(tup2 string string) ->! Caqti_type.int)
|
(tup2 string string ->! int)
|
||||||
"SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?)"
|
"SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?)"
|
||||||
|
|
||||||
let upload_user =
|
let upload_user =
|
||||||
( Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
|
(tup4 string string string (tup2 string string) ->. unit)
|
||||||
->. Caqti_type.unit )
|
|
||||||
"INSERT INTO user VALUES (?, ?, ?, ?, ?)"
|
"INSERT INTO user VALUES (?, ?, ?, ?, ?)"
|
||||||
|
|
||||||
let list_nicks =
|
let list_nicks = (unit ->* string) "SELECT nick FROM user"
|
||||||
(Caqti_type.unit ->* Caqti_type.string) "SELECT nick FROM user"
|
|
||||||
|
|
||||||
let get_user =
|
let get_user =
|
||||||
(* there is no "tup6" *)
|
(* there is no "tup6" *)
|
||||||
( Caqti_type.string
|
(string ->! tup4 string string string (tup2 string string))
|
||||||
->! Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
|
|
||||||
)
|
|
||||||
"SELECT * FROM user WHERE user_id=?"
|
"SELECT * FROM user WHERE user_id=?"
|
||||||
|
|
||||||
let update_bio =
|
let update_bio =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?"
|
||||||
"UPDATE user SET bio=? WHERE user_id=?"
|
|
||||||
|
|
||||||
let update_nick =
|
let update_nick =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?"
|
||||||
"UPDATE user SET nick=? WHERE user_id=?"
|
|
||||||
|
|
||||||
let update_email =
|
let update_email =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?"
|
||||||
"UPDATE user SET email=? WHERE user_id=?"
|
|
||||||
|
|
||||||
let update_password =
|
let update_password =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "UPDATE user SET password=? WHERE user_id=?"
|
||||||
"UPDATE user SET password=? WHERE user_id=?"
|
|
||||||
|
|
||||||
let get_nick =
|
let get_nick = (string ->! string) "SELECT nick FROM user WHERE user_id=?"
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
|
||||||
"SELECT nick FROM user WHERE user_id=?"
|
|
||||||
|
|
||||||
let get_bio =
|
let get_bio = (string ->! string) "SELECT bio FROM user WHERE user_id=?"
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
|
||||||
"SELECT bio FROM user WHERE user_id=?"
|
|
||||||
|
|
||||||
let get_email =
|
let get_email = (string ->! string) "SELECT email FROM user WHERE user_id=?"
|
||||||
(Caqti_type.string ->! Caqti_type.string)
|
|
||||||
"SELECT email FROM user WHERE user_id=?"
|
|
||||||
|
|
||||||
let delete_user =
|
let delete_user = (string ->. unit) "DELETE FROM user WHERE user_id=?"
|
||||||
(Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user WHERE user_id=?"
|
|
||||||
|
|
||||||
let upload_banished =
|
let upload_banished =
|
||||||
(Caqti_type.(tup2 string string) ->. Caqti_type.unit)
|
(tup2 string string ->. unit) "INSERT INTO banished VALUES (?,?)"
|
||||||
"INSERT INTO banished VALUES (?,?)"
|
|
||||||
|
|
||||||
let get_banished =
|
let get_banished =
|
||||||
(Caqti_type.(tup2 string string) ->! Caqti_type.(tup2 string string))
|
(tup2 string string ->! tup2 string string)
|
||||||
"SELECT * FROM banished WHERE nick=? OR email=?"
|
"SELECT * FROM banished WHERE nick=? OR email=?"
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue