diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/dune | 12 | ||||
| -rw-r--r-- | lib/handler.ml | 162 | ||||
| -rw-r--r-- | lib/pages.ml | 33 | ||||
| -rw-r--r-- | lib/post_handlers.ml | 100 | ||||
| -rw-r--r-- | lib/query.ml | 159 | ||||
| -rw-r--r-- | lib/router.ml | 84 |
6 files changed, 550 insertions, 0 deletions
diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..9064fed --- /dev/null +++ b/lib/dune @@ -0,0 +1,12 @@ +(library + (name lib) + (libraries + piaf + routes + yojson + caqti + caqti-driver-sqlite3 + caqti-eio + ppx_rapper_eio) + (preprocess + (pps ppx_rapper))) diff --git a/lib/handler.ml b/lib/handler.ml new file mode 100644 index 0000000..3408184 --- /dev/null +++ b/lib/handler.ml @@ -0,0 +1,162 @@ +open Piaf + +type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t + +(* This is the main handler function for the GET /posts endpoint. *) +(* It takes a database connection pool and a Piaf request as input. *) +let get_posts (db_pool : pool) (_request : Request.t) = + (* Use a connection from the pool. Caqti_eio.Pool.use handles acquiring and releasing the connection. *) + Caqti_eio.Pool.use + (fun conn -> + (* Call the get_poasts function from the Query module to fetch posts from the database. *) + let posts_or_error = Query.get_poasts () conn in + (* Pattern match on the result of the database query. *) + match posts_or_error with + (* If the query is successful, the result is a list of posts. *) + | Ok posts -> + (* Map the list of post tuples to a Yojson list. *) + let json = + `List + ((* For each post tuple, create a JSON object. *) + List.map + (fun (post : Query.post_summary) -> `Assoc [ "title", `String post.title ]) + posts) + in + (* Return a 200 OK response with the JSON body. *) + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + (* If the query fails, log the error and return a 500 Internal Server Error response. *) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; + +(* Handler for GET /posts/:id - gets a single post by ID *) +let get_post post_id (db_pool : pool) (_request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + let post_or_error = Query.get_poast post_id conn in + match post_or_error with + | Ok (Some post) -> + let json = + `Assoc + [ "id", `Int post.id + ; "title", `String post.title + ; "content", `String post.content + ; "date", `String post.date + ; "tags", `String post.tags + ; "url", `String post.url + ] + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + | Ok None -> Ok (Response.create `Not_found) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; + +(* Handler for GET /comments/:id - gets a single comment by ID *) +let get_comment comment_id (db_pool : pool) (_request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + let comment_or_error = Query.Query.comment ~id:comment_id conn in + match comment_or_error with + | Ok (Some comment) -> + let json = + `Assoc + [ "id", `Int comment.id + ; "content", `String comment.content + ; "date", `String comment.date + ; "tags", `String comment.tags + ; "url", `String comment.url + ] + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + | Ok None -> Ok (Response.create `Not_found) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; + +(* Handler for GET /users/:username/comments - gets comments by a user *) +let get_user_comments username (db_pool : pool) (_request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + let comments_or_error = Query.Query.user_comments ~username conn in + match comments_or_error with + | Ok comments -> + let json = + `List + (List.map + (fun (comment : Query.comment) -> + `Assoc + [ "id", `Int comment.id + ; "content", `String comment.content + ; "date", `String comment.date + ; "tags", `String comment.tags + ; "url", `String comment.url + ]) + comments) + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; + +(* Handler for GET /posts/:id/comments - gets comments for a post *) +let get_post_comments post_id (db_pool : pool) (_request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + let comments_or_error = Query.Query.post_comments ~post_id conn in + match comments_or_error with + | Ok comments -> + let json = + `List + (List.map + (fun (comment : Query.comment) -> + `Assoc + [ "id", `Int comment.id + ; "content", `String comment.content + ; "date", `String comment.date + ; "tags", `String comment.tags + ; "url", `String comment.url + ]) + comments) + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; + +(* Handler for GET /comments/:id/children - gets child comments *) +let get_comment_children parent_id (db_pool : pool) (_request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + let comments_or_error = Query.Query.comment_children ~post_id:parent_id conn in + match comments_or_error with + | Ok comments -> + let json = + `List + (List.map + (fun (comment : Query.comment) -> + `Assoc + [ "id", `Int comment.id + ; "content", `String comment.content + ; "date", `String comment.date + ; "tags", `String comment.tags + ; "url", `String comment.url + ]) + comments) + in + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; diff --git a/lib/pages.ml b/lib/pages.ml new file mode 100644 index 0000000..e52332f --- /dev/null +++ b/lib/pages.ml @@ -0,0 +1,33 @@ +open Piaf + +type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t + +(* This is the main handler function for the GET /posts endpoint. *) +(* It takes a database connection pool and a Piaf request as input. *) +let get_root (db_pool : pool) (request : Request.t) = + let _coki = Piaf.Cookies.Cookie.parse request.headers in + (* Use a connection from the pool. Caqti_eio.Pool.use handles acquiring and releasing the connection. *) + Caqti_eio.Pool.use + (fun conn -> + (* Call the get_poasts function from the Query module to fetch posts from the database. *) + let posts_or_error = Query.get_poasts () conn in + (* Pattern match on the result of the database query. *) + match posts_or_error with + (* If the query is successful, the result is a list of posts. *) + | Ok posts -> + (* Map the list of post tuples to a Yojson list. *) + let json = + `List + ((* For each post tuple, create a JSON object. *) + List.map + (fun (post : Query.post_summary) -> `Assoc [ "title", `String post.title ]) + posts) + in + (* Return a 200 OK response with the JSON body. *) + Ok (Response.of_string ~body:(Yojson.Safe.to_string json) `OK) + (* If the query fails, log the error and return a 500 Internal Server Error response. *) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error)) + db_pool +;; diff --git a/lib/post_handlers.ml b/lib/post_handlers.ml new file mode 100644 index 0000000..2035792 --- /dev/null +++ b/lib/post_handlers.ml @@ -0,0 +1,100 @@ +open Piaf + +type pool = ((module Rapper_helper.CONNECTION), Caqti_error.t) Caqti_eio.Pool.t + +(* POST handlers for creating resources *) + +(* Handler for POST /posts - creates a new post *) +let create_post (db_pool : pool) (request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + (* Parse JSON body *) + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let title = json |> member "title" |> to_string in + let content = json |> member "content" |> to_string in + let tags = json |> member "tags" |> to_string_option |> Option.value ~default:"" in + let url = json |> member "url" |> to_string_option |> Option.value ~default:"" in + let date = Unix.time () |> Unix.gmtime |> fun tm -> + Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" + (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday + tm.tm_hour tm.tm_min tm.tm_sec in + (* Insert the post *) + match Query.create_post ~title ~content ~date ~tags ~url conn with + | Ok () -> + let response_json = `Assoc ["message", `String "Post created successfully"] in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request)) + db_pool +;; + +(* Handler for POST /comments - creates a new comment *) +let create_comment (db_pool : pool) (request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let content = json |> member "content" |> to_string in + let post_id = json |> member "post_id" |> to_int in + let parent = json |> member "parent" |> to_int_option in + let author = json |> member "author" |> to_string in + let tags = json |> member "tags" |> to_string_option |> Option.value ~default:"" in + let url = json |> member "url" |> to_string_option |> Option.value ~default:"" in + let date = Unix.time () |> Unix.gmtime |> fun tm -> + Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" + (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday + tm.tm_hour tm.tm_min tm.tm_sec in + (* Insert the comment *) + match Query.create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn with + | Ok () -> + let response_json = `Assoc ["message", `String "Comment created successfully"] in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request)) + db_pool +;; + +(* Handler for POST /votes - creates a new vote *) +let create_vote (db_pool : pool) (request : Request.t) = + Caqti_eio.Pool.use + (fun conn -> + match Body.to_string request.body with + | Error _ -> Ok (Response.create `Bad_request) + | Ok body_str -> + try + let json = Yojson.Safe.from_string body_str in + let open Yojson.Safe.Util in + let user_id = json |> member "user_id" |> to_string in + let vote_type = json |> member "vote_type" |> to_string in + let post_id = json |> member "post_id" |> to_int_option in + let comment_id = json |> member "comment_id" |> to_int_option in + (* Insert the vote *) + match Query.create_vote ~user_id ~vote_type ?post_id ?comment_id conn with + | Ok () -> + let response_json = `Assoc ["message", `String "Vote created successfully"] in + Ok (Response.of_string ~body:(Yojson.Safe.to_string response_json) `Created) + | Error err -> + Logs.err (fun m -> m "Database error: %a" Caqti_error.pp err); + Ok (Response.create `Internal_server_error) + with + | Yojson.Json_error _ -> Ok (Response.create `Bad_request) + | _ -> Ok (Response.create `Bad_request)) + db_pool +;;
\ No newline at end of file diff --git a/lib/query.ml b/lib/query.ml new file mode 100644 index 0000000..70285fc --- /dev/null +++ b/lib/query.ml @@ -0,0 +1,159 @@ +(* Define record types for the query outputs *) +type post_summary = { + id: int; + title: string; + content: string; + date: string; +} + +type post = { + id: int; + title: string; + content: string; + date: string; + tags: string; + url: string; +} + +type comment = { + id: int; + content: string; + date: string; + tags: string; + url: string; +} + +module Query = struct + let poasts = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{title}, @string{content}, @string{date} + FROM Posts + ORDER BY id DESC LIMIT 100 + |sql} + record_out] + ;; + + let poast = + [%rapper + get_opt + {sql| + SELECT @int{id}, @string{title}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Posts + WHERE id = %int{post_id} + |sql} + record_out] + ;; + + let comment = + [%rapper + get_opt + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE id = %int{id} + |sql} + record_out] + ;; + + let user_comments = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE author = %string{username} + |sql} + record_out] + ;; + + let post_comments = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE post_id = %int{post_id} + |sql} + record_out] + ;; + + let comment_children = + [%rapper + get_many + {sql| + SELECT @int{id}, @string{content}, @string{date}, @string{tags}, @string{url} + FROM Comments + WHERE parent= %int{post_id} + |sql} + record_out] + ;; + + (* Insert queries *) + let insert_post = + [%rapper + execute + {sql| + INSERT INTO Posts (title, content, date, tags, url) + VALUES (%string{title}, %string{content}, %string{date}, %string{tags}, %string{url}) + |sql}] + ;; + + let insert_comment = + [%rapper + execute + {sql| + INSERT INTO Comments (content, date, tags, url, post_id, parent, author) + VALUES (%string{content}, %string{date}, %string{tags}, %string{url}, %int{post_id}, %int?{parent}, %string{author}) + |sql}] + ;; + + let insert_vote = + [%rapper + execute + {sql| + INSERT INTO Votes (post_id, comment_id, user_id, vote_type) + VALUES (%int?{post_id}, %int?{comment_id}, %string{user_id}, %string{vote_type}) + |sql}] + ;; +end + +let get_poasts conn = Query.poasts conn +let get_poast post_id conn = Query.poast ~post_id conn + +(* Insert functions *) +let create_post ~title ~content ~date ~tags ~url conn = + Query.insert_post ~title ~content ~date ~tags ~url conn + +let create_comment ~content ~date ~tags ~url ~post_id ?parent ~author conn = + Query.insert_comment ~content ~date ~tags ~url ~post_id ~parent ~author conn + +let create_vote ~user_id ~vote_type ?post_id ?comment_id conn = + Query.insert_vote ~post_id ~comment_id ~user_id ~vote_type conn + +(* SQLite performance pragmas - to be implemented *) +let sqlite_pragmas = [ + "PRAGMA journal_mode = WAL"; + "PRAGMA foreign_keys = ON"; + "PRAGMA cache_size = -8000"; + "PRAGMA temp_store = MEMORY"; + "PRAGMA synchronous = NORMAL"; + "PRAGMA mmap_size = 30000000000"; +] + +(* Example of how to execute raw SQL with Caqti *) +let init_connection conn = + let module C = (val conn : Rapper_helper.CONNECTION) in + (* Create a request: unit input -> unit output using Caqti infix operators *) + let pragma_req sql = + let open Caqti_request.Infix in + let open Caqti_type in + (unit ->. unit) sql + in + (* Execute each pragma *) + List.fold_left (fun acc sql -> + match acc with + | Error e -> Error e + | Ok () -> C.exec (pragma_req sql) () + ) (Ok ()) sqlite_pragmas diff --git a/lib/router.ml b/lib/router.ml new file mode 100644 index 0000000..013686c --- /dev/null +++ b/lib/router.ml @@ -0,0 +1,84 @@ +(* Import the StdLabels module which provides labeled versions of standard library functions *) +open StdLabels + +(* Import the Routes library for type-safe HTTP routing *) +open Routes + +(* Import Piaf for HTTP types like Method.t *) +open Piaf + +(* Create a custom Map module keyed by HTTP methods (GET, POST, etc.) *) +(* This allows us to organize routes by their HTTP verb *) +module R = Map.Make (struct + (* The key type is Piaf's Method.t (represents HTTP methods) *) + type t = Method.t + + (* Define how to compare two HTTP methods for ordering in the map *) + let compare a b = + (* Convert methods to strings (e.g., "GET", "POST") *) + let a_str = Method.to_string a in + let b_str = Method.to_string b in + (* Use standard string comparison *) + String.compare a_str b_str + ;; + end) + +(* Define all routes in the application *) +let routes = + (* Use fold_left to build up a map of routes *) + List.fold_left + (* For each (verb, route) pair, add the route to the map under that verb *) + ~f:(fun acc (v, r) -> R.add_to_list v r acc) (* Start with an empty map *) + ~init:R.empty + (* List of (HTTP method, route pattern -> handler) tuples *) + [ `GET, (s "posts" /? nil) @--> Handler.get_posts + (* `GET - HTTP GET method *) + (* s "posts" - matches the literal string "posts" *) + (* /? - path concatenation operator *) + (* nil - end of path (no more segments) *) + (* @--> - binds the route pattern to the handler function *) + (* Handler.get_posts - the function that handles this route *) + ; `GET, (s "posts" / int /? nil) @--> Handler.get_post + (* / int - captures an integer parameter (post ID) *) + ; `GET, (s "comments" / int /? nil) @--> Handler.get_comment + (* Get a single comment by ID *) + ; `GET, (s "users" / str / s "comments" /? nil) @--> Handler.get_user_comments + (* / str - captures a string parameter (username) *) + ; `GET, (s "posts" / int / s "comments" /? nil) @--> Handler.get_post_comments + (* Get all comments for a specific post *) + ; `GET, (s "comments" / int / s "children" /? nil) @--> Handler.get_comment_children + (* Get child comments (replies) for a comment *) + ; `POST, (s "posts" /? nil) @--> Post_handlers.create_post (* Create a new post *) + ; `POST, (s "comments" /? nil) @--> Post_handlers.create_comment + (* Create a new comment *) + ; `POST, (s "votes" /? nil) @--> Post_handlers.create_vote + (* Create a new vote *) + + (* bs5 routes *) + (* root *) + ; `GET, nil @--> Pages.get_root + ; `GET, (s "l" /? nil) @--> Pages.get_root + ] +;; + +(* Transform the routes map by applying 'one_of' to each list of routes *) +(* 'one_of' combines multiple routes into a single router that tries each in order *) +let router = R.map one_of routes + +(* Function to match an incoming request against our routes *) +let match_route verb path = + (* Try to find routes for the given HTTP verb in our map *) + match R.find_opt verb router with + (* If we have routes for this verb, try to match the path *) + | Some router -> + (* Use the Routes library's match' function to find a matching route *) + (match match' router ~target:path with + (* Exact match - the path matches completely *) + | FullMatch r -> Some r + (* Match with trailing slash - e.g., "/posts" matches "/posts/" *) + | MatchWithTrailingSlash r -> Some r + (* No routes matched the path *) + | NoMatch -> None) + (* We don't have any routes for this HTTP verb *) + | None -> None +;; |