diff options
| -rw-r--r-- | bin/bot.ml | 41 | ||||
| -rw-r--r-- | bin/handler.ml | 1 | ||||
| -rw-r--r-- | disml.opam | 4 | ||||
| -rw-r--r-- | dune | 5 | ||||
| -rw-r--r-- | lib/client.ml | 9 | ||||
| -rw-r--r-- | lib/dispatch.ml | 121 | ||||
| -rw-r--r-- | lib/http.ml | 4 | ||||
| -rw-r--r-- | lib/models/activity.ml | 5 | ||||
| -rw-r--r-- | lib/models/attachment.ml | 2 | ||||
| -rw-r--r-- | lib/models/ban.ml | 2 | ||||
| -rw-r--r-- | lib/models/channel.ml | 2 | ||||
| -rw-r--r-- | lib/models/embed.ml | 12 | ||||
| -rw-r--r-- | lib/models/emoji.ml | 2 | ||||
| -rw-r--r-- | lib/models/guild.ml | 2 | ||||
| -rw-r--r-- | lib/models/member.ml | 2 | ||||
| -rw-r--r-- | lib/models/message.ml | 2 | ||||
| -rw-r--r-- | lib/models/presence.ml | 2 | ||||
| -rw-r--r-- | lib/models/reaction.ml | 2 | ||||
| -rw-r--r-- | lib/models/role.ml | 2 | ||||
| -rw-r--r-- | lib/models/snowflake.ml | 2 | ||||
| -rw-r--r-- | lib/models/user.ml | 2 | ||||
| -rw-r--r-- | lib/s.ml | 256 | ||||
| -rw-r--r-- | lib/sharder.ml | 19 | ||||
| -rw-r--r-- | lib/sharder.mli | 2 |
24 files changed, 286 insertions, 217 deletions
@@ -5,47 +5,10 @@ module Client = Disml.Client.Make(struct let token = match Sys.getenv "DISCORD_TOKEN" with | Some t -> t | None -> failwith "No token in env" -end) - -(* let rec ev_loop read = - Pipe.read read >>= fun frame -> - match frame with - | `Eof -> return () - | `Ok (t, data) -> begin - match t with - | "MESSAGE_CREATE" -> begin - let msg = Model.to_message data in - let msg_time = Time.(to_span_since_epoch @@ now ()) in - let content = msg.content in - let channel = msg.channel in - if String.is_prefix ~prefix:"!?ping" content then begin - Http.create_message channel @@ `Assoc [ - ("content", `String "Pong!"); - ("tts", `Bool false); - ] - >>> fun resp -> - let message_id = Yojson.Basic.Util.(member "id" resp |> to_string) in - let rtt = Time.(to_span_since_epoch @@ sub (now ()) msg_time) in - Http.edit_message channel message_id @@ `Assoc [ - ("content", `String ("Pong! `" ^ (Float.to_string @@ Time.Span.to_ms rtt) ^ " ms`")); - ] - >>> fun _ -> print_endline "Message Edited!" - end; - return () - end - | "GUILD_CREATE" -> begin - let guild = Model.to_guild data in - print_endline guild.name; - return () - end - | _ -> return () - end - >>= fun _ -> ev_loop read *) +end)(Handler) let main () = - let (_r,w) = Pipe.create () in - let client = Client.init ~handler:w () in - (* ev_loop r >>> ignore; *) + let client = Client.init () in Client.start client >>> fun client -> Clock.every diff --git a/bin/handler.ml b/bin/handler.ml new file mode 100644 index 0000000..1dd01cb --- /dev/null +++ b/bin/handler.ml @@ -0,0 +1 @@ +let handle_event _a _b = print_endline "Received event!"
\ No newline at end of file @@ -2,8 +2,8 @@ opam-version: "2.0" name: "disml" version: "~dev" synopsis: "A Discord API wrapper" -maintainer: "Mishio595 <[email protected]>" -authors: "Mishio595 <[email protected]>" +maintainer: "Adelyn Breedlove <[email protected]>" +authors: "Adelyn Breedlove <[email protected]>" license: "MIT" homepage: "https://gitlab.com/Mishio595/disml" bug-reports: "https://gitlab.com/Mishio595/disml/issues" @@ -1,13 +1,14 @@ (library (name disml) (modules activity attachment ban channel embed emoji guild member message presence reaction role snowflake user client dispatch endpoints event http opcode s sharder) - (libraries core async_ssl cohttp-async yojson websocket-async zlib) + (libraries core async_ssl cohttp-async yojson websocket-async zlib ppx_deriving_yojson.runtime) + (preprocess (pps ppx_jane ppx_deriving_yojson)) ) ; Test executable (executable (name bot) - (modules bot) + (modules bot handler) (libraries core async_ssl disml) ) diff --git a/lib/client.ml b/lib/client.ml index b27a2ee..018f3e6 100644 --- a/lib/client.ml +++ b/lib/client.ml @@ -1,21 +1,20 @@ open Async -module Make(T : S.Token) = struct +module Make(T : S.Token)(H : S.Handler) = struct include T module Http = Http.Make(T) - module Sharder = Sharder.Make(Http) + module Dispatch = Dispatch.Make(H) + module Sharder = Sharder.Make(Http)(Dispatch) type t = { sharder: Sharder.t Ivar.t; - handler: string Pipe.Writer.t; token: string; } - let init ~handler () = + let init () = { sharder = Ivar.create (); - handler; token; } diff --git a/lib/dispatch.ml b/lib/dispatch.ml index 43ffe1f..65c84ef 100644 --- a/lib/dispatch.ml +++ b/lib/dispatch.ml @@ -1,38 +1,85 @@ -(* open Async *) +open Core -type dispatch_event = -| HELLO of Yojson.Basic.json -| READY of Yojson.Basic.json -| RESUMED of Yojson.Basic.json -| INVALID_SESSION of Yojson.Basic.json -| CHANNEL_CREATE of Channel.t -| CHANNEL_UPDATE of Channel.t -| CHANNEL_DELETE of Channel.t -| CHANNEL_PINS_UPDATE of Yojson.Basic.json -| GUILD_CREATE of Guild.t -| GUILD_UPDATE of Guild.t -| GUILD_DELETE of Guild.t -| GUILD_BAN_ADD of Ban.t -| GUILD_BAN_REMOVE of Ban.t -| GUILD_EMOJIS_UPDATE of Yojson.Basic.json -| GUILD_INTEGRATIONS_UPDATE of Yojson.Basic.json -| GUILD_MEMBER_ADD of Member.t -| GUILD_MEMBER_REMOVE of Member.t -| GUILD_MEMBER_UPDATE of Member.t -| GUILD_MEMBERS_CHUNK of Member.t list -| GUILD_ROLE_CREATE of Role.t * Guild.t -| GUILD_ROLE_UPDATE of Role.t * Guild.t -| GUILD_ROLE_DELETE of Role.t * Guild.t -| MESSAGE_CREATE of Message.t -| MESSAGE_UPDATE of Message.t -| MESSAGE_DELETE of Message.t -| MESSAGE_BULK_DELETE of Message.t list -| MESSAGE_REACTION_ADD of Message.t * Reaction.t -| MESSAGE_REACTION_REMOVE of Message.t * Reaction.t -| MESSAGE_REACTION_REMOVE_ALL of Message.t * Reaction.t list -| PRESENCE_UPDATE of Presence.t -| TYPING_START of Yojson.Basic.json -| USER_UPDATE of Yojson.Basic.json -| VOICE_STATE_UPDATE of Yojson.Basic.json -| VOICE_SERVER_UPDATE of Yojson.Basic.json -| WEBHOOKS_UPDATE of Yojson.Basic.json +module Make(H : S.Handler) : S.Dispatch = struct + type dispatch_event = + | HELLO of Yojson.Safe.json + | READY of Yojson.Safe.json + | RESUMED of Yojson.Safe.json + | INVALID_SESSION of Yojson.Safe.json + | CHANNEL_CREATE of Channel.t + | CHANNEL_UPDATE of Channel.t + | CHANNEL_DELETE of Channel.t + | CHANNEL_PINS_UPDATE of Yojson.Safe.json + | GUILD_CREATE of Guild.t + | GUILD_UPDATE of Guild.t + | GUILD_DELETE of Guild.t + | GUILD_BAN_ADD of Ban.t + | GUILD_BAN_REMOVE of Ban.t + | GUILD_EMOJIS_UPDATE of Yojson.Safe.json + | GUILD_INTEGRATIONS_UPDATE of Yojson.Safe.json + | GUILD_MEMBER_ADD of Member.t + | GUILD_MEMBER_REMOVE of Member.t + | GUILD_MEMBER_UPDATE of Member.t + | GUILD_MEMBERS_CHUNK of Member.t list + | GUILD_ROLE_CREATE of Role.t (* * Guild.t *) + | GUILD_ROLE_UPDATE of Role.t (* * Guild.t *) + | GUILD_ROLE_DELETE of Role.t (* * Guild.t *) + | MESSAGE_CREATE of Message.t + | MESSAGE_UPDATE of Message.t + | MESSAGE_DELETE of Message.t + | MESSAGE_BULK_DELETE of Message.t list + | MESSAGE_REACTION_ADD of (* Message.t * *) Reaction.t + | MESSAGE_REACTION_REMOVE of (* Message.t * *) Reaction.t + | MESSAGE_REACTION_REMOVE_ALL of (* Message.t * *) Reaction.t list + | PRESENCE_UPDATE of Presence.t + | TYPING_START of Yojson.Safe.json + | USER_UPDATE of Yojson.Safe.json + | VOICE_STATE_UPDATE of Yojson.Safe.json + | VOICE_SERVER_UPDATE of Yojson.Safe.json + | WEBHOOKS_UPDATE of Yojson.Safe.json + + exception Invalid_event of string + + let event_of_string ~contents t = match t with + | "HELLO" -> HELLO contents + | "READY" -> READY contents + | "RESUMED" -> RESUMED contents + | "INVALID_SESSION" -> INVALID_SESSION contents + | "CHANNEL_CREATE" -> CHANNEL_CREATE (Channel.of_yojson_exn contents) + | "CHANNEL_UPDATE" -> CHANNEL_UPDATE (Channel.of_yojson_exn contents) + | "CHANNEL_DELETE" -> CHANNEL_DELETE (Channel.of_yojson_exn contents) + | "CHANNEL_PINS_UPDATE" -> CHANNEL_PINS_UPDATE contents + | "GUILD_CREATE" -> GUILD_CREATE (Guild.of_yojson_exn contents) + | "GUILD_UPDATE" -> GUILD_UPDATE (Guild.of_yojson_exn contents) + | "GUILD_DELETE" -> GUILD_DELETE (Guild.of_yojson_exn contents) + | "GUILD_BAN_ADD" -> GUILD_BAN_ADD (Ban.of_yojson_exn contents) + | "GUILD_BAN_REMOVE" -> GUILD_BAN_REMOVE (Ban.of_yojson_exn contents) + | "GUILD_EMOJIS_UPDATE" -> GUILD_EMOJIS_UPDATE contents + | "GUILD_INTEGRATIONS_UPDATE" -> GUILD_INTEGRATIONS_UPDATE contents + | "GUILD_MEMBER_ADD" -> GUILD_MEMBER_ADD (Member.of_yojson_exn contents) + | "GUILD_MEMBER_REMOVE" -> GUILD_MEMBER_REMOVE (Member.of_yojson_exn contents) + | "GUILD_MEMBER_UPDATE" -> GUILD_MEMBER_UPDATE (Member.of_yojson_exn contents) + | "GUILD_MEMBERS_CHUNK" -> GUILD_MEMBERS_CHUNK (Yojson.Safe.Util.to_list contents |> List.map ~f:(fun m -> Member.of_yojson_exn m)) + | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE (Role.of_yojson_exn contents) + | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE (Role.of_yojson_exn contents) + | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE (Role.of_yojson_exn contents) + | "MESSAGE_CREATE" -> MESSAGE_CREATE (Message.of_yojson_exn contents) + | "MESSAGE_UPDATE" -> MESSAGE_UPDATE (Message.of_yojson_exn contents) + | "MESSAGE_DELETE" -> MESSAGE_DELETE (Message.of_yojson_exn contents) + | "MESSAGE_BULK_DELETE" -> MESSAGE_BULK_DELETE (Yojson.Safe.Util.to_list contents |> List.map ~f:(fun m -> Message.of_yojson_exn m)) + | "MESSAGE_REACTION_ADD" -> MESSAGE_REACTION_ADD (Reaction.of_yojson_exn contents) + | "MESSAGE_REACTION_REMOVE" -> MESSAGE_REACTION_REMOVE (Reaction.of_yojson_exn contents) + | "MESSAGE_REACTION_REMOVE_ALL" -> MESSAGE_REACTION_REMOVE_ALL (Yojson.Safe.Util.to_list contents |> List.map ~f:(fun r -> Reaction.of_yojson_exn r)) + | "PRESENCE_UPDATE" -> PRESENCE_UPDATE (Presence.of_yojson_exn contents) + | "TYPING_START" -> TYPING_START contents + | "USER_UPDATE" -> USER_UPDATE contents + | "VOICE_STATE_UPDATE" -> VOICE_STATE_UPDATE contents + | "VOICE_SERVER_UPDATE" -> VOICE_SERVER_UPDATE contents + | "WEBHOOKS_UPDATE" -> WEBHOOKS_UPDATE contents + | s -> raise (Invalid_event s) + + let dispatch ~ev contents = + let ctx = () in + event_of_string ~contents ev + |> H.handle_event ctx +end
\ No newline at end of file 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 diff --git a/lib/models/activity.ml b/lib/models/activity.ml index eb6679e..80f1049 100644 --- a/lib/models/activity.ml +++ b/lib/models/activity.ml @@ -1 +1,4 @@ -type t
\ No newline at end of file +type t = { + id: Snowflake.t; +} +[@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/attachment.ml b/lib/models/attachment.ml index 095743d..595aa45 100644 --- a/lib/models/attachment.ml +++ b/lib/models/attachment.ml @@ -6,4 +6,4 @@ type t = { proxy_url: string; height: int option; width: int option; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/ban.ml b/lib/models/ban.ml index 510c2f5..ff0fb67 100644 --- a/lib/models/ban.ml +++ b/lib/models/ban.ml @@ -1,4 +1,4 @@ type t = { id: Snowflake.t; user: User.t; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/channel.ml b/lib/models/channel.ml index 78051c3..ac3e596 100644 --- a/lib/models/channel.ml +++ b/lib/models/channel.ml @@ -14,4 +14,4 @@ type t = { owner_id: Snowflake.t option; application_id: Snowflake.t option; parent_id: Snowflake.t option; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/embed.ml b/lib/models/embed.ml index 6ba1115..b4dc143 100644 --- a/lib/models/embed.ml +++ b/lib/models/embed.ml @@ -2,31 +2,31 @@ type footer = { text: string; icon_url: string option; proxy_icon_url: string option; -} +} [@@deriving yojson] type image = { url: string option; proxy_url: string option; height: int option; width: int option; -} +} [@@deriving yojson] type video = { url: string option; height: int option; width: int option; -} +} [@@deriving yojson] type provider = { name: string option; url: string option; -} +} [@@deriving yojson] type field = { name: string; value: string; inline: bool option; -} +} [@@deriving yojson] type t = { title: string option; @@ -41,4 +41,4 @@ type t = { video: video option; provider: provider option; fields: (field list) option; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/emoji.ml b/lib/models/emoji.ml index 3d89867..cfbfe64 100644 --- a/lib/models/emoji.ml +++ b/lib/models/emoji.ml @@ -6,4 +6,4 @@ type t = { require_colons: bool option; managed: bool; animated: bool; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/guild.ml b/lib/models/guild.ml index 364a4d5..5f5855b 100644 --- a/lib/models/guild.ml +++ b/lib/models/guild.ml @@ -25,4 +25,4 @@ type t = { member_count: int; members: Member.t list; channels: Channel.t list; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/member.ml b/lib/models/member.ml index 1cbe50b..4621902 100644 --- a/lib/models/member.ml +++ b/lib/models/member.ml @@ -5,4 +5,4 @@ type t = { joined_at: string; deaf: bool; mute: bool; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/message.ml b/lib/models/message.ml index 6c2e80d..c578d9f 100644 --- a/lib/models/message.ml +++ b/lib/models/message.ml @@ -18,4 +18,4 @@ type t = { pinned: bool; webhook_id: Snowflake.t; kind: int; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/presence.ml b/lib/models/presence.ml index 7243f43..ed1bdb6 100644 --- a/lib/models/presence.ml +++ b/lib/models/presence.ml @@ -5,4 +5,4 @@ type t = { guild: Guild.t; status: string; activities: Activity.t list; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/reaction.ml b/lib/models/reaction.ml index b427505..00bebe6 100644 --- a/lib/models/reaction.ml +++ b/lib/models/reaction.ml @@ -1,4 +1,4 @@ type t = { count: int; emoji: Emoji.t; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/role.ml b/lib/models/role.ml index debba60..0577342 100644 --- a/lib/models/role.ml +++ b/lib/models/role.ml @@ -7,4 +7,4 @@ type t = { permissions: int; managed: bool; mentionable: bool; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file diff --git a/lib/models/snowflake.ml b/lib/models/snowflake.ml index ed80b62..ab723a7 100644 --- a/lib/models/snowflake.ml +++ b/lib/models/snowflake.ml @@ -1,7 +1,7 @@ type t = { id: int; as_string: string; -} +} [@@deriving yojson] let to_int t = t.id let to_string t = t.as_string diff --git a/lib/models/user.ml b/lib/models/user.ml index 05cf570..e6c5c69 100644 --- a/lib/models/user.ml +++ b/lib/models/user.ml @@ -4,4 +4,4 @@ type t = { discriminator: string; avatar: string; bot: bool; -}
\ No newline at end of file +} [@@deriving yojson]
\ No newline at end of file @@ -1,10 +1,64 @@ open Async -open Cohttp module type Token = sig val token : string end +module type Client = sig + type context +end + +module type Handler = sig + val handle_event : + 'a -> + 'b -> + unit +end + +module type Dispatch = sig + type dispatch_event = + | HELLO of Yojson.Safe.json + | READY of Yojson.Safe.json + | RESUMED of Yojson.Safe.json + | INVALID_SESSION of Yojson.Safe.json + | CHANNEL_CREATE of Channel.t + | CHANNEL_UPDATE of Channel.t + | CHANNEL_DELETE of Channel.t + | CHANNEL_PINS_UPDATE of Yojson.Safe.json + | GUILD_CREATE of Guild.t + | GUILD_UPDATE of Guild.t + | GUILD_DELETE of Guild.t + | GUILD_BAN_ADD of Ban.t + | GUILD_BAN_REMOVE of Ban.t + | GUILD_EMOJIS_UPDATE of Yojson.Safe.json + | GUILD_INTEGRATIONS_UPDATE of Yojson.Safe.json + | GUILD_MEMBER_ADD of Member.t + | GUILD_MEMBER_REMOVE of Member.t + | GUILD_MEMBER_UPDATE of Member.t + | GUILD_MEMBERS_CHUNK of Member.t list + | GUILD_ROLE_CREATE of Role.t (* * Guild.t *) + | GUILD_ROLE_UPDATE of Role.t (* * Guild.t *) + | GUILD_ROLE_DELETE of Role.t (* * Guild.t *) + | MESSAGE_CREATE of Message.t + | MESSAGE_UPDATE of Message.t + | MESSAGE_DELETE of Message.t + | MESSAGE_BULK_DELETE of Message.t list + | MESSAGE_REACTION_ADD of (* Message.t * *) Reaction.t + | MESSAGE_REACTION_REMOVE of (* Message.t * *) Reaction.t + | MESSAGE_REACTION_REMOVE_ALL of (* Message.t * *) Reaction.t list + | PRESENCE_UPDATE of Presence.t + | TYPING_START of Yojson.Safe.json + | USER_UPDATE of Yojson.Safe.json + | VOICE_STATE_UPDATE of Yojson.Safe.json + | VOICE_SERVER_UPDATE of Yojson.Safe.json + | WEBHOOKS_UPDATE of Yojson.Safe.json + + exception Invalid_event of string + + val event_of_string : contents:Yojson.Safe.json -> string -> dispatch_event + val dispatch : ev:string -> Yojson.Safe.json -> unit +end + module type Http = sig val token : string @@ -14,178 +68,178 @@ module type Http = sig val base_url : string val process_url : string -> Uri.t - val process_request_body : Yojson.Basic.json -> Cohttp_async.Body.t - val process_request_headers : unit -> Header.t + val process_request_body : Yojson.Safe.json -> Cohttp_async.Body.t + val process_request_headers : unit -> Cohttp.Header.t val process_response : Cohttp_async.Response.t * Cohttp_async.Body.t -> - Yojson.Basic.json Deferred.t + Yojson.Safe.json Deferred.t val request : - ?body:Yojson.Basic.json -> + ?body:Yojson.Safe.json -> [> `DELETE | `GET | `PATCH | `POST | `PUT ] -> string -> - Yojson.Basic.json Deferred.t + Yojson.Safe.json Deferred.t end (* Auto-generated signatures *) - val get_gateway : unit -> Yojson.Basic.json Async.Deferred.t - val get_gateway_bot : unit -> Yojson.Basic.json Async.Deferred.t - val get_channel : string -> Yojson.Basic.json Async.Deferred.t + val get_gateway : unit -> Yojson.Safe.json Async.Deferred.t + val get_gateway_bot : unit -> Yojson.Safe.json Async.Deferred.t + val get_channel : string -> Yojson.Safe.json Async.Deferred.t val modify_channel : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val delete_channel : string -> Yojson.Basic.json Async.Deferred.t - val get_messages : string -> Yojson.Basic.json Async.Deferred.t - val get_message : string -> string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val delete_channel : string -> Yojson.Safe.json Async.Deferred.t + val get_messages : string -> Yojson.Safe.json Async.Deferred.t + val get_message : string -> string -> Yojson.Safe.json Async.Deferred.t val create_message : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val create_reaction : - string -> string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t val delete_own_reaction : - string -> string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t val delete_reaction : string -> - string -> string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t val get_reactions : - string -> string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t val delete_reactions : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val edit_message : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val delete_message : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val bulk_delete : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val edit_channel_permissions : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_channel_invites : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_channel_invites : string -> Yojson.Safe.json Async.Deferred.t val create_channel_invite : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val delete_channel_permission : - string -> string -> Yojson.Basic.json Async.Deferred.t - val broadcast_typing : string -> Yojson.Basic.json Async.Deferred.t - val get_pinned_messages : string -> Yojson.Basic.json Async.Deferred.t - val pin_message : string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t + val broadcast_typing : string -> Yojson.Safe.json Async.Deferred.t + val get_pinned_messages : string -> Yojson.Safe.json Async.Deferred.t + val pin_message : string -> string -> Yojson.Safe.json Async.Deferred.t val unpin_message : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val group_recipient_add : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val group_recipient_remove : - string -> string -> Yojson.Basic.json Async.Deferred.t - val get_emojis : string -> Yojson.Basic.json Async.Deferred.t - val get_emoji : string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t + val get_emojis : string -> Yojson.Safe.json Async.Deferred.t + val get_emoji : string -> string -> Yojson.Safe.json Async.Deferred.t val create_emoji : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val edit_emoji : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val delete_emoji : string -> string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val delete_emoji : string -> string -> Yojson.Safe.json Async.Deferred.t val create_guild : - Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_guild : string -> Yojson.Basic.json Async.Deferred.t + Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_guild : string -> Yojson.Safe.json Async.Deferred.t val edit_guild : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val delete_guild : string -> Yojson.Basic.json Async.Deferred.t - val get_guild_channels : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val delete_guild : string -> Yojson.Safe.json Async.Deferred.t + val get_guild_channels : string -> Yojson.Safe.json Async.Deferred.t val create_guild_channel : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val modify_guild_channel_positions : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_member : string -> string -> Yojson.Basic.json Async.Deferred.t - val get_members : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_member : string -> string -> Yojson.Safe.json Async.Deferred.t + val get_members : string -> Yojson.Safe.json Async.Deferred.t val add_member : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val edit_member : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val remove_member : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val change_nickname : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val add_member_role : - string -> string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t val remove_member_role : - string -> string -> string -> Yojson.Basic.json Async.Deferred.t - val get_bans : string -> Yojson.Basic.json Async.Deferred.t - val get_ban : string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> string -> Yojson.Safe.json Async.Deferred.t + val get_bans : string -> Yojson.Safe.json Async.Deferred.t + val get_ban : string -> string -> Yojson.Safe.json Async.Deferred.t val guild_ban_add : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val guild_ban_remove : - string -> string -> Yojson.Basic.json Async.Deferred.t - val get_roles : string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t + val get_roles : string -> Yojson.Safe.json Async.Deferred.t val guild_role_add : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val guild_roles_edit : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val guild_role_edit : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val guild_role_remove : - string -> string -> Yojson.Basic.json Async.Deferred.t - val guild_prune_count : string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t + val guild_prune_count : string -> Yojson.Safe.json Async.Deferred.t val guild_prune_start : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val get_guild_voice_regions : - string -> Yojson.Basic.json Async.Deferred.t - val get_guild_invites : string -> Yojson.Basic.json Async.Deferred.t - val get_integrations : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json Async.Deferred.t + val get_guild_invites : string -> Yojson.Safe.json Async.Deferred.t + val get_integrations : string -> Yojson.Safe.json Async.Deferred.t val add_integration : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val edit_integration : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val delete_integration : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val sync_integration : - string -> string -> Yojson.Basic.json Async.Deferred.t - val get_guild_embed : string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t + val get_guild_embed : string -> Yojson.Safe.json Async.Deferred.t val edit_guild_embed : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_vanity_url : string -> Yojson.Basic.json Async.Deferred.t - val get_invite : string -> Yojson.Basic.json Async.Deferred.t - val delete_invite : string -> Yojson.Basic.json Async.Deferred.t - val get_current_user : unit -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_vanity_url : string -> Yojson.Safe.json Async.Deferred.t + val get_invite : string -> Yojson.Safe.json Async.Deferred.t + val delete_invite : string -> Yojson.Safe.json Async.Deferred.t + val get_current_user : unit -> Yojson.Safe.json Async.Deferred.t val edit_current_user : - Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_guilds : unit -> Yojson.Basic.json Async.Deferred.t - val leave_guild : string -> Yojson.Basic.json Async.Deferred.t - val get_private_channels : unit -> Yojson.Basic.json Async.Deferred.t - val create_dm : Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_guilds : unit -> Yojson.Safe.json Async.Deferred.t + val leave_guild : string -> Yojson.Safe.json Async.Deferred.t + val get_private_channels : unit -> Yojson.Safe.json Async.Deferred.t + val create_dm : Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val create_group_dm : - Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_connections : unit -> Yojson.Basic.json Async.Deferred.t - val get_user : string -> Yojson.Basic.json Async.Deferred.t - val get_voice_regions : unit -> Yojson.Basic.json Async.Deferred.t + Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_connections : unit -> Yojson.Safe.json Async.Deferred.t + val get_user : string -> Yojson.Safe.json Async.Deferred.t + val get_voice_regions : unit -> Yojson.Safe.json Async.Deferred.t val create_webhook : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val get_channel_webhooks : string -> Yojson.Basic.json Async.Deferred.t - val get_guild_webhooks : string -> Yojson.Basic.json Async.Deferred.t - val get_webhook : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val get_channel_webhooks : string -> Yojson.Safe.json Async.Deferred.t + val get_guild_webhooks : string -> Yojson.Safe.json Async.Deferred.t + val get_webhook : string -> Yojson.Safe.json Async.Deferred.t val get_webhook_with_token : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val edit_webhook : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val edit_webhook_with_token : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t - val delete_webhook : string -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t + val delete_webhook : string -> Yojson.Safe.json Async.Deferred.t val delete_webhook_with_token : - string -> string -> Yojson.Basic.json Async.Deferred.t + string -> string -> Yojson.Safe.json Async.Deferred.t val execute_webhook : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val execute_slack_webhook : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val execute_git_webhook : string -> - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t val get_audit_logs : - string -> Yojson.Basic.json -> Yojson.Basic.json Async.Deferred.t + string -> Yojson.Safe.json -> Yojson.Safe.json Async.Deferred.t end module type Sharder = sig @@ -216,7 +270,7 @@ module type Sharder = sig shard Deferred.t val set_status : - status:Yojson.Basic.json -> + status:Yojson.Safe.json -> shard -> shard Deferred.t @@ -235,12 +289,12 @@ module type Sharder = sig end val set_status : - status:Yojson.Basic.json -> + status:Yojson.Safe.json -> t -> Shard.shard list Deferred.t val set_status_with : - f:(Shard.shard -> Yojson.Basic.json) -> + f:(Shard.shard -> Yojson.Safe.json) -> t -> Shard.shard list Deferred.t diff --git a/lib/sharder.ml b/lib/sharder.ml index 1c26d8c..6ac8584 100644 --- a/lib/sharder.ml +++ b/lib/sharder.ml @@ -1,4 +1,4 @@ -module Make(H: S.Http) = struct +module Make(H : S.Http)(D : S.Dispatch) : S.Sharder = struct open Async open Core open Websocket_async @@ -34,7 +34,7 @@ module Make(H: S.Http) = struct | `Ok s -> begin let open Frame.Opcode in match s.opcode with - | Text -> Some (Yojson.Basic.from_string s.content) + | Text -> Some (Yojson.Safe.from_string s.content) | _ -> None end | `Eof -> None @@ -44,7 +44,7 @@ module Make(H: S.Http) = struct let content = match payload with | None -> "" | Some p -> - Yojson.Basic.to_string @@ `Assoc [ + Yojson.Safe.to_string @@ `Assoc [ ("op", `Int (Opcode.to_int ev)); ("d", p); ] @@ -62,20 +62,21 @@ module Make(H: S.Http) = struct push_frame ~payload ~ev:HEARTBEAT shard let dispatch ~payload shard = - let module J = Yojson.Basic.Util in + let module J = Yojson.Safe.Util in let seq = J.(member "s" payload |> to_int) in let t = J.(member "t" payload |> to_string) in let data = J.member "d" payload in let session = J.(member "session_id" data |> to_string_option) in if t = "READY" then begin - Ivar.fill_if_empty shard.ready (); + Ivar.fill_if_empty shard.ready () end; + D.dispatch ~ev:t data; return { shard with seq = seq; session = session; } - let set_status ~(status:Yojson.Basic.json) shard = + let set_status ~(status:Yojson.Safe.json) shard = let payload = match status with | `Assoc [("name", `String name); ("type", `Int t)] -> `Assoc [ @@ -112,7 +113,7 @@ module Make(H: S.Http) = struct push_frame ~payload ~ev:REQUEST_GUILD_MEMBERS shard let initialize ?data shard = - let module J = Yojson.Basic.Util in + let module J = Yojson.Safe.Util in let hb = match shard.hb with | None -> begin match data with @@ -168,7 +169,7 @@ module Make(H: S.Http) = struct push_frame ~payload ~ev:RESUME shard let handle_frame ~f shard = - let module J = Yojson.Basic.Util in + let module J = Yojson.Safe.Util in let op = J.(member "op" f |> to_int) |> Opcode.from_int in @@ -285,7 +286,7 @@ module Make(H: S.Http) = struct } let start ?count () = - let module J = Yojson.Basic.Util in + let module J = Yojson.Safe.Util in H.get_gateway_bot () >>= fun data -> let url = J.(member "url" data |> to_string) in let count = match count with diff --git a/lib/sharder.mli b/lib/sharder.mli index d872c8c..8d04c8d 100644 --- a/lib/sharder.mli +++ b/lib/sharder.mli @@ -1 +1 @@ -module Make(H : S.Http) : S.Sharder
\ No newline at end of file +module Make(H : S.Http)(D : S.Dispatch) : S.Sharder
\ No newline at end of file |