diff --git a/src/babillard.ml b/src/babillard.ml index 301e965..3a38dda 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -41,163 +41,155 @@ type t = | Post of post module Q = struct + open Caqti_request.Infix + let create_post_user_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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 \ DELETE CASCADE);" (* one row for each thread, with thread's data *) let create_thread_info_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS thread_info (thread_id TEXT, subject TEXT, \ lat FLOAT, lng FLOAT, FOREIGN KEY(thread_id) REFERENCES \ post_user(post_id) ON DELETE CASCADE);" (* map thread and reply to the thread *) let create_thread_post_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_replies_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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(reply_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_citations_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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(cited_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_date_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS post_date (post_id TEXT, date FLOAT, FOREIGN \ KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_comment_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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_post_tags_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \ KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_report_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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) \ ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \ DELETE CASCADE);" let upload_report = - Caqti_request.exec - Caqti_type.(tup4 string string float string) + (Caqti_type.(tup4 string string float string) ->. Caqti_type.unit) "INSERT INTO report VALUES (?,?,?,?);" let ignore_report = - Caqti_request.exec Caqti_type.string "DELETE FROM report WHERE post_id=?;" + (Caqti_type.string ->. Caqti_type.unit) + "DELETE FROM report WHERE post_id=?;" let get_reports = - Caqti_request.collect Caqti_type.unit - Caqti_type.(tup4 string string float string) + (Caqti_type.unit ->* Caqti_type.(tup4 string string float string)) "SELECT * FROM report;" let upload_post_id = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO post_user VALUES (?,?);" let upload_thread_info = - Caqti_request.exec - Caqti_type.(tup4 string string float float) + (Caqti_type.(tup4 string string float float) ->. Caqti_type.unit) "INSERT INTO thread_info VALUES (?,?,?,?);" let upload_thread_post = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO thread_post VALUES (?,?);" let upload_post_reply = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO post_replies VALUES (?,?);" let upload_post_comment = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO post_comment VALUES (?,?);" let upload_post_tag = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO post_tags VALUES (?,?);" let upload_post_date = - Caqti_request.exec - Caqti_type.(tup2 string float) + (Caqti_type.(tup2 string float) ->. Caqti_type.unit) "INSERT INTO post_date VALUES (?,?);" let get_post_user_id = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT user_id FROM post_user WHERE post_id=?;" let get_post_comment = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT comment FROM post_comment WHERE post_id=?;" let get_post_tags = - Caqti_request.collect Caqti_type.string Caqti_type.string + (Caqti_type.string ->* Caqti_type.string) "SELECT tag FROM post_tags WHERE post_id=?;" let get_post_date = - Caqti_request.find Caqti_type.string Caqti_type.float + (Caqti_type.string ->! Caqti_type.float) "SELECT date FROM post_date WHERE post_id=?;" let get_post_citations = - Caqti_request.collect Caqti_type.string Caqti_type.string + (Caqti_type.string ->* Caqti_type.string) "SELECT post_id FROM post_citations WHERE post_id=?;" let get_post_replies = - Caqti_request.collect Caqti_type.string Caqti_type.string + (Caqti_type.string ->* Caqti_type.string) "SELECT reply_id FROM post_replies WHERE post_id=?;" let get_thread_posts = - Caqti_request.collect Caqti_type.string Caqti_type.string + (Caqti_type.string ->* Caqti_type.string) "SELECT post_id FROM thread_post WHERE thread_id=?;" let count_thread_posts = - Caqti_request.find Caqti_type.string Caqti_type.int + (Caqti_type.string ->! Caqti_type.int) "SELECT COUNT(post_id) FROM thread_post WHERE thread_id=?;" let get_is_thread = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT thread_id FROM thread_info WHERE thread_id=? LIMIT 1;" let get_is_post = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT post_id FROM post_user WHERE post_id=? LIMIT 1;" let get_post_thread = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT thread_id FROM thread_post WHERE post_id=? LIMIT 1;" let get_thread_info = - Caqti_request.find Caqti_type.string - Caqti_type.(tup3 string float float) + (Caqti_type.string ->! Caqti_type.(tup3 string float float)) "SELECT subject,lat,lng FROM thread_info WHERE thread_id=?;" let get_threads = - Caqti_request.collect Caqti_type.unit Caqti_type.string - "SELECT thread_id FROM thread_info;" + (Caqti_type.unit ->* Caqti_type.string) "SELECT thread_id FROM thread_info;" let delete_post = - Caqti_request.exec Caqti_type.string + (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM post_user WHERE post_id=?;" end diff --git a/src/db.ml b/src/db.ml index 3c78bd9..d3f47f1 100644 --- a/src/db.ml +++ b/src/db.ml @@ -1,3 +1,5 @@ +open Caqti_request.Infix + let db_root = App.data_dir let () = @@ -16,14 +18,14 @@ module Db = let () = let set_foreign_keys_on = - Caqti_request.exec Caqti_type.unit "PRAGMA foreign_keys = ON;" + (Caqti_type.unit ->. Caqti_type.unit) "PRAGMA foreign_keys = ON;" in if Result.is_error (Db.exec set_foreign_keys_on ()) then Dream.error (fun log -> log "can't set foreign_keys on") let () = let query = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \ TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL);" in diff --git a/src/discuss.ml b/src/discuss.ml index bc9ac1f..583980a 100644 --- a/src/discuss.ml +++ b/src/discuss.ml @@ -1,3 +1,6 @@ +open Db +open Caqti_request.Infix + (** Creating the table of all messages. Each message is made of : @@ -10,27 +13,25 @@ TODO: add date ? *) let () = let create_msg_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "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 \ user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \ user(user_id) ON DELETE CASCADE);" in - match Db.Db.exec create_msg_table () with + match Db.exec create_msg_table () with | Ok () -> () | 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 find_comrades = let find_comrades = - Caqti_request.collect - Caqti_type.(tup2 string string) - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->* Caqti_type.(tup2 string string)) "SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?" in fun user_id -> let open Syntax in - let^ comrades = Db.Db.collect_list find_comrades (user_id, user_id) 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 @@ -39,15 +40,14 @@ let find_comrades = (** find all messages between two товарищи *) let find_messages = let find_messages = - Caqti_request.collect - Caqti_type.(tup2 (tup2 string string) (tup2 string string)) - Caqti_type.(tup2 string string) + ( Caqti_type.(tup2 (tup2 string string) (tup2 string string)) + ->* Caqti_type.(tup2 string string) ) "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.Db.collect_list find_messages ((k1, k2), (k2, k1)) in + let^ comrades = Db.collect_list find_messages ((k1, k2), (k2, k1)) in Ok comrades (** display the list of discussions *) @@ -135,13 +135,12 @@ let render_one request = let insert_msg = let insert_msg = - Caqti_request.exec - Caqti_type.(tup3 string string string) + (Caqti_type.(tup3 string string string) ->. Caqti_type.unit) "INSERT INTO msg VALUES (NULL, ?, ?, ?);" in fun from_id to_id msg -> let open Syntax in - let^ () = Db.Db.exec insert_msg (from_id, to_id, msg) in + let^ () = Db.exec insert_msg (from_id, to_id, msg) in Ok () (** handle posts *) diff --git a/src/image.ml b/src/image.ml index 532def0..7609f36 100644 --- a/src/image.ml +++ b/src/image.ml @@ -1,5 +1,5 @@ -open Syntax open Db +open Syntax type t = { name : string @@ -9,85 +9,81 @@ type t = } module Q = struct + open Caqti_request.Infix + let create_info_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. 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 + (Caqti_type.unit ->. 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 + (Caqti_type.unit ->. 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) + (Caqti_type.(tup3 string string string) ->. Caqti_type.unit) "INSERT INTO image_info VALUES (?,?,?);" let upload_content = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO image_content VALUES (?,?);" let upload_thumbnail = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO image_thumbnail VALUES (?,?);" let get_post_content = - Caqti_request.find_opt Caqti_type.string Caqti_type.string + (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 + (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) + (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 + (Caqti_type.unit ->. 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 + (Caqti_type.unit ->. 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) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO user_image_content VALUES (?,?);" let upload_user_thumbnail = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO user_image_thumbnail VALUES (?,?);" let get_user_content = - Caqti_request.find_opt Caqti_type.string Caqti_type.string + (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 + (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 + (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user_image_content WHERE user_id=?;" let delete_user_thumbnail = - Caqti_request.exec Caqti_type.string + (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user_image_thumbnail WHERE user_id=?;" end diff --git a/src/user.ml b/src/user.ml index 96ae5bb..d73835a 100644 --- a/src/user.ml +++ b/src/user.ml @@ -1,5 +1,5 @@ -open Syntax open Db +open Syntax type t = { user_id : string @@ -11,110 +11,102 @@ type t = } module Q = struct + open Caqti_request.Infix + let create_user_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \ TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id));" let create_banished_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT);" let create_metadata_table = - Caqti_request.exec Caqti_type.unit + (Caqti_type.unit ->. Caqti_type.unit) "CREATE TABLE IF NOT EXISTS user_metadata (user_id TEXT, metadata TEXT, \ FOREIGN KEY(user_id) REFERENCES user(user_id) ON DELETE CASCADE);" let get_metadata = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT metadata FROM user_metadata WHERE user_id=?;" let upload_metadata = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO user_metadata VALUES (?, ?);" let delete_metadata = - Caqti_request.exec Caqti_type.string + (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user_metadata WHERE user_id=?;" let get_user_id_from_nick = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT user_id FROM user WHERE nick=?;" let get_user_id_from_email = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT user_id FROM user WHERE email=?;" let get_password = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT password FROM user WHERE user_id=?;" let is_already_user = - Caqti_request.find - Caqti_type.(tup2 string string) - Caqti_type.int + (Caqti_type.(tup2 string string) ->! Caqti_type.int) "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);" let upload_user = - Caqti_request.exec - Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + ( Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + ->. Caqti_type.unit ) "INSERT INTO user VALUES (?, ?, ?, ?, ?);" let list_nicks = - Caqti_request.collect Caqti_type.unit Caqti_type.string - "SELECT nick FROM user;" + (Caqti_type.unit ->* Caqti_type.string) "SELECT nick FROM user;" let get_user = - Caqti_request.find Caqti_type.string - (* there is no "tup6" *) - Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + (* there is no "tup6" *) + ( Caqti_type.string + ->! Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + ) "SELECT * FROM user WHERE user_id=?;" let update_bio = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "UPDATE user SET bio=? WHERE user_id=?;" let update_nick = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "UPDATE user SET nick=? WHERE user_id=?;" let update_email = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "UPDATE user SET email=? WHERE user_id=?;" let update_password = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "UPDATE user SET password=? WHERE user_id=?;" let get_nick = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT nick FROM user WHERE user_id=?;" let get_bio = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT bio FROM user WHERE user_id=?;" let get_email = - Caqti_request.find Caqti_type.string Caqti_type.string + (Caqti_type.string ->! Caqti_type.string) "SELECT email FROM user WHERE user_id=?;" let delete_user = - Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE user_id=?;" + (Caqti_type.string ->. Caqti_type.unit) "DELETE FROM user WHERE user_id=?;" let upload_banished = - Caqti_request.exec - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->. Caqti_type.unit) "INSERT INTO banished VALUES (?,?);" let get_banished = - Caqti_request.find - Caqti_type.(tup2 string string) - Caqti_type.(tup2 string string) + (Caqti_type.(tup2 string string) ->! Caqti_type.(tup2 string string)) "SELECT * FROM banished WHERE nick=? OR email=?;" end