From 473072f66e6c7e228b4f26730cbc7304941fb12b Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Thu, 29 Nov 2018 12:55:10 -0700 Subject: functors! --- lib/http.ml | 439 ++++++++++++++++++++++++++++++------------------------------ 1 file changed, 221 insertions(+), 218 deletions(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index 8d0b679..a8e6b22 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -1,319 +1,322 @@ open Async open Cohttp -module Base = struct - exception Invalid_Method +module Make(T : S.Token) = struct + include T - let base_url = "https://discordapp.com/api/v7" - let cdn_url = "https://cdn.discordapp.com" + module Base = struct + exception Invalid_Method - let process_url path = - Uri.of_string (base_url ^ path) + let base_url = "https://discordapp.com/api/v7" + let cdn_url = "https://cdn.discordapp.com" - let process_request_body body = - body - |> Yojson.Basic.to_string - |> Cohttp_async.Body.of_string + let process_url path = + Uri.of_string (base_url ^ path) - let process_request_headers () = - let token = match Sys.getenv "DISCORD_TOKEN" with - | Some t -> t - | None -> failwith "Please provide a token" - in - let h = Header.init_with "User-Agent" "Dis.ml v0.1.0" in - let h = Header.add h "Authorization" ("Bot " ^ token) in - Header.add h "Content-Type" "application/json" + let process_request_body body = + body + |> Yojson.Basic.to_string + |> Cohttp_async.Body.of_string - (* TODO Finish processor *) - let process_response (_resp, body) = - body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string + let process_request_headers () = + let h = Header.init () in + Header.add_list h [ + "User-Agent", "Dis.ml v0.1.0"; + "Authorization", ("Bot " ^ token); + "Content-Type", "application/json"; + ] - let request ?(body=`Null) m path = - let uri = process_url path in - let headers = process_request_headers () in - let body = process_request_body body in - (match m with - | `DELETE -> Cohttp_async.Client.delete ~headers ~body uri - | `GET -> Cohttp_async.Client.get ~headers uri - | `PATCH -> Cohttp_async.Client.patch ~headers ~body uri - | `POST -> Cohttp_async.Client.post ~headers ~body uri - | `PUT -> Cohttp_async.Client.put ~headers ~body uri - | _ -> raise Invalid_Method) - >>= process_response -end + (* TODO Finish processor *) + let process_response (_resp, body) = + body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string -let get_gateway () = - Base.request `GET Endpoints.gateway + let request ?(body=`Null) m path = + let uri = process_url path in + let headers = process_request_headers () in + let body = process_request_body body in + (match m with + | `DELETE -> Cohttp_async.Client.delete ~headers ~body uri + | `GET -> Cohttp_async.Client.get ~headers uri + | `PATCH -> Cohttp_async.Client.patch ~headers ~body uri + | `POST -> Cohttp_async.Client.post ~headers ~body uri + | `PUT -> Cohttp_async.Client.put ~headers ~body uri + | _ -> raise Invalid_Method) + >>= process_response + end -let get_gateway_bot () = - Base.request `GET Endpoints.gateway_bot + let get_gateway () = + Base.request `GET Endpoints.gateway -let get_channel channel_id = - Base.request `GET (Endpoints.channel channel_id) + let get_gateway_bot () = + Base.request `GET Endpoints.gateway_bot -let modify_channel channel_id body = - Base.request ~body `PATCH (Endpoints.channel channel_id) + let get_channel channel_id = + Base.request `GET (Endpoints.channel channel_id) -let delete_channel channel_id = - Base.request `DELETE (Endpoints.channel channel_id) + let modify_channel channel_id body = + Base.request ~body `PATCH (Endpoints.channel channel_id) -let get_messages channel_id = - Base.request `GET (Endpoints.channel_messages channel_id) + let delete_channel channel_id = + Base.request `DELETE (Endpoints.channel channel_id) -let get_message channel_id message_id = - Base.request `GET (Endpoints.channel_message channel_id message_id) + let get_messages channel_id = + Base.request `GET (Endpoints.channel_messages channel_id) -let create_message channel_id body = - Base.request ~body:body `POST (Endpoints.channel_messages channel_id) + let get_message channel_id message_id = + Base.request `GET (Endpoints.channel_message channel_id message_id) -let create_reaction channel_id message_id emoji = - Base.request `PUT (Endpoints.channel_reaction_me channel_id message_id emoji) + let create_message channel_id body = + Base.request ~body:body `POST (Endpoints.channel_messages channel_id) -let delete_own_reaction channel_id message_id emoji = - Base.request `DELETE (Endpoints.channel_reaction_me channel_id message_id emoji) + let create_reaction channel_id message_id emoji = + Base.request `PUT (Endpoints.channel_reaction_me channel_id message_id emoji) -let delete_reaction channel_id message_id emoji user_id = - Base.request `DELETE (Endpoints.channel_reaction channel_id message_id emoji user_id) + let delete_own_reaction channel_id message_id emoji = + Base.request `DELETE (Endpoints.channel_reaction_me channel_id message_id emoji) -let get_reactions channel_id message_id emoji = - Base.request `GET (Endpoints.channel_reactions_get channel_id message_id emoji) + let delete_reaction channel_id message_id emoji user_id = + Base.request `DELETE (Endpoints.channel_reaction channel_id message_id emoji user_id) -let delete_reactions channel_id message_id = - Base.request `DELETE (Endpoints.channel_reactions_delete channel_id message_id) + let get_reactions channel_id message_id emoji = + Base.request `GET (Endpoints.channel_reactions_get channel_id message_id emoji) -let edit_message channel_id message_id body = - Base.request ~body `PATCH (Endpoints.channel_message channel_id message_id) + let delete_reactions channel_id message_id = + Base.request `DELETE (Endpoints.channel_reactions_delete channel_id message_id) -let delete_message channel_id message_id = - Base.request `DELETE (Endpoints.channel_message channel_id message_id) + let edit_message channel_id message_id body = + Base.request ~body `PATCH (Endpoints.channel_message channel_id message_id) -let bulk_delete channel_id body = - Base.request ~body `POST (Endpoints.channel_bulk_delete channel_id) + let delete_message channel_id message_id = + Base.request `DELETE (Endpoints.channel_message channel_id message_id) -let edit_channel_permissions channel_id overwrite_id body = - Base.request ~body `PUT (Endpoints.channel_permission channel_id overwrite_id) + let bulk_delete channel_id body = + Base.request ~body `POST (Endpoints.channel_bulk_delete channel_id) -let get_channel_invites channel_id = - Base.request `GET (Endpoints.channel_invites channel_id) + let edit_channel_permissions channel_id overwrite_id body = + Base.request ~body `PUT (Endpoints.channel_permission channel_id overwrite_id) -let create_channel_invite channel_id body = - Base.request ~body `POST (Endpoints.channel_invites channel_id) + let get_channel_invites channel_id = + Base.request `GET (Endpoints.channel_invites channel_id) -let delete_channel_permission channel_id overwrite_id = - Base.request `DELETE (Endpoints.channel_permission channel_id overwrite_id) + let create_channel_invite channel_id body = + Base.request ~body `POST (Endpoints.channel_invites channel_id) -let broadcast_typing channel_id = - Base.request `POST (Endpoints.channel_typing channel_id) + let delete_channel_permission channel_id overwrite_id = + Base.request `DELETE (Endpoints.channel_permission channel_id overwrite_id) -let get_pinned_messages channel_id = - Base.request `GET (Endpoints.channel_pins channel_id) + let broadcast_typing channel_id = + Base.request `POST (Endpoints.channel_typing channel_id) -let pin_message channel_id message_id = - Base.request `PUT (Endpoints.channel_pin channel_id message_id) + let get_pinned_messages channel_id = + Base.request `GET (Endpoints.channel_pins channel_id) -let unpin_message channel_id message_id = - Base.request `DELETE (Endpoints.channel_pin channel_id message_id) + let pin_message channel_id message_id = + Base.request `PUT (Endpoints.channel_pin channel_id message_id) -let group_recipient_add channel_id user_id = - Base.request `PUT (Endpoints.group_recipient channel_id user_id) + let unpin_message channel_id message_id = + Base.request `DELETE (Endpoints.channel_pin channel_id message_id) -let group_recipient_remove channel_id user_id = - Base.request `DELETE (Endpoints.group_recipient channel_id user_id) + let group_recipient_add channel_id user_id = + Base.request `PUT (Endpoints.group_recipient channel_id user_id) -let get_emojis guild_id = - Base.request `GET (Endpoints.guild_emojis guild_id) + let group_recipient_remove channel_id user_id = + Base.request `DELETE (Endpoints.group_recipient channel_id user_id) -let get_emoji guild_id emoji_id = - Base.request `GET (Endpoints.guild_emoji guild_id emoji_id) + let get_emojis guild_id = + Base.request `GET (Endpoints.guild_emojis guild_id) -let create_emoji guild_id body = - Base.request ~body `POST (Endpoints.guild_emojis guild_id) + let get_emoji guild_id emoji_id = + Base.request `GET (Endpoints.guild_emoji guild_id emoji_id) -let edit_emoji guild_id emoji_id body = - Base.request ~body `PATCH (Endpoints.guild_emoji guild_id emoji_id) + let create_emoji guild_id body = + Base.request ~body `POST (Endpoints.guild_emojis guild_id) -let delete_emoji guild_id emoji_id = - Base.request `DELETE (Endpoints.guild_emoji guild_id emoji_id) + let edit_emoji guild_id emoji_id body = + Base.request ~body `PATCH (Endpoints.guild_emoji guild_id emoji_id) -let create_guild body = - Base.request ~body `POST Endpoints.guilds + let delete_emoji guild_id emoji_id = + Base.request `DELETE (Endpoints.guild_emoji guild_id emoji_id) -let get_guild guild_id = - Base.request `GET (Endpoints.guild guild_id) + let create_guild body = + Base.request ~body `POST Endpoints.guilds -let edit_guild guild_id body = - Base.request ~body `PATCH (Endpoints.guild guild_id) + let get_guild guild_id = + Base.request `GET (Endpoints.guild guild_id) -let delete_guild guild_id = - Base.request `DELETE (Endpoints.guild guild_id) + let edit_guild guild_id body = + Base.request ~body `PATCH (Endpoints.guild guild_id) -let get_guild_channels guild_id = - Base.request `GET (Endpoints.guild_channels guild_id) + let delete_guild guild_id = + Base.request `DELETE (Endpoints.guild guild_id) -let create_guild_channel guild_id body = - Base.request ~body `POST (Endpoints.guild_channels guild_id) + let get_guild_channels guild_id = + Base.request `GET (Endpoints.guild_channels guild_id) -let modify_guild_channel_positions guild_id body = - Base.request ~body `PATCH (Endpoints.guild_channels guild_id) + let create_guild_channel guild_id body = + Base.request ~body `POST (Endpoints.guild_channels guild_id) -let get_member guild_id user_id = - Base.request `GET (Endpoints.guild_member guild_id user_id) + let modify_guild_channel_positions guild_id body = + Base.request ~body `PATCH (Endpoints.guild_channels guild_id) -let get_members guild_id = - Base.request `GET (Endpoints.guild_members guild_id) + let get_member guild_id user_id = + Base.request `GET (Endpoints.guild_member guild_id user_id) -let add_member guild_id user_id body = - Base.request ~body `PUT (Endpoints.guild_member guild_id user_id) + let get_members guild_id = + Base.request `GET (Endpoints.guild_members guild_id) -let edit_member guild_id user_id body = - Base.request ~body `PATCH (Endpoints.guild_member guild_id user_id) + let add_member guild_id user_id body = + Base.request ~body `PUT (Endpoints.guild_member guild_id user_id) -let remove_member guild_id user_id = - Base.request `DELETE (Endpoints.guild_member guild_id user_id) + let edit_member guild_id user_id body = + Base.request ~body `PATCH (Endpoints.guild_member guild_id user_id) -let change_nickname guild_id body = - Base.request ~body `PATCH (Endpoints.guild_me_nick guild_id) + let remove_member guild_id user_id = + Base.request `DELETE (Endpoints.guild_member guild_id user_id) -let add_member_role guild_id user_id role_id = - Base.request `PUT (Endpoints.guild_member_role guild_id user_id role_id) + let change_nickname guild_id body = + Base.request ~body `PATCH (Endpoints.guild_me_nick guild_id) -let remove_member_role guild_id user_id role_id = - Base.request `DELETE (Endpoints.guild_member_role guild_id user_id role_id) + let add_member_role guild_id user_id role_id = + Base.request `PUT (Endpoints.guild_member_role guild_id user_id role_id) -let get_bans guild_id = - Base.request `GET (Endpoints.guild_bans guild_id) + let remove_member_role guild_id user_id role_id = + Base.request `DELETE (Endpoints.guild_member_role guild_id user_id role_id) -let get_ban guild_id user_id = - Base.request `GET (Endpoints.guild_ban guild_id user_id) + let get_bans guild_id = + Base.request `GET (Endpoints.guild_bans guild_id) -let guild_ban_add guild_id user_id body = - Base.request ~body `PUT (Endpoints.guild_ban guild_id user_id) + let get_ban guild_id user_id = + Base.request `GET (Endpoints.guild_ban guild_id user_id) -let guild_ban_remove guild_id user_id = - Base.request `DELETE (Endpoints.guild_ban guild_id user_id) + let guild_ban_add guild_id user_id body = + Base.request ~body `PUT (Endpoints.guild_ban guild_id user_id) -let get_roles guild_id = - Base.request `GET (Endpoints.guild_roles guild_id) + let guild_ban_remove guild_id user_id = + Base.request `DELETE (Endpoints.guild_ban guild_id user_id) -let guild_role_add guild_id body = - Base.request ~body `POST (Endpoints.guild_roles guild_id) + let get_roles guild_id = + Base.request `GET (Endpoints.guild_roles guild_id) -let guild_roles_edit guild_id body = - Base.request ~body `PATCH (Endpoints.guild_roles guild_id) + let guild_role_add guild_id body = + Base.request ~body `POST (Endpoints.guild_roles guild_id) -let guild_role_edit guild_id role_id body = - Base.request ~body `PATCH (Endpoints.guild_role guild_id role_id) + let guild_roles_edit guild_id body = + Base.request ~body `PATCH (Endpoints.guild_roles guild_id) -let guild_role_remove guild_id role_id = - Base.request `DELETE (Endpoints.guild_role guild_id role_id) + let guild_role_edit guild_id role_id body = + Base.request ~body `PATCH (Endpoints.guild_role guild_id role_id) -let guild_prune_count guild_id = - Base.request `GET (Endpoints.guild_prune guild_id) + let guild_role_remove guild_id role_id = + Base.request `DELETE (Endpoints.guild_role guild_id role_id) -let guild_prune_start guild_id body = - Base.request ~body `POST (Endpoints.guild_prune guild_id) + let guild_prune_count guild_id = + Base.request `GET (Endpoints.guild_prune guild_id) -let get_guild_voice_regions guild_id = - Base.request `GET (Endpoints.guild_voice_regions guild_id) + let guild_prune_start guild_id body = + Base.request ~body `POST (Endpoints.guild_prune guild_id) -let get_guild_invites guild_id = - Base.request `GET (Endpoints.guild_invites guild_id) + let get_guild_voice_regions guild_id = + Base.request `GET (Endpoints.guild_voice_regions guild_id) -let get_integrations guild_id = - Base.request `GET (Endpoints.guild_integrations guild_id) + let get_guild_invites guild_id = + Base.request `GET (Endpoints.guild_invites guild_id) -let add_integration guild_id body = - Base.request ~body `POST (Endpoints.guild_integrations guild_id) + let get_integrations guild_id = + Base.request `GET (Endpoints.guild_integrations guild_id) -let edit_integration guild_id integration_id body = - Base.request ~body `POST (Endpoints.guild_integration guild_id integration_id) + let add_integration guild_id body = + Base.request ~body `POST (Endpoints.guild_integrations guild_id) -let delete_integration guild_id integration_id = - Base.request `DELETE (Endpoints.guild_integration guild_id integration_id) + let edit_integration guild_id integration_id body = + Base.request ~body `POST (Endpoints.guild_integration guild_id integration_id) -let sync_integration guild_id integration_id = - Base.request `POST (Endpoints.guild_integration_sync guild_id integration_id) + let delete_integration guild_id integration_id = + Base.request `DELETE (Endpoints.guild_integration guild_id integration_id) -let get_guild_embed guild_id = - Base.request `GET (Endpoints.guild_embed guild_id) + let sync_integration guild_id integration_id = + Base.request `POST (Endpoints.guild_integration_sync guild_id integration_id) -let edit_guild_embed guild_id body = - Base.request ~body `PATCH (Endpoints.guild_embed guild_id) + let get_guild_embed guild_id = + Base.request `GET (Endpoints.guild_embed guild_id) -let get_vanity_url guild_id = - Base.request `GET (Endpoints.guild_vanity_url guild_id) + let edit_guild_embed guild_id body = + Base.request ~body `PATCH (Endpoints.guild_embed guild_id) -let get_invite invite_code = - Base.request `GET (Endpoints.invite invite_code) + let get_vanity_url guild_id = + Base.request `GET (Endpoints.guild_vanity_url guild_id) -let delete_invite invite_code = - Base.request `DELETE (Endpoints.invite invite_code) + let get_invite invite_code = + Base.request `GET (Endpoints.invite invite_code) -let get_current_user () = - Base.request `GET Endpoints.me + let delete_invite invite_code = + Base.request `DELETE (Endpoints.invite invite_code) -let edit_current_user body = - Base.request ~body `PATCH Endpoints.me + let get_current_user () = + Base.request `GET Endpoints.me -let get_guilds () = - Base.request `GET Endpoints.me_guilds + let edit_current_user body = + Base.request ~body `PATCH Endpoints.me -let leave_guild guild_id = - Base.request `DELETE (Endpoints.me_guild guild_id) + let get_guilds () = + Base.request `GET Endpoints.me_guilds -let get_private_channels () = - Base.request `GET Endpoints.me_channels + let leave_guild guild_id = + Base.request `DELETE (Endpoints.me_guild guild_id) -let create_dm body = - Base.request ~body `POST Endpoints.me_channels + let get_private_channels () = + Base.request `GET Endpoints.me_channels -let create_group_dm body = - Base.request ~body `POST Endpoints.me_channels + let create_dm body = + Base.request ~body `POST Endpoints.me_channels -let get_connections () = - Base.request `GET Endpoints.me_connections + let create_group_dm body = + Base.request ~body `POST Endpoints.me_channels -let get_user user_id = - Base.request `GET (Endpoints.user user_id) + let get_connections () = + Base.request `GET Endpoints.me_connections -let get_voice_regions () = - Base.request `GET Endpoints.regions + let get_user user_id = + Base.request `GET (Endpoints.user user_id) -let create_webhook channel_id body = - Base.request ~body `POST (Endpoints.webhooks_channel channel_id) + let get_voice_regions () = + Base.request `GET Endpoints.regions -let get_channel_webhooks channel_id = - Base.request `GET (Endpoints.webhooks_channel channel_id) + let create_webhook channel_id body = + Base.request ~body `POST (Endpoints.webhooks_channel channel_id) -let get_guild_webhooks guild_id = - Base.request `GET (Endpoints.webhooks_guild guild_id) + let get_channel_webhooks channel_id = + Base.request `GET (Endpoints.webhooks_channel channel_id) -let get_webhook webhook_id = - Base.request `GET (Endpoints.webhook webhook_id) + let get_guild_webhooks guild_id = + Base.request `GET (Endpoints.webhooks_guild guild_id) -let get_webhook_with_token webhook_id token = - Base.request `GET (Endpoints.webhook_token webhook_id token) + let get_webhook webhook_id = + Base.request `GET (Endpoints.webhook webhook_id) -let edit_webhook webhook_id body = - Base.request ~body `PATCH (Endpoints.webhook webhook_id) + let get_webhook_with_token webhook_id token = + Base.request `GET (Endpoints.webhook_token webhook_id token) -let edit_webhook_with_token webhook_id token body = - Base.request ~body `PATCH (Endpoints.webhook_token webhook_id token) + let edit_webhook webhook_id body = + Base.request ~body `PATCH (Endpoints.webhook webhook_id) -let delete_webhook webhook_id = - Base.request `DELETE (Endpoints.webhook webhook_id) + let edit_webhook_with_token webhook_id token body = + Base.request ~body `PATCH (Endpoints.webhook_token webhook_id token) -let delete_webhook_with_token webhook_id token = - Base.request `DELETE (Endpoints.webhook_token webhook_id token) + let delete_webhook webhook_id = + Base.request `DELETE (Endpoints.webhook webhook_id) -let execute_webhook webhook_id token body = - Base.request ~body `POST (Endpoints.webhook_token webhook_id token) + let delete_webhook_with_token webhook_id token = + Base.request `DELETE (Endpoints.webhook_token webhook_id token) -let execute_slack_webhook webhook_id token body = - Base.request ~body `POST (Endpoints.webhook_slack webhook_id token) + let execute_webhook webhook_id token body = + Base.request ~body `POST (Endpoints.webhook_token webhook_id token) -let execute_git_webhook webhook_id token body = - Base.request ~body `POST (Endpoints.webhook_git webhook_id token) + let execute_slack_webhook webhook_id token body = + Base.request ~body `POST (Endpoints.webhook_slack webhook_id token) -let get_audit_logs guild_id body = - Base.request ~body `GET (Endpoints.guild_audit_logs guild_id) \ No newline at end of file + let execute_git_webhook webhook_id token body = + Base.request ~body `POST (Endpoints.webhook_git webhook_id token) + + let get_audit_logs guild_id body = + Base.request ~body `GET (Endpoints.guild_audit_logs guild_id) +end \ No newline at end of file -- cgit v1.2.3 From 18f4b7e8cada448f6fc15ee8ee18944dcb0b1676 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Thu, 29 Nov 2018 13:50:53 -0700 Subject: Try to make it a more properly structured lib --- lib/http.ml | 1 - 1 file changed, 1 deletion(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index a8e6b22..8cc56fb 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -8,7 +8,6 @@ module Make(T : S.Token) = struct exception Invalid_Method let base_url = "https://discordapp.com/api/v7" - let cdn_url = "https://cdn.discordapp.com" let process_url path = Uri.of_string (base_url ^ path) -- cgit v1.2.3 From eaccd45894e5b519bca82662d0b950b5f1d9c598 Mon Sep 17 00:00:00 2001 From: Mishio595 Date: Thu, 29 Nov 2018 18:10:45 -0700 Subject: Fix all the errors from coding without merlin --- lib/http.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index 8cc56fb..6f14a22 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -1,7 +1,6 @@ -open Async -open Cohttp - module Make(T : S.Token) = struct + open Async + open Cohttp include T module Base = struct @@ -18,7 +17,7 @@ module Make(T : S.Token) = struct |> Cohttp_async.Body.of_string let process_request_headers () = - let h = Header.init () in + let h = Header.init () in Header.add_list h [ "User-Agent", "Dis.ml v0.1.0"; "Authorization", ("Bot " ^ token); @@ -26,7 +25,7 @@ module Make(T : S.Token) = struct ] (* TODO Finish processor *) - let process_response (_resp, body) = + let process_response ((_resp:Response.t), body) = body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string let request ?(body=`Null) m path = -- cgit v1.2.3 From 260ccd9960b852b9c69b88e9840d5a8b22bb8e1d Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Wed, 12 Dec 2018 15:00:46 -0700 Subject: Work on event dispatch and add model derives --- lib/http.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index 6f14a22..3e10eb8 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -13,7 +13,7 @@ module Make(T : S.Token) = struct let process_request_body body = body - |> Yojson.Basic.to_string + |> Yojson.Safe.to_string |> Cohttp_async.Body.of_string let process_request_headers () = @@ -26,7 +26,7 @@ module Make(T : S.Token) = struct (* TODO Finish processor *) let process_response ((_resp:Response.t), body) = - body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string + body |> Cohttp_async.Body.to_string >>| Yojson.Safe.from_string let request ?(body=`Null) m path = let uri = process_url path in -- cgit v1.2.3 From c848b9cc265f5ac2bcc70bd73e1cc8945d512e34 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Thu, 13 Dec 2018 14:11:23 -0700 Subject: Add rate limit handling --- lib/http.ml | 42 +++++++++++++++++++++++++++++------------- 1 file changed, 29 insertions(+), 13 deletions(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index 3e10eb8..d2dff65 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -5,6 +5,9 @@ module Make(T : S.Token) = struct module Base = struct exception Invalid_Method + exception Bad_response_headers + + let rl = ref Rl.empty let base_url = "https://discordapp.com/api/v7" @@ -24,22 +27,35 @@ module Make(T : S.Token) = struct "Content-Type", "application/json"; ] - (* TODO Finish processor *) - let process_response ((_resp:Response.t), body) = + let process_response path ((resp:Response.t), body) = + (match Response.headers resp + |> Rl.rl_of_header with + | Some r -> Mvar.put (Rl.find_exn !rl path) r + | None -> raise Bad_response_headers) + >>= fun () -> body |> Cohttp_async.Body.to_string >>| Yojson.Safe.from_string let request ?(body=`Null) m path = - let uri = process_url path in - let headers = process_request_headers () in - let body = process_request_body body in - (match m with - | `DELETE -> Cohttp_async.Client.delete ~headers ~body uri - | `GET -> Cohttp_async.Client.get ~headers uri - | `PATCH -> Cohttp_async.Client.patch ~headers ~body uri - | `POST -> Cohttp_async.Client.post ~headers ~body uri - | `PUT -> Cohttp_async.Client.put ~headers ~body uri - | _ -> raise Invalid_Method) - >>= process_response + rl := Rl.update ~f:(function + | None -> Mvar.create () + | Some r -> r + ) !rl path; + let limit = Rl.find_exn !rl path in + Mvar.take limit >>= fun limit -> + let process () = + let uri = process_url path in + let headers = process_request_headers () in + let body = process_request_body body in + (match m with + | `DELETE -> Cohttp_async.Client.delete ~headers ~body uri + | `GET -> Cohttp_async.Client.get ~headers uri + | `PATCH -> Cohttp_async.Client.patch ~headers ~body uri + | `POST -> Cohttp_async.Client.post ~headers ~body uri + | `PUT -> Cohttp_async.Client.put ~headers ~body uri + | _ -> raise Invalid_Method) + >>= process_response path + in if limit.remaining > 0 then process () + else Clock.at (Core.Time.(Span.of_int_sec limit.reset |> of_span_since_epoch)) >>= process end let get_gateway () = -- cgit v1.2.3 From 179d9598fe62e2966471b312fd438e98ff3a272a Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Thu, 13 Dec 2018 15:50:37 -0700 Subject: Fix more dispatch issues --- lib/http.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lib/http.ml') diff --git a/lib/http.ml b/lib/http.ml index d2dff65..810bdc3 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -37,7 +37,10 @@ module Make(T : S.Token) = struct let request ?(body=`Null) m path = rl := Rl.update ~f:(function - | None -> Mvar.create () + | None -> + let r = Mvar.create () in + Mvar.set r Rl.default; + r | Some r -> r ) !rl path; let limit = Rl.find_exn !rl path in -- cgit v1.2.3