├── .gitignore ├── lib ├── models │ ├── guild │ │ ├── ban.ml │ │ ├── ban.mli │ │ ├── ban_t.ml │ │ ├── ban_t.mli │ │ ├── role.mli │ │ ├── role_t.ml │ │ ├── role.ml │ │ ├── member.mli │ │ ├── role_t.mli │ │ ├── member_t.ml │ │ ├── member_t.mli │ │ ├── member.ml │ │ ├── guild.mli │ │ ├── guild_t.mli │ │ ├── guild_t.ml │ │ └── guild.ml │ ├── id │ │ ├── user_id.ml │ │ ├── user_id.mli │ │ ├── role_id.mli │ │ ├── message_id.mli │ │ ├── user_id_t.mli │ │ ├── guild_id_t.mli │ │ ├── channel_id_t.mli │ │ ├── role_id.ml │ │ ├── message_id.ml │ │ ├── user_id_t.ml │ │ ├── guild_id_t.ml │ │ ├── channel_id_t.ml │ │ ├── channel_id.mli │ │ ├── channel_id.ml │ │ ├── guild_id.mli │ │ └── guild_id.ml │ ├── channel │ │ ├── message │ │ │ ├── reaction.ml │ │ │ ├── attachment.mli │ │ │ ├── attachment.ml │ │ │ ├── reaction.mli │ │ │ ├── reaction_t.ml │ │ │ ├── reaction_t.mli │ │ │ ├── message_t.ml │ │ │ ├── message.mli │ │ │ ├── message_t.mli │ │ │ ├── message.ml │ │ │ ├── embed.ml │ │ │ └── embed.mli │ │ ├── channel.mli │ │ ├── channel.ml │ │ ├── channel_t.mli │ │ └── channel_t.ml │ ├── overwrites.mli │ ├── user │ │ ├── activity.ml │ │ ├── presence.ml │ │ ├── activity.mli │ │ ├── presence.mli │ │ ├── user.mli │ │ ├── user_t.ml │ │ ├── user.ml │ │ └── user_t.mli │ ├── overwrites.ml │ ├── snowflake.mli │ ├── emoji.ml │ ├── snowflake.ml │ ├── emoji.mli │ ├── permissions.mli │ └── permissions.ml ├── client_options.ml ├── client_options.mli ├── client.ml ├── gateway │ ├── opcode.mli │ ├── opcode.ml │ ├── event.mli │ ├── dispatch.ml │ ├── sharder.mli │ ├── dispatch.mli │ ├── event.ml │ └── sharder.ml ├── dune ├── http │ ├── rl.mli │ ├── rl.ml │ ├── endpoints.mli │ ├── endpoints.ml │ ├── http.mli │ └── http.ml ├── client.mli ├── cache.ml ├── cache.mli └── disml.ml ├── bin ├── README.md ├── dune ├── bot.ml └── commands.ml ├── dune-project ├── .gitlab-ci.yml ├── LICENSE ├── disml.opam ├── README.md └── disml.install /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | _build/ -------------------------------------------------------------------------------- /lib/models/guild/ban.ml: -------------------------------------------------------------------------------- 1 | include Ban_t -------------------------------------------------------------------------------- /bin/README.md: -------------------------------------------------------------------------------- 1 | # This is a test executable -------------------------------------------------------------------------------- /lib/client_options.ml: -------------------------------------------------------------------------------- 1 | let token = ref "" -------------------------------------------------------------------------------- /lib/models/id/user_id.ml: -------------------------------------------------------------------------------- 1 | include User_id_t -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.3) 2 | (name disml) 3 | -------------------------------------------------------------------------------- /lib/models/guild/ban.mli: -------------------------------------------------------------------------------- 1 | include module type of Ban_t -------------------------------------------------------------------------------- /lib/models/channel/message/reaction.ml: -------------------------------------------------------------------------------- 1 | include Reaction_t -------------------------------------------------------------------------------- /lib/models/id/user_id.mli: -------------------------------------------------------------------------------- 1 | include module type of User_id_t -------------------------------------------------------------------------------- /lib/client_options.mli: -------------------------------------------------------------------------------- 1 | (** Token that is set when using {!Client.start} *) 2 | val token : string ref -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bot) 3 | (modules bot commands) 4 | (libraries core async_ssl disml) 5 | ) -------------------------------------------------------------------------------- /lib/models/id/role_id.mli: -------------------------------------------------------------------------------- 1 | type t = [ `Role_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] 2 | 3 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/id/message_id.mli: -------------------------------------------------------------------------------- 1 | type t = [ `Message_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] 2 | 3 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/id/user_id_t.mli: -------------------------------------------------------------------------------- 1 | type t = [ `User_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] 2 | 3 | val compare : t -> t -> int 4 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/overwrites.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { id: Snowflake.t 3 | ; kind: string 4 | ; allow: Permissions.t 5 | ; deny: Permissions.t 6 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/id/guild_id_t.mli: -------------------------------------------------------------------------------- 1 | type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] 2 | 3 | val compare : t -> t -> int 4 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/guild/ban_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = { 4 | reason: string option [@default None]; 5 | user: User_t.t; 6 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/id/channel_id_t.mli: -------------------------------------------------------------------------------- 1 | type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp, yojson { exn = true }] 2 | 3 | val compare : t -> t -> int 4 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/guild/ban_t.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | reason: string option; (** The reason for the ban. *) 3 | user: User_t.t; (** The banned user. *) 4 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/user/activity.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = { 4 | name: string; 5 | kind: int [@key "type"]; 6 | url: string option [@default None]; 7 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/overwrites.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = 4 | { id: Snowflake.t 5 | ; kind: string [@key "type"] 6 | ; allow: Permissions.t 7 | ; deny: Permissions.t 8 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/channel/message/attachment.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | id: Snowflake.t; 3 | filename: string; 4 | size: int; 5 | url: string; 6 | proxy_url: string; 7 | height: int; 8 | width: int; 9 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/user/presence.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = { 4 | user: User_t.partial_user; 5 | game: Activity.t option [@default None]; 6 | status: string; 7 | activities: Activity.t list; 8 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/channel/message/attachment.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = { 4 | id: Snowflake.t; 5 | filename: string; 6 | size: int; 7 | url: string; 8 | proxy_url: string; 9 | height: int [@default -1]; 10 | width: int [@default -1]; 11 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/user/activity.mli: -------------------------------------------------------------------------------- 1 | (** An activity object. *) 2 | type t = { 3 | name: string; (** The name of the activity. *) 4 | kind: int; (** 0 = Playing, 1 = Streaming, 2 = Listening, 3 = Watching *) 5 | url: string option; (** Stream URL. Only validated for kind = 1. *) 6 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/channel/message/reaction.mli: -------------------------------------------------------------------------------- 1 | include module type of Reaction_t 2 | 3 | (* val delete : Reaction_t.t -> Yojson.Safe.t Deferred.Or_error.t 4 | val get_users : Reaction_t.t -> int -> User_t.t list Deferred.Or_error.t 5 | val get_users_after : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t 6 | val get_users_before : Reaction_t.t -> Snowflake.t -> int -> User_t.t list Deferred.Or_error.t *) -------------------------------------------------------------------------------- /lib/models/id/role_id.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = [ `Role_id of Snowflake.t ] [@@deriving sexp] 4 | 5 | let of_yojson a : (t, string) result = 6 | match Snowflake.of_yojson a with 7 | | Ok id -> Ok (`Role_id id) 8 | | Error err -> Error err 9 | 10 | let of_yojson_exn a : t = `Role_id (Snowflake.of_yojson_exn a) 11 | let to_yojson (`Role_id id) = (Snowflake.to_yojson id) 12 | 13 | let get_id (`Role_id id) = id -------------------------------------------------------------------------------- /lib/models/user/presence.mli: -------------------------------------------------------------------------------- 1 | (** A user presence. *) 2 | type t = { 3 | user: User_t.partial_user; (** A partial user that this presence belongs to. *) 4 | game: Activity.t option; (** The current activity of the user, if any. *) 5 | status: string; (** One of [online], [idle], [offline], or [dnd]. *) 6 | activities: Activity.t list; (** A list of all of the user's current activities. *) 7 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/id/message_id.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = [ `Message_id of Snowflake.t ] [@@deriving sexp] 4 | 5 | let of_yojson a : (t, string) result = 6 | match Snowflake.of_yojson a with 7 | | Ok id -> Ok (`Message_id id) 8 | | Error err -> Error err 9 | 10 | let of_yojson_exn a : t = `Message_id (Snowflake.of_yojson_exn a) 11 | let to_yojson (`Message_id id) = (Snowflake.to_yojson id) 12 | 13 | let get_id (`Message_id id) = id -------------------------------------------------------------------------------- /lib/models/channel/message/reaction_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type reaction_event = { 4 | user_id: User_id_t.t; 5 | channel_id: Channel_id_t.t; 6 | message_id: Message_id.t; 7 | guild_id: Guild_id_t.t option [@default None]; 8 | emoji: Emoji.partial_emoji; 9 | } [@@deriving sexp, yojson { exn = true }] 10 | 11 | type t = { 12 | count: int; 13 | emoji: Emoji.t; 14 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/user/user.mli: -------------------------------------------------------------------------------- 1 | include module type of User_t 2 | 3 | (** The user tag. Equivalent to concatenating the username and discriminator, separated by a '#'. *) 4 | val tag : t -> string 5 | 6 | (** The mention string for the user. Equivalent to [<@USER_ID>]. *) 7 | val mention : t -> string 8 | 9 | (** The default avatar for the user. *) 10 | val default_avatar : t -> string 11 | 12 | (** The avatar url of the user, falling back to the default avatar. *) 13 | val face : t -> string -------------------------------------------------------------------------------- /lib/models/id/user_id_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = [ `User_id of Snowflake.t ] [@@deriving sexp] 4 | 5 | let compare (`User_id t) (`User_id t') = Int.compare t t' 6 | 7 | let of_yojson a : (t, string) result = 8 | match Snowflake.of_yojson a with 9 | | Ok id -> Ok (`User_id id) 10 | | Error err -> Error err 11 | 12 | let of_yojson_exn a : t = `User_id (Snowflake.of_yojson_exn a) 13 | let to_yojson (`User_id id) = (Snowflake.to_yojson id) 14 | 15 | let get_id (`User_id id) = id -------------------------------------------------------------------------------- /lib/models/id/guild_id_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = [ `Guild_id of Snowflake.t ] [@@deriving sexp] 4 | 5 | let compare (`Guild_id t) (`Guild_id t') = Int.compare t t' 6 | 7 | let of_yojson a : (t, string) result = 8 | match Snowflake.of_yojson a with 9 | | Ok id -> Ok (`Guild_id id) 10 | | Error err -> Error err 11 | 12 | let of_yojson_exn a : t = `Guild_id (Snowflake.of_yojson_exn a) 13 | let to_yojson (`Guild_id id) = (Snowflake.to_yojson id) 14 | 15 | let get_id (`Guild_id id) = id -------------------------------------------------------------------------------- /lib/models/snowflake.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = Int.t [@@deriving sexp, yojson { exn = true }] 4 | 5 | (** Convert a snowflake into a {!Core.Time.t} *) 6 | val time_of_t : t -> Time.t 7 | 8 | (** Convert a snowflake into a Unix timestamp. Millisecond precision. *) 9 | val timestamp : t -> int 10 | 11 | (** Convert a snowflake into an ISO8601 timestamp string. This is equivalent to calling [Snowflake.time_of_t snowflake |> Time.(to_string_iso8601_basic ~zone:Zone.utc)] *) 12 | val timestamp_iso : t -> string -------------------------------------------------------------------------------- /lib/models/id/channel_id_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = [ `Channel_id of Snowflake.t ] [@@deriving sexp] 4 | 5 | let compare (`Channel_id t) (`Channel_id t') = Int.compare t t' 6 | 7 | let of_yojson a : (t, string) result = 8 | match Snowflake.of_yojson a with 9 | | Ok id -> Ok (`Channel_id id) 10 | | Error err -> Error err 11 | 12 | let of_yojson_exn a : t = `Channel_id (Snowflake.of_yojson_exn a) 13 | let to_yojson (`Channel_id id) = (Snowflake.to_yojson id) 14 | 15 | let get_id (`Channel_id id) = id -------------------------------------------------------------------------------- /lib/models/channel/message/reaction_t.mli: -------------------------------------------------------------------------------- 1 | (** Represents a single reaction as received over the gateway. *) 2 | type reaction_event = { 3 | user_id: User_id_t.t; 4 | channel_id: Channel_id_t.t; 5 | message_id: Message_id.t; 6 | guild_id: Guild_id_t.t option; 7 | emoji: Emoji.partial_emoji; 8 | } [@@deriving sexp, yojson { exn = true }] 9 | 10 | (** Represents a number of emojis used as a reaction on a message. *) 11 | type t = { 12 | count: int; 13 | emoji: Emoji.t; 14 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/emoji.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type partial_emoji = { 4 | id: Snowflake.t option [@default None]; 5 | name: string; 6 | } [@@deriving sexp, yojson { strict = false; exn = true }] 7 | 8 | type t = { 9 | id: Snowflake.t option [@default None]; 10 | name: string; 11 | roles: Role_id.t list [@default []]; 12 | user: User_t.t option [@default None]; 13 | require_colons: bool [@default false]; 14 | managed: bool [@default false]; 15 | animated: bool [@default false]; 16 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/user/user_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type partial_user = { 4 | id: User_id_t.t; 5 | username: string option [@default None]; 6 | discriminator: string option [@default None]; 7 | avatar: string option [@default None]; 8 | bot: bool [@default false]; 9 | } [@@deriving sexp, yojson { strict = false; exn = true }] 10 | 11 | type t = { 12 | id: User_id_t.t; 13 | username: string; 14 | discriminator: string; 15 | avatar: string option [@default None]; 16 | bot: bool [@default false]; 17 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | image: ocaml/opam2:latest 2 | 3 | before_script: 4 | - sudo apt-get -y install m4 pkg-config libssl-dev libffi-dev 5 | - opam init 6 | - eval `opam config env` 7 | - opam update 8 | - opam pin add ppx_deriving_yojson --dev-repo -n 9 | - opam pin add disml . 10 | 11 | build: 12 | stage: build 13 | script: 14 | - echo "Build successful" 15 | only: 16 | - master 17 | - merge_requests 18 | 19 | pages: 20 | stage: deploy 21 | script: 22 | - opam pin add odoc --dev-repo 23 | - dune build @doc 24 | - cp -r _build/default/_doc/_html/ public/ 25 | artifacts: 26 | paths: 27 | - public 28 | only: 29 | - tags -------------------------------------------------------------------------------- /lib/models/snowflake.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = Int.t [@@deriving sexp] 4 | 5 | let of_yojson_exn d = Yojson.Safe.Util.to_string d |> Int.of_string 6 | 7 | let of_yojson d = 8 | try Ok (of_yojson_exn d) 9 | with Yojson.Safe.Util.Type_error (why,_) -> Error why 10 | 11 | let to_yojson s : Yojson.Safe.t = `String (Int.to_string s) 12 | 13 | let timestamp snowflake = (snowflake lsr 22) + 1_420_070_400_000 14 | 15 | let time_of_t snowflake = 16 | let t = timestamp snowflake |> float_of_int in 17 | Time.(Span.of_ms t 18 | |> of_span_since_epoch) 19 | 20 | let timestamp_iso snowflake = 21 | time_of_t snowflake 22 | |> Time.(to_string_iso8601_basic ~zone:Zone.utc) -------------------------------------------------------------------------------- /lib/models/user/user.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | include User_t 3 | 4 | let tag user = 5 | Printf.sprintf "%s#%s" user.username user.discriminator 6 | 7 | let mention user = 8 | let `User_id id = user.id in 9 | Printf.sprintf "<@%d>" id 10 | 11 | let default_avatar user = 12 | let avatar = Int.of_string user.discriminator % 5 in 13 | Endpoints.cdn_default_avatar avatar 14 | 15 | let face user = 16 | let `User_id id = user.id in 17 | match user.avatar with 18 | | Some avatar -> 19 | let ext = if String.is_substring ~substring:"a_" avatar 20 | then "gif" 21 | else "png" in 22 | Endpoints.cdn_avatar id avatar ext 23 | | None -> default_avatar user -------------------------------------------------------------------------------- /lib/client.ml: -------------------------------------------------------------------------------- 1 | open Async 2 | include Dispatch 3 | 4 | type t = 5 | { sharder: Sharder.t 6 | } 7 | 8 | let start ?count ?compress ?(large=250) token = 9 | Client_options.token := token; 10 | Sharder.start ?count ?compress ~large_threshold:large () 11 | >>| fun sharder -> 12 | { sharder; } 13 | 14 | let set_status ?status ?kind ?name ?since ?url client = 15 | Sharder.set_status ?status ?kind ?name ?since ?url client.sharder 16 | 17 | let request_guild_members ~guild ?query ?limit client = 18 | let `Guild_id guild = guild in 19 | Sharder.request_guild_members ~guild ?query ?limit client.sharder 20 | 21 | let shutdown_all ?restart client = 22 | Sharder.shutdown_all ?restart client.sharder -------------------------------------------------------------------------------- /lib/models/guild/role.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | include module type of Role_t 4 | 5 | (** Deletes the role. This is permanent. *) 6 | val delete : t -> unit Deferred.Or_error.t 7 | 8 | (** Edits the role to allow mentions. *) 9 | val allow_mention : t -> t Deferred.Or_error.t 10 | 11 | (** Opposite of {!allow_mention} *) 12 | val disallow_mention : t -> t Deferred.Or_error.t 13 | 14 | (** Hoists the role. See {!Role.t.hoist}. *) 15 | val hoist : t -> t Deferred.Or_error.t 16 | 17 | (** Opposite of {!hoist}. *) 18 | val unhoist : t -> t Deferred.Or_error.t 19 | 20 | (** Sets the colour of the role. *) 21 | val set_colour : colour:int -> t -> t Deferred.Or_error.t 22 | 23 | (** Sets the name of the role. *) 24 | val set_name : name:string -> t -> t Deferred.Or_error.t 25 | -------------------------------------------------------------------------------- /lib/models/user/user_t.mli: -------------------------------------------------------------------------------- 1 | (** A partial user. Used internally. *) 2 | type partial_user = { 3 | id: User_id_t.t; 4 | username: string option; 5 | discriminator: string option; 6 | avatar: string option; 7 | bot: bool; 8 | } [@@deriving sexp, yojson { exn = true }] 9 | 10 | (** A user object. *) 11 | type t = { 12 | id: User_id_t.t; (** The user's Snowflake ID, wrapped in the convenience [`User_id] type. *) 13 | username: string; (** The username of the user. *) 14 | discriminator: string; (** The 4 digits, as a string, that come after the '#' in a Discord username. *) 15 | avatar: string option; (** The hash of the user avatar, if they have one set. See {!User.face} to get the avatar URL. *) 16 | bot: bool; (** Whether the user is a bot. *) 17 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/gateway/opcode.mli: -------------------------------------------------------------------------------- 1 | (** Internal Opcode abstractions. *) 2 | 3 | (** Type of known opcodes. *) 4 | type t = 5 | | DISPATCH 6 | | HEARTBEAT 7 | | IDENTIFY 8 | | STATUS_UPDATE 9 | | VOICE_STATE_UPDATE 10 | | RESUME 11 | | RECONNECT 12 | | REQUEST_GUILD_MEMBERS 13 | | INVALID_SESSION 14 | | HELLO 15 | | HEARTBEAT_ACK 16 | 17 | (** Raised when receiving an invalid opcode. This should never occur. *) 18 | exception Invalid_Opcode of int 19 | 20 | (** Converts an opcode to its integer form for outgoing frames. *) 21 | val to_int : t -> int 22 | 23 | (** Converts an integer to an opcode for incoming frames. 24 | Raise {!Invalid_Opcode} Raised when an unkown opcode is received. 25 | *) 26 | val from_int : int -> t 27 | 28 | (** Converts and opcode to a human-readable string. Used for logging purposes. *) 29 | val to_string : t -> string -------------------------------------------------------------------------------- /lib/models/guild/role_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type role = { 4 | id: Role_id.t; 5 | name: string; 6 | colour: int [@key "color"]; 7 | hoist: bool; 8 | position: int; 9 | permissions: Permissions.t; 10 | managed: bool; 11 | mentionable: bool; 12 | } [@@deriving sexp, yojson { strict = false; exn = true }] 13 | 14 | type t = { 15 | id: Role_id.t; 16 | name: string; 17 | colour: int [@key "color"]; 18 | hoist: bool; 19 | position: int; 20 | permissions: Permissions.t; 21 | managed: bool; 22 | mentionable: bool; 23 | guild_id: Guild_id_t.t; 24 | } [@@deriving sexp, yojson { strict = false; exn = true }] 25 | 26 | let wrap ~guild_id ({id;name;colour;hoist;position;permissions;managed;mentionable}:role) = 27 | {id;name;colour;hoist;position;permissions;managed;mentionable;guild_id = `Guild_id guild_id} -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name disml) 3 | (public_name disml) 4 | (synopsis "An OCaml library for interfacing with the Discord API") 5 | (modules 6 | activity 7 | attachment 8 | ban ban_t 9 | channel channel_t channel_id channel_id_t 10 | embed 11 | emoji 12 | guild guild_t guild_id guild_id_t 13 | member member_t 14 | message message_t message_id 15 | overwrites 16 | permissions 17 | presence 18 | reaction reaction_t 19 | role role_t role_id 20 | snowflake 21 | user user_t user_id user_id_t 22 | event_models 23 | cache client client_options disml dispatch endpoints event http opcode rl sharder 24 | ) 25 | (libraries checkseum.ocaml core async_ssl cohttp-async decompress.zl logs yojson websocket-async ppx_deriving_yojson.runtime bitmasks) 26 | (preprocess (pps ppx_sexp_conv ppx_deriving_yojson))) 27 | 28 | (include_subdirs unqualified) 29 | -------------------------------------------------------------------------------- /lib/models/channel/message/message_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = { 4 | id: Message_id.t; 5 | author: User_t.t; 6 | channel_id: Channel_id_t.t; 7 | member: Member_t.partial_member option [@default None]; 8 | guild_id: Guild_id_t.t option [@default None]; 9 | content: string; 10 | timestamp: string; 11 | edited_timestamp: string option [@default None]; 12 | tts: bool; 13 | mention_everyone: bool; 14 | mentions: User_t.t list [@default []]; 15 | mention_roles: Role_id.t list [@default []]; 16 | attachments: Attachment.t list [@default []]; 17 | embeds: Embed.t list [@default []]; 18 | reactions: Reaction_t.t list [@default []]; 19 | nonce: Snowflake.t option [@default None]; 20 | pinned: bool; 21 | webhook_id: Snowflake.t option [@default None]; 22 | kind: int [@key "type"]; 23 | } [@@deriving sexp, yojson { strict = false; exn = true }] -------------------------------------------------------------------------------- /lib/models/emoji.mli: -------------------------------------------------------------------------------- 1 | (** A partial emoji, used internally. *) 2 | type partial_emoji = { 3 | id: Snowflake.t option; 4 | name: string; 5 | } [@@deriving sexp, yojson { exn = true }] 6 | 7 | (** A full emoji object. *) 8 | type t = { 9 | id: Snowflake.t option; (** Snowflake ID of the emoji. Only exists for custom emojis. *) 10 | name: string; (** Name of the emoji. Either the emoji custom name or a unicode character. *) 11 | roles: Role_id.t list; (** List of roles required to use this emoji. Is only non-empty on some integration emojis. *) 12 | user: User_t.t option; (** User object of the person who uploaded the emoji. Only exists for custom emojis. *) 13 | require_colons: bool; (** Whether the emoji must be wrapped in colons. Is false for unicode emojis. *) 14 | managed: bool; (** Whether the emoji is managed by an integration. *) 15 | animated: bool; (** Whether the emoji is animated. *) 16 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/guild/role.ml: -------------------------------------------------------------------------------- 1 | include Role_t 2 | 3 | let edit_role ~body (role:t) = 4 | let `Role_id id = role.id in 5 | let `Guild_id guild_id = role.guild_id in 6 | Http.guild_role_edit guild_id id body 7 | 8 | let allow_mention role = 9 | edit_role ~body:(`Assoc [("mentionable", `Bool true)]) role 10 | 11 | let delete (role:t) = 12 | let `Role_id id = role.id in 13 | let `Guild_id guild_id = role.guild_id in 14 | Http.guild_role_remove guild_id id 15 | 16 | let disallow_mention role = 17 | edit_role ~body:(`Assoc [("mentionable", `Bool false)]) role 18 | 19 | let hoist role = 20 | edit_role ~body:(`Assoc [("hoist", `Bool true)]) role 21 | 22 | let set_colour ~colour role = 23 | edit_role ~body:(`Assoc [("color", `Int colour)]) role 24 | 25 | let set_name ~name role = 26 | edit_role ~body:(`Assoc [("name", `String name)]) role 27 | 28 | let unhoist role = 29 | edit_role ~body:(`Assoc [("hoist", `Bool false)]) role -------------------------------------------------------------------------------- /lib/models/permissions.mli: -------------------------------------------------------------------------------- 1 | type elt = 2 | | CREATE_INSTANT_INVITE 3 | | KICK_MEMBERS 4 | | BAN_MEMBERS 5 | | ADMINISTRATOR 6 | | MANAGE_CHANNELS 7 | | MANAGE_GUILD 8 | | ADD_REACTIONS 9 | | VIEW_AUDIT_LOG 10 | | PRIORITY_SPEAKER 11 | | READ_MESSAGES 12 | | SEND_MESSAGES 13 | | SEND_TTS_MESSAGES 14 | | MANAGE_MESSAGES 15 | | EMBED_LINKS 16 | | ATTACH_FILES 17 | | READ_MESSAGE_HISTORY 18 | | MENTION_EVERYONE 19 | | USE_EXTERNAL_EMOJIS 20 | | CONNECT 21 | | SPEAK 22 | | MUTE_MEMBERS 23 | | DEAFEN_MEMBERS 24 | | MOVE_MEMBERS 25 | | USE_VAD 26 | | CHANGE_NICKNAME 27 | | MANAGE_NICKNAMES 28 | | MANAGE_ROLES 29 | | MANAGE_WEBHOOKS 30 | | MANAGE_EMOJIS 31 | [@@deriving sexp] 32 | 33 | include BitMaskSet.S with type elt := elt 34 | with type storage = int 35 | with type t = private int 36 | 37 | val sexp_of_t : t -> Sexplib.Sexp.t 38 | val t_of_sexp : Sexplib.Sexp.t -> t 39 | val of_yojson_exn : Yojson.Safe.t -> t 40 | val of_yojson : Yojson.Safe.t -> (t, string) result 41 | val to_yojson : t -> Yojson.Safe.t 42 | -------------------------------------------------------------------------------- /lib/models/guild/member.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | include module type of Member_t 4 | 5 | (** Adds a role to the member. *) 6 | val add_role : role:Role_t.t -> Member_t.t -> unit Deferred.Or_error.t 7 | 8 | (** Removes a role from the member. *) 9 | val remove_role : role:Role_t.t -> Member_t.t -> unit Deferred.Or_error.t 10 | 11 | (** Bans the member with optional reason and days of messages to delete. *) 12 | val ban : ?reason:string -> ?days:int -> Member_t.t -> unit Deferred.Or_error.t 13 | 14 | (** Kicks the member with the optional reason. *) 15 | val kick : ?reason:string -> Member_t.t -> unit Deferred.Or_error.t 16 | 17 | (** Mutes the member, preventing them from speaking in voice chats. *) 18 | val mute : Member_t.t -> unit Deferred.Or_error.t 19 | 20 | (** Deafens the member, preventing them from hearing others in voice chats. *) 21 | val deafen : Member_t.t -> unit Deferred.Or_error.t 22 | 23 | (** Opposite of {!mute}. *) 24 | val unmute : Member_t.t -> unit Deferred.Or_error.t 25 | 26 | (** Opposite of {!deafen}. *) 27 | val undeafen : Member_t.t -> unit Deferred.Or_error.t -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018-2019 Adelyn Breedlove 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /lib/http/rl.mli: -------------------------------------------------------------------------------- 1 | (** Internal ratelimit route mapping. *) 2 | 3 | open Core 4 | open Async 5 | 6 | (** Type for mapping route -> {!rl}. *) 7 | module RouteMap : module type of Map.Make(String) 8 | 9 | (** Type representing ratelimit information. *) 10 | type rl = { 11 | limit: int; 12 | remaining: int; 13 | reset: int; 14 | } [@@deriving sexp] 15 | 16 | (** Type representing the specific case of {!RouteMap}. *) 17 | type t = ((rl, read_write) Mvar.t) RouteMap.t 18 | 19 | val get_rl : 20 | [ `Get | `Delete | `Post | `Patch | `Put ] -> 21 | string -> 22 | t -> 23 | (rl, read_write) Mvar.t * t 24 | 25 | (** Converts Cohttp header data into ratelimit information. 26 | @return Some of ratelimit information or None on bad headers 27 | *) 28 | val rl_of_header : Cohttp.Header.t -> rl option 29 | 30 | (** Default for type rl. Used for prepopulating routes. *) 31 | val default : rl 32 | 33 | (** Empty ratelimit route map. *) 34 | val empty : t 35 | 36 | (** Analogous to {!RouteMap.update}. *) 37 | val update : 'a RouteMap.t -> string -> f:('a option -> 'a) -> 'a RouteMap.t 38 | 39 | (** Analogous to {!RouteMap.find}. *) 40 | val find : 'a RouteMap.t -> string -> 'a option 41 | 42 | (** Analogous to {!RouteMap.find_exn}. *) 43 | val find_exn : 'a RouteMap.t -> string -> 'a -------------------------------------------------------------------------------- /lib/models/channel/message/message.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | include module type of Message_t 4 | 5 | (** Add the given emoji as a reaction. *) 6 | val add_reaction : t -> Emoji.t -> unit Deferred.Or_error.t 7 | 8 | (** Remove the reaction. Must also specify the user. *) 9 | val remove_reaction : t -> Emoji.t -> User_t.t -> unit Deferred.Or_error.t 10 | 11 | (** Remove all reactions from the message. *) 12 | val clear_reactions : t -> unit Deferred.Or_error.t 13 | 14 | (** Delete the message. *) 15 | val delete : t -> unit Deferred.Or_error.t 16 | 17 | (** Pin the message. *) 18 | val pin : t -> unit Deferred.Or_error.t 19 | 20 | (** Unping the message. *) 21 | val unpin : t -> unit Deferred.Or_error.t 22 | 23 | (** Sugar for [Channel_id.say msg.channel_id content]. *) 24 | val reply : t -> string -> t Deferred.Or_error.t 25 | 26 | (** Sugar for [Channel_id.send_message ?embed ?content ?file ?tts msg.channel_id]. *) 27 | val reply_with : 28 | ?embed:Embed.t -> 29 | ?content:string -> 30 | ?file:string -> 31 | ?tts:bool -> 32 | t -> 33 | Message_t.t Deferred.Or_error.t 34 | 35 | (** Set the content of the message. *) 36 | val set_content : t -> string -> t Deferred.Or_error.t 37 | 38 | (** Set the embed of the message. *) 39 | val set_embed : t -> Embed.t -> t Deferred.Or_error.t 40 | -------------------------------------------------------------------------------- /lib/models/guild/role_t.mli: -------------------------------------------------------------------------------- 1 | (** A role as Discord sends it. Only difference between this and {!t} is the lack of the guild_id field. *) 2 | type role = { 3 | id: Role_id.t; 4 | name: string; 5 | colour: int; 6 | hoist: bool; 7 | position: int; 8 | permissions: Permissions.t; 9 | managed: bool; 10 | mentionable: bool; 11 | } [@@deriving sexp, yojson { exn = true }] 12 | 13 | (** A role object. *) 14 | type t = { 15 | id: Role_id.t; (** The role's snowflake ID. *) 16 | name: string; (** The role's name. *) 17 | colour: int; (** The integer representation of the role colour. *) 18 | hoist: bool; (** Whether the role is hoisted. This property controls whether the role is separated on the sidebar. *) 19 | position: int; (** The position of the role. [@everyone] begins the list at 0. *) 20 | permissions: Permissions.t; (** The integer representation of the permissions the role has. *) 21 | managed: bool; (** Whether the guild is managed by an integration. *) 22 | mentionable: bool; (** Whether the role can be mentioned. *) 23 | guild_id: Guild_id_t.t; (** The guild ID this role belongs to. *) 24 | } [@@deriving sexp, yojson { exn = true }] 25 | 26 | (** Convenience method to produce {!t} from {!role} and a snowflake. *) 27 | val wrap : guild_id:Snowflake.t -> role -> t -------------------------------------------------------------------------------- /lib/models/guild/member_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type partial_member = { 4 | nick: string option [@default None]; 5 | roles: Role_id.t list; 6 | joined_at: string; 7 | deaf: bool; 8 | mute: bool; 9 | } [@@deriving sexp, yojson { strict = false; exn = true }] 10 | 11 | type member = { 12 | nick: string option [@default None]; 13 | roles: Role_id.t list; 14 | joined_at: string; 15 | deaf: bool; 16 | mute: bool; 17 | user: User_t.t; 18 | } [@@deriving sexp, yojson { strict = false; exn = true }] 19 | 20 | type member_wrapper = { 21 | guild_id: Guild_id_t.t; 22 | user: User_t.t; 23 | } [@@deriving sexp, yojson { strict = false; exn = true }] 24 | 25 | type member_update = { 26 | guild_id: Guild_id_t.t; 27 | roles: Role_id.t list [@default []]; 28 | user: User_t.t; 29 | nick: string option [@default None]; 30 | } [@@deriving sexp, yojson { strict = false; exn = true }] 31 | 32 | type t = { 33 | nick: string option [@default None]; 34 | roles: Role_id.t list; 35 | joined_at: string; 36 | deaf: bool; 37 | mute: bool; 38 | user: User_t.t; 39 | guild_id: Guild_id_t.t; 40 | } [@@deriving sexp, yojson { strict = false; exn = true }] 41 | 42 | let wrap ~guild_id ({nick;roles;joined_at;deaf;mute;user}:member) = 43 | {nick;roles;joined_at;deaf;mute;user;guild_id = `Guild_id guild_id} -------------------------------------------------------------------------------- /lib/models/permissions.ml: -------------------------------------------------------------------------------- 1 | type elt = 2 | | CREATE_INSTANT_INVITE 3 | | KICK_MEMBERS 4 | | BAN_MEMBERS 5 | | ADMINISTRATOR 6 | | MANAGE_CHANNELS 7 | | MANAGE_GUILD 8 | | ADD_REACTIONS 9 | | VIEW_AUDIT_LOG 10 | | PRIORITY_SPEAKER 11 | | READ_MESSAGES 12 | | SEND_MESSAGES 13 | | SEND_TTS_MESSAGES 14 | | MANAGE_MESSAGES 15 | | EMBED_LINKS 16 | | ATTACH_FILES 17 | | READ_MESSAGE_HISTORY 18 | | MENTION_EVERYONE 19 | | USE_EXTERNAL_EMOJIS 20 | | CONNECT 21 | | SPEAK 22 | | MUTE_MEMBERS 23 | | DEAFEN_MEMBERS 24 | | MOVE_MEMBERS 25 | | USE_VAD 26 | | CHANGE_NICKNAME 27 | | MANAGE_NICKNAMES 28 | | MANAGE_ROLES 29 | | MANAGE_WEBHOOKS 30 | | MANAGE_EMOJIS 31 | [@@deriving sexp] 32 | 33 | include BitMaskSet.Make(struct 34 | include BitMaskSet.Int 35 | type t = elt 36 | let mask = 0b0111_1111_1111_0111_1111_1101_1111_1111 37 | end) 38 | 39 | let sexp_of_t = Core.Int.sexp_of_t 40 | let t_of_sexp = Core.Int.t_of_sexp 41 | 42 | let of_yojson_exn j = create @@ Yojson.Safe.Util.to_int j 43 | 44 | let of_yojson j = 45 | try Ok (of_yojson_exn j) 46 | with Yojson.Safe.Util.Type_error (why,_) -> Error why 47 | 48 | let to_yojson t : Yojson.Safe.t = `Int t 49 | 50 | let of_seq seq = List.of_seq seq |> of_list 51 | 52 | let to_seq mask = elements mask |> List.to_seq 53 | 54 | let to_seq_from elt init = 55 | let _, _, r = split elt init in 56 | elt :: elements r |> List.to_seq 57 | 58 | let add_seq seq init = 59 | of_seq seq |> union init 60 | -------------------------------------------------------------------------------- /disml.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "disml" 3 | version: "0.2.5" 4 | maintainer: "Adelyn Breedlove " 5 | authors: "Adelyn Breedlove " 6 | license: "MIT" 7 | homepage: "https://gitlab.com/Mishio595/disml" 8 | doc: "https://mishio595.gitlab.io/disml/" 9 | dev-repo: "git+https://gitlab.com/Mishio595/disml" 10 | bug-reports: "https://gitlab.com/Mishio595/disml/issues" 11 | tags: ["discord"] 12 | synopsis: "An OCaml library for interfacing with the Discord API" 13 | description: """ 14 | Dis.ml is a library that provides a high-level interface to the Discord API. 15 | Key features include: 16 | * Automatic sharding 17 | * Deserialization of Discord objects to record types with related helper methods 18 | * Automatic rate-limiting 19 | 20 | For examples, see `/bin` in the git repo. 21 | """ 22 | depends: [ 23 | "ocaml" {>= "4.04.1"} 24 | "dune" {build & >= "1.3.0"} 25 | "async_ssl" {>= "v0.11.0"} 26 | "cohttp-async" {>= "1.2.0"} 27 | "core" {>= "v0.11.3"} 28 | "decompress" {>= "1.4.2"} 29 | "odoc" {with-doc & >= "1.3.0"} 30 | "ppx_deriving_yojson" {>= "3.3"} 31 | "ppx_sexp_conv" {>= "v0.11.2"} 32 | "websocket-async" {>= "2.12"} 33 | "yojson" {>= "1.6.0"} 34 | "bitmasks" {>= "1.1.0"} 35 | ] 36 | build: [ 37 | ["dune" "subst"] {pinned} 38 | ["dune" "build" "-p" name "-j" jobs] 39 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 40 | ] 41 | -------------------------------------------------------------------------------- /lib/models/guild/member_t.mli: -------------------------------------------------------------------------------- 1 | type partial_member = { 2 | nick: string option; 3 | roles: Role_id.t list; 4 | joined_at: string; 5 | deaf: bool; 6 | mute: bool; 7 | } [@@deriving sexp, yojson { exn = true }] 8 | 9 | type member = { 10 | nick: string option; 11 | roles: Role_id.t list; 12 | joined_at: string; 13 | deaf: bool; 14 | mute: bool; 15 | user: User_t.t; 16 | } [@@deriving sexp, yojson { exn = true }] 17 | 18 | type member_wrapper = { 19 | guild_id: Guild_id_t.t; 20 | user: User_t.t; 21 | } [@@deriving sexp, yojson { exn = true }] 22 | 23 | type member_update = { 24 | guild_id: Guild_id_t.t; 25 | roles: Role_id.t list; 26 | user: User_t.t; 27 | nick: string option; 28 | } [@@deriving sexp, yojson { exn = true }] 29 | 30 | (** A member object. *) 31 | type t = { 32 | nick: string option; (** The nickname of the member, if they have one set. *) 33 | roles: Role_id.t list; (** The roles the member has. *) 34 | joined_at: string; (** An ISO8601 timestamp of when the user joined. *) 35 | deaf: bool; (** Whether the user is deafened. *) 36 | mute: bool; (** Whether the user is muted. *) 37 | user: User_t.t; (** The underlying user object for the member. *) 38 | guild_id: Guild_id_t.t; (** The guild ID in which the member exists. *) 39 | } [@@deriving sexp, yojson { exn = true }] 40 | 41 | val wrap : guild_id:Snowflake.t -> member -> t -------------------------------------------------------------------------------- /lib/models/channel/channel.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | include module type of Channel_t 3 | 4 | exception Invalid_message 5 | exception No_message_found 6 | 7 | (** Advanced message sending. 8 | 9 | Raises {!Invalid_message} if one of content or embed is not set. 10 | 11 | {3 Examples} 12 | {[ 13 | open Core 14 | open Disml 15 | 16 | let check_command (msg : Message.t) = 17 | if String.is_prefix ~prefix:"!hello" msg.content then 18 | let embed = Embed.(default |> title "Hello World!") in 19 | Channel_id.send_message ~embed msg.channel_id >>> ignore 20 | 21 | Client.message_create := check_command 22 | ]} 23 | *) 24 | val send_message : 25 | ?embed:Embed.t -> 26 | ?content:string -> 27 | ?file:string -> 28 | ?tts:bool -> 29 | t -> 30 | Message_t.t Deferred.Or_error.t 31 | 32 | (** [say str ch] is equivalent to [send_message ~content:str ch]. *) 33 | val say : string -> t -> Message_t.t Deferred.Or_error.t 34 | 35 | val delete : t -> Channel_t.t Deferred.Or_error.t 36 | val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t 37 | val get_messages : 38 | ?mode:[ `Before | `After | `Around ] -> 39 | ?id:Snowflake.t -> 40 | ?limit:int -> 41 | t -> 42 | Message_t.t list Deferred.Or_error.t 43 | val broadcast_typing : t -> unit Deferred.Or_error.t 44 | val get_pins : t -> Message_t.t list Deferred.Or_error.t 45 | val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t 46 | (* TODO more things related to guild channels *) 47 | -------------------------------------------------------------------------------- /lib/models/id/channel_id.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | include module type of Channel_id_t 3 | 4 | exception Invalid_message 5 | exception No_message_found 6 | 7 | (** Advanced message sending. 8 | 9 | Raises {!Invalid_message} if one of content or embed is not set. 10 | 11 | {3 Examples} 12 | {[ 13 | open Core 14 | open Disml 15 | 16 | let check_command (msg : Message.t) = 17 | if String.is_prefix ~prefix:"!hello" msg.content then 18 | let embed = Embed.(default |> title "Hello World!") in 19 | Channel_id.send_message ~embed msg.channel_id >>> ignore 20 | 21 | Client.message_create := check_command 22 | ]} 23 | *) 24 | val send_message : 25 | ?embed:Embed.t -> 26 | ?content:string -> 27 | ?file:string -> 28 | ?tts:bool -> 29 | t -> 30 | Message_t.t Deferred.Or_error.t 31 | 32 | (** [say str ch] is equivalent to [send_message ~content:str ch]. *) 33 | val say : string -> t -> Message_t.t Deferred.Or_error.t 34 | 35 | val delete : t -> Channel_t.t Deferred.Or_error.t 36 | val get_message : id:Snowflake.t -> t -> Message_t.t Deferred.Or_error.t 37 | val get_messages : 38 | ?mode:[ `Before | `After | `Around ] -> 39 | ?id:Snowflake.t -> 40 | ?limit:int -> 41 | t -> 42 | Message_t.t list Deferred.Or_error.t 43 | val broadcast_typing : t -> unit Deferred.Or_error.t 44 | val get_pins : t -> Message_t.t list Deferred.Or_error.t 45 | val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t 46 | (* TODO more things related to guild channels *) 47 | -------------------------------------------------------------------------------- /lib/gateway/opcode.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t = 4 | | DISPATCH 5 | | HEARTBEAT 6 | | IDENTIFY 7 | | STATUS_UPDATE 8 | | VOICE_STATE_UPDATE 9 | | RESUME 10 | | RECONNECT 11 | | REQUEST_GUILD_MEMBERS 12 | | INVALID_SESSION 13 | | HELLO 14 | | HEARTBEAT_ACK 15 | 16 | exception Invalid_Opcode of int 17 | 18 | let to_int = function 19 | | DISPATCH -> 0 20 | | HEARTBEAT -> 1 21 | | IDENTIFY -> 2 22 | | STATUS_UPDATE -> 3 23 | | VOICE_STATE_UPDATE -> 4 24 | | RESUME -> 6 25 | | RECONNECT -> 7 26 | | REQUEST_GUILD_MEMBERS -> 8 27 | | INVALID_SESSION -> 9 28 | | HELLO -> 10 29 | | HEARTBEAT_ACK -> 11 30 | 31 | let from_int = function 32 | | 0 -> DISPATCH 33 | | 1 -> HEARTBEAT 34 | | 2 -> IDENTIFY 35 | | 3 -> STATUS_UPDATE 36 | | 4 -> VOICE_STATE_UPDATE 37 | | 6 -> RESUME 38 | | 7 -> RECONNECT 39 | | 8 -> REQUEST_GUILD_MEMBERS 40 | | 9 -> INVALID_SESSION 41 | | 10 -> HELLO 42 | | 11 -> HEARTBEAT_ACK 43 | | op -> raise (Invalid_Opcode op) 44 | 45 | let to_string = function 46 | | DISPATCH -> "DISPATCH" 47 | | HEARTBEAT -> "HEARTBEAT" 48 | | IDENTIFY -> "IDENTIFY" 49 | | STATUS_UPDATE -> "STATUS_UPDATE" 50 | | VOICE_STATE_UPDATE -> "VOICE_STATE_UPDATE" 51 | | RESUME -> "RESUME" 52 | | RECONNECT -> "RECONNECT" 53 | | REQUEST_GUILD_MEMBERS -> "REQUEST_GUILD_MEMBER" 54 | | INVALID_SESSION -> "INVALID_SESSION" 55 | | HELLO -> "HELLO" 56 | | HEARTBEAT_ACK -> "HEARTBEAT_ACK" -------------------------------------------------------------------------------- /lib/models/channel/channel.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | include Channel_t 3 | 4 | exception Invalid_message 5 | exception No_message_found 6 | 7 | let send_message ?embed ?content ?file ?(tts=false) ch = 8 | let embed = match embed with 9 | | Some e -> Embed.to_yojson e 10 | | None -> `Null in 11 | let content = match content with 12 | | Some c -> `String c 13 | | None -> `Null in 14 | let file = match file with 15 | | Some f -> `String f 16 | | None -> `Null in 17 | let () = match embed, content with 18 | | `Null, `Null -> raise Invalid_message 19 | | _ -> () in 20 | Http.create_message (get_id ch) (`Assoc [ 21 | ("embed", embed); 22 | ("content", content); 23 | ("file", file); 24 | ("tts", `Bool tts); 25 | ]) 26 | 27 | let say content ch = 28 | send_message ~content ch 29 | 30 | let delete ch = 31 | Http.delete_channel (get_id ch) 32 | 33 | let get_message ~id ch = 34 | Http.get_message (get_id ch) id 35 | 36 | let get_messages ?(mode=`Around) ?id ?(limit=50) ch = 37 | let kind = match mode with 38 | | `Around -> "around", limit 39 | | `Before -> "before", limit 40 | | `After -> "after", limit 41 | in 42 | let id = match id with 43 | | Some id -> id 44 | | None -> raise No_message_found in 45 | Http.get_messages (get_id ch) id kind 46 | 47 | let broadcast_typing ch = 48 | Http.broadcast_typing (get_id ch) 49 | 50 | let get_pins ch = 51 | Http.get_pinned_messages (get_id ch) 52 | 53 | let bulk_delete msgs ch = 54 | let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in 55 | Http.bulk_delete (get_id ch) msgs -------------------------------------------------------------------------------- /lib/models/id/channel_id.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | include Channel_id_t 3 | 4 | exception Invalid_message 5 | exception No_message_found 6 | 7 | let send_message ?embed ?content ?file ?(tts=false) ch = 8 | let embed = match embed with 9 | | Some e -> Embed.to_yojson e 10 | | None -> `Null in 11 | let content = match content with 12 | | Some c -> `String c 13 | | None -> `Null in 14 | let file = match file with 15 | | Some f -> `String f 16 | | None -> `Null in 17 | let () = match embed, content with 18 | | `Null, `Null -> raise Invalid_message 19 | | _ -> () in 20 | Http.create_message (get_id ch) (`Assoc [ 21 | ("embed", embed); 22 | ("content", content); 23 | ("file", file); 24 | ("tts", `Bool tts); 25 | ]) 26 | 27 | let say content ch = 28 | send_message ~content ch 29 | 30 | let delete ch = 31 | Http.delete_channel (get_id ch) 32 | 33 | let get_message ~id ch = 34 | Http.get_message (get_id ch) id 35 | 36 | let get_messages ?(mode=`Around) ?id ?(limit=50) ch = 37 | let kind = match mode with 38 | | `Around -> "around", limit 39 | | `Before -> "before", limit 40 | | `After -> "after", limit 41 | in 42 | let id = match id with 43 | | Some id -> id 44 | | None -> raise No_message_found in 45 | Http.get_messages (get_id ch) id kind 46 | 47 | let broadcast_typing ch = 48 | Http.broadcast_typing (get_id ch) 49 | 50 | let get_pins ch = 51 | Http.get_pinned_messages (get_id ch) 52 | 53 | let bulk_delete msgs ch = 54 | let msgs = `List (List.map ~f:(fun id -> `Int id) msgs) in 55 | Http.bulk_delete (get_id ch) msgs -------------------------------------------------------------------------------- /lib/models/channel/message/message_t.mli: -------------------------------------------------------------------------------- 1 | (** Represents a message object. *) 2 | type t = { 3 | id: Message_id.t; (** Snowflake ID of the message. *) 4 | author: User_t.t; (** User that authored the message. *) 5 | channel_id: Channel_id_t.t; (** Channel ID the message exists in. *) 6 | member: Member_t.partial_member option; (** A partial member if the message was sent in a guild. *) 7 | guild_id: Guild_id_t.t option; (** Guild ID if the message was sent in a guild. *) 8 | content: string; (** Content of the message. *) 9 | timestamp: string; (** ISO8601 timestamp of when the message was created. *) 10 | edited_timestamp: string option; (** Like timestamp, but for last edit, if any. *) 11 | tts: bool; (** Whether the message used text-to-speech. *) 12 | mention_everyone: bool; (** Whether the message mentioned [@everyone] or [@here] *) 13 | mentions: User_t.t list; (** A List of users that were mentioned in the message. *) 14 | mention_roles: Role_id.t list; (** A list of roles that were mentioned in the message. *) 15 | attachments: Attachment.t list; (** A list of attachments. *) 16 | embeds: Embed.t list; (** A List of embeds on the message. *) 17 | reactions: Reaction_t.t list; (** A list of reactions. *) 18 | nonce: Snowflake.t option; (** Used in verification, safe to ignore. *) 19 | pinned: bool; (** Whether the message is pinned. *) 20 | webhook_id: Snowflake.t option; (** The webhook ID, if the message was sent by a webhook. *) 21 | kind: int; (** See {{:https://discordapp.com/developers/docs/resources/channel#message-object-message-types}the discord docs} for message type enumeration. *) 22 | } [@@deriving sexp, yojson { exn = true }] -------------------------------------------------------------------------------- /lib/models/id/guild_id.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | include module type of Guild_id_t 3 | 4 | val ban_user : id:Snowflake.t -> ?reason:string -> ?days:int -> t -> unit Deferred.Or_error.t 5 | val create_emoji : name:string -> image:string -> t -> Emoji.t Deferred.Or_error.t 6 | val create_role : 7 | name:string -> 8 | ?colour:int -> 9 | ?permissions:int -> 10 | ?hoist:bool -> 11 | ?mentionable:bool -> 12 | t -> 13 | Role_t.t Deferred.Or_error.t 14 | val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> t -> Channel_t.t Deferred.Or_error.t 15 | val delete : t -> unit Deferred.Or_error.t 16 | val get_ban : id:Snowflake.t -> t -> Ban_t.t Deferred.Or_error.t 17 | val get_bans : t -> Ban_t.t list Deferred.Or_error.t 18 | val get_emoji : id:Snowflake.t -> t -> Emoji.t Deferred.Or_error.t 19 | val get_invites : t -> Yojson.Safe.t Deferred.Or_error.t 20 | val get_prune_count : days:int -> t -> int Deferred.Or_error.t 21 | val get_webhooks : t -> Yojson.Safe.t Deferred.Or_error.t 22 | val kick_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t 23 | val leave : t -> unit Deferred.Or_error.t 24 | val list_voice_regions : t -> Yojson.Safe.t Deferred.Or_error.t 25 | val prune : days:int -> t -> int Deferred.Or_error.t 26 | val request_members : t -> Member_t.t list Deferred.Or_error.t 27 | val set_afk_channel : id:Snowflake.t -> t -> Guild_t.t Deferred.Or_error.t 28 | val set_afk_timeout : timeout:int -> t -> Guild_t.t Deferred.Or_error.t 29 | val set_name : name:string -> t -> Guild_t.t Deferred.Or_error.t 30 | val set_icon : icon:string -> t -> Guild_t.t Deferred.Or_error.t 31 | val unban_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t -------------------------------------------------------------------------------- /lib/http/rl.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | module RouteMap = Map.Make(String) 5 | 6 | type rl = { 7 | limit: int; 8 | remaining: int; 9 | reset: int; 10 | } [@@deriving sexp] 11 | 12 | (* TODO improve route getting, use Date header *) 13 | type t = ((rl, read_write) Mvar.t) RouteMap.t 14 | 15 | let r_message_delete = Str.regexp "/channel/[0-9]+/messages/" 16 | let r_emoji = Str.regexp "/channel/[0-9]+/messages/[0-9]+/reactions/[A-Za-z0-9_\\-]+/\\(@me|[0-9]+\\)" 17 | 18 | let route_of_path meth path = 19 | match meth with 20 | | `Delete -> if Str.string_match r_message_delete path 0 then Str.matched_string path else path 21 | | `Put -> if Str.string_match r_emoji path 0 then Str.matched_string path else path 22 | | _ -> path 23 | 24 | let rl_of_header h = 25 | let module C = Cohttp.Header in 26 | match C.get h "X-RateLimit-Limit", C.get h "X-RateLimit-Remaining", C.get h "X-RateLimit-Reset" with 27 | | Some lim, Some rem, Some re -> 28 | let limit = Int.of_string lim in 29 | let remaining = Int.of_string rem in 30 | let reset = Int.of_string re in 31 | Some { limit; remaining; reset; } 32 | | _ -> None 33 | 34 | let default = { limit = 1; remaining = 1; reset = 0; } 35 | let empty : t = RouteMap.empty 36 | let update = RouteMap.update 37 | let find = RouteMap.find 38 | let find_exn m s = match find m s with 39 | | Some r -> r 40 | | None -> raise (Not_found_s (String.sexp_of_t s)) 41 | 42 | let get_rl meth path rl = 43 | let route = route_of_path meth path in 44 | match RouteMap.find rl route with 45 | | Some r -> r, rl 46 | | None -> 47 | let data = Mvar.create () in 48 | Mvar.set data default; 49 | let rl = RouteMap.add_exn rl ~key:route ~data in 50 | data, rl -------------------------------------------------------------------------------- /lib/client.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | include module type of Dispatch 4 | 5 | (** Type of the Client, it isn't recommended to access the fields directly. *) 6 | type t = 7 | { sharder: Sharder.t 8 | } 9 | 10 | (** Start the Client. This begins shard connections to Discord and event handlers should be registered prior to calling this. 11 | {3 Example} 12 | {[ 13 | open Async 14 | open Disml 15 | 16 | let main () = 17 | let token = "a valid bot token" in 18 | Client.start ~count:5 token >>> print_endline "Client launched" 19 | 20 | let _ = 21 | Scheduler.go_main ~main () 22 | ]} 23 | @param ?count Optional amount of shards to launch. Defaults to autosharding. 24 | @param ?compress Whether to use compression over the gateway. 25 | @param ?large Large threshold for guilds. Default is 100. 26 | @param string The token used for authentication. 27 | @return A deferred client object. 28 | *) 29 | val start : 30 | ?count:int -> 31 | ?compress:bool -> 32 | ?large:int -> 33 | string -> 34 | t Deferred.t 35 | 36 | (** Same as {!Sharder.set_status} where [client.sharder] is passed. *) 37 | val set_status : 38 | ?status:string -> 39 | ?kind:int -> 40 | ?name:string -> 41 | ?since:int -> 42 | ?url:string -> 43 | t -> 44 | Sharder.Shard.shard list Deferred.t 45 | 46 | (** Same as {!Sharder.request_guild_members} where [client.sharder] is passed. *) 47 | val request_guild_members : 48 | guild:Guild_id.t -> 49 | ?query:string -> 50 | ?limit:int -> 51 | t -> 52 | Sharder.Shard.shard list Deferred.t 53 | 54 | (** Same as {!Sharder.shutdown_all} where [client.sharder] is passed. *) 55 | val shutdown_all : 56 | ?restart:bool -> 57 | t -> 58 | unit list Deferred.t 59 | -------------------------------------------------------------------------------- /lib/gateway/event.mli: -------------------------------------------------------------------------------- 1 | (** Barebones of event dispatching. Most users will have no reason to look here. *) 2 | 3 | open Event_models 4 | 5 | (** Event dispatch type wrapper. Used internally. *) 6 | type t = 7 | | READY of Ready.t 8 | | RESUMED of Resumed.t 9 | | CHANNEL_CREATE of ChannelCreate.t 10 | | CHANNEL_UPDATE of ChannelUpdate.t 11 | | CHANNEL_DELETE of ChannelDelete.t 12 | | CHANNEL_PINS_UPDATE of ChannelPinsUpdate.t 13 | | GUILD_CREATE of GuildCreate.t 14 | | GUILD_UPDATE of GuildUpdate.t 15 | | GUILD_DELETE of GuildDelete.t 16 | | GUILD_BAN_ADD of GuildBanAdd.t 17 | | GUILD_BAN_REMOVE of GuildBanRemove.t 18 | | GUILD_EMOJIS_UPDATE of GuildEmojisUpdate.t 19 | (* | GUILD_INTEGRATIONS_UPDATE of Yojson.Safe.t *) 20 | | GUILD_MEMBER_ADD of GuildMemberAdd.t 21 | | GUILD_MEMBER_REMOVE of GuildMemberRemove.t 22 | | GUILD_MEMBER_UPDATE of GuildMemberUpdate.t 23 | | GUILD_MEMBERS_CHUNK of GuildMembersChunk.t 24 | | GUILD_ROLE_CREATE of GuildRoleCreate.t 25 | | GUILD_ROLE_UPDATE of GuildRoleUpdate.t 26 | | GUILD_ROLE_DELETE of GuildRoleDelete.t 27 | | MESSAGE_CREATE of MessageCreate.t 28 | | MESSAGE_UPDATE of MessageUpdate.t 29 | | MESSAGE_DELETE of MessageDelete.t 30 | | MESSAGE_DELETE_BULK of MessageDeleteBulk.t 31 | | REACTION_ADD of ReactionAdd.t 32 | | REACTION_REMOVE of ReactionRemove.t 33 | | REACTION_REMOVE_ALL of ReactionRemoveAll.t 34 | | PRESENCE_UPDATE of PresenceUpdate.t 35 | | TYPING_START of TypingStart.t 36 | | USER_UPDATE of UserUpdate.t 37 | (* | VOICE_STATE_UPDATE of Yojson.Safe.t *) 38 | (* | VOICE_SERVER_UPDATE of Yojson.Safe.t *) 39 | | WEBHOOK_UPDATE of WebhookUpdate.t 40 | | UNKNOWN of Unknown.t 41 | 42 | (** Used to convert an event string and payload into a t wrapper type. *) 43 | val event_of_yojson : contents:Yojson.Safe.t -> string -> t 44 | 45 | (** Sends the event to the registered handler. *) 46 | val dispatch : t -> unit 47 | 48 | (** Wrapper to other functions. This is called from the shards. *) 49 | val handle_event : ev:string -> Yojson.Safe.t -> unit -------------------------------------------------------------------------------- /lib/models/guild/member.ml: -------------------------------------------------------------------------------- 1 | include Member_t 2 | 3 | let add_role ~(role:Role_t.t) member = 4 | let `Guild_id guild_id = member.guild_id in 5 | let `User_id user_id = member.user.id in 6 | let `Role_id role_id = role.id in 7 | Http.add_member_role guild_id user_id role_id 8 | 9 | let remove_role ~(role:Role_t.t) member = 10 | let `Guild_id guild_id = member.guild_id in 11 | let `User_id user_id = member.user.id in 12 | let `Role_id role_id = role.id in 13 | Http.remove_member_role guild_id user_id role_id 14 | 15 | let ban ?(reason="") ?(days=0) member = 16 | let `Guild_id guild_id = member.guild_id in 17 | let `User_id user_id = member.user.id in 18 | Http.guild_ban_add guild_id user_id (`Assoc [ 19 | ("delete-message-days", `Int days); 20 | ("reason", `String reason); 21 | ]) 22 | 23 | let kick ?reason member = 24 | let `Guild_id guild_id = member.guild_id in 25 | let `User_id user_id = member.user.id in 26 | let payload = match reason with 27 | | Some r -> `Assoc [("reason", `String r)] 28 | | None -> `Null 29 | in Http.remove_member guild_id user_id payload 30 | 31 | let mute member = 32 | let `Guild_id guild_id = member.guild_id in 33 | let `User_id user_id = member.user.id in 34 | Http.edit_member guild_id user_id (`Assoc [ 35 | ("mute", `Bool true); 36 | ]) 37 | 38 | let deafen member = 39 | let `Guild_id guild_id = member.guild_id in 40 | let `User_id user_id = member.user.id in 41 | Http.edit_member guild_id user_id (`Assoc [ 42 | ("deaf", `Bool true); 43 | ]) 44 | 45 | let unmute member = 46 | let `Guild_id guild_id = member.guild_id in 47 | let `User_id user_id = member.user.id in 48 | Http.edit_member guild_id user_id (`Assoc [ 49 | ("mute", `Bool false); 50 | ]) 51 | 52 | let undeafen member = 53 | let `Guild_id guild_id = member.guild_id in 54 | let `User_id user_id = member.user.id in 55 | Http.edit_member guild_id user_id (`Assoc [ 56 | ("deaf", `Bool false); 57 | ]) 58 | -------------------------------------------------------------------------------- /lib/gateway/dispatch.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Event_models 3 | 4 | let ready = ref (fun (_:Ready.t) -> ()) 5 | let resumed = ref (fun (_:Resumed.t) -> ()) 6 | let channel_create = ref (fun (_:ChannelCreate.t) -> ()) 7 | let channel_update = ref (fun (_:ChannelUpdate.t) -> ()) 8 | let channel_delete = ref (fun (_:ChannelDelete.t) -> ()) 9 | let channel_pins_update = ref (fun (_:ChannelPinsUpdate.t) -> ()) 10 | let guild_create = ref (fun (_:GuildCreate.t) -> ()) 11 | let guild_update = ref (fun (_:GuildUpdate.t) -> ()) 12 | let guild_delete = ref (fun (_:GuildDelete.t) -> ()) 13 | let member_ban = ref (fun (_:GuildBanAdd.t) -> ()) 14 | let member_unban = ref (fun (_:GuildBanRemove.t) -> ()) 15 | let guild_emojis_update = ref (fun (_:GuildEmojisUpdate.t) -> ()) 16 | (* let integrations_update = ref (fun (_:Yojson.Safe.t) -> ()) *) 17 | let member_join = ref (fun (_:GuildMemberAdd.t) -> ()) 18 | let member_leave = ref (fun (_:GuildMemberRemove.t) -> ()) 19 | let member_update = ref (fun (_:GuildMemberUpdate.t) -> ()) 20 | let members_chunk = ref (fun (_:GuildMembersChunk.t) -> ()) 21 | let role_create = ref (fun (_:GuildRoleCreate.t) -> ()) 22 | let role_update = ref (fun (_:GuildRoleUpdate.t) -> ()) 23 | let role_delete = ref (fun (_:GuildRoleDelete.t) -> ()) 24 | let message_create = ref (fun (_:MessageCreate.t) -> ()) 25 | let message_update = ref (fun (_:MessageUpdate.t) -> ()) 26 | let message_delete = ref (fun (_:MessageDelete.t) -> ()) 27 | let message_delete_bulk = ref (fun (_:MessageDeleteBulk.t) -> ()) 28 | let reaction_add = ref (fun (_:ReactionAdd.t) -> ()) 29 | let reaction_remove = ref (fun (_:ReactionRemove.t) -> ()) 30 | let reaction_remove_all = ref (fun (_:ReactionRemoveAll.t) -> ()) 31 | let presence_update = ref (fun (_:PresenceUpdate.t) -> ()) 32 | let typing_start = ref (fun (_:TypingStart.t) -> ()) 33 | let user_update = ref (fun (_:UserUpdate.t) -> ()) 34 | (* let voice_state_update = ref (fun (_:Yojson.Safe.t) -> ()) *) 35 | (* let voice_server_update = ref (fun (_:Yojson.Safe.t) -> ()) *) 36 | let webhook_update = ref (fun (_:WebhookUpdate.t) -> ()) 37 | let unknown = ref (fun (_:Unknown.t) -> ()) -------------------------------------------------------------------------------- /lib/models/channel/message/message.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | include Message_t 4 | 5 | let add_reaction msg (emoji:Emoji.t) = 6 | let `Message_id id = msg.id in 7 | let `Channel_id channel_id = msg.channel_id in 8 | let e = match emoji.id with 9 | | Some i -> Printf.sprintf "%s:%d" emoji.name i 10 | | None -> emoji.name 11 | in 12 | Http.create_reaction channel_id id e 13 | 14 | 15 | let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) = 16 | let `Message_id id = msg.id in 17 | let `Channel_id channel_id = msg.channel_id in 18 | let `User_id user_id = user.id in 19 | let e = match emoji.id with 20 | | Some i -> Printf.sprintf "%s:%d" emoji.name i 21 | | None -> emoji.name 22 | in 23 | Http.delete_reaction channel_id id e user_id 24 | 25 | 26 | let clear_reactions msg = 27 | let `Message_id id = msg.id in 28 | let `Channel_id channel_id = msg.channel_id in 29 | Http.delete_reactions channel_id id 30 | 31 | 32 | let delete msg = 33 | let `Message_id id = msg.id in 34 | let `Channel_id channel_id = msg.channel_id in 35 | Http.delete_message channel_id id 36 | 37 | 38 | let pin msg = 39 | let `Message_id id = msg.id in 40 | let `Channel_id channel_id = msg.channel_id in 41 | Http.pin_message channel_id id 42 | 43 | 44 | let unpin msg = 45 | let `Message_id id = msg.id in 46 | let `Channel_id channel_id = msg.channel_id in 47 | Http.unpin_message channel_id id 48 | 49 | 50 | let reply msg content = 51 | Channel_id.say content msg.channel_id 52 | 53 | let reply_with ?embed ?content ?file ?tts msg = 54 | Channel_id.send_message ?embed ?content ?file ?tts msg.channel_id 55 | 56 | let set_content msg cont = 57 | let `Message_id id = msg.id in 58 | let `Channel_id channel_id = msg.channel_id in 59 | to_yojson { msg with content = cont; } 60 | |> Http.edit_message channel_id id 61 | 62 | 63 | let set_embed msg embed = 64 | let `Message_id id = msg.id in 65 | let `Channel_id channel_id = msg.channel_id in 66 | to_yojson { msg with embeds = [embed]; } 67 | |> Http.edit_message channel_id id 68 | 69 | -------------------------------------------------------------------------------- /lib/cache.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | module ChannelMap = Map.Make(Channel_id_t) 5 | module GuildMap = Map.Make(Guild_id_t) 6 | module UserMap = Map.Make(User_id_t) 7 | 8 | type t = 9 | { text_channels: Channel_t.guild_text ChannelMap.t 10 | ; voice_channels: Channel_t.guild_voice ChannelMap.t 11 | ; categories: Channel_t.category ChannelMap.t 12 | ; groups: Channel_t.group ChannelMap.t 13 | ; private_channels: Channel_t.dm ChannelMap.t 14 | ; guilds: Guild_t.t GuildMap.t 15 | ; presences: Presence.t UserMap.t 16 | (* ; messages: Channel_id_t.t GuildMap.t *) 17 | ; unavailable_guilds: Guild_t.unavailable GuildMap.t 18 | ; user: User_t.t option 19 | ; users: User_t.t UserMap.t 20 | } 21 | 22 | let create () = 23 | { text_channels = ChannelMap.empty 24 | ; voice_channels = ChannelMap.empty 25 | ; categories = ChannelMap.empty 26 | ; groups = ChannelMap.empty 27 | ; private_channels = ChannelMap.empty 28 | ; guilds = GuildMap.empty 29 | ; presences = UserMap.empty 30 | ; unavailable_guilds = GuildMap.empty 31 | ; user = None 32 | ; users = UserMap.empty 33 | } 34 | 35 | let cache = 36 | let m = Mvar.create () in 37 | Mvar.set m (create ()); 38 | m 39 | 40 | let guild cache = GuildMap.find cache.guilds 41 | 42 | let text_channel cache = ChannelMap.find cache.text_channels 43 | 44 | let voice_channel cache = ChannelMap.find cache.voice_channels 45 | 46 | let category cache = ChannelMap.find cache.categories 47 | 48 | let dm cache = ChannelMap.find cache.private_channels 49 | 50 | let group cache = ChannelMap.find cache.groups 51 | 52 | let channel cache id = 53 | let check = ChannelMap.find in 54 | match check cache.text_channels id with 55 | | Some c -> Some (`GuildText c) 56 | | None -> ( 57 | match check cache.voice_channels id with 58 | | Some c -> Some (`GuildVoice c) 59 | | None -> ( 60 | match check cache.categories id with 61 | | Some c -> Some (`Category c) 62 | | None -> ( 63 | match check cache.private_channels id with 64 | | Some c -> Some (`Private c) 65 | | None -> ( 66 | match check cache.groups id with 67 | | Some c -> Some (`Group c) 68 | | None -> None 69 | )))) -------------------------------------------------------------------------------- /lib/models/guild/guild.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | include module type of Guild_t 4 | 5 | val ban_user : id:Snowflake.t -> ?reason:string -> ?days:int -> t -> unit Deferred.Or_error.t 6 | val create : (string * Yojson.Safe.t) list -> t Deferred.Or_error.t 7 | val create_emoji : name:string -> image:string -> t -> Emoji.t Deferred.Or_error.t 8 | val create_role : 9 | name:string -> 10 | ?colour:int -> 11 | ?permissions:int -> 12 | ?hoist:bool -> 13 | ?mentionable:bool -> 14 | t -> 15 | Role_t.t Deferred.Or_error.t 16 | val create_channel : mode:[ `Text | `Voice | `Category ] -> name:string -> t -> Channel_t.t Deferred.Or_error.t 17 | val delete : t -> unit Deferred.Or_error.t 18 | val get_ban : id:Snowflake.t -> t -> Ban_t.t Deferred.Or_error.t 19 | val get_bans : t -> Ban_t.t list Deferred.Or_error.t 20 | val get_emoji : id:Snowflake.t -> t -> Emoji.t Deferred.Or_error.t 21 | val get_invites : t -> Yojson.Safe.t Deferred.Or_error.t 22 | val get_prune_count : days:int -> t -> int Deferred.Or_error.t 23 | val get_webhooks : t -> Yojson.Safe.t Deferred.Or_error.t 24 | val kick_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t 25 | val leave : t -> unit Deferred.Or_error.t 26 | val list_voice_regions : t -> Yojson.Safe.t Deferred.Or_error.t 27 | val prune : days:int -> t -> int Deferred.Or_error.t 28 | val request_members : t -> Member_t.t list Deferred.Or_error.t 29 | val set_afk_channel : id:Snowflake.t -> t -> Guild_t.t Deferred.Or_error.t 30 | val set_afk_timeout : timeout:int -> t -> Guild_t.t Deferred.Or_error.t 31 | val set_name : name:string -> t -> Guild_t.t Deferred.Or_error.t 32 | val set_icon : icon:string -> t -> Guild_t.t Deferred.Or_error.t 33 | val unban_user : id:Snowflake.t -> ?reason:string -> t -> unit Deferred.Or_error.t 34 | 35 | (** Get a channel belonging to this guild. This does not make an HTTP request. *) 36 | val get_channel : id:Channel_id_t.t -> t -> Channel_t.t Deferred.Or_error.t 37 | 38 | (** Get a member belonging to this guild. This does not make an HTTP request. *) 39 | val get_member : id:User_id_t.t -> t -> Member_t.t Deferred.Or_error.t 40 | 41 | (** Get a role belonging to this guild. This does not make an HTTP request. *) 42 | val get_role : id:Role_id.t -> t -> Role_t.t option -------------------------------------------------------------------------------- /bin/bot.ml: -------------------------------------------------------------------------------- 1 | open Async 2 | open Core 3 | open Disml 4 | open Models 5 | 6 | (* Define a function to handle message_create *) 7 | let check_command (message:Message.t) = 8 | (* Simple example of command parsing. *) 9 | let cmd, rest = match String.split ~on:' ' message.content with 10 | | hd::tl -> hd, tl 11 | | [] -> "", [] 12 | in match cmd with 13 | | "!ping" -> Commands.ping message rest 14 | | "!spam" -> Commands.spam message rest 15 | | "!list" -> Commands.list message rest 16 | | "!embed" -> Commands.embed message rest 17 | | "!status" -> Commands.status message rest 18 | | "!echo" -> Commands.echo message rest 19 | | "!cache" -> Commands.cache message rest 20 | | "!shutdown" -> Commands.shutdown message rest 21 | | "!rgm" -> Commands.request_members message rest 22 | | "!new" -> Commands.new_guild message rest 23 | | "!delall" -> Commands.delete_guilds message rest 24 | | "!roletest" -> Commands.role_test message rest 25 | | "!perms" -> Commands.check_permissions message rest 26 | | _ -> () (* Fallback case, no matched command. *) 27 | 28 | (* Example logs setup *) 29 | let setup_logger () = 30 | Logs.set_reporter (Logs_fmt.reporter ()); 31 | Logs.set_level ~all:true (Some Logs.Debug) 32 | 33 | let main () = 34 | setup_logger (); 35 | (* Register some event handlers *) 36 | Client.message_create := check_command; 37 | Client.ready := (fun ready -> Logs.info (fun m -> m "Logged in as %s" (User.tag ready.user))); 38 | Client.guild_create := (fun guild -> Logs.info (fun m -> m "Joined guild %s" guild.name)); 39 | Client.guild_delete := (fun {id;_} -> let `Guild_id id = id in Logs.info (fun m -> m "Left guild %d" id)); 40 | (* Pull token from env var. It is not recommended to hardcode your token. *) 41 | let token = match Sys.getenv "DISCORD_TOKEN" with 42 | | Some t -> t 43 | | None -> failwith "No token in env" 44 | in 45 | (* Start client. *) 46 | Client.start ~large:250 ~compress:true token 47 | (* Fill that ivar once its done *) 48 | >>> Ivar.fill Commands.client 49 | 50 | (* Lastly, we have to register this to the Async Scheduler for anything to work *) 51 | let _ = 52 | Scheduler.go_main ~main () 53 | -------------------------------------------------------------------------------- /lib/cache.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | open Core 3 | 4 | (** Represents a Map of {!Channel_id.t} keys. *) 5 | module ChannelMap : module type of Map.Make(Channel_id_t) 6 | 7 | (** Represents a Map of {!Guild_id.t} keys. *) 8 | module GuildMap : module type of Map.Make(Guild_id_t) 9 | 10 | (** Represents a Map of {!User_id.t} keys. *) 11 | module UserMap : module type of Map.Make(User_id_t) 12 | 13 | (** The full cache record. Immutable and intended to be wrapped in a concurrency-safe wrapper such as {{!Async.Mvar.Read_write.t}Mvar}. 14 | Channels are split by type so it isn't necessary to match them later on. 15 | *) 16 | type t = 17 | { text_channels: Channel_t.guild_text ChannelMap.t 18 | ; voice_channels: Channel_t.guild_voice ChannelMap.t 19 | ; categories: Channel_t.category ChannelMap.t 20 | ; groups: Channel_t.group ChannelMap.t 21 | ; private_channels: Channel_t.dm ChannelMap.t 22 | ; guilds: Guild_t.t GuildMap.t 23 | ; presences: Presence.t UserMap.t 24 | (* ; messages: Channel_id_t.t GuildMap.t *) 25 | ; unavailable_guilds: Guild_t.unavailable GuildMap.t 26 | ; user: User_t.t option 27 | ; users: User_t.t UserMap.t 28 | } 29 | 30 | (** A {{!t}cache} wrapped in an {{!Async.Mvar.Read_write.t}Mvar}. *) 31 | val cache : t Mvar.Read_write.t 32 | 33 | (** Creates a new, empty cache. *) 34 | val create : 35 | (* ?max_messages:int -> *) 36 | unit -> 37 | t 38 | 39 | (** Equivalent to {!GuildMap.find} on cache.guilds. *) 40 | val guild : 41 | t -> 42 | Guild_id_t.t -> 43 | Guild_t.t option 44 | 45 | (** Equivalent to {!ChannelMap.find} on cache.text_channels. *) 46 | val text_channel : 47 | t -> 48 | Channel_id_t.t -> 49 | Channel_t.guild_text option 50 | 51 | (** Equivalent to {!ChannelMap.find} on cache.voice_channels. *) 52 | val voice_channel : 53 | t -> 54 | Channel_id_t.t -> 55 | Channel_t.guild_voice option 56 | 57 | (** Equivalent to {!ChannelMap.find} on cache.categories. *) 58 | val category : 59 | t -> 60 | Channel_id_t.t -> 61 | Channel_t.category option 62 | 63 | (** Equivalent to {!ChannelMap.find} on cache.private_channels. *) 64 | val dm : 65 | t -> 66 | Channel_id_t.t -> 67 | Channel_t.dm option 68 | 69 | (** Equivalent to {!ChannelMap.find} on cache.groups. *) 70 | val group : 71 | t -> 72 | Channel_id_t.t -> 73 | Channel_t.group option 74 | 75 | (** Helper method that scans all channel stores and returns a {!Channel.t} holding the channel. *) 76 | val channel : 77 | t -> 78 | Channel_id_t.t -> 79 | Channel_t.t option -------------------------------------------------------------------------------- /lib/http/endpoints.mli: -------------------------------------------------------------------------------- 1 | (** Endpoint formatters used internally. *) 2 | 3 | val gateway : string 4 | val gateway_bot : string 5 | val channel : int -> string 6 | val channel_messages : int -> string 7 | val channel_message : int -> int -> string 8 | val channel_reaction_me : int -> int -> string -> string 9 | val channel_reaction : int -> int -> string -> int -> string 10 | val channel_reactions_get : int -> int -> string -> string 11 | val channel_reactions_delete : int -> int -> string 12 | val channel_bulk_delete : int -> string 13 | val channel_permission : int -> int -> string 14 | val channel_permissions : int -> string 15 | val channels : string 16 | val channel_call_ring : int -> string 17 | val channel_invites : int -> string 18 | val channel_typing : int -> string 19 | val channel_pins : int -> string 20 | val channel_pin : int -> int -> string 21 | val guilds : string 22 | val guild : int -> string 23 | val guild_channels : int -> string 24 | val guild_members : int -> string 25 | val guild_member : int -> int -> string 26 | val guild_member_role : int -> int -> int -> string 27 | val guild_bans : int -> string 28 | val guild_ban : int -> int -> string 29 | val guild_roles : int -> string 30 | val guild_role : int -> int -> string 31 | val guild_prune : int -> string 32 | val guild_voice_regions : int -> string 33 | val guild_invites : int -> string 34 | val guild_integrations : int -> string 35 | val guild_integration : int -> int -> string 36 | val guild_integration_sync : int -> int -> string 37 | val guild_embed : int -> string 38 | val guild_emojis : int -> string 39 | val guild_emoji : int -> int -> string 40 | val webhooks_guild : int -> string 41 | val webhooks_channel : int -> string 42 | val webhook : int -> string 43 | val webhook_token : int -> string -> string 44 | val webhook_git : int -> string -> string 45 | val webhook_slack : int -> string -> string 46 | val user : int -> string 47 | val me : string 48 | val me_guilds : string 49 | val me_guild : int -> string 50 | val me_channels : string 51 | val me_connections : string 52 | val invite : string -> string 53 | val regions : string 54 | val application_information : string 55 | val group_recipient : int -> int -> string 56 | val guild_me_nick : int -> string 57 | val guild_vanity_url : int -> string 58 | val guild_audit_logs : int -> string 59 | val cdn_embed_avatar : string -> string 60 | val cdn_emoji : string -> string -> string 61 | val cdn_icon : int -> string -> string -> string 62 | val cdn_avatar : int -> string -> string -> string 63 | val cdn_default_avatar : int -> string -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Dis.ml - An OCaml library for interfacing with the Discord API 2 | 3 | This is a library for creating bots on [Discord](https://discordapp.com/). Dis.ml uses JaneStreet's Async and Core libs and I highly recommend having a solid understanding of both of these before using this library. 4 | 5 | Docs can be found [here](https://mishio595.gitlab.io/disml) or generated using odoc and dune with `dune build @doc` 6 | 7 | --- 8 | ## State of the project 9 | #### What is implemented? 10 | * The full Discord REST API (Exposed through `Disml.Http` with abstractions on various models) 11 | * Complete gateway support (sans voice) 12 | * Automatic and manual sharding 13 | * Event dispatch to a user-defined consumer that can be changed at runtime 14 | * Automatic reconnection of dropped gateway connections, using RESUME when possible 15 | * Automatic rate limit handling for REST requests 16 | * Cache 17 | 18 | #### What is not implemented? 19 | * Abstractions for Discord Objects (**Mostly Completed**) 20 | * Voice 21 | 22 | --- 23 | ## Getting started 24 | In order to get started you'll first need to install OCaml (of course). I recommend using OPAM and Dune as a package manager and build tool respectively. 25 | 26 | As of release 0.2.5 (12 February 2019), disml is published on OPAM and installable by running 27 | 28 | ``` 29 | opam install disml 30 | ``` 31 | If you would like to use the development version, run 32 | ``` 33 | opam pin add disml --dev-repo 34 | ``` 35 | **Note:** The dev repo relies on being pinned to the latest `ppx_deriving_yojson` due to breaking changes in `yojson.1.6.0`. You can pin the package with `opam pin add ppx_deriving_yojson --dev-repo` 36 | 37 | If you do not use opam, see `disml.opam` for build instructions. 38 | 39 | You'll find an example bot in /bin directory. 40 | 41 | --- 42 | ## Examples 43 | 44 | #### Robust example 45 | `/bin/bot.ml` **Note:** I use this for most of my testing involving API compat, so you'll likely see some bizarre commands. 46 | 47 | #### Basic example 48 | 49 | ```ocaml 50 | open Async 51 | open Core 52 | open Disml 53 | open Models 54 | 55 | (* Create a function to handle message_create. *) 56 | let check_command (message:Message.t) = 57 | if String.is_prefix ~prefix:"!ping" message.content then 58 | Message.reply message "Pong!" >>> ignore 59 | 60 | let main () = 61 | (* Register the event handler *) 62 | Client.message_create := check_command; 63 | (* Start the client. It's recommended to load the token from an env var or other config file. *) 64 | Client.start "My token" >>> ignore 65 | 66 | let _ = 67 | (* Launch the Async scheduler. You must do this for anything to work. *) 68 | Scheduler.go_main ~main () 69 | ``` -------------------------------------------------------------------------------- /lib/models/guild/guild_t.mli: -------------------------------------------------------------------------------- 1 | type unavailable = { 2 | id: Guild_id_t.t; 3 | unavailable: bool; 4 | } [@@deriving sexp, yojson { exn = true }] 5 | 6 | (** Used internally. *) 7 | type pre = { 8 | id: Guild_id_t.t; 9 | name: string; 10 | icon: string option; 11 | splash: string option; 12 | owner_id: User_id_t.t; 13 | region: string; 14 | afk_channel_id: Channel_id_t.t option; 15 | afk_timeout: int; 16 | embed_enabled: bool; 17 | embed_channel_id: Channel_id_t.t option; 18 | verification_level: int; 19 | default_message_notifications: int; 20 | explicit_content_filter: int; 21 | roles: Role_t.role list; 22 | emojis: Emoji.t list; 23 | features: string list; 24 | mfa_level: int; 25 | application_id: Snowflake.t option; 26 | widget_enabled: bool; 27 | widget_channel_id: Channel_id_t.t option; 28 | system_channel_id: Channel_id_t.t option; 29 | large: bool; 30 | member_count: int option; 31 | members: Member_t.member list; 32 | channels: Channel_t.channel_wrapper list; 33 | } [@@deriving sexp, yojson { exn = true }] 34 | 35 | (** A Guild object *) 36 | type t = { 37 | id: Guild_id_t.t; (** The guild's snowflake ID. *) 38 | name: string; (** The guild name. *) 39 | icon: string option; (** The guild icon hash, if one is set. *) 40 | splash: string option; (** The guild splash hash, if one is set. *) 41 | owner_id: User_id_t.t; (** The user ID of the owner. *) 42 | region: string; (** The region the guild is in. *) 43 | afk_channel_id: Channel_id_t.t option; (** The AFK channel ID, if one is set. *) 44 | afk_timeout: int; (** The time before a user is moved to the AFK channel. *) 45 | embed_enabled: bool; (** Whether the embed is enabled. *) 46 | embed_channel_id: Channel_id_t.t option; (** The channel ID of the embed channel, if it is enabled. *) 47 | verification_level: int; (** See {{:https://discordapp.com/developers/docs/resources/guild#guild-object-verification-level} the discord docs} for details. *) 48 | default_message_notifications: int; (** 0 = All messages, 1 = Only mentions *) 49 | explicit_content_filter: int; (** 0 = Disabled, 1 = For members with no roles, 2 = All members *) 50 | roles: Role_t.t list; (** List of roles in the guild. *) 51 | emojis: Emoji.t list; (** List of custom emojis in the guild. *) 52 | features: string list; (** A List of features enabled for the guild. *) 53 | mfa_level: int; (** 0 = None, 1 = Elevated *) 54 | application_id: Snowflake.t option; (** Snowflake ID if the guild is bot-created. *) 55 | widget_enabled: bool; (** Whether the widget is enabled. *) 56 | widget_channel_id: Channel_id_t.t option; (** The channel ID for the widget, if enabled. *) 57 | system_channel_id: Channel_id_t.t option; (** The channel ID where system messages are sent. *) 58 | large: bool; (** Whether the guild exceeds the configured large threshold. *) 59 | member_count: int option; (** Total number of members in the guild. *) 60 | members: Member_t.t list; (** List of guild members. *) 61 | channels: Channel_t.t list; (** List of guild channels. *) 62 | } [@@deriving sexp, yojson { exn = true }] 63 | 64 | val wrap : pre -> t 65 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/http/endpoints.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Printf 3 | 4 | let gateway = "/gateway" 5 | let gateway_bot = "/gateway/bot" 6 | let channel = sprintf "/channels/%d" 7 | let channel_messages = sprintf "/channels/%d/messages" 8 | let channel_message = sprintf "/channels/%d/messages/%d" 9 | let channel_reaction_me = sprintf "/channels/%d/messages/%d/reactions/%s/@me" 10 | let channel_reaction = sprintf "/channels/%d/messages/%d/reactions/%s/%d" 11 | let channel_reactions_get = sprintf "/channels/%d/messages/%d/reactions/%s" 12 | let channel_reactions_delete = sprintf "/channels/%d/messages/%d/reactions" 13 | let channel_bulk_delete = sprintf "/channels/%d" 14 | let channel_permission = sprintf "/channels/%d/permissions/%d" 15 | let channel_permissions = sprintf "/channels/%d/permissions" 16 | let channels = "/channels" 17 | let channel_call_ring = sprintf "/channels/%d/call/ring" 18 | let channel_invites = sprintf "/channels/%d/invites" 19 | let channel_typing = sprintf "/channels/%d/typing" 20 | let channel_pins = sprintf "/channels/%d/pins" 21 | let channel_pin = sprintf "/channels/%d/pins/%d" 22 | let guilds = "/guilds" 23 | let guild = sprintf "/guilds/%d" 24 | let guild_channels = sprintf "/guilds/%d/channels" 25 | let guild_members = sprintf "/guilds/%d/members" 26 | let guild_member = sprintf "/guilds/%d/members/%d" 27 | let guild_member_role = sprintf "/guilds/%d/members/%d/roles/%d" 28 | let guild_bans = sprintf "/guilds/%d/bans" 29 | let guild_ban = sprintf "/guilds/%d/bans/%d" 30 | let guild_roles = sprintf "/guilds/%d/roles" 31 | let guild_role = sprintf "/guilds/%d/roles/%d" 32 | let guild_prune = sprintf "/guilds/%d/prune" 33 | let guild_voice_regions = sprintf "/guilds/%d/regions" 34 | let guild_invites = sprintf "/guilds/%d/invites" 35 | let guild_integrations = sprintf "/guilds/%d/integrations" 36 | let guild_integration = sprintf "/guilds/%d/integrations/%d" 37 | let guild_integration_sync = sprintf "/guilds/%d/integrations/%d/sync" 38 | let guild_embed = sprintf "/guilds/%d/embed" 39 | let guild_emojis = sprintf "/guilds/%d/emojis" 40 | let guild_emoji = sprintf "/guilds/%d/emojis/%d" 41 | let webhooks_guild = sprintf "/guilds/%d/webhooks" 42 | let webhooks_channel = sprintf "/channels/%d/webhooks" 43 | let webhook = sprintf "/webhooks/%d" 44 | let webhook_token = sprintf "/webhooks/%d/%s" 45 | let webhook_git = sprintf "/webhooks/%d/%s/github" 46 | let webhook_slack = sprintf "/webhooks/%d/%s/slack" 47 | let user = sprintf "/users/%d" 48 | let me = "/users/@me" 49 | let me_guilds = "/users/@me/guilds" 50 | let me_guild = sprintf "/users/@me/guilds/%d" 51 | let me_channels = "/users/@me/channels" 52 | let me_connections = "/users/@me/connections" 53 | let invite = sprintf "/invites/%s" 54 | let regions = "/voice/regions" 55 | let application_information = "/oauth2/applications/@me" 56 | let group_recipient = sprintf "/channels/%d/recipients/%d" 57 | let guild_me_nick = sprintf "/guilds/%d/members/@me/nick" 58 | let guild_vanity_url = sprintf "/guilds/%d/vanity-url" 59 | let guild_audit_logs = sprintf "/guilds/%d/audit-logs" 60 | let cdn_embed_avatar = sprintf "/embed/avatars/%s.png" 61 | let cdn_emoji = sprintf "/emojis/%s.%s" 62 | let cdn_icon = sprintf "/icons/%d/%s.%s" 63 | let cdn_avatar = sprintf "/avatars/%d/%s.%s" 64 | let cdn_default_avatar = sprintf "/embed/avatars/%d" -------------------------------------------------------------------------------- /lib/models/channel/channel_t.mli: -------------------------------------------------------------------------------- 1 | exception Invalid_channel of Yojson.Safe.t 2 | 3 | (** Represents a Group channel object. *) 4 | type group = { 5 | id: Channel_id_t.t; 6 | last_message_id: Message_id.t option; 7 | last_pin_timestamp: string option; 8 | icon: string option; 9 | name: string option; 10 | owner_id: User_id_t.t; 11 | recipients: User_t.t list; 12 | } [@@deriving sexp, yojson { exn = true }] 13 | 14 | (** Represents a private channel with a single user. *) 15 | type dm = { 16 | id: Channel_id_t.t; 17 | last_message_id: Message_id.t option; 18 | last_pin_timestamp: string option; 19 | } [@@deriving sexp, yojson { exn = true }] 20 | 21 | (** Represents a text channel in a guild. *) 22 | type guild_text = { 23 | id: Channel_id_t.t; 24 | last_message_id: Message_id.t option; 25 | last_pin_timestamp: string option; 26 | category_id: Channel_id_t.t option; 27 | guild_id: Guild_id_t.t option; 28 | name: string; 29 | position: int; 30 | topic: string option; 31 | nsfw: bool; 32 | slow_mode_timeout: int option; 33 | permission_overwrites: Overwrites.t list; 34 | } [@@deriving sexp, yojson { exn = true }] 35 | 36 | (** Represents a voice channel in a guild. *) 37 | type guild_voice = { 38 | id: Channel_id_t.t; 39 | category_id: Channel_id_t.t option; 40 | guild_id: Guild_id_t.t option; 41 | name: string; 42 | position: int; 43 | user_limit: int; 44 | bitrate: int option; 45 | permission_overwrites: Overwrites.t list; 46 | } [@@deriving sexp, yojson { exn = true }] 47 | 48 | (** Represents a guild category. *) 49 | type category = { 50 | id: Channel_id_t.t; 51 | guild_id: Guild_id_t.t option; 52 | position: int; 53 | name: string; 54 | permission_overwrites: Overwrites.t list; 55 | } [@@deriving sexp, yojson { exn = true }] 56 | 57 | (** Wrapper variant for all channel types. *) 58 | type t = [ 59 | | `Group of group 60 | | `Private of dm 61 | | `GuildText of guild_text 62 | | `GuildVoice of guild_voice 63 | | `Category of category 64 | ] [@@deriving sexp, yojson { exn = true }] 65 | 66 | (** Intermediate used internally. *) 67 | type channel_wrapper = { 68 | id: Channel_id_t.t; 69 | kind: int; 70 | guild_id: Guild_id_t.t option; 71 | position: int option; 72 | name: string option; 73 | topic: string option; 74 | nsfw: bool option; 75 | last_message_id: Message_id.t option; 76 | bitrate: int option; 77 | user_limit: int option; 78 | slow_mode_timeout: int option; 79 | recipients: User_t.t list option; 80 | icon: string option; 81 | owner_id: User_id_t.t option; 82 | application_id: Snowflake.t option; 83 | category_id: Channel_id_t.t option; 84 | last_pin_timestamp: string option; 85 | permission_overwrites: Overwrites.t list; 86 | } [@@deriving sexp, yojson { exn = true }] 87 | 88 | val unwrap_as_guild_text : channel_wrapper -> guild_text 89 | 90 | val unwrap_as_guild_voice : channel_wrapper -> guild_voice 91 | 92 | val unwrap_as_dm : channel_wrapper -> dm 93 | 94 | val unwrap_as_group : channel_wrapper -> group 95 | 96 | val unwrap_as_category : channel_wrapper -> category 97 | 98 | val wrap : channel_wrapper -> t 99 | 100 | val get_id : t -> Snowflake.t -------------------------------------------------------------------------------- /lib/models/guild/guild_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type unavailable = { 4 | id: Guild_id_t.t; 5 | unavailable: bool [@default false]; 6 | } [@@deriving sexp, yojson { strict = false; exn = true }] 7 | 8 | type pre = { 9 | id: Guild_id_t.t; 10 | name: string; 11 | icon: string option [@default None]; 12 | splash: string option [@default None]; 13 | owner_id: User_id_t.t; 14 | region: string; 15 | afk_channel_id: Channel_id_t.t option [@default None]; 16 | afk_timeout: int; 17 | embed_enabled: bool [@default false]; 18 | embed_channel_id: Channel_id_t.t option [@default None]; 19 | verification_level: int; 20 | default_message_notifications: int; 21 | explicit_content_filter: int; 22 | roles: Role_t.role list; 23 | emojis: Emoji.t list; 24 | features: string list; 25 | mfa_level: int; 26 | application_id: Snowflake.t option [@default None]; 27 | widget_enabled: bool [@default false]; 28 | widget_channel_id: Channel_id_t.t option [@default None]; 29 | system_channel_id: Channel_id_t.t option [@default None]; 30 | large: bool [@default false]; 31 | member_count: int option [@default None]; 32 | members: Member_t.member list [@default []]; 33 | channels: Channel_t.channel_wrapper list [@default []]; 34 | } [@@deriving sexp, yojson { strict = false; exn = true }] 35 | 36 | type t = { 37 | id: Guild_id_t.t; 38 | name: string; 39 | icon: string option [@default None]; 40 | splash: string option [@default None]; 41 | owner_id: User_id_t.t; 42 | region: string; 43 | afk_channel_id: Channel_id_t.t option [@default None]; 44 | afk_timeout: int; 45 | embed_enabled: bool [@default false]; 46 | embed_channel_id: Channel_id_t.t option [@default None]; 47 | verification_level: int; 48 | default_message_notifications: int; 49 | explicit_content_filter: int; 50 | roles: Role_t.t list; 51 | emojis: Emoji.t list; 52 | features: string list; 53 | mfa_level: int; 54 | application_id: Snowflake.t option [@default None]; 55 | widget_enabled: bool [@default false]; 56 | widget_channel_id: Channel_id_t.t option [@default None]; 57 | system_channel_id: Channel_id_t.t option [@default None]; 58 | large: bool; 59 | member_count: int option [@default None]; 60 | members: Member_t.t list; 61 | channels: Channel_t.t list; 62 | } [@@deriving sexp, yojson { strict = false; exn = true }] 63 | 64 | let wrap ({id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;member_count;members;channels}:pre) = 65 | let `Guild_id id = id in 66 | let roles = List.map ~f:(Role_t.wrap ~guild_id:id) roles in 67 | let members = List.map ~f:(Member_t.wrap ~guild_id:id) members in 68 | let channels = List.map ~f:Channel_t.wrap channels in 69 | {id = `Guild_id id;name;icon;splash;owner_id;region;afk_channel_id;afk_timeout;embed_enabled;embed_channel_id;verification_level;default_message_notifications;explicit_content_filter;roles;emojis;features;mfa_level;application_id;widget_enabled;widget_channel_id;system_channel_id;large;member_count;members;channels} 70 | 71 | let get_id guild = let `Guild_id id = guild.id in id -------------------------------------------------------------------------------- /lib/models/id/guild_id.ml: -------------------------------------------------------------------------------- 1 | include Guild_id_t 2 | 3 | let ban_user ~id ?(reason="") ?(days=0) guild = 4 | Http.guild_ban_add (get_id guild) id (`Assoc [ 5 | ("delete-message-days", `Int days); 6 | ("reason", `String reason); 7 | ]) 8 | 9 | let create_emoji ~name ~image guild = 10 | Http.create_emoji (get_id guild) (`Assoc [ 11 | ("name", `String name); 12 | ("image", `String image); 13 | ("roles", `List []); 14 | ]) 15 | 16 | let create_role ~name ?colour ?permissions ?hoist ?mentionable guild = 17 | let payload = ("name", `String name) :: [] in 18 | let payload = match permissions with 19 | | Some p -> ("permissions", `Int p) :: payload 20 | | None -> payload 21 | in let payload = match colour with 22 | | Some c -> ("color", `Int c) :: payload 23 | | None -> payload 24 | in let payload = match hoist with 25 | | Some h -> ("hoist", `Bool h) :: payload 26 | | None -> payload 27 | in let payload = match mentionable with 28 | | Some m -> ("mentionable", `Bool m) :: payload 29 | | None -> payload 30 | in Http.guild_role_add (get_id guild) (`Assoc payload) 31 | 32 | let create_channel ~mode ~name guild = 33 | let kind = match mode with 34 | | `Text -> 0 35 | | `Voice -> 2 36 | | `Category -> 4 37 | in Http.create_guild_channel (get_id guild) (`Assoc [ 38 | ("name", `String name); 39 | ("type", `Int kind); 40 | ]) 41 | 42 | let delete guild = 43 | Http.delete_guild (get_id guild) 44 | 45 | let get_ban ~id guild = 46 | Http.get_ban (get_id guild) id 47 | 48 | let get_bans guild = 49 | Http.get_bans (get_id guild) 50 | 51 | let get_emoji ~id guild = 52 | Http.get_emoji (get_id guild) id 53 | 54 | (* TODO add invite abstraction? *) 55 | let get_invites guild = 56 | Http.get_guild_invites (get_id guild) 57 | 58 | let get_prune_count ~days guild = 59 | Http.guild_prune_count (get_id guild) days 60 | 61 | (* TODO add webhook abstraction? *) 62 | let get_webhooks guild = 63 | Http.get_guild_webhooks (get_id guild) 64 | 65 | let kick_user ~id ?reason guild = 66 | let payload = match reason with 67 | | Some r -> `Assoc [("reason", `String r)] 68 | | None -> `Null 69 | in Http.remove_member (get_id guild) id payload 70 | 71 | let leave guild = 72 | Http.leave_guild (get_id guild) 73 | 74 | (* TODO Voice region abstractions? *) 75 | let list_voice_regions guild = 76 | Http.get_guild_voice_regions (get_id guild) 77 | 78 | let prune ~days guild = 79 | Http.guild_prune_start (get_id guild) days 80 | 81 | let request_members guild = 82 | Http.get_members (get_id guild) 83 | 84 | let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [ 85 | ("afk_channel_id", `Int id); 86 | ]) 87 | 88 | let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [ 89 | ("afk_timeout", `Int timeout); 90 | ]) 91 | 92 | let set_name ~name guild = Http.edit_guild (get_id guild) (`Assoc [ 93 | ("name", `String name); 94 | ]) 95 | 96 | let set_icon ~icon guild = Http.edit_guild (get_id guild) (`Assoc [ 97 | ("icon", `String icon); 98 | ]) 99 | 100 | let unban_user ~id ?reason guild = 101 | let payload = match reason with 102 | | Some r -> `Assoc [("reason", `String r)] 103 | | None -> `Null 104 | in Http.guild_ban_remove (get_id guild) id payload 105 | -------------------------------------------------------------------------------- /lib/gateway/sharder.mli: -------------------------------------------------------------------------------- 1 | (** Internal sharding manager. Most of this is accessed through {!Client}. *) 2 | 3 | open Core 4 | open Async 5 | open Websocket_async 6 | 7 | exception Invalid_Payload 8 | exception Failure_to_Establish_Heartbeat 9 | 10 | type t 11 | 12 | (** Start the Sharder. This is called by {!Client.start}. *) 13 | val start : 14 | ?count:int -> 15 | ?compress:bool -> 16 | ?large_threshold:int -> 17 | unit -> 18 | t Deferred.t 19 | 20 | (** Module representing a single shard. *) 21 | module Shard : sig 22 | (** Representation of the state of a shard. *) 23 | type shard = { 24 | compress: bool; (** Whether to compress payloads. *) 25 | id: int * int; (** A tuple as expected by Discord. First element is the current shard index, second element is the total shard count. *) 26 | hb_interval: Time.Span.t Ivar.t; (** Time span between heartbeats, wrapped in an Ivar. *) 27 | hb_stopper: unit Ivar.t; (** Stops the heartbeat sequencer when filled. *) 28 | large_threshold: int; (** Minimum number of members needed for a guild to be considered large. *) 29 | pipe: Frame.t Pipe.Reader.t * Frame.t Pipe.Writer.t; (** Raw frame IO pipe used for websocket communications. *) 30 | ready: unit Ivar.t; (** A simple Ivar indicating if the shard has received READY. *) 31 | seq: int; (** Current sequence number *) 32 | session: string option; (** Session id, if one exists. *) 33 | url: string; (** The websocket URL in use. *) 34 | _internal: Reader.t * Writer.t; 35 | } 36 | 37 | (** Wrapper around an internal state, used to wrap {!shard}. *) 38 | type 'a t = { 39 | mutable state: 'a; 40 | mutable stopped: bool; 41 | mutable can_resume: bool; 42 | } 43 | 44 | (** Send a heartbeat to Discord. This is handled automatically. *) 45 | val heartbeat : 46 | shard -> 47 | shard Deferred.t 48 | 49 | (** Set the status of the shard. *) 50 | val set_status : 51 | ?status:string -> 52 | ?kind:int -> 53 | ?name:string -> 54 | ?since:int -> 55 | ?url:string -> 56 | shard -> 57 | shard Deferred.t 58 | 59 | (** Request guild members for the shard's guild. Causes dispatch of multiple {{!Dispatch.members_chunk}member chunk} events. *) 60 | val request_guild_members : 61 | ?query:string -> 62 | ?limit:int -> 63 | guild:Snowflake.t -> 64 | shard -> 65 | shard Deferred.t 66 | 67 | (** Create a new shard *) 68 | val create : 69 | url:string -> 70 | shards:int * int -> 71 | ?compress:bool -> 72 | ?large_threshold:int -> 73 | unit -> 74 | shard Deferred.t 75 | 76 | val shutdown : 77 | ?clean:bool -> 78 | ?restart:bool -> 79 | shard t -> 80 | unit Deferred.t 81 | end 82 | 83 | (** Calls {!Shard.set_status} for each shard registered with the sharder. *) 84 | val set_status : 85 | ?status:string -> 86 | ?kind:int -> 87 | ?name:string -> 88 | ?since:int -> 89 | ?url:string -> 90 | t -> 91 | Shard.shard list Deferred.t 92 | 93 | (** Calls {!Shard.request_guild_members} for each shard registered with the sharder. *) 94 | val request_guild_members : 95 | ?query:string -> 96 | ?limit:int -> 97 | guild:Snowflake.t -> 98 | t -> 99 | Shard.shard list Deferred.t 100 | 101 | val shutdown_all : 102 | ?restart:bool -> 103 | t -> 104 | unit list Deferred.t 105 | -------------------------------------------------------------------------------- /lib/models/channel/message/embed.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type footer = { 4 | text: string; 5 | icon_url: string option [@default None]; 6 | proxy_icon_url: string option [@default None]; 7 | } [@@deriving sexp, yojson { strict = false; exn = true }] 8 | 9 | type image = { 10 | url: string option [@default None]; 11 | proxy_url: string option [@default None]; 12 | height: int option [@default None]; 13 | width: int option [@default None]; 14 | } [@@deriving sexp, yojson { strict = false; exn = true }] 15 | 16 | type video = { 17 | url: string option [@default None]; 18 | height: int option [@default None]; 19 | width: int option [@default None]; 20 | } [@@deriving sexp, yojson { strict = false; exn = true }] 21 | 22 | type provider = { 23 | name: string option [@default None]; 24 | url: string option [@default None]; 25 | } [@@deriving sexp, yojson { strict = false; exn = true }] 26 | 27 | type author = { 28 | name: string option [@default None]; 29 | url: string option [@default None]; 30 | icon_url: string option [@default None]; 31 | proxy_icon_url: string option [@default None]; 32 | } [@@deriving sexp, yojson { strict = false; exn = true }] 33 | 34 | type field = { 35 | name: string; 36 | value: string; 37 | inline: bool [@default false]; 38 | } [@@deriving sexp, yojson { strict = false; exn = true }] 39 | 40 | type t = { 41 | title: string option [@default None]; 42 | kind: string option [@default None][@key "type"]; 43 | description: string option [@default None]; 44 | url: string option [@default None]; 45 | timestamp: string option [@default None]; 46 | colour: int option [@default None][@key "color"]; 47 | footer: footer option [@default None]; 48 | image: image option [@default None]; 49 | thumbnail: image option [@default None]; 50 | video: video option [@default None]; 51 | provider: provider option [@default None]; 52 | author: author option [@default None]; 53 | fields: field list [@default []]; 54 | } [@@deriving sexp, yojson { strict = false; exn = true }] 55 | 56 | let default = { 57 | title = None; 58 | kind = None; 59 | description = None; 60 | url = None; 61 | timestamp = None; 62 | colour = None; 63 | footer = None; 64 | image = None; 65 | thumbnail = None; 66 | video = None; 67 | provider = None; 68 | author = None; 69 | fields = []; 70 | } 71 | 72 | let default_footer = { 73 | text = ""; 74 | icon_url = None; 75 | proxy_icon_url = None; 76 | } 77 | 78 | let default_image = { 79 | url = None; 80 | proxy_url = None; 81 | height = None; 82 | width = None; 83 | } 84 | 85 | let default_video = { 86 | url = None; 87 | width = None; 88 | height = None; 89 | } 90 | 91 | let default_provider = { 92 | name = None; 93 | url = None; 94 | } 95 | 96 | let default_author = { 97 | name = None; 98 | url = None; 99 | icon_url = None; 100 | proxy_icon_url = None; 101 | } 102 | 103 | let title v e = { e with title = Some v } 104 | let description v e = { e with description = Some v } 105 | let url v e = { e with url = Some v } 106 | let timestamp v e = { e with timestamp = Some v } 107 | let colour v e = { e with colour = Some v } 108 | let color v e = { e with colour = Some v } 109 | let footer f e = { e with footer = Some (f default_footer) } 110 | let image v e = { e with image = Some { default_image with url = Some v } } 111 | let thumbnail v e = { e with thumbnail = Some { default_image with url = Some v } } 112 | let author f e = { e with author = Some (f default_author) } 113 | let field (name, value, inline) e = { e with fields = { name; value; inline; }::e.fields } 114 | let fields l e = { e with fields = List.map ~f:(fun (name, value, inline) -> { name; value; inline; }) l } 115 | 116 | let footer_text v f : footer = { f with text = v } 117 | let footer_icon v f : footer = { f with icon_url = Some v } 118 | 119 | let author_name v a : author = { a with name = Some v } 120 | let author_url v a : author = { a with url = Some v } 121 | let author_icon v a : author = { a with icon_url = Some v } -------------------------------------------------------------------------------- /lib/models/guild/guild.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | include Guild_t 5 | 6 | let ban_user ~id ?(reason="") ?(days=0) guild = 7 | Http.guild_ban_add (get_id guild) id (`Assoc [ 8 | ("delete-message-days", `Int days); 9 | ("reason", `String reason); 10 | ]) 11 | 12 | let create data = 13 | let data = `Assoc data in 14 | Http.create_guild data 15 | 16 | let create_emoji ~name ~image guild = 17 | Http.create_emoji (get_id guild) (`Assoc [ 18 | ("name", `String name); 19 | ("image", `String image); 20 | ("roles", `List []); 21 | ]) 22 | 23 | let create_role ~name ?colour ?permissions ?hoist ?mentionable guild = 24 | let payload = ("name", `String name) :: [] in 25 | let payload = match permissions with 26 | | Some p -> ("permissions", `Int p) :: payload 27 | | None -> payload 28 | in let payload = match colour with 29 | | Some c -> ("color", `Int c) :: payload 30 | | None -> payload 31 | in let payload = match hoist with 32 | | Some h -> ("hoist", `Bool h) :: payload 33 | | None -> payload 34 | in let payload = match mentionable with 35 | | Some m -> ("mentionable", `Bool m) :: payload 36 | | None -> payload 37 | in Http.guild_role_add (get_id guild) (`Assoc payload) 38 | 39 | let create_channel ~mode ~name guild = 40 | let kind = match mode with 41 | | `Text -> 0 42 | | `Voice -> 2 43 | | `Category -> 4 44 | in Http.create_guild_channel (get_id guild) (`Assoc [ 45 | ("name", `String name); 46 | ("type", `Int kind); 47 | ]) 48 | 49 | let delete guild = 50 | Http.delete_guild (get_id guild) 51 | 52 | let get_ban ~id guild = 53 | Http.get_ban (get_id guild) id 54 | 55 | let get_bans guild = 56 | Http.get_bans (get_id guild) 57 | 58 | let get_emoji ~id guild = 59 | Http.get_emoji (get_id guild) id 60 | 61 | (* TODO add invite abstraction? *) 62 | let get_invites guild = 63 | Http.get_guild_invites (get_id guild) 64 | 65 | let get_prune_count ~days guild = 66 | Http.guild_prune_count (get_id guild) days 67 | 68 | (* TODO add webhook abstraction? *) 69 | let get_webhooks guild = 70 | Http.get_guild_webhooks (get_id guild) 71 | 72 | let kick_user ~id ?reason guild = 73 | let payload = match reason with 74 | | Some r -> `Assoc [("reason", `String r)] 75 | | None -> `Null 76 | in Http.remove_member (get_id guild) id payload 77 | 78 | let leave guild = 79 | Http.leave_guild (get_id guild) 80 | 81 | (* TODO Voice region abstractions? *) 82 | let list_voice_regions guild = 83 | Http.get_guild_voice_regions (get_id guild) 84 | 85 | let prune ~days guild = 86 | Http.guild_prune_start (get_id guild) days 87 | 88 | let request_members guild = 89 | Http.get_members (get_id guild) 90 | 91 | let set_afk_channel ~id guild = Http.edit_guild (get_id guild) (`Assoc [ 92 | ("afk_channel_id", `Int id); 93 | ]) 94 | 95 | let set_afk_timeout ~timeout guild = Http.edit_guild (get_id guild) (`Assoc [ 96 | ("afk_timeout", `Int timeout); 97 | ]) 98 | 99 | let set_name ~name guild = Http.edit_guild (get_id guild) (`Assoc [ 100 | ("name", `String name); 101 | ]) 102 | 103 | let set_icon ~icon guild = Http.edit_guild (get_id guild) (`Assoc [ 104 | ("icon", `String icon); 105 | ]) 106 | 107 | let unban_user ~id ?reason guild = 108 | let payload = match reason with 109 | | Some r -> `Assoc [("reason", `String r)] 110 | | None -> `Null 111 | in Http.guild_ban_remove (get_id guild) id payload 112 | 113 | let get_member ~(id:User_id_t.t) guild = 114 | match List.find ~f:(fun m -> (User_id_t.get_id m.user.id) = (User_id_t.get_id id)) guild.members with 115 | | Some m -> Deferred.Or_error.return m 116 | | None -> 117 | let `User_id id = id in 118 | Http.get_member (get_id guild) id 119 | 120 | let get_channel ~(id:Channel_id_t.t) guild = 121 | let `Channel_id id = id in 122 | match List.find ~f:(fun c -> Channel_t.get_id c = id) guild.channels with 123 | | Some c -> Deferred.Or_error.return c 124 | | None -> Http.get_channel id 125 | 126 | (* TODO add HTTP fallback *) 127 | let get_role ~(id:Role_id.t) guild = 128 | List.find ~f:(fun r -> (Role_id.get_id r.id) = (Role_id.get_id id)) guild.roles 129 | -------------------------------------------------------------------------------- /lib/disml.ml: -------------------------------------------------------------------------------- 1 | (** 2 | {2 Dis.ml - An OCaml library for interfacing with the Discord API} 3 | 4 | {3 Example} 5 | 6 | {[ 7 | open Async 8 | open Core 9 | open Disml 10 | open Models 11 | 12 | (* Create a function to handle message_create. *) 13 | let check_command (Event.MessageCreate.{message}) = 14 | if String.is_prefix ~prefix:"!ping" message.content then 15 | Message.reply message "Pong!" >>> ignore 16 | 17 | let main () = 18 | (* Register the event handler *) 19 | Client.message_create := check_command; 20 | (* Start the client. It's recommended to load the token from an env var or other config file. *) 21 | Client.start "My token" >>> ignore 22 | 23 | let _ = 24 | (* Launch the Async scheduler. You must do this for anything to work. *) 25 | Scheduler.go_main ~main () 26 | ]} 27 | *) 28 | 29 | (** The primary interface for connecting to Discord and handling gateway events. *) 30 | module Client = Client 31 | 32 | (** Caching module. {!Cache.cache} is an {{!Async.Mvar.Read_write.t}Mvar}, which is always filled, containing an immutable cache record to allow for safe, concurrent access. *) 33 | module Cache = Cache 34 | 35 | (** Raw HTTP abstractions for Discord's REST API. *) 36 | module Http = struct 37 | include Http 38 | 39 | (** Internal module for resolving endpoints *) 40 | module Endpoints = Endpoints 41 | 42 | (** Internal module for handling rate limiting *) 43 | module Ratelimits = Rl 44 | end 45 | 46 | (** Gateway connection super module. *) 47 | module Gateway = struct 48 | 49 | (** Internal module used for dispatching events. *) 50 | module Dispatch = Dispatch 51 | 52 | (** Internal module for representing events. *) 53 | module Event = Event 54 | 55 | (** Internal module for representing Discord's opcodes. *) 56 | module Opcode = Opcode 57 | 58 | (** Shard manager *) 59 | module Sharder = Sharder 60 | end 61 | 62 | (** Super module for all Discord object types. *) 63 | module Models = struct 64 | 65 | (** Represents a user's activity. *) 66 | module Activity = Activity 67 | 68 | (** Represents a message attachment. *) 69 | module Attachment = Attachment 70 | 71 | (** Represents a ban object. *) 72 | module Ban = Ban 73 | 74 | (** Represents a full channel object. *) 75 | module Channel = Channel 76 | 77 | (** Represents solely a channel ID. REST operations can be performed without the full object overhead using this. *) 78 | module Channel_id = Channel_id 79 | 80 | (** Represents an embed object. *) 81 | module Embed = Embed 82 | 83 | (** Represents an emoji, both custom and unicode. *) 84 | module Emoji = Emoji 85 | 86 | (** Represents a guild object, also called a server. *) 87 | module Guild = Guild 88 | 89 | (** Represents solely a guild ID. REST operations can be performed without the full object overhead using this. *) 90 | module Guild_id = Guild_id 91 | 92 | (** Represents a user in the context of a guild. *) 93 | module Member = Member 94 | 95 | (** Represents a message object in any channel. *) 96 | module Message = Message 97 | 98 | (** Represents solely a message ID. REST operations can be performed without the full object overhead using this. *) 99 | module Message_id = Message_id 100 | 101 | (** Represents a permission integer as bitmask, allowing for constant set representation. *) 102 | module Permissions = struct 103 | include Permissions 104 | 105 | module Overwrite = Overwrites 106 | end 107 | 108 | (** Represents a user presence. See {!Models.Event.PresenceUpdate}. *) 109 | module Presence = Presence 110 | 111 | (** Represents an emoji used to react to a message. *) 112 | module Reaction = Reaction 113 | 114 | (** Represents a role object. *) 115 | module Role = Role 116 | 117 | (** Represents solely a role ID. REST operations can be performed without the full object overhead using this. *) 118 | module Role_id = Role_id 119 | 120 | (** Represents a Discord ID. *) 121 | module Snowflake = Snowflake 122 | 123 | (** Represents a user object. *) 124 | module User = User 125 | 126 | (** Represents solely a user ID. REST operations can be performed without the full object overhead using this. *) 127 | module User_id = User_id 128 | 129 | (** Represents the structures received over the gateway. *) 130 | module Event = Event_models 131 | end 132 | -------------------------------------------------------------------------------- /lib/models/channel/message/embed.mli: -------------------------------------------------------------------------------- 1 | (** A footer object belonging to an embed. *) 2 | type footer = { 3 | text: string; 4 | icon_url: string option; 5 | proxy_icon_url: string option; 6 | } [@@deriving sexp, yojson { exn = true }] 7 | 8 | (** An image object belonging to an embed. *) 9 | type image = { 10 | url: string option; 11 | proxy_url: string option; 12 | height: int option; 13 | width: int option; 14 | } [@@deriving sexp, yojson { exn = true }] 15 | 16 | (** A video object belonging to an embed. *) 17 | type video = { 18 | url: string option; 19 | height: int option; 20 | width: int option; 21 | } [@@deriving sexp, yojson { exn = true }] 22 | 23 | (** A provider object belonging to an embed. *) 24 | type provider = { 25 | name: string option; 26 | url: string option; 27 | } [@@deriving sexp, yojson { exn = true }] 28 | 29 | (** An author object belonging to an embed. *) 30 | type author = { 31 | name: string option; 32 | url: string option; 33 | icon_url: string option; 34 | proxy_icon_url: string option; 35 | } [@@deriving sexp, yojson { exn = true }] 36 | 37 | (** A field object belonging to an embed. *) 38 | type field = { 39 | name: string; 40 | value: string; 41 | inline: bool; 42 | } [@@deriving sexp, yojson { exn = true }] 43 | 44 | (** An embed object. See this {{:https://leovoel.github.io/embed-visualizer/}embed visualiser} if you need help understanding each component. *) 45 | type t = { 46 | title: string option; 47 | kind: string option[@key "type"]; 48 | description: string option; 49 | url: string option; 50 | timestamp: string option; 51 | colour: int option[@key "color"]; 52 | footer: footer option; 53 | image: image option; 54 | thumbnail: image option; 55 | video: video option; 56 | provider: provider option; 57 | author: author option; 58 | fields: field list [@default []]; 59 | } [@@deriving sexp, yojson { strict = false; exn = true }] 60 | 61 | (** An embed where all values are empty. *) 62 | val default : t 63 | 64 | (** A footer where all values are empty. *) 65 | val default_footer : footer 66 | 67 | (** An image where all values are empty. *) 68 | val default_image : image 69 | 70 | (** A video where all values are empty. *) 71 | val default_video : video 72 | 73 | (** A provider where all values are empty. *) 74 | val default_provider : provider 75 | 76 | (** An author where all values are empty. *) 77 | val default_author : author 78 | 79 | (** Set the title of an embed. *) 80 | val title : string -> t -> t 81 | 82 | (** Set the description of an embed. *) 83 | val description : string -> t -> t 84 | 85 | (** Set the URL of an embed. *) 86 | val url : string -> t -> t 87 | 88 | (** Set the timestamp of an embed. *) 89 | val timestamp : string -> t -> t 90 | 91 | (** Set the colour of an embed. *) 92 | val colour : int -> t -> t 93 | 94 | (** Identical to {!colour} but with US English spelling. *) 95 | val color : int -> t -> t 96 | 97 | (** Set the footer of an embed. The function passes {!default_footer} and must return a footer. *) 98 | val footer : (footer -> footer) -> t -> t 99 | 100 | (** Set the image URL of an embed. *) 101 | val image : string -> t -> t 102 | 103 | (** Set the thumbnail URL of an embed. *) 104 | val thumbnail : string -> t -> t 105 | 106 | (** Set the author of an embed. The function passes {!default_author} and must return an author. *) 107 | val author : (author -> author) -> t -> t 108 | 109 | (** Add a field to an embed. Takes a tuple in [(name, value, inline)] order. {b Fields added this way will appear in reverse order in the embed.} *) 110 | val field : string * string * bool -> t -> t 111 | 112 | (** Set the fields of an embed. Similar to {!val:field}, but because a complete list is passed, fields preserve order. *) 113 | val fields : (string * string * bool) list -> t -> t 114 | 115 | (** Set the footer text. Typically used in the closure passed to {!val:footer}. *) 116 | val footer_text : string -> footer -> footer 117 | 118 | (** Set the footer icon URL. Typically used in the closure passed to {!val:footer}. *) 119 | val footer_icon : string -> footer -> footer 120 | 121 | (** Set the author name. Typically used in the closure passed to {!val:author}. *) 122 | val author_name : string -> author -> author 123 | 124 | (** Set the author URL. Typically used in the closure passed to {!val:author}. *) 125 | val author_url : string -> author -> author 126 | 127 | (** Set the author icon URL. Typically used in the closure passed to {!val:author}. *) 128 | val author_icon : string -> author -> author -------------------------------------------------------------------------------- /lib/gateway/dispatch.mli: -------------------------------------------------------------------------------- 1 | (** Used to store dispatch callbacks. Each event can only have one callback registered at a time. 2 | These should be accessed through their re-export in {!Client}. 3 | {3 Examples} 4 | [Client.ready := (fun _ -> print_endline "Shard is Ready!")] 5 | 6 | [Client.guild_create := (fun guild -> print_endline guild.name)] 7 | 8 | {[ 9 | open Core 10 | open Disml 11 | 12 | let check_command (msg : Message.t) = 13 | if String.is_prefix ~prefix:"!ping" msg.content then 14 | Message.reply msg "Pong!" >>> ignore 15 | 16 | Client.message_create := check_command 17 | ]} 18 | *) 19 | 20 | open Event_models 21 | 22 | (** Dispatched when each shard receives READY from discord after identifying on the gateway. Other event dispatch is received after this. *) 23 | val ready : (Ready.t -> unit) ref 24 | 25 | (** Dispatched when successfully reconnecting to the gateway. *) 26 | val resumed : (Resumed.t -> unit) ref 27 | 28 | (** Dispatched when a channel is created which is visible to the bot. *) 29 | val channel_create : (ChannelCreate.t -> unit) ref 30 | 31 | (** Dispatched when a channel visible to the bot is changed. *) 32 | val channel_update : (ChannelUpdate.t -> unit) ref 33 | 34 | (** Dispatched when a channel visible to the bot is deleted. *) 35 | val channel_delete : (ChannelDelete.t -> unit) ref 36 | 37 | (** Dispatched when messages are pinned or unpinned from a a channel. *) 38 | val channel_pins_update : (ChannelPinsUpdate.t -> unit) ref 39 | 40 | (** Dispatched when the bot joins a guild, and during startup. *) 41 | val guild_create : (GuildCreate.t -> unit) ref 42 | 43 | (** Dispatched when a guild the bot is in is edited. *) 44 | val guild_update : (GuildUpdate.t -> unit) ref 45 | 46 | (** Dispatched when the bot is removed from a guild. *) 47 | val guild_delete : (GuildDelete.t -> unit) ref 48 | 49 | (** Dispatched when a member is banned. *) 50 | val member_ban : (GuildBanAdd.t -> unit) ref 51 | 52 | (** Dispatched when a member is unbanned. *) 53 | val member_unban : (GuildBanRemove.t -> unit) ref 54 | 55 | (** Dispatched when emojis are added or removed from a guild. *) 56 | val guild_emojis_update : (GuildEmojisUpdate.t -> unit) ref 57 | 58 | (** Dispatched when a guild's integrations are updated. *) 59 | (* val integrations_update : (Yojson.Safe.t -> unit) ref *) 60 | 61 | (** Dispatched when a member joins a guild. *) 62 | val member_join : (GuildMemberAdd.t -> unit) ref 63 | 64 | (** Dispatched when a member leaves a guild. Is Dispatched alongside {!Client.member_ban} when a user is banned. *) 65 | val member_leave : (GuildMemberRemove.t -> unit) ref 66 | 67 | (** Dispatched when a member object is updated. *) 68 | val member_update : (GuildMemberUpdate.t -> unit) ref 69 | 70 | (** Dispatched when requesting guild members through {!Client.request_guild_members} *) 71 | val members_chunk : (GuildMembersChunk.t -> unit) ref 72 | 73 | (** Dispatched when a role is created. *) 74 | val role_create : (GuildRoleCreate.t -> unit) ref 75 | 76 | (** Dispatched when a role is edited. *) 77 | val role_update : (GuildRoleUpdate.t -> unit) ref 78 | 79 | (** Dispatched when a role is deleted. *) 80 | val role_delete : (GuildRoleDelete.t -> unit) ref 81 | 82 | (** Dispatched when a message is sent. *) 83 | val message_create : (MessageCreate.t -> unit) ref 84 | 85 | (** Dispatched when a message is edited. This does not necessarily mean the content changed. *) 86 | val message_update : (MessageUpdate.t -> unit) ref 87 | 88 | (** Dispatched when a message is deleted. *) 89 | val message_delete : (MessageDelete.t -> unit) ref 90 | 91 | (** Dispatched when messages are bulk deleted. *) 92 | val message_delete_bulk : (MessageDeleteBulk.t -> unit) ref 93 | 94 | (** Dispatched when a rection is added to a message. *) 95 | val reaction_add : (ReactionAdd.t -> unit) ref 96 | 97 | (** Dispatched when a reaction is removed from a message. *) 98 | val reaction_remove : (ReactionRemove.t -> unit) ref 99 | 100 | (** Dispatched when all reactions are cleared from a message. *) 101 | val reaction_remove_all : (ReactionRemoveAll.t -> unit) ref 102 | 103 | (** Dispatched when a user updates their presence. *) 104 | val presence_update : (PresenceUpdate.t -> unit) ref 105 | 106 | (** Dispatched when a typing indicator is displayed. *) 107 | val typing_start : (TypingStart.t -> unit) ref 108 | 109 | (** Dispatched when the current user is updated. You most likely want {!Client.member_update} or {!Client.presence_update} instead. *) 110 | val user_update : (UserUpdate.t -> unit) ref 111 | 112 | (** Dispatched when a webhook is updated. *) 113 | val webhook_update : (WebhookUpdate.t -> unit) ref 114 | 115 | (** Dispatched as a fallback for unknown events. *) 116 | val unknown : (Unknown.t -> unit) ref 117 | 118 | (**/**) 119 | (* val voice_state_update : (Yojson.Safe.t -> unit) ref *) 120 | (* val voice_server_update : (Yojson.Safe.t -> unit) ref *) 121 | -------------------------------------------------------------------------------- /lib/models/channel/channel_t.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | exception Invalid_channel of Yojson.Safe.t 4 | 5 | type group = { 6 | id: Channel_id_t.t; 7 | last_message_id: Message_id.t option [@default None]; 8 | last_pin_timestamp: string option [@default None]; 9 | icon: string option [@default None]; 10 | name: string option [@default None]; 11 | owner_id: User_id_t.t; 12 | recipients: User_t.t list [@default []]; 13 | } [@@deriving sexp, yojson { strict = false; exn = true }] 14 | 15 | type dm = { 16 | id: Channel_id_t.t; 17 | last_message_id: Message_id.t option [@default None]; 18 | last_pin_timestamp: string option [@default None]; 19 | } [@@deriving sexp, yojson { strict = false; exn = true }] 20 | 21 | type guild_text = { 22 | id: Channel_id_t.t; 23 | last_message_id: Message_id.t option [@default None]; 24 | last_pin_timestamp: string option [@default None]; 25 | category_id: Channel_id_t.t option [@default None][@key "parent_id"]; 26 | guild_id: Guild_id_t.t option [@default None]; 27 | name: string; 28 | position: int; 29 | topic: string option [@default None]; 30 | nsfw: bool; 31 | slow_mode_timeout: int option [@default None]; 32 | permission_overwrites: Overwrites.t list [@default []]; 33 | } [@@deriving sexp, yojson { strict = false; exn = true }] 34 | 35 | type guild_voice = { 36 | id: Channel_id_t.t; 37 | category_id: Channel_id_t.t option [@default None][@key "parent_id"]; 38 | guild_id: Guild_id_t.t option [@default None]; 39 | name: string; 40 | position: int; 41 | user_limit: int [@default -1]; 42 | bitrate: int option [@default None]; 43 | permission_overwrites: Overwrites.t list [@default []]; 44 | } [@@deriving sexp, yojson { strict = false; exn = true }] 45 | 46 | type category = { 47 | id: Channel_id_t.t; 48 | guild_id: Guild_id_t.t option [@default None]; 49 | position: int; 50 | name: string; 51 | permission_overwrites: Overwrites.t list [@default []]; 52 | } [@@deriving sexp, yojson { strict = false; exn = true }] 53 | 54 | type t = [ 55 | | `Group of group 56 | | `Private of dm 57 | | `GuildText of guild_text 58 | | `GuildVoice of guild_voice 59 | | `Category of category 60 | ] [@@deriving sexp, yojson { strict = false; exn = true }] 61 | 62 | type channel_wrapper = { 63 | id: Channel_id_t.t; 64 | kind: int [@key "type"]; 65 | guild_id: Guild_id_t.t option [@default None]; 66 | position: int option [@default None]; 67 | name: string option [@default None]; 68 | topic: string option [@default None]; 69 | nsfw: bool option [@default None]; 70 | last_message_id: Message_id.t option [@default None]; 71 | bitrate: int option [@default None]; 72 | user_limit: int option [@default None]; 73 | slow_mode_timeout: int option [@default None]; 74 | recipients: User_t.t list option [@default None]; 75 | icon: string option [@default None]; 76 | owner_id: User_id_t.t option [@default None]; 77 | application_id: Snowflake.t option [@default None]; 78 | category_id: Channel_id_t.t option [@default None][@key "parent_id"]; 79 | last_pin_timestamp: string option [@default None]; 80 | permission_overwrites: Overwrites.t list [@default []]; 81 | } [@@deriving sexp, yojson { strict = false; exn = true }] 82 | 83 | let unwrap_as_guild_text {id;guild_id;position;name;topic;nsfw;last_message_id;slow_mode_timeout;category_id;last_pin_timestamp;permission_overwrites;_} = 84 | let position = Option.value_exn position in 85 | let name = Option.value_exn name in 86 | let nsfw = Option.value ~default:false nsfw in 87 | { id; guild_id; position; name; topic; nsfw; last_message_id; slow_mode_timeout; category_id; last_pin_timestamp; permission_overwrites } 88 | 89 | let unwrap_as_guild_voice {id;guild_id;position;name;bitrate;user_limit;category_id;permission_overwrites;_} = 90 | let position = Option.value_exn position in 91 | let name = Option.value_exn name in 92 | let user_limit = Option.value ~default:(-1) user_limit in 93 | { id; guild_id; position; name; user_limit; bitrate ; category_id; permission_overwrites } 94 | 95 | let unwrap_as_dm {id;last_message_id;last_pin_timestamp;_} = 96 | { id; last_message_id; last_pin_timestamp; } 97 | 98 | let unwrap_as_group {id;name;last_message_id;recipients;icon;owner_id;last_pin_timestamp;_} = 99 | let recipients = Option.value ~default:[] recipients in 100 | let owner_id = Option.value_exn owner_id in 101 | { id; name; last_message_id; recipients; icon; owner_id; last_pin_timestamp; } 102 | 103 | let unwrap_as_category {id;guild_id;position;name;permission_overwrites;_} = 104 | let position = Option.value_exn position in 105 | let name = Option.value_exn name in 106 | { id; guild_id; position; name; permission_overwrites } 107 | 108 | let wrap s = 109 | match s.kind with 110 | | 0 -> `GuildText (unwrap_as_guild_text s) 111 | | 1 -> `Private (unwrap_as_dm s) 112 | | 2 -> `GuildVoice (unwrap_as_guild_voice s) 113 | | 3 -> `Group (unwrap_as_group s) 114 | | 4 -> `Category (unwrap_as_category s) 115 | | _ -> raise (Invalid_channel (channel_wrapper_to_yojson s)) 116 | 117 | let get_id (c:t) = match c with 118 | | `Group g -> let `Channel_id id = g.id in id 119 | | `Private p -> let `Channel_id id = p.id in id 120 | | `GuildText t -> let `Channel_id id = t.id in id 121 | | `GuildVoice v -> let `Channel_id id = v.id in id 122 | | `Category c -> let `Channel_id id = c.id in id -------------------------------------------------------------------------------- /lib/http/http.mli: -------------------------------------------------------------------------------- 1 | open Async 2 | 3 | module Base : sig 4 | exception Invalid_Method 5 | 6 | val base_url : string 7 | 8 | val process_url : string -> Uri.t 9 | val process_request_body : Yojson.Safe.t -> Cohttp_async.Body.t 10 | val process_request_headers : unit -> Cohttp.Header.t 11 | 12 | val process_response : 13 | string -> 14 | Cohttp_async.Response.t * Cohttp_async.Body.t -> 15 | Yojson.Safe.t Deferred.Or_error.t 16 | 17 | val request : 18 | ?body:Yojson.Safe.t -> 19 | ?query:(string * string) list -> 20 | [ `Delete | `Get | `Patch | `Post | `Put ] -> 21 | string -> 22 | Yojson.Safe.t Deferred.Or_error.t 23 | end 24 | 25 | val get_gateway : unit -> Yojson.Safe.t Deferred.Or_error.t 26 | val get_gateway_bot : unit -> Yojson.Safe.t Deferred.Or_error.t 27 | val get_channel : int -> Channel_t.t Deferred.Or_error.t 28 | val modify_channel : 29 | int -> Yojson.Safe.t -> Channel_t.t Deferred.Or_error.t 30 | val delete_channel : int -> Channel_t.t Deferred.Or_error.t 31 | val get_messages : int -> int -> string * int -> Message_t.t list Deferred.Or_error.t 32 | val get_message : int -> int -> Message_t.t Deferred.Or_error.t 33 | val create_message : 34 | int -> Yojson.Safe.t -> Message_t.t Deferred.Or_error.t 35 | val create_reaction : 36 | int -> int -> string -> unit Deferred.Or_error.t 37 | val delete_own_reaction : 38 | int -> int -> string -> unit Deferred.Or_error.t 39 | val delete_reaction : 40 | int -> int -> string -> int -> unit Deferred.Or_error.t 41 | val get_reactions : 42 | int -> int -> string -> User_t.t list Deferred.Or_error.t 43 | val delete_reactions : 44 | int -> int -> unit Deferred.Or_error.t 45 | val edit_message : 46 | int -> 47 | int -> Yojson.Safe.t -> Message_t.t Deferred.Or_error.t 48 | val delete_message : 49 | int -> int -> unit Deferred.Or_error.t 50 | val bulk_delete : 51 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 52 | val edit_channel_permissions : 53 | int -> 54 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 55 | val get_channel_invites : int -> Yojson.Safe.t Deferred.Or_error.t 56 | val create_channel_invite : 57 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 58 | val delete_channel_permission : 59 | int -> int -> unit Deferred.Or_error.t 60 | val broadcast_typing : int -> unit Deferred.Or_error.t 61 | val get_pinned_messages : int -> Message_t.t list Deferred.Or_error.t 62 | val pin_message : int -> int -> unit Deferred.Or_error.t 63 | val unpin_message : int -> int -> unit Deferred.Or_error.t 64 | val group_recipient_add : 65 | int -> int -> unit Deferred.Or_error.t 66 | val group_recipient_remove : 67 | int -> int -> unit Deferred.Or_error.t 68 | val get_emojis : int -> Emoji.t list Deferred.Or_error.t 69 | val get_emoji : int -> int -> Emoji.t Deferred.Or_error.t 70 | val create_emoji : 71 | int -> Yojson.Safe.t -> Emoji.t Deferred.Or_error.t 72 | val edit_emoji : 73 | int -> 74 | int -> Yojson.Safe.t -> Emoji.t Deferred.Or_error.t 75 | val delete_emoji : int -> int -> unit Deferred.Or_error.t 76 | val create_guild : 77 | Yojson.Safe.t -> Guild_t.t Deferred.Or_error.t 78 | val get_guild : int -> Guild_t.t Deferred.Or_error.t 79 | val edit_guild : 80 | int -> Yojson.Safe.t -> Guild_t.t Deferred.Or_error.t 81 | val delete_guild : int -> unit Deferred.Or_error.t 82 | val get_guild_channels : int -> Channel_t.t list Deferred.Or_error.t 83 | val create_guild_channel : 84 | int -> Yojson.Safe.t -> Channel_t.t Deferred.Or_error.t 85 | val modify_guild_channel_positions : 86 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 87 | val get_member : int -> int -> Member.t Deferred.Or_error.t 88 | val get_members : int -> Member.t list Deferred.Or_error.t 89 | val add_member : 90 | int -> 91 | int -> Yojson.Safe.t -> Member.t Deferred.Or_error.t 92 | val edit_member : 93 | int -> 94 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 95 | val remove_member : 96 | int -> 97 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 98 | val change_nickname : 99 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 100 | val add_member_role : 101 | int -> int -> int -> unit Deferred.Or_error.t 102 | val remove_member_role : 103 | int -> int -> int -> unit Deferred.Or_error.t 104 | val get_bans : int -> Ban.t list Deferred.Or_error.t 105 | val get_ban : int -> int -> Ban.t Deferred.Or_error.t 106 | val guild_ban_add : 107 | int -> 108 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 109 | val guild_ban_remove : 110 | int -> 111 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 112 | val get_roles : int -> Role_t.t list Deferred.Or_error.t 113 | val guild_role_add : 114 | int -> Yojson.Safe.t -> Role_t.t Deferred.Or_error.t 115 | val guild_roles_edit : 116 | int -> Yojson.Safe.t -> Role_t.t list Deferred.Or_error.t 117 | val guild_role_edit : 118 | int -> 119 | int -> Yojson.Safe.t -> Role_t.t Deferred.Or_error.t 120 | val guild_role_remove : 121 | int -> int -> unit Deferred.Or_error.t 122 | val guild_prune_count : 123 | int -> int -> int Deferred.Or_error.t 124 | val guild_prune_start : 125 | int -> int -> int Deferred.Or_error.t 126 | val get_guild_voice_regions : 127 | int -> Yojson.Safe.t Deferred.Or_error.t 128 | val get_guild_invites : int -> Yojson.Safe.t Deferred.Or_error.t 129 | val get_integrations : int -> Yojson.Safe.t Deferred.Or_error.t 130 | val add_integration : 131 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 132 | val edit_integration : 133 | int -> 134 | int -> Yojson.Safe.t -> unit Deferred.Or_error.t 135 | val delete_integration : 136 | int -> int -> unit Deferred.Or_error.t 137 | val sync_integration : 138 | int -> int -> unit Deferred.Or_error.t 139 | val get_guild_embed : int -> Yojson.Safe.t Deferred.Or_error.t 140 | val edit_guild_embed : 141 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 142 | val get_vanity_url : int -> Yojson.Safe.t Deferred.Or_error.t 143 | val get_invite : string -> Yojson.Safe.t Deferred.Or_error.t 144 | val delete_invite : string -> Yojson.Safe.t Deferred.Or_error.t 145 | val get_current_user : unit -> User_t.t Deferred.Or_error.t 146 | val edit_current_user : 147 | Yojson.Safe.t -> User_t.t Deferred.Or_error.t 148 | val get_guilds : unit -> Guild_t.t list Deferred.Or_error.t 149 | val leave_guild : int -> unit Deferred.Or_error.t 150 | val get_private_channels : 151 | unit -> Yojson.Safe.t Deferred.Or_error.t 152 | val create_dm : 153 | Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 154 | val create_group_dm : 155 | Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 156 | val get_connections : unit -> Yojson.Safe.t Deferred.Or_error.t 157 | val get_user : int -> User_t.t Deferred.Or_error.t 158 | val get_voice_regions : unit -> Yojson.Safe.t Deferred.Or_error.t 159 | val create_webhook : 160 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 161 | val get_channel_webhooks : int -> Yojson.Safe.t Deferred.Or_error.t 162 | val get_guild_webhooks : int -> Yojson.Safe.t Deferred.Or_error.t 163 | val get_webhook : int -> Yojson.Safe.t Deferred.Or_error.t 164 | val get_webhook_with_token : 165 | int -> string -> Yojson.Safe.t Deferred.Or_error.t 166 | val edit_webhook : 167 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 168 | val edit_webhook_with_token : 169 | int -> 170 | string -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 171 | val delete_webhook : int -> unit Deferred.Or_error.t 172 | val delete_webhook_with_token : 173 | int -> string -> unit Deferred.Or_error.t 174 | val execute_webhook : 175 | int -> 176 | string -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 177 | val execute_slack_webhook : 178 | int -> 179 | string -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 180 | val execute_git_webhook : 181 | int -> 182 | string -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 183 | val get_audit_logs : 184 | int -> Yojson.Safe.t -> Yojson.Safe.t Deferred.Or_error.t 185 | val get_application_info : unit -> Yojson.Safe.t Deferred.Or_error.t -------------------------------------------------------------------------------- /lib/gateway/event.ml: -------------------------------------------------------------------------------- 1 | open Async 2 | open Core 3 | open Event_models 4 | 5 | type t = 6 | | READY of Ready.t 7 | | RESUMED of Resumed.t 8 | | CHANNEL_CREATE of ChannelCreate.t 9 | | CHANNEL_UPDATE of ChannelUpdate.t 10 | | CHANNEL_DELETE of ChannelDelete.t 11 | | CHANNEL_PINS_UPDATE of ChannelPinsUpdate.t 12 | | GUILD_CREATE of GuildCreate.t 13 | | GUILD_UPDATE of GuildUpdate.t 14 | | GUILD_DELETE of GuildDelete.t 15 | | GUILD_BAN_ADD of GuildBanAdd.t 16 | | GUILD_BAN_REMOVE of GuildBanRemove.t 17 | | GUILD_EMOJIS_UPDATE of GuildEmojisUpdate.t 18 | (* | GUILD_INTEGRATIONS_UPDATE of Yojson.Safe.t *) 19 | | GUILD_MEMBER_ADD of GuildMemberAdd.t 20 | | GUILD_MEMBER_REMOVE of GuildMemberRemove.t 21 | | GUILD_MEMBER_UPDATE of GuildMemberUpdate.t 22 | | GUILD_MEMBERS_CHUNK of GuildMembersChunk.t 23 | | GUILD_ROLE_CREATE of GuildRoleCreate.t 24 | | GUILD_ROLE_UPDATE of GuildRoleUpdate.t 25 | | GUILD_ROLE_DELETE of GuildRoleDelete.t 26 | | MESSAGE_CREATE of MessageCreate.t 27 | | MESSAGE_UPDATE of MessageUpdate.t 28 | | MESSAGE_DELETE of MessageDelete.t 29 | | MESSAGE_DELETE_BULK of MessageDeleteBulk.t 30 | | REACTION_ADD of ReactionAdd.t 31 | | REACTION_REMOVE of ReactionRemove.t 32 | | REACTION_REMOVE_ALL of ReactionRemoveAll.t 33 | | PRESENCE_UPDATE of PresenceUpdate.t 34 | | TYPING_START of TypingStart.t 35 | | USER_UPDATE of UserUpdate.t 36 | (* | VOICE_STATE_UPDATE of Yojson.Safe.t *) 37 | (* | VOICE_SERVER_UPDATE of Yojson.Safe.t *) 38 | | WEBHOOK_UPDATE of WebhookUpdate.t 39 | | UNKNOWN of Unknown.t 40 | 41 | let event_of_yojson ~contents = function 42 | | "READY" -> READY Ready.(deserialize contents) 43 | | "RESUMED" -> RESUMED Resumed.(deserialize contents) 44 | | "CHANNEL_CREATE" -> CHANNEL_CREATE ChannelCreate.(deserialize contents) 45 | | "CHANNEL_UPDATE" -> CHANNEL_UPDATE ChannelUpdate.(deserialize contents) 46 | | "CHANNEL_DELETE" -> CHANNEL_DELETE ChannelDelete.(deserialize contents) 47 | | "CHANNEL_PINS_UPDATE" -> CHANNEL_PINS_UPDATE ChannelPinsUpdate.(deserialize contents) 48 | | "GUILD_CREATE" -> GUILD_CREATE GuildCreate.(deserialize contents) 49 | | "GUILD_UPDATE" -> GUILD_UPDATE GuildUpdate.(deserialize contents) 50 | | "GUILD_DELETE" -> GUILD_DELETE GuildDelete.(deserialize contents) 51 | | "GUILD_BAN_ADD" -> GUILD_BAN_ADD GuildBanAdd.(deserialize contents) 52 | | "GUILD_BAN_REMOVE" -> GUILD_BAN_REMOVE GuildBanRemove.(deserialize contents) 53 | | "GUILD_EMOJIS_UPDATE" -> GUILD_EMOJIS_UPDATE GuildEmojisUpdate.(deserialize contents) 54 | (* | "GUILD_INTEGRATIONS_UPDATE" -> GUILD_INTEGRATIONS_UPDATE contents *) 55 | | "GUILD_MEMBER_ADD" -> GUILD_MEMBER_ADD GuildMemberAdd.(deserialize contents) 56 | | "GUILD_MEMBER_REMOVE" -> GUILD_MEMBER_REMOVE GuildMemberRemove.(deserialize contents) 57 | | "GUILD_MEMBER_UPDATE" -> GUILD_MEMBER_UPDATE GuildMemberUpdate.(deserialize contents) 58 | | "GUILD_MEMBERS_CHUNK" -> GUILD_MEMBERS_CHUNK GuildMembersChunk.(deserialize contents) 59 | | "GUILD_ROLE_CREATE" -> GUILD_ROLE_CREATE GuildRoleCreate.(deserialize contents) 60 | | "GUILD_ROLE_UPDATE" -> GUILD_ROLE_UPDATE GuildRoleUpdate.(deserialize contents) 61 | | "GUILD_ROLE_DELETE" -> GUILD_ROLE_DELETE GuildRoleDelete.(deserialize contents) 62 | | "MESSAGE_CREATE" -> MESSAGE_CREATE MessageCreate.(deserialize contents) 63 | | "MESSAGE_UPDATE" -> MESSAGE_UPDATE MessageUpdate.(deserialize contents) 64 | | "MESSAGE_DELETE" -> MESSAGE_DELETE MessageDelete.(deserialize contents) 65 | | "MESSAGE_DELETE_BULK" -> MESSAGE_DELETE_BULK MessageDeleteBulk.(deserialize contents) 66 | | "MESSAGE_REACTION_ADD" -> REACTION_ADD ReactionAdd.(deserialize contents) 67 | | "MESSAGE_REACTION_REMOVE" -> REACTION_REMOVE ReactionRemove.(deserialize contents) 68 | | "MESSAGE_REACTION_REMOVE_ALL" -> REACTION_REMOVE_ALL ReactionRemoveAll.(deserialize contents) 69 | | "PRESENCE_UPDATE" -> PRESENCE_UPDATE PresenceUpdate.(deserialize contents) 70 | | "TYPING_START" -> TYPING_START TypingStart.(deserialize contents) 71 | | "USER_UPDATE" -> USER_UPDATE UserUpdate.(deserialize contents) 72 | (* | "VOICE_STATE_UPDATE" -> VOICE_STATE_UPDATE contents *) 73 | (* | "VOICE_SERVER_UPDATE" -> VOICE_SERVER_UPDATE contents *) 74 | | "WEBHOOK_UPDATE" -> WEBHOOK_UPDATE WebhookUpdate.(deserialize contents) 75 | | s -> UNKNOWN Unknown.(deserialize s contents) 76 | 77 | let dispatch ev = 78 | match ev with 79 | | READY d -> 80 | Mvar.update_exn Cache.cache ~f:(fun cache -> Ready.update_cache cache d); 81 | !Dispatch.ready d 82 | | RESUMED d -> 83 | Mvar.update_exn Cache.cache ~f:(fun cache -> Resumed.update_cache cache d); 84 | !Dispatch.resumed d 85 | | CHANNEL_CREATE d -> 86 | Mvar.update_exn Cache.cache ~f:(fun cache -> ChannelCreate.update_cache cache d); 87 | !Dispatch.channel_create d 88 | | CHANNEL_UPDATE d -> 89 | Mvar.update_exn Cache.cache ~f:(fun cache -> ChannelUpdate.update_cache cache d); 90 | !Dispatch.channel_update d 91 | | CHANNEL_DELETE d -> 92 | Mvar.update_exn Cache.cache ~f:(fun cache -> ChannelDelete.update_cache cache d); 93 | !Dispatch.channel_delete d 94 | | CHANNEL_PINS_UPDATE d -> 95 | Mvar.update_exn Cache.cache ~f:(fun cache -> ChannelPinsUpdate.update_cache cache d); 96 | !Dispatch.channel_pins_update d 97 | | GUILD_CREATE d -> 98 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildCreate.update_cache cache d); 99 | !Dispatch.guild_create d 100 | | GUILD_UPDATE d -> 101 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildUpdate.update_cache cache d); 102 | !Dispatch.guild_update d 103 | | GUILD_DELETE d -> 104 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildDelete.update_cache cache d); 105 | !Dispatch.guild_delete d 106 | | GUILD_BAN_ADD d -> 107 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildBanAdd.update_cache cache d); 108 | !Dispatch.member_ban d 109 | | GUILD_BAN_REMOVE d -> 110 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildBanRemove.update_cache cache d); 111 | !Dispatch.member_unban d 112 | | GUILD_EMOJIS_UPDATE d -> 113 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildEmojisUpdate.update_cache cache d); 114 | !Dispatch.guild_emojis_update d 115 | (* | GUILD_INTEGRATIONS_UPDATE d -> !Dispatch.integrations_update d *) 116 | | GUILD_MEMBER_ADD d -> 117 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildMemberAdd.update_cache cache d); 118 | !Dispatch.member_join d 119 | | GUILD_MEMBER_REMOVE d -> 120 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildMemberRemove.update_cache cache d); 121 | !Dispatch.member_leave d 122 | | GUILD_MEMBER_UPDATE d -> 123 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildMemberUpdate.update_cache cache d); 124 | !Dispatch.member_update d 125 | | GUILD_MEMBERS_CHUNK d -> 126 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildMembersChunk.update_cache cache d); 127 | !Dispatch.members_chunk d 128 | | GUILD_ROLE_CREATE d -> 129 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildRoleCreate.update_cache cache d); 130 | !Dispatch.role_create d 131 | | GUILD_ROLE_UPDATE d -> 132 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildRoleUpdate.update_cache cache d); 133 | !Dispatch.role_update d 134 | | GUILD_ROLE_DELETE d -> 135 | Mvar.update_exn Cache.cache ~f:(fun cache -> GuildRoleDelete.update_cache cache d); 136 | !Dispatch.role_delete d 137 | | MESSAGE_CREATE d -> 138 | Mvar.update_exn Cache.cache ~f:(fun cache -> MessageCreate.update_cache cache d); 139 | !Dispatch.message_create d 140 | | MESSAGE_UPDATE d -> 141 | Mvar.update_exn Cache.cache ~f:(fun cache -> MessageUpdate.update_cache cache d); 142 | !Dispatch.message_update d 143 | | MESSAGE_DELETE d -> 144 | Mvar.update_exn Cache.cache ~f:(fun cache -> MessageDelete.update_cache cache d); 145 | !Dispatch.message_delete d 146 | | MESSAGE_DELETE_BULK d -> 147 | Mvar.update_exn Cache.cache ~f:(fun cache -> MessageDeleteBulk.update_cache cache d); 148 | !Dispatch.message_delete_bulk d 149 | | REACTION_ADD d -> 150 | Mvar.update_exn Cache.cache ~f:(fun cache -> ReactionAdd.update_cache cache d); 151 | !Dispatch.reaction_add d 152 | | REACTION_REMOVE d -> 153 | Mvar.update_exn Cache.cache ~f:(fun cache -> ReactionRemove.update_cache cache d); 154 | !Dispatch.reaction_remove d 155 | | REACTION_REMOVE_ALL d -> 156 | Mvar.update_exn Cache.cache ~f:(fun cache -> ReactionRemoveAll.update_cache cache d); 157 | !Dispatch.reaction_remove_all d 158 | | PRESENCE_UPDATE d -> 159 | Mvar.update_exn Cache.cache ~f:(fun cache -> PresenceUpdate.update_cache cache d); 160 | !Dispatch.presence_update d 161 | | TYPING_START d -> 162 | Mvar.update_exn Cache.cache ~f:(fun cache -> TypingStart.update_cache cache d); 163 | !Dispatch.typing_start d 164 | | USER_UPDATE d -> 165 | Mvar.update_exn Cache.cache ~f:(fun cache -> UserUpdate.update_cache cache d); 166 | !Dispatch.user_update d 167 | (* | VOICE_STATE_UPDATE d -> !Dispatch.voice_state_update d *) 168 | (* | VOICE_SERVER_UPDATE d -> !Dispatch.voice_server_update d *) 169 | | WEBHOOK_UPDATE d -> 170 | Mvar.update_exn Cache.cache ~f:(fun cache -> WebhookUpdate.update_cache cache d); 171 | !Dispatch.webhook_update d 172 | | UNKNOWN d -> !Dispatch.unknown d 173 | 174 | let handle_event ~ev contents = 175 | event_of_yojson ~contents ev 176 | |> dispatch -------------------------------------------------------------------------------- /bin/commands.ml: -------------------------------------------------------------------------------- 1 | open Async 2 | open Core 3 | open Disml 4 | open Models 5 | 6 | (* Client object will be stored here after creation. *) 7 | let client = Ivar.create () 8 | 9 | (* Example ping command with REST round trip time edited into the response. *) 10 | let ping message _args = 11 | Message.reply message "Pong!" >>> function 12 | | Ok message -> 13 | let diff = Time.diff (Time.now ()) (Time.of_string message.timestamp) in 14 | Message.set_content message (Printf.sprintf "Pong! `%d ms`" (Time.Span.to_ms diff |> Float.abs |> Float.to_int)) >>> ignore 15 | | Error e -> Error.raise e 16 | 17 | (* Send a list of consecutive integers of N size with 1 message per list item. *) 18 | let spam message args = 19 | let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in 20 | List.range 0 count 21 | |> List.iter ~f:(fun i -> Message.reply message (string_of_int i) >>> ignore) 22 | 23 | (* Send a list of consecutive integers of N size in a single message. *) 24 | let list message args = 25 | let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in 26 | let list = List.range 0 count 27 | |> List.sexp_of_t Int.sexp_of_t 28 | |> Sexp.to_string_hum in 29 | Message.reply message list >>> function 30 | | Ok msg -> print_endline msg.content 31 | | Error err -> print_endline (Error.to_string_hum err) 32 | 33 | (* Example of setting pretty much everything in an embed using the Embed module builders *) 34 | let embed message _args = 35 | let image_url = "https://cdn.discordapp.com/avatars/345316276098433025/17ccdc992814cc6e21a9e7d743a30e37.png" in 36 | let embed = Embed.(default 37 | |> title "Foo" 38 | |> description "Bar" 39 | |> url "https://gitlab.com/Mishio595/disml" 40 | |> timestamp Time.(now () |> to_string_iso8601_basic ~zone:Time.Zone.utc) 41 | |> colour 0xff 42 | |> footer (fun f -> footer_text "boop" f) 43 | |> image image_url 44 | |> thumbnail image_url 45 | |> author (fun a -> a 46 | |> author_name "Adelyn" 47 | |> author_icon image_url 48 | |> author_url "https://gitlab.com/Mishio595/disml") 49 | |> field ("field 3", "test", true) 50 | |> field ("field 2", "test", true) 51 | |> field ("field 1", "test", true) 52 | ) in 53 | Message.reply_with ~embed message >>> ignore 54 | 55 | (* Set the status of all shards to a given string. *) 56 | let status message args = 57 | let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in 58 | Ivar.read client >>> fun client -> 59 | Client.set_status ~name client 60 | >>> fun _ -> 61 | Message.reply message "Updated status" >>> ignore 62 | 63 | (* Fetches a message by ID in the current channel, defaulting to the sent message, and prints in s-expr form. *) 64 | let echo (message:Message.t) args = 65 | let `Message_id id = message.id in 66 | let id = Option.((List.hd args >>| Int.of_string) |> value ~default:id) in 67 | Channel_id.get_message ~id message.channel_id >>> function 68 | | Ok msg -> 69 | let str = Message.sexp_of_t msg |> Sexp.to_string_hum in 70 | Message.reply message (Printf.sprintf "```lisp\n%s```" str) >>> ignore 71 | | _ -> () 72 | 73 | (* Output cache counts as a a basic embed. *) 74 | let cache message _args = 75 | let module C = Cache.ChannelMap in 76 | let module G = Cache.GuildMap in 77 | let module U = Cache.UserMap in 78 | let cache = Mvar.peek_exn Cache.cache in 79 | let gc = G.length cache.guilds in 80 | let ug = G.length cache.unavailable_guilds in 81 | let tc = C.length cache.text_channels in 82 | let vc = C.length cache.voice_channels in 83 | let cs = C.length cache.categories in 84 | let gr = C.length cache.groups in 85 | let pr = C.length cache.private_channels in 86 | let uc = U.length cache.users in 87 | let pre = U.length cache.presences in 88 | let user = Option.(value ~default:"None" (cache.user >>| User.tag)) in 89 | let embed = Embed.(default 90 | |> description (Printf.sprintf 91 | "Guilds: %d\nUnavailable Guilds: %d\n\ 92 | Text Channels: %d\nVoice Channels: %d\n\ 93 | Categories: %d\nGroups: %d\n\ 94 | Private Channels: %d\nUsers: %d\n\ 95 | Presences: %d\nCurrent User: %s" 96 | gc ug tc vc cs gr pr uc pre user)) in 97 | Message.reply_with ~embed message >>> ignore 98 | 99 | (* Issue a shutdown to all shards, then exits the process. *) 100 | let shutdown (message:Message.t) _args = 101 | if message.author.id = `User_id 242675474927583232 then 102 | Ivar.read client >>= Client.shutdown_all ~restart:false >>> fun _ -> 103 | exit 0 104 | 105 | (* Request guild members to be sent over the gateway for the guild the command is run in. This will cause multiple GUILD_MEMBERS_CHUNK events. *) 106 | let request_members (message:Message.t) _args = 107 | Ivar.read client >>> fun client -> 108 | match message.guild_id with 109 | | Some guild -> Client.request_guild_members ~guild client >>> ignore 110 | | None -> () 111 | 112 | (* Creates a guild named testing or what the user provided *) 113 | let new_guild message args = 114 | let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in 115 | let name = if String.length name = 0 then "Testing" else name in 116 | Guild.create [ "name", `String name ] >>= begin function 117 | | Ok g -> Message.reply message (Printf.sprintf "Created guild %s" g.name) 118 | | Error e -> Message.reply message (Printf.sprintf "Failed to create guild. Error: %s" (Error.to_string_hum e)) 119 | end >>> ignore 120 | 121 | (* Deletes all guilds made by the bot *) 122 | let delete_guilds message _args = 123 | let cache = Mvar.peek_exn Cache.cache in 124 | let uid = match cache.user with 125 | | Some u -> u.id 126 | | None -> `User_id 0 127 | in 128 | let guilds = Cache.GuildMap.filter cache.guilds ~f:(fun g -> g.owner_id = uid) in 129 | let res = ref "" in 130 | let all = Cache.GuildMap.(map guilds ~f:(fun g -> Guild.delete g >>| function 131 | | Ok () -> res := Printf.sprintf "%s\nDeleted %s" !res g.name 132 | | Error _ -> ()) |> to_alist) |> List.map ~f:(snd) in 133 | Deferred.all all >>= (fun _ -> 134 | Message.reply message !res) >>> ignore 135 | 136 | let role_test (message:Message.t) args = 137 | let exception Member_not_found in 138 | let cache = Mvar.peek_exn Cache.cache in 139 | let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in 140 | let create_role name guild_id = 141 | Guild_id.create_role ~name guild_id >>| function 142 | | Ok role -> role 143 | | Error e -> Error.raise e 144 | in 145 | let delete_role role = 146 | Role.delete role >>| function 147 | | Ok () -> () 148 | | Error e -> Error.raise e 149 | in 150 | let add_role member role = 151 | Member.add_role ~role member >>| function 152 | | Ok () -> role 153 | | Error e -> Error.raise e 154 | in 155 | let remove_role member role = 156 | Member.remove_role ~role member >>| function 157 | | Ok () -> role 158 | | Error e -> Error.raise e 159 | in 160 | let get_member id = match Cache.GuildMap.find cache.guilds id with 161 | | Some guild -> 162 | begin match List.find guild.members ~f:(fun m -> m.user.id = message.author.id) with 163 | | Some member -> member 164 | | None -> raise Member_not_found 165 | end 166 | | None -> raise Member_not_found 167 | in 168 | match message.guild_id with 169 | | Some id -> begin try 170 | let member = get_member id in 171 | create_role name id 172 | >>= add_role member 173 | >>= remove_role member 174 | >>= delete_role 175 | >>= (fun () -> Message.reply message "Role test finished") 176 | with 177 | | Member_not_found -> Message.reply message "Error: Member not found" 178 | | exn -> Message.reply message (Printf.sprintf "Error: %s" Error.(of_exn exn |> to_string_hum)) 179 | end >>> ignore 180 | | None -> () 181 | 182 | let check_permissions (message:Message.t) _args = 183 | let cache = Mvar.peek_exn Cache.cache in 184 | let empty = Permissions.empty in 185 | let permissions = match message.guild_id, message.member with 186 | | Some g, Some m -> 187 | begin match Cache.guild cache g with 188 | | Some g -> 189 | List.fold m.roles ~init:Permissions.empty ~f:(fun acc rid -> 190 | let role = List.find_exn g.roles ~f:(fun r -> r.id = rid) in 191 | Permissions.union acc role.permissions) 192 | | None -> empty 193 | end 194 | | _ -> empty in 195 | let allow, deny = match message.member with 196 | | Some m -> 197 | begin match Cache.text_channel cache message.channel_id with 198 | | Some c -> 199 | List.fold c.permission_overwrites ~init:(empty, empty) ~f:(fun (a,d) {allow; deny; id; kind} -> 200 | let `User_id uid = message.author.id in 201 | if (kind = "role" && List.mem m.roles (`Role_id id) ~equal:(=)) || (kind = "user" && id = uid) then 202 | Permissions.union allow a, Permissions.union deny d 203 | else a, d 204 | ) 205 | | None -> empty, empty 206 | end 207 | | None -> empty, empty in 208 | let g_perms = Permissions.elements permissions 209 | |> List.sexp_of_t Permissions.sexp_of_elt 210 | |> Sexp.to_string_hum in 211 | let c_perms = Permissions.(union permissions allow 212 | |> diff deny 213 | |> elements) 214 | |> List.sexp_of_t Permissions.sexp_of_elt 215 | |> Sexp.to_string_hum in 216 | Message.reply message (Printf.sprintf "Global Permissions: %s\nChannel Permissions: %s" g_perms c_perms) >>> ignore -------------------------------------------------------------------------------- /lib/gateway/sharder.ml: -------------------------------------------------------------------------------- 1 | open Async 2 | open Core 3 | open Zl 4 | open Websocket_async 5 | 6 | exception Invalid_Payload 7 | exception Failure_to_Establish_Heartbeat 8 | 9 | let decompress src = 10 | let src' = Bigstring.of_string src in 11 | let i = De.bigstring_create De.io_buffer_size in 12 | let o = De.bigstring_create De.io_buffer_size in 13 | let allocate bits = De.make_window ~bits in 14 | let pos = ref 0 in 15 | let src_len = String.length src in 16 | let res = Buffer.create (src_len) in 17 | let refill buf = 18 | let len = min (src_len - !pos) De.io_buffer_size in 19 | Bigstringaf.blit src' ~src_off:!pos buf ~dst_off:0 ~len; 20 | pos := !pos + len; 21 | len in 22 | let flush buf len = 23 | let str = Bigstringaf.substring buf ~off:0 ~len in 24 | Buffer.add_string res str in 25 | match Higher.uncompress ~allocate ~refill ~flush i o with 26 | | Ok _ -> Buffer.contents res 27 | (* This could definitely be better, I think; 28 | * I'm not really sure how to throw a better exception here *) 29 | | Error (`Msg m) -> raise (Failure m) 30 | 31 | module Shard = struct 32 | type shard = 33 | { compress: bool 34 | ; id: int * int 35 | ; hb_interval: Time.Span.t Ivar.t 36 | ; hb_stopper: unit Ivar.t 37 | ; large_threshold: int 38 | ; pipe: Frame.t Pipe.Reader.t * Frame.t Pipe.Writer.t 39 | ; ready: unit Ivar.t 40 | ; seq: int 41 | ; session: string option 42 | ; url: string 43 | ; _internal: Reader.t * Writer.t 44 | } 45 | 46 | type 'a t = 47 | { mutable state: 'a 48 | ; mutable stopped: bool 49 | ; mutable can_resume: bool 50 | } 51 | 52 | let identify_lock = Mvar.create () 53 | let _ = Mvar.set identify_lock () 54 | 55 | let parse ~compress (frame:[`Ok of Frame.t | `Eof]) = 56 | match frame with 57 | | `Ok s -> begin 58 | let open Frame.Opcode in 59 | match s.opcode with 60 | | Text -> `Ok (Yojson.Safe.from_string s.content) 61 | | Binary -> 62 | if compress then `Ok (decompress s.content |> Yojson.Safe.from_string) 63 | else `Error "Failed to decompress" 64 | | Close -> `Close s 65 | | op -> 66 | let op = Frame.Opcode.to_string op in 67 | `Error ("Unexpected opcode " ^ op) 68 | end 69 | | `Eof -> `Eof 70 | 71 | let push_frame ?payload ~ev shard = 72 | let content = match payload with 73 | | None -> "" 74 | | Some p -> 75 | Yojson.Safe.to_string @@ `Assoc [ 76 | "op", `Int (Opcode.to_int ev); 77 | "d", p; 78 | ] 79 | in 80 | let (_, write) = shard.pipe in 81 | Pipe.write_if_open write @@ Frame.create ~content () 82 | >>| fun () -> 83 | shard 84 | 85 | let heartbeat shard = 86 | match shard.seq with 87 | | 0 -> return shard 88 | | i -> 89 | Logs.debug (fun m -> m "Heartbeating - Shard: [%d, %d] - Seq: %d" (fst shard.id) (snd shard.id) (shard.seq)); 90 | push_frame ~payload:(`Int i) ~ev:HEARTBEAT shard 91 | 92 | let dispatch ~payload shard = 93 | let module J = Yojson.Safe.Util in 94 | let seq = J.(member "s" payload |> to_int) in 95 | let (t: string) = J.(member "t" payload |> to_string) in 96 | let data = J.member "d" payload in 97 | let b = String.compare t "READY" in 98 | let session = if b = 0 then begin 99 | Ivar.fill_if_empty shard.ready (); 100 | Clock.after (Core.Time.Span.create ~sec:5 ()) 101 | >>> (fun _ -> Mvar.put identify_lock () >>> ignore); 102 | J.(member "session_id" data |> to_string_option) 103 | end else shard.session in 104 | Event.handle_event ~ev:t data; 105 | return 106 | { shard with seq = seq 107 | ; session = session 108 | } 109 | 110 | let set_status ?(status="online") ?(kind=0) ?name ?since ?url shard = 111 | let since = Option.(since >>| (fun v -> `Int v) |> value ~default:`Null) in 112 | let url = Option.(url >>| (fun v -> `String v) |> value ~default:`Null) in 113 | let game = match name with 114 | | Some name -> `Assoc 115 | [ "name", `String name 116 | ; "type", `Int kind 117 | ; "url", url 118 | ] 119 | | None -> `Null 120 | in 121 | let payload = `Assoc 122 | [ "status", `String status 123 | ; "afk", `Bool false 124 | ; "since", since 125 | ; "game", game 126 | ] 127 | in 128 | Ivar.read shard.ready >>= fun _ -> 129 | push_frame ~payload ~ev:STATUS_UPDATE shard 130 | 131 | let request_guild_members ?(query="") ?(limit=0) ~guild shard = 132 | let payload = `Assoc 133 | [ "guild_id", `String (Int.to_string guild) 134 | ; "query", `String query 135 | ; "limit", `Int limit 136 | ] 137 | in 138 | Ivar.read shard.ready >>= fun _ -> 139 | push_frame ~payload ~ev:REQUEST_GUILD_MEMBERS shard 140 | 141 | let initialize ?data shard = 142 | let module J = Yojson.Safe.Util in 143 | let _ = match data with 144 | | Some data -> Ivar.fill_if_empty shard.hb_interval (Time.Span.create ~ms:J.(member "heartbeat_interval" data |> to_int) ()) 145 | | None -> raise Failure_to_Establish_Heartbeat 146 | in 147 | let shards = [`Int (fst shard.id); `Int (snd shard.id)] in 148 | match shard.session with 149 | | None -> begin 150 | Mvar.take identify_lock >>= fun () -> 151 | Logs.debug (fun m -> m "Identifying shard [%d, %d]" (fst shard.id) (snd shard.id)); 152 | let payload = `Assoc 153 | [ "token", `String !Client_options.token 154 | ; "properties", `Assoc 155 | [ "$os", `String Sys.os_type 156 | ; "$device", `String "dis.ml" 157 | ; "$browser", `String "dis.ml" 158 | ] 159 | ; "compress", `Bool shard.compress 160 | ; "large_threshold", `Int shard.large_threshold 161 | ; "shard", `List shards 162 | ] 163 | in 164 | push_frame ~payload ~ev:IDENTIFY shard 165 | >>| fun s -> s 166 | end 167 | | Some s -> 168 | let payload = `Assoc 169 | [ "token", `String !Client_options.token 170 | ; "session_id", `String s 171 | ; "seq", `Int shard.seq 172 | ] 173 | in 174 | push_frame ~payload ~ev:RESUME shard 175 | 176 | let handle_frame ~f shard = 177 | let module J = Yojson.Safe.Util in 178 | let op = J.(member "op" f |> to_int) |> Opcode.from_int in 179 | match op with 180 | | DISPATCH -> dispatch ~payload:f shard 181 | | HEARTBEAT -> heartbeat shard 182 | | INVALID_SESSION -> begin 183 | Logs.err (fun m -> m "Invalid Session on Shard [%d, %d]: %s" (fst shard.id) (snd shard.id) (Yojson.Safe.pretty_to_string f)); 184 | if J.(member "d" f |> to_bool) then 185 | initialize shard 186 | else begin 187 | initialize { shard with session = None; } 188 | end 189 | end 190 | | RECONNECT -> initialize shard 191 | | HELLO -> initialize ~data:(J.member "d" f) shard 192 | | HEARTBEAT_ACK -> return shard 193 | | opcode -> 194 | Logs.warn (fun m -> m "Invalid Opcode: %s" (Opcode.to_string opcode)); 195 | return shard 196 | 197 | let rec make_client 198 | ~initialized 199 | ~extra_headers 200 | ~app_to_ws 201 | ~ws_to_app 202 | ~net_to_ws 203 | ~ws_to_net 204 | ?(ms=500) 205 | uri = 206 | client 207 | ~initialized 208 | ~extra_headers 209 | ~app_to_ws 210 | ~ws_to_app 211 | ~net_to_ws 212 | ~ws_to_net 213 | uri 214 | >>> fun res -> 215 | match res with 216 | | Ok () -> () 217 | | Error _ -> 218 | let backoff = Time.Span.create ~ms () in 219 | Clock.after backoff >>> (fun () -> 220 | make_client 221 | ~initialized 222 | ~extra_headers 223 | ~app_to_ws 224 | ~ws_to_app 225 | ~net_to_ws 226 | ~ws_to_net 227 | ~ms:(min 60_000 (ms * 2)) 228 | uri) 229 | 230 | 231 | let create ~url ~shards ?(compress=true) ?(large_threshold=100) () = 232 | let open Core in 233 | let uri = (url ^ "?v=6&encoding=json") |> Uri.of_string in 234 | let extra_headers = Http.Base.process_request_headers () in 235 | let host = Option.value_exn ~message:"no host in uri" Uri.(host uri) in 236 | let port = 237 | match Uri.port uri, Uri_services.tcp_port_of_uri uri with 238 | | Some p, _ -> p 239 | | None, Some p -> p 240 | | _ -> 443 in 241 | let scheme = Option.value_exn ~message:"no scheme in uri" Uri.(scheme uri) in 242 | let tcp_fun (net_to_ws, ws_to_net) = 243 | let (app_to_ws, write) = Pipe.create () in 244 | let (read, ws_to_app) = Pipe.create () in 245 | let initialized = Ivar.create () in 246 | make_client 247 | ~initialized 248 | ~extra_headers 249 | ~app_to_ws 250 | ~ws_to_app 251 | ~net_to_ws 252 | ~ws_to_net 253 | uri; 254 | Ivar.read initialized >>| fun () -> 255 | { pipe = (read, write) 256 | ; ready = Ivar.create () 257 | ; hb_interval = Ivar.create () 258 | ; hb_stopper = Ivar.create () 259 | ; seq = 0 260 | ; id = shards 261 | ; session = None 262 | ; url 263 | ; large_threshold 264 | ; compress 265 | ; _internal = (net_to_ws, ws_to_net) 266 | } 267 | in 268 | match Unix.getaddrinfo host (string_of_int port) [] with 269 | | [] -> failwithf "DNS resolution failed for %s" host () 270 | | { ai_addr; _ } :: _ -> 271 | let addr = 272 | match scheme, ai_addr with 273 | | _, ADDR_UNIX path -> `Unix_domain_socket path 274 | | "https", ADDR_INET (h, p) 275 | | "wss", ADDR_INET (h, p) -> 276 | let h = Ipaddr_unix.of_inet_addr h in 277 | `OpenSSL (h, p, Conduit_async.V2.Ssl.Config.create ()) 278 | | _, ADDR_INET (h, p) -> 279 | let h = Ipaddr_unix.of_inet_addr h in 280 | `TCP (h, p) 281 | in 282 | Conduit_async.V2.connect addr >>= tcp_fun 283 | 284 | let shutdown ?(clean=false) ?(restart=true) t = 285 | let _ = clean in 286 | t.can_resume <- restart; 287 | t.stopped <- true; 288 | Logs.debug (fun m -> m "Performing shutdown. Shard [%d, %d]" (fst t.state.id) (snd t.state.id)); 289 | Pipe.write_if_open (snd t.state.pipe) (Frame.close 1001) 290 | >>= fun () -> 291 | Ivar.fill_if_empty t.state.hb_stopper (); 292 | Pipe.close_read (fst t.state.pipe); 293 | Writer.close (snd t.state._internal) 294 | end 295 | 296 | type t = { shards: (Shard.shard Shard.t) list } 297 | 298 | let start ?count ?compress ?large_threshold () = 299 | let module J = Yojson.Safe.Util in 300 | Http.get_gateway_bot () >>= fun data -> 301 | let data = match data with 302 | | Ok d -> d 303 | | Error e -> Error.raise e 304 | in 305 | let url = J.(member "url" data |> to_string) in 306 | let count = match count with 307 | | Some c -> c 308 | | None -> J.(member "shards" data |> to_int) 309 | in 310 | let shard_list = (0, count) in 311 | Logs.info (fun m -> m "Connecting to %s" url); 312 | let rec ev_loop (t:Shard.shard Shard.t) = 313 | let step (t:Shard.shard Shard.t) = 314 | Pipe.read (fst t.state.pipe) >>= fun frame -> 315 | begin match Shard.parse ~compress:t.state.compress frame with 316 | | `Ok f -> 317 | Shard.handle_frame ~f t.state >>| fun s -> 318 | t.state <- s 319 | | `Close c -> 320 | Logs.warn (fun m -> m "Close frame received. %s" (Frame.show c)); 321 | Shard.shutdown t 322 | | `Error e -> 323 | Logs.warn (fun m -> m "Websocket soft error: %s" e); 324 | return () 325 | | `Eof -> 326 | Logs.warn (fun m -> m "Websocket closed unexpectedly"); 327 | Shard.shutdown t 328 | end >>| fun () -> t 329 | in 330 | if t.stopped then return () 331 | else step t >>= ev_loop 332 | in 333 | let rec gen_shards l a = 334 | match l with 335 | | (id, total) when id >= total -> return a 336 | | (id, total) -> 337 | let wrap ?(reuse:Shard.shard Shard.t option) state = match reuse with 338 | | Some t -> 339 | t.state <- state; 340 | t.stopped <- false; 341 | return t 342 | | None -> 343 | return Shard.{ state 344 | ; stopped = false 345 | ; can_resume = true 346 | } 347 | in 348 | let create () = 349 | Shard.create ~url ~shards:(id, total) ?compress ?large_threshold () 350 | in 351 | let rec bind (t:Shard.shard Shard.t) = 352 | let _ = Ivar.read t.state.hb_interval >>> fun hb -> 353 | Clock.every' 354 | ~stop:(Ivar.read t.state.hb_stopper) 355 | ~continue_on_error:true 356 | hb (fun () -> Shard.heartbeat t.state >>| ignore) in 357 | ev_loop t >>> (fun () -> Logs.debug (fun m -> m "Event loop stopped.")); 358 | Pipe.closed (fst t.state.pipe) >>> (fun () -> if t.can_resume then 359 | create () >>= wrap ~reuse:t >>= bind >>> ignore); 360 | return t 361 | in 362 | create () >>= wrap >>= bind >>= fun t -> 363 | gen_shards (id+1, total) (t :: a) 364 | in 365 | gen_shards shard_list [] 366 | >>| fun shards -> 367 | { shards } 368 | 369 | let set_status ?status ?kind ?name ?since ?url sharder = 370 | Deferred.all @@ List.map ~f:(fun t -> 371 | Shard.set_status ?status ?kind ?name ?since ?url t.state 372 | ) sharder.shards 373 | 374 | let request_guild_members ?query ?limit ~guild sharder = 375 | Deferred.all @@ List.map ~f:(fun t -> 376 | Shard.request_guild_members ~guild ?query ?limit t.state 377 | ) sharder.shards 378 | 379 | let shutdown_all ?restart sharder = 380 | Deferred.all @@ List.map ~f:(fun t -> 381 | Shard.shutdown ~clean:true ?restart t 382 | ) sharder.shards 383 | -------------------------------------------------------------------------------- /lib/http/http.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | open Cohttp 4 | 5 | module Base = struct 6 | exception Invalid_Method 7 | 8 | let rl = ref Rl.empty 9 | 10 | let base_url = "https://discordapp.com/api/v7" 11 | 12 | let process_url path = 13 | Uri.of_string (base_url ^ path) 14 | 15 | let process_request_body body = 16 | body 17 | |> Yojson.Safe.to_string 18 | |> Cohttp_async.Body.of_string 19 | 20 | let process_request_headers () = 21 | let h = Header.init () in 22 | Header.add_list h 23 | [ "User-Agent", "DiscordBot (https://gitlab.com/Mishio595/disml, v0.2.3)" 24 | ; "Authorization", ("Bot " ^ !Client_options.token) 25 | ; "Content-Type", "application/json" 26 | ; "Connection", "keep-alive" 27 | ] 28 | 29 | let process_response path ((resp:Response.t), body) = 30 | let limit = match Response.headers resp |> Rl.rl_of_header with 31 | | Some r -> r 32 | | None -> Rl.default 33 | in Mvar.put (Rl.find_exn !rl path) limit 34 | >>= fun () -> 35 | match resp |> Response.status |> Code.code_of_status with 36 | | 204 -> Deferred.Or_error.return `Null 37 | | code when Code.is_success code -> body |> Cohttp_async.Body.to_string >>| Yojson.Safe.from_string >>= Deferred.Or_error.return 38 | | code -> 39 | body |> Cohttp_async.Body.to_string >>= fun body -> 40 | let headers = Response.sexp_of_t resp |> Sexp.to_string_hum in 41 | Logs.warn (fun m -> m "[Unsuccessful Response] [Code: %d]\n%s\n%s" code body headers); 42 | Deferred.Or_error.errorf "Unsuccessful response received: %d - %s" code body 43 | 44 | let request ?(body=`Null) ?(query=[]) m path = 45 | let limit, rlm = Rl.get_rl m path !rl in 46 | rl := rlm; 47 | Mvar.take limit >>= fun limit -> 48 | let process () = 49 | let uri = Uri.add_query_params' (process_url path) query in 50 | let headers = process_request_headers () in 51 | let body = process_request_body body in 52 | (match m with 53 | | `Delete -> Cohttp_async.Client.delete ~headers ~body uri 54 | | `Get -> Cohttp_async.Client.get ~headers uri 55 | | `Patch -> Cohttp_async.Client.patch ~headers ~body uri 56 | | `Post -> Cohttp_async.Client.post ~headers ~body uri 57 | | `Put -> Cohttp_async.Client.put ~headers ~body uri) 58 | >>= process_response path 59 | in if limit.remaining > 0 then process () 60 | else 61 | let time = Time.(Span.of_int_sec limit.reset |> of_span_since_epoch) in 62 | Logs.debug (fun m -> m "Rate-limiting [Route: %s] [Duration: %d ms]" path Time.(diff time (Time.now ()) |> Span.to_ms |> Float.to_int) ); 63 | Clock.at time >>= process 64 | end 65 | 66 | let get_gateway () = 67 | Base.request `Get Endpoints.gateway 68 | 69 | let get_gateway_bot () = 70 | Base.request `Get Endpoints.gateway_bot 71 | 72 | let get_channel channel_id = 73 | Base.request `Get (Endpoints.channel channel_id) >>| Result.map ~f:(fun c -> Channel_t.(channel_wrapper_of_yojson_exn c |> wrap)) 74 | 75 | let modify_channel channel_id body = 76 | Base.request ~body `Patch (Endpoints.channel channel_id) >>| Result.map ~f:(fun c -> Channel_t.(channel_wrapper_of_yojson_exn c |> wrap)) 77 | 78 | let delete_channel channel_id = 79 | Base.request `Delete (Endpoints.channel channel_id) >>| Result.map ~f:(fun c -> Channel_t.(channel_wrapper_of_yojson_exn c |> wrap)) 80 | 81 | let get_messages channel_id limit (kind, id) = 82 | Base.request ~query:[(kind, string_of_int id); ("limit", string_of_int limit)] `Get (Endpoints.channel_messages channel_id) 83 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:Message_t.of_yojson_exn) 84 | 85 | let get_message channel_id message_id = 86 | Base.request `Get (Endpoints.channel_message channel_id message_id) >>| Result.map ~f:Message_t.of_yojson_exn 87 | 88 | let create_message channel_id body = 89 | Base.request ~body:body `Post (Endpoints.channel_messages channel_id) >>| Result.map ~f:Message_t.of_yojson_exn 90 | 91 | let create_reaction channel_id message_id emoji = 92 | Base.request `Put (Endpoints.channel_reaction_me channel_id message_id emoji) >>| Result.map ~f:ignore 93 | 94 | let delete_own_reaction channel_id message_id emoji = 95 | Base.request `Delete (Endpoints.channel_reaction_me channel_id message_id emoji) >>| Result.map ~f:ignore 96 | 97 | let delete_reaction channel_id message_id emoji user_id = 98 | Base.request `Delete (Endpoints.channel_reaction channel_id message_id emoji user_id) >>| Result.map ~f:ignore 99 | 100 | let get_reactions channel_id message_id emoji = 101 | Base.request `Get (Endpoints.channel_reactions_get channel_id message_id emoji) 102 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:User_t.of_yojson_exn) 103 | 104 | let delete_reactions channel_id message_id = 105 | Base.request `Delete (Endpoints.channel_reactions_delete channel_id message_id) >>| Result.map ~f:ignore 106 | 107 | let edit_message channel_id message_id body = 108 | Base.request ~body `Patch (Endpoints.channel_message channel_id message_id) >>| Result.map ~f:Message_t.of_yojson_exn 109 | 110 | let delete_message channel_id message_id = 111 | Base.request `Delete (Endpoints.channel_message channel_id message_id) >>| Result.map ~f:ignore 112 | 113 | let bulk_delete channel_id body = 114 | Base.request ~body `Post (Endpoints.channel_bulk_delete channel_id) >>| Result.map ~f:ignore 115 | 116 | let edit_channel_permissions channel_id overwrite_id body = 117 | Base.request ~body `Put (Endpoints.channel_permission channel_id overwrite_id) >>| Result.map ~f:ignore 118 | 119 | let get_channel_invites channel_id = 120 | Base.request `Get (Endpoints.channel_invites channel_id) 121 | 122 | let create_channel_invite channel_id body = 123 | Base.request ~body `Post (Endpoints.channel_invites channel_id) 124 | 125 | let delete_channel_permission channel_id overwrite_id = 126 | Base.request `Delete (Endpoints.channel_permission channel_id overwrite_id) >>| Result.map ~f:ignore 127 | 128 | let broadcast_typing channel_id = 129 | Base.request `Post (Endpoints.channel_typing channel_id) >>| Result.map ~f:ignore 130 | 131 | let get_pinned_messages channel_id = 132 | Base.request `Get (Endpoints.channel_pins channel_id) 133 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:Message_t.of_yojson_exn) 134 | 135 | let pin_message channel_id message_id = 136 | Base.request `Put (Endpoints.channel_pin channel_id message_id) >>| Result.map ~f:ignore 137 | 138 | let unpin_message channel_id message_id = 139 | Base.request `Delete (Endpoints.channel_pin channel_id message_id) >>| Result.map ~f:ignore 140 | 141 | let group_recipient_add channel_id user_id = 142 | Base.request `Put (Endpoints.group_recipient channel_id user_id) >>| Result.map ~f:ignore 143 | 144 | let group_recipient_remove channel_id user_id = 145 | Base.request `Delete (Endpoints.group_recipient channel_id user_id) >>| Result.map ~f:ignore 146 | 147 | let get_emojis guild_id = 148 | Base.request `Get (Endpoints.guild_emojis guild_id) 149 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:Emoji.of_yojson_exn) 150 | 151 | let get_emoji guild_id emoji_id = 152 | Base.request `Get (Endpoints.guild_emoji guild_id emoji_id) >>| Result.map ~f:Emoji.of_yojson_exn 153 | 154 | let create_emoji guild_id body = 155 | Base.request ~body `Post (Endpoints.guild_emojis guild_id) >>| Result.map ~f:Emoji.of_yojson_exn 156 | 157 | let edit_emoji guild_id emoji_id body = 158 | Base.request ~body `Patch (Endpoints.guild_emoji guild_id emoji_id) >>| Result.map ~f:Emoji.of_yojson_exn 159 | 160 | let delete_emoji guild_id emoji_id = 161 | Base.request `Delete (Endpoints.guild_emoji guild_id emoji_id) >>| Result.map ~f:ignore 162 | 163 | let create_guild body = 164 | Base.request ~body `Post Endpoints.guilds >>| Result.map ~f:(fun g -> Guild_t.(pre_of_yojson_exn g |> wrap)) 165 | 166 | let get_guild guild_id = 167 | Base.request `Get (Endpoints.guild guild_id) >>| Result.map ~f:(fun g -> Guild_t.(pre_of_yojson_exn g |> wrap)) 168 | 169 | let edit_guild guild_id body = 170 | Base.request ~body `Patch (Endpoints.guild guild_id) >>| Result.map ~f:(fun g -> Guild_t.(pre_of_yojson_exn g |> wrap)) 171 | 172 | let delete_guild guild_id = 173 | Base.request `Delete (Endpoints.guild guild_id) >>| Result.map ~f:ignore 174 | 175 | let get_guild_channels guild_id = 176 | Base.request `Get (Endpoints.guild_channels guild_id) 177 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:(fun g -> Channel_t.(channel_wrapper_of_yojson_exn g |> wrap))) 178 | 179 | let create_guild_channel guild_id body = 180 | Base.request ~body `Post (Endpoints.guild_channels guild_id) >>| Result.map ~f:(fun c -> Channel_t.(channel_wrapper_of_yojson_exn c |> wrap)) 181 | 182 | let modify_guild_channel_positions guild_id body = 183 | Base.request ~body `Patch (Endpoints.guild_channels guild_id) >>| Result.map ~f:ignore 184 | 185 | let get_member guild_id user_id = 186 | Base.request `Get (Endpoints.guild_member guild_id user_id) >>| Result.map ~f:(fun m -> Member_t.(member_of_yojson_exn m |> wrap ~guild_id)) 187 | 188 | let get_members guild_id = 189 | Base.request `Get (Endpoints.guild_members guild_id) 190 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:(fun m -> Member_t.(member_of_yojson_exn m |> wrap ~guild_id))) 191 | 192 | let add_member guild_id user_id body = 193 | Base.request ~body `Put (Endpoints.guild_member guild_id user_id) 194 | >>| Result.map ~f:(fun m -> Member_t.(member_of_yojson_exn m |> wrap ~guild_id)) 195 | 196 | let edit_member guild_id user_id body = 197 | Base.request ~body `Patch (Endpoints.guild_member guild_id user_id) >>| Result.map ~f:ignore 198 | 199 | let remove_member guild_id user_id body = 200 | Base.request ~body `Delete (Endpoints.guild_member guild_id user_id) >>| Result.map ~f:ignore 201 | 202 | let change_nickname guild_id body = 203 | Base.request ~body `Patch (Endpoints.guild_me_nick guild_id) 204 | 205 | let add_member_role guild_id user_id role_id = 206 | Base.request `Put (Endpoints.guild_member_role guild_id user_id role_id) >>| Result.map ~f:ignore 207 | 208 | let remove_member_role guild_id user_id role_id = 209 | Base.request `Delete (Endpoints.guild_member_role guild_id user_id role_id) >>| Result.map ~f:ignore 210 | 211 | let get_bans guild_id = 212 | Base.request `Get (Endpoints.guild_bans guild_id) 213 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:Ban_t.of_yojson_exn) 214 | 215 | let get_ban guild_id user_id = 216 | Base.request `Get (Endpoints.guild_ban guild_id user_id) >>| Result.map ~f:Ban_t.of_yojson_exn 217 | 218 | let guild_ban_add guild_id user_id body = 219 | Base.request ~body `Put (Endpoints.guild_ban guild_id user_id) >>| Result.map ~f:ignore 220 | 221 | let guild_ban_remove guild_id user_id body = 222 | Base.request ~body `Delete (Endpoints.guild_ban guild_id user_id) >>| Result.map ~f:ignore 223 | 224 | let get_roles guild_id = 225 | Base.request `Get (Endpoints.guild_roles guild_id) 226 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:(fun r -> Role_t.(role_of_yojson_exn r |> wrap ~guild_id))) 227 | 228 | let guild_role_add guild_id body = 229 | Base.request ~body `Post (Endpoints.guild_roles guild_id) >>| Result.map ~f:(fun r -> Role_t.(role_of_yojson_exn r |> wrap ~guild_id)) 230 | 231 | let guild_roles_edit guild_id body = 232 | Base.request ~body `Patch (Endpoints.guild_roles guild_id) 233 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:(fun r -> Role_t.(role_of_yojson_exn r |> wrap ~guild_id))) 234 | 235 | let guild_role_edit guild_id role_id body = 236 | Base.request ~body `Patch (Endpoints.guild_role guild_id role_id) >>| Result.map ~f:(fun r -> Role_t.(role_of_yojson_exn r |> wrap ~guild_id)) 237 | 238 | let guild_role_remove guild_id role_id = 239 | Base.request `Delete (Endpoints.guild_role guild_id role_id) >>| Result.map ~f:ignore 240 | 241 | let guild_prune_count guild_id days = 242 | Base.request ~query:[("days", Int.to_string days)] `Get (Endpoints.guild_prune guild_id) 243 | >>| Result.map ~f:(fun c -> Yojson.Safe.Util.(member "pruned" c |> to_int)) 244 | 245 | let guild_prune_start guild_id days = 246 | Base.request ~query:[("days", Int.to_string days)] `Post (Endpoints.guild_prune guild_id) 247 | >>| Result.map ~f:(fun c -> Yojson.Safe.Util.(member "pruned" c |> to_int)) 248 | 249 | let get_guild_voice_regions guild_id = 250 | Base.request `Get (Endpoints.guild_voice_regions guild_id) 251 | 252 | let get_guild_invites guild_id = 253 | Base.request `Get (Endpoints.guild_invites guild_id) 254 | 255 | let get_integrations guild_id = 256 | Base.request `Get (Endpoints.guild_integrations guild_id) 257 | 258 | let add_integration guild_id body = 259 | Base.request ~body `Post (Endpoints.guild_integrations guild_id) >>| Result.map ~f:ignore 260 | 261 | let edit_integration guild_id integration_id body = 262 | Base.request ~body `Post (Endpoints.guild_integration guild_id integration_id) >>| Result.map ~f:ignore 263 | 264 | let delete_integration guild_id integration_id = 265 | Base.request `Delete (Endpoints.guild_integration guild_id integration_id) >>| Result.map ~f:ignore 266 | 267 | let sync_integration guild_id integration_id = 268 | Base.request `Post (Endpoints.guild_integration_sync guild_id integration_id) >>| Result.map ~f:ignore 269 | 270 | let get_guild_embed guild_id = 271 | Base.request `Get (Endpoints.guild_embed guild_id) 272 | 273 | let edit_guild_embed guild_id body = 274 | Base.request ~body `Patch (Endpoints.guild_embed guild_id) 275 | 276 | let get_vanity_url guild_id = 277 | Base.request `Get (Endpoints.guild_vanity_url guild_id) 278 | 279 | let get_invite invite_code = 280 | Base.request `Get (Endpoints.invite invite_code) 281 | 282 | let delete_invite invite_code = 283 | Base.request `Delete (Endpoints.invite invite_code) 284 | 285 | let get_current_user () = 286 | Base.request `Get Endpoints.me >>| Result.map ~f:User_t.of_yojson_exn 287 | 288 | let edit_current_user body = 289 | Base.request ~body `Patch Endpoints.me >>| Result.map ~f:User_t.of_yojson_exn 290 | 291 | let get_guilds () = 292 | Base.request `Get Endpoints.me_guilds 293 | >>| Result.map ~f:(fun l -> Yojson.Safe.Util.to_list l |> List.map ~f:(fun g -> Guild_t.(pre_of_yojson_exn g |> wrap))) 294 | 295 | let leave_guild guild_id = 296 | Base.request `Delete (Endpoints.me_guild guild_id) >>| Result.map ~f:ignore 297 | 298 | let get_private_channels () = 299 | Base.request `Get Endpoints.me_channels 300 | 301 | let create_dm body = 302 | Base.request ~body `Post Endpoints.me_channels 303 | 304 | let create_group_dm body = 305 | Base.request ~body `Post Endpoints.me_channels 306 | 307 | let get_connections () = 308 | Base.request `Get Endpoints.me_connections 309 | 310 | let get_user user_id = 311 | Base.request `Get (Endpoints.user user_id) >>| Result.map ~f:User_t.of_yojson_exn 312 | 313 | let get_voice_regions () = 314 | Base.request `Get Endpoints.regions 315 | 316 | let create_webhook channel_id body = 317 | Base.request ~body `Post (Endpoints.webhooks_channel channel_id) 318 | 319 | let get_channel_webhooks channel_id = 320 | Base.request `Get (Endpoints.webhooks_channel channel_id) 321 | 322 | let get_guild_webhooks guild_id = 323 | Base.request `Get (Endpoints.webhooks_guild guild_id) 324 | 325 | let get_webhook webhook_id = 326 | Base.request `Get (Endpoints.webhook webhook_id) 327 | 328 | let get_webhook_with_token webhook_id token = 329 | Base.request `Get (Endpoints.webhook_token webhook_id token) 330 | 331 | let edit_webhook webhook_id body = 332 | Base.request ~body `Patch (Endpoints.webhook webhook_id) 333 | 334 | let edit_webhook_with_token webhook_id token body = 335 | Base.request ~body `Patch (Endpoints.webhook_token webhook_id token) 336 | 337 | let delete_webhook webhook_id = 338 | Base.request `Delete (Endpoints.webhook webhook_id) >>| Result.map ~f:ignore 339 | 340 | let delete_webhook_with_token webhook_id token = 341 | Base.request `Delete (Endpoints.webhook_token webhook_id token) >>| Result.map ~f:ignore 342 | 343 | let execute_webhook webhook_id token body = 344 | Base.request ~body `Post (Endpoints.webhook_token webhook_id token) 345 | 346 | let execute_slack_webhook webhook_id token body = 347 | Base.request ~body `Post (Endpoints.webhook_slack webhook_id token) 348 | 349 | let execute_git_webhook webhook_id token body = 350 | Base.request ~body `Post (Endpoints.webhook_git webhook_id token) 351 | 352 | let get_audit_logs guild_id body = 353 | Base.request ~body `Get (Endpoints.guild_audit_logs guild_id) 354 | 355 | let get_application_info () = 356 | Base.request `Get (Endpoints.application_information) -------------------------------------------------------------------------------- /disml.install: -------------------------------------------------------------------------------- 1 | lib: [ 2 | "_build/install/default/lib/disml/META" {"META"} 3 | "_build/install/default/lib/disml/activity.ml" {"activity.ml"} 4 | "_build/install/default/lib/disml/activity.mli" {"activity.mli"} 5 | "_build/install/default/lib/disml/attachment.ml" {"attachment.ml"} 6 | "_build/install/default/lib/disml/attachment.mli" {"attachment.mli"} 7 | "_build/install/default/lib/disml/ban.ml" {"ban.ml"} 8 | "_build/install/default/lib/disml/ban.mli" {"ban.mli"} 9 | "_build/install/default/lib/disml/ban_t.ml" {"ban_t.ml"} 10 | "_build/install/default/lib/disml/ban_t.mli" {"ban_t.mli"} 11 | "_build/install/default/lib/disml/channel.ml" {"channel.ml"} 12 | "_build/install/default/lib/disml/channel.mli" {"channel.mli"} 13 | "_build/install/default/lib/disml/channel_id.ml" {"channel_id.ml"} 14 | "_build/install/default/lib/disml/channel_id.mli" {"channel_id.mli"} 15 | "_build/install/default/lib/disml/channel_id_t.ml" {"channel_id_t.ml"} 16 | "_build/install/default/lib/disml/channel_id_t.mli" {"channel_id_t.mli"} 17 | "_build/install/default/lib/disml/channel_t.ml" {"channel_t.ml"} 18 | "_build/install/default/lib/disml/channel_t.mli" {"channel_t.mli"} 19 | "_build/install/default/lib/disml/client.ml" {"client.ml"} 20 | "_build/install/default/lib/disml/client.mli" {"client.mli"} 21 | "_build/install/default/lib/disml/client_options.ml" {"client_options.ml"} 22 | "_build/install/default/lib/disml/client_options.mli" {"client_options.mli"} 23 | "_build/install/default/lib/disml/disml.a" {"disml.a"} 24 | "_build/install/default/lib/disml/disml.cma" {"disml.cma"} 25 | "_build/install/default/lib/disml/disml.cmi" {"disml.cmi"} 26 | "_build/install/default/lib/disml/disml.cmt" {"disml.cmt"} 27 | "_build/install/default/lib/disml/disml.cmx" {"disml.cmx"} 28 | "_build/install/default/lib/disml/disml.cmxa" {"disml.cmxa"} 29 | "_build/install/default/lib/disml/disml.cmxs" {"disml.cmxs"} 30 | "_build/install/default/lib/disml/disml.dune" {"disml.dune"} 31 | "_build/install/default/lib/disml/disml.ml" {"disml.ml"} 32 | "_build/install/default/lib/disml/disml__.cmi" {"disml__.cmi"} 33 | "_build/install/default/lib/disml/disml__.cmt" {"disml__.cmt"} 34 | "_build/install/default/lib/disml/disml__.cmx" {"disml__.cmx"} 35 | "_build/install/default/lib/disml/disml__.ml" {"disml__.ml"} 36 | "_build/install/default/lib/disml/disml__Activity.cmi" {"disml__Activity.cmi"} 37 | "_build/install/default/lib/disml/disml__Activity.cmt" {"disml__Activity.cmt"} 38 | "_build/install/default/lib/disml/disml__Activity.cmti" {"disml__Activity.cmti"} 39 | "_build/install/default/lib/disml/disml__Activity.cmx" {"disml__Activity.cmx"} 40 | "_build/install/default/lib/disml/disml__Attachment.cmi" {"disml__Attachment.cmi"} 41 | "_build/install/default/lib/disml/disml__Attachment.cmt" {"disml__Attachment.cmt"} 42 | "_build/install/default/lib/disml/disml__Attachment.cmti" {"disml__Attachment.cmti"} 43 | "_build/install/default/lib/disml/disml__Attachment.cmx" {"disml__Attachment.cmx"} 44 | "_build/install/default/lib/disml/disml__Ban.cmi" {"disml__Ban.cmi"} 45 | "_build/install/default/lib/disml/disml__Ban.cmt" {"disml__Ban.cmt"} 46 | "_build/install/default/lib/disml/disml__Ban.cmti" {"disml__Ban.cmti"} 47 | "_build/install/default/lib/disml/disml__Ban.cmx" {"disml__Ban.cmx"} 48 | "_build/install/default/lib/disml/disml__Ban_t.cmi" {"disml__Ban_t.cmi"} 49 | "_build/install/default/lib/disml/disml__Ban_t.cmt" {"disml__Ban_t.cmt"} 50 | "_build/install/default/lib/disml/disml__Ban_t.cmti" {"disml__Ban_t.cmti"} 51 | "_build/install/default/lib/disml/disml__Ban_t.cmx" {"disml__Ban_t.cmx"} 52 | "_build/install/default/lib/disml/disml__Channel.cmi" {"disml__Channel.cmi"} 53 | "_build/install/default/lib/disml/disml__Channel.cmt" {"disml__Channel.cmt"} 54 | "_build/install/default/lib/disml/disml__Channel.cmti" {"disml__Channel.cmti"} 55 | "_build/install/default/lib/disml/disml__Channel.cmx" {"disml__Channel.cmx"} 56 | "_build/install/default/lib/disml/disml__Channel_id.cmi" {"disml__Channel_id.cmi"} 57 | "_build/install/default/lib/disml/disml__Channel_id.cmt" {"disml__Channel_id.cmt"} 58 | "_build/install/default/lib/disml/disml__Channel_id.cmti" {"disml__Channel_id.cmti"} 59 | "_build/install/default/lib/disml/disml__Channel_id.cmx" {"disml__Channel_id.cmx"} 60 | "_build/install/default/lib/disml/disml__Channel_id_t.cmi" {"disml__Channel_id_t.cmi"} 61 | "_build/install/default/lib/disml/disml__Channel_id_t.cmt" {"disml__Channel_id_t.cmt"} 62 | "_build/install/default/lib/disml/disml__Channel_id_t.cmti" {"disml__Channel_id_t.cmti"} 63 | "_build/install/default/lib/disml/disml__Channel_id_t.cmx" {"disml__Channel_id_t.cmx"} 64 | "_build/install/default/lib/disml/disml__Channel_t.cmi" {"disml__Channel_t.cmi"} 65 | "_build/install/default/lib/disml/disml__Channel_t.cmt" {"disml__Channel_t.cmt"} 66 | "_build/install/default/lib/disml/disml__Channel_t.cmti" {"disml__Channel_t.cmti"} 67 | "_build/install/default/lib/disml/disml__Channel_t.cmx" {"disml__Channel_t.cmx"} 68 | "_build/install/default/lib/disml/disml__Client.cmi" {"disml__Client.cmi"} 69 | "_build/install/default/lib/disml/disml__Client.cmt" {"disml__Client.cmt"} 70 | "_build/install/default/lib/disml/disml__Client.cmti" {"disml__Client.cmti"} 71 | "_build/install/default/lib/disml/disml__Client.cmx" {"disml__Client.cmx"} 72 | "_build/install/default/lib/disml/disml__Client_options.cmi" {"disml__Client_options.cmi"} 73 | "_build/install/default/lib/disml/disml__Client_options.cmt" {"disml__Client_options.cmt"} 74 | "_build/install/default/lib/disml/disml__Client_options.cmti" {"disml__Client_options.cmti"} 75 | "_build/install/default/lib/disml/disml__Client_options.cmx" {"disml__Client_options.cmx"} 76 | "_build/install/default/lib/disml/disml__Dispatch.cmi" {"disml__Dispatch.cmi"} 77 | "_build/install/default/lib/disml/disml__Dispatch.cmt" {"disml__Dispatch.cmt"} 78 | "_build/install/default/lib/disml/disml__Dispatch.cmti" {"disml__Dispatch.cmti"} 79 | "_build/install/default/lib/disml/disml__Dispatch.cmx" {"disml__Dispatch.cmx"} 80 | "_build/install/default/lib/disml/disml__Embed.cmi" {"disml__Embed.cmi"} 81 | "_build/install/default/lib/disml/disml__Embed.cmt" {"disml__Embed.cmt"} 82 | "_build/install/default/lib/disml/disml__Embed.cmti" {"disml__Embed.cmti"} 83 | "_build/install/default/lib/disml/disml__Embed.cmx" {"disml__Embed.cmx"} 84 | "_build/install/default/lib/disml/disml__Emoji.cmi" {"disml__Emoji.cmi"} 85 | "_build/install/default/lib/disml/disml__Emoji.cmt" {"disml__Emoji.cmt"} 86 | "_build/install/default/lib/disml/disml__Emoji.cmti" {"disml__Emoji.cmti"} 87 | "_build/install/default/lib/disml/disml__Emoji.cmx" {"disml__Emoji.cmx"} 88 | "_build/install/default/lib/disml/disml__Endpoints.cmi" {"disml__Endpoints.cmi"} 89 | "_build/install/default/lib/disml/disml__Endpoints.cmt" {"disml__Endpoints.cmt"} 90 | "_build/install/default/lib/disml/disml__Endpoints.cmti" {"disml__Endpoints.cmti"} 91 | "_build/install/default/lib/disml/disml__Endpoints.cmx" {"disml__Endpoints.cmx"} 92 | "_build/install/default/lib/disml/disml__Event.cmi" {"disml__Event.cmi"} 93 | "_build/install/default/lib/disml/disml__Event.cmt" {"disml__Event.cmt"} 94 | "_build/install/default/lib/disml/disml__Event.cmti" {"disml__Event.cmti"} 95 | "_build/install/default/lib/disml/disml__Event.cmx" {"disml__Event.cmx"} 96 | "_build/install/default/lib/disml/disml__Event_models.cmi" {"disml__Event_models.cmi"} 97 | "_build/install/default/lib/disml/disml__Event_models.cmt" {"disml__Event_models.cmt"} 98 | "_build/install/default/lib/disml/disml__Event_models.cmx" {"disml__Event_models.cmx"} 99 | "_build/install/default/lib/disml/disml__Guild.cmi" {"disml__Guild.cmi"} 100 | "_build/install/default/lib/disml/disml__Guild.cmt" {"disml__Guild.cmt"} 101 | "_build/install/default/lib/disml/disml__Guild.cmti" {"disml__Guild.cmti"} 102 | "_build/install/default/lib/disml/disml__Guild.cmx" {"disml__Guild.cmx"} 103 | "_build/install/default/lib/disml/disml__Guild_id.cmi" {"disml__Guild_id.cmi"} 104 | "_build/install/default/lib/disml/disml__Guild_id.cmt" {"disml__Guild_id.cmt"} 105 | "_build/install/default/lib/disml/disml__Guild_id.cmti" {"disml__Guild_id.cmti"} 106 | "_build/install/default/lib/disml/disml__Guild_id.cmx" {"disml__Guild_id.cmx"} 107 | "_build/install/default/lib/disml/disml__Guild_id_t.cmi" {"disml__Guild_id_t.cmi"} 108 | "_build/install/default/lib/disml/disml__Guild_id_t.cmt" {"disml__Guild_id_t.cmt"} 109 | "_build/install/default/lib/disml/disml__Guild_id_t.cmti" {"disml__Guild_id_t.cmti"} 110 | "_build/install/default/lib/disml/disml__Guild_id_t.cmx" {"disml__Guild_id_t.cmx"} 111 | "_build/install/default/lib/disml/disml__Guild_t.cmi" {"disml__Guild_t.cmi"} 112 | "_build/install/default/lib/disml/disml__Guild_t.cmt" {"disml__Guild_t.cmt"} 113 | "_build/install/default/lib/disml/disml__Guild_t.cmti" {"disml__Guild_t.cmti"} 114 | "_build/install/default/lib/disml/disml__Guild_t.cmx" {"disml__Guild_t.cmx"} 115 | "_build/install/default/lib/disml/disml__Http.cmi" {"disml__Http.cmi"} 116 | "_build/install/default/lib/disml/disml__Http.cmt" {"disml__Http.cmt"} 117 | "_build/install/default/lib/disml/disml__Http.cmti" {"disml__Http.cmti"} 118 | "_build/install/default/lib/disml/disml__Http.cmx" {"disml__Http.cmx"} 119 | "_build/install/default/lib/disml/disml__Impl.cmi" {"disml__Impl.cmi"} 120 | "_build/install/default/lib/disml/disml__Impl.cmt" {"disml__Impl.cmt"} 121 | "_build/install/default/lib/disml/disml__Impl.cmx" {"disml__Impl.cmx"} 122 | "_build/install/default/lib/disml/disml__Member.cmi" {"disml__Member.cmi"} 123 | "_build/install/default/lib/disml/disml__Member.cmt" {"disml__Member.cmt"} 124 | "_build/install/default/lib/disml/disml__Member.cmti" {"disml__Member.cmti"} 125 | "_build/install/default/lib/disml/disml__Member.cmx" {"disml__Member.cmx"} 126 | "_build/install/default/lib/disml/disml__Member_t.cmi" {"disml__Member_t.cmi"} 127 | "_build/install/default/lib/disml/disml__Member_t.cmt" {"disml__Member_t.cmt"} 128 | "_build/install/default/lib/disml/disml__Member_t.cmti" {"disml__Member_t.cmti"} 129 | "_build/install/default/lib/disml/disml__Member_t.cmx" {"disml__Member_t.cmx"} 130 | "_build/install/default/lib/disml/disml__Message.cmi" {"disml__Message.cmi"} 131 | "_build/install/default/lib/disml/disml__Message.cmt" {"disml__Message.cmt"} 132 | "_build/install/default/lib/disml/disml__Message.cmti" {"disml__Message.cmti"} 133 | "_build/install/default/lib/disml/disml__Message.cmx" {"disml__Message.cmx"} 134 | "_build/install/default/lib/disml/disml__Message_id.cmi" {"disml__Message_id.cmi"} 135 | "_build/install/default/lib/disml/disml__Message_id.cmt" {"disml__Message_id.cmt"} 136 | "_build/install/default/lib/disml/disml__Message_id.cmti" {"disml__Message_id.cmti"} 137 | "_build/install/default/lib/disml/disml__Message_id.cmx" {"disml__Message_id.cmx"} 138 | "_build/install/default/lib/disml/disml__Message_t.cmi" {"disml__Message_t.cmi"} 139 | "_build/install/default/lib/disml/disml__Message_t.cmt" {"disml__Message_t.cmt"} 140 | "_build/install/default/lib/disml/disml__Message_t.cmti" {"disml__Message_t.cmti"} 141 | "_build/install/default/lib/disml/disml__Message_t.cmx" {"disml__Message_t.cmx"} 142 | "_build/install/default/lib/disml/disml__Opcode.cmi" {"disml__Opcode.cmi"} 143 | "_build/install/default/lib/disml/disml__Opcode.cmt" {"disml__Opcode.cmt"} 144 | "_build/install/default/lib/disml/disml__Opcode.cmti" {"disml__Opcode.cmti"} 145 | "_build/install/default/lib/disml/disml__Opcode.cmx" {"disml__Opcode.cmx"} 146 | "_build/install/default/lib/disml/disml__Presence.cmi" {"disml__Presence.cmi"} 147 | "_build/install/default/lib/disml/disml__Presence.cmt" {"disml__Presence.cmt"} 148 | "_build/install/default/lib/disml/disml__Presence.cmti" {"disml__Presence.cmti"} 149 | "_build/install/default/lib/disml/disml__Presence.cmx" {"disml__Presence.cmx"} 150 | "_build/install/default/lib/disml/disml__Reaction.cmi" {"disml__Reaction.cmi"} 151 | "_build/install/default/lib/disml/disml__Reaction.cmt" {"disml__Reaction.cmt"} 152 | "_build/install/default/lib/disml/disml__Reaction.cmti" {"disml__Reaction.cmti"} 153 | "_build/install/default/lib/disml/disml__Reaction.cmx" {"disml__Reaction.cmx"} 154 | "_build/install/default/lib/disml/disml__Reaction_t.cmi" {"disml__Reaction_t.cmi"} 155 | "_build/install/default/lib/disml/disml__Reaction_t.cmt" {"disml__Reaction_t.cmt"} 156 | "_build/install/default/lib/disml/disml__Reaction_t.cmti" {"disml__Reaction_t.cmti"} 157 | "_build/install/default/lib/disml/disml__Reaction_t.cmx" {"disml__Reaction_t.cmx"} 158 | "_build/install/default/lib/disml/disml__Rl.cmi" {"disml__Rl.cmi"} 159 | "_build/install/default/lib/disml/disml__Rl.cmt" {"disml__Rl.cmt"} 160 | "_build/install/default/lib/disml/disml__Rl.cmti" {"disml__Rl.cmti"} 161 | "_build/install/default/lib/disml/disml__Rl.cmx" {"disml__Rl.cmx"} 162 | "_build/install/default/lib/disml/disml__Role.cmi" {"disml__Role.cmi"} 163 | "_build/install/default/lib/disml/disml__Role.cmt" {"disml__Role.cmt"} 164 | "_build/install/default/lib/disml/disml__Role.cmti" {"disml__Role.cmti"} 165 | "_build/install/default/lib/disml/disml__Role.cmx" {"disml__Role.cmx"} 166 | "_build/install/default/lib/disml/disml__Role_id.cmi" {"disml__Role_id.cmi"} 167 | "_build/install/default/lib/disml/disml__Role_id.cmt" {"disml__Role_id.cmt"} 168 | "_build/install/default/lib/disml/disml__Role_id.cmti" {"disml__Role_id.cmti"} 169 | "_build/install/default/lib/disml/disml__Role_id.cmx" {"disml__Role_id.cmx"} 170 | "_build/install/default/lib/disml/disml__Role_t.cmi" {"disml__Role_t.cmi"} 171 | "_build/install/default/lib/disml/disml__Role_t.cmt" {"disml__Role_t.cmt"} 172 | "_build/install/default/lib/disml/disml__Role_t.cmti" {"disml__Role_t.cmti"} 173 | "_build/install/default/lib/disml/disml__Role_t.cmx" {"disml__Role_t.cmx"} 174 | "_build/install/default/lib/disml/disml__S.cmi" {"disml__S.cmi"} 175 | "_build/install/default/lib/disml/disml__S.cmt" {"disml__S.cmt"} 176 | "_build/install/default/lib/disml/disml__S.cmx" {"disml__S.cmx"} 177 | "_build/install/default/lib/disml/disml__Sharder.cmi" {"disml__Sharder.cmi"} 178 | "_build/install/default/lib/disml/disml__Sharder.cmt" {"disml__Sharder.cmt"} 179 | "_build/install/default/lib/disml/disml__Sharder.cmti" {"disml__Sharder.cmti"} 180 | "_build/install/default/lib/disml/disml__Sharder.cmx" {"disml__Sharder.cmx"} 181 | "_build/install/default/lib/disml/disml__Snowflake.cmi" {"disml__Snowflake.cmi"} 182 | "_build/install/default/lib/disml/disml__Snowflake.cmt" {"disml__Snowflake.cmt"} 183 | "_build/install/default/lib/disml/disml__Snowflake.cmti" {"disml__Snowflake.cmti"} 184 | "_build/install/default/lib/disml/disml__Snowflake.cmx" {"disml__Snowflake.cmx"} 185 | "_build/install/default/lib/disml/disml__User.cmi" {"disml__User.cmi"} 186 | "_build/install/default/lib/disml/disml__User.cmt" {"disml__User.cmt"} 187 | "_build/install/default/lib/disml/disml__User.cmti" {"disml__User.cmti"} 188 | "_build/install/default/lib/disml/disml__User.cmx" {"disml__User.cmx"} 189 | "_build/install/default/lib/disml/disml__User_id.cmi" {"disml__User_id.cmi"} 190 | "_build/install/default/lib/disml/disml__User_id.cmt" {"disml__User_id.cmt"} 191 | "_build/install/default/lib/disml/disml__User_id.cmti" {"disml__User_id.cmti"} 192 | "_build/install/default/lib/disml/disml__User_id.cmx" {"disml__User_id.cmx"} 193 | "_build/install/default/lib/disml/disml__User_id_t.cmi" {"disml__User_id_t.cmi"} 194 | "_build/install/default/lib/disml/disml__User_id_t.cmt" {"disml__User_id_t.cmt"} 195 | "_build/install/default/lib/disml/disml__User_id_t.cmti" {"disml__User_id_t.cmti"} 196 | "_build/install/default/lib/disml/disml__User_id_t.cmx" {"disml__User_id_t.cmx"} 197 | "_build/install/default/lib/disml/disml__User_t.cmi" {"disml__User_t.cmi"} 198 | "_build/install/default/lib/disml/disml__User_t.cmt" {"disml__User_t.cmt"} 199 | "_build/install/default/lib/disml/disml__User_t.cmti" {"disml__User_t.cmti"} 200 | "_build/install/default/lib/disml/disml__User_t.cmx" {"disml__User_t.cmx"} 201 | "_build/install/default/lib/disml/dispatch.ml" {"dispatch.ml"} 202 | "_build/install/default/lib/disml/dispatch.mli" {"dispatch.mli"} 203 | "_build/install/default/lib/disml/embed.ml" {"embed.ml"} 204 | "_build/install/default/lib/disml/embed.mli" {"embed.mli"} 205 | "_build/install/default/lib/disml/emoji.ml" {"emoji.ml"} 206 | "_build/install/default/lib/disml/emoji.mli" {"emoji.mli"} 207 | "_build/install/default/lib/disml/endpoints.ml" {"endpoints.ml"} 208 | "_build/install/default/lib/disml/endpoints.mli" {"endpoints.mli"} 209 | "_build/install/default/lib/disml/event.ml" {"event.ml"} 210 | "_build/install/default/lib/disml/event.mli" {"event.mli"} 211 | "_build/install/default/lib/disml/event_models.ml" {"event_models.ml"} 212 | "_build/install/default/lib/disml/guild.ml" {"guild.ml"} 213 | "_build/install/default/lib/disml/guild.mli" {"guild.mli"} 214 | "_build/install/default/lib/disml/guild_id.ml" {"guild_id.ml"} 215 | "_build/install/default/lib/disml/guild_id.mli" {"guild_id.mli"} 216 | "_build/install/default/lib/disml/guild_id_t.ml" {"guild_id_t.ml"} 217 | "_build/install/default/lib/disml/guild_id_t.mli" {"guild_id_t.mli"} 218 | "_build/install/default/lib/disml/guild_t.ml" {"guild_t.ml"} 219 | "_build/install/default/lib/disml/guild_t.mli" {"guild_t.mli"} 220 | "_build/install/default/lib/disml/http.ml" {"http.ml"} 221 | "_build/install/default/lib/disml/http.mli" {"http.mli"} 222 | "_build/install/default/lib/disml/impl.ml" {"impl.ml"} 223 | "_build/install/default/lib/disml/member.ml" {"member.ml"} 224 | "_build/install/default/lib/disml/member.mli" {"member.mli"} 225 | "_build/install/default/lib/disml/member_t.ml" {"member_t.ml"} 226 | "_build/install/default/lib/disml/member_t.mli" {"member_t.mli"} 227 | "_build/install/default/lib/disml/message.ml" {"message.ml"} 228 | "_build/install/default/lib/disml/message.mli" {"message.mli"} 229 | "_build/install/default/lib/disml/message_id.ml" {"message_id.ml"} 230 | "_build/install/default/lib/disml/message_id.mli" {"message_id.mli"} 231 | "_build/install/default/lib/disml/message_t.ml" {"message_t.ml"} 232 | "_build/install/default/lib/disml/message_t.mli" {"message_t.mli"} 233 | "_build/install/default/lib/disml/opam" {"opam"} 234 | "_build/install/default/lib/disml/opcode.ml" {"opcode.ml"} 235 | "_build/install/default/lib/disml/opcode.mli" {"opcode.mli"} 236 | "_build/install/default/lib/disml/presence.ml" {"presence.ml"} 237 | "_build/install/default/lib/disml/presence.mli" {"presence.mli"} 238 | "_build/install/default/lib/disml/reaction.ml" {"reaction.ml"} 239 | "_build/install/default/lib/disml/reaction.mli" {"reaction.mli"} 240 | "_build/install/default/lib/disml/reaction_t.ml" {"reaction_t.ml"} 241 | "_build/install/default/lib/disml/reaction_t.mli" {"reaction_t.mli"} 242 | "_build/install/default/lib/disml/rl.ml" {"rl.ml"} 243 | "_build/install/default/lib/disml/rl.mli" {"rl.mli"} 244 | "_build/install/default/lib/disml/role.ml" {"role.ml"} 245 | "_build/install/default/lib/disml/role.mli" {"role.mli"} 246 | "_build/install/default/lib/disml/role_id.ml" {"role_id.ml"} 247 | "_build/install/default/lib/disml/role_id.mli" {"role_id.mli"} 248 | "_build/install/default/lib/disml/role_t.ml" {"role_t.ml"} 249 | "_build/install/default/lib/disml/role_t.mli" {"role_t.mli"} 250 | "_build/install/default/lib/disml/s.ml" {"s.ml"} 251 | "_build/install/default/lib/disml/sharder.ml" {"sharder.ml"} 252 | "_build/install/default/lib/disml/sharder.mli" {"sharder.mli"} 253 | "_build/install/default/lib/disml/snowflake.ml" {"snowflake.ml"} 254 | "_build/install/default/lib/disml/snowflake.mli" {"snowflake.mli"} 255 | "_build/install/default/lib/disml/user.ml" {"user.ml"} 256 | "_build/install/default/lib/disml/user.mli" {"user.mli"} 257 | "_build/install/default/lib/disml/user_id.ml" {"user_id.ml"} 258 | "_build/install/default/lib/disml/user_id.mli" {"user_id.mli"} 259 | "_build/install/default/lib/disml/user_id_t.ml" {"user_id_t.ml"} 260 | "_build/install/default/lib/disml/user_id_t.mli" {"user_id_t.mli"} 261 | "_build/install/default/lib/disml/user_t.ml" {"user_t.ml"} 262 | "_build/install/default/lib/disml/user_t.mli" {"user_t.mli"} 263 | ] 264 | doc: [ 265 | "_build/install/default/doc/disml/LICENSE" 266 | "_build/install/default/doc/disml/README.md" 267 | ] 268 | --------------------------------------------------------------------------------