From ef28f111cfec95a62b21a9267f9d24b1edc645dd Mon Sep 17 00:00:00 2001 From: Adelyn Breedlove Date: Fri, 1 Mar 2019 23:15:23 -0700 Subject: Style improvements who dis --- bin/commands.ml | 32 ++++++++++++++++---- lib/client.mli | 20 ++++++------- lib/disml.ml | 42 +++++++++++++------------- lib/dune | 3 +- lib/gateway/dispatch.mli | 18 ++++++------ lib/gateway/sharder.ml | 8 ++--- lib/gateway/sharder.mli | 2 +- lib/models/channel/channel.mli | 16 +++++----- lib/models/channel/message/message.ml | 16 +++++----- lib/models/channel/message/message.mli | 4 +-- lib/models/event_models.ml | 14 ++++----- lib/models/guild/guild.ml | 4 +-- lib/models/id/channel_id.mli | 16 +++++----- lib/models/id/guild_id.ml | 4 +-- lib/models/permissions.ml | 54 +++++++++++++++++----------------- lib/models/permissions.mli | 54 +++++++++++++++++----------------- 16 files changed, 164 insertions(+), 143 deletions(-) diff --git a/bin/commands.ml b/bin/commands.ml index 3cfe210..afdc40a 100644 --- a/bin/commands.ml +++ b/bin/commands.ml @@ -97,7 +97,8 @@ let cache message _args = Message.reply_with ~embed message >>> ignore (* Issue a shutdown to all shards, then exits the process. *) -let shutdown _message _args = +let shutdown (message:Message.t) _args = + if message.author.id = `User_id 242675474927583232 then Ivar.read client >>= Client.shutdown_all ~restart:false >>> fun _ -> exit 0 @@ -180,6 +181,7 @@ let role_test (message:Message.t) args = let check_permissions (message:Message.t) _args = let cache = Mvar.peek_exn Cache.cache in + let empty = Permissions.empty in let permissions = match message.guild_id, message.member with | Some g, Some m -> begin match Cache.guild cache g with @@ -187,8 +189,28 @@ let check_permissions (message:Message.t) _args = List.fold m.roles ~init:Permissions.empty ~f:(fun acc rid -> let role = List.find_exn g.roles ~f:(fun r -> r.id = rid) in Permissions.union acc role.permissions) - | None -> Permissions.empty + | None -> empty end - | _ -> Permissions.empty in - let permissions = Permissions.elements permissions |> List.sexp_of_t Permissions.sexp_of_elt |> Sexp.to_string_hum in - Message.reply message (Printf.sprintf "Permissions: %s" permissions) >>> ignore \ No newline at end of file + | _ -> empty in + let allow, deny = match message.member with + | Some m -> + begin match Cache.text_channel cache message.channel_id with + | Some c -> + List.fold c.permission_overwrites ~init:(empty, empty) ~f:(fun (a,d) {allow; deny; id; kind} -> + let `User_id uid = message.author.id in + if (kind = "role" && List.mem m.roles (`Role_id id) ~equal:(=)) || (kind = "user" && id = uid) then + Permissions.union allow a, Permissions.union deny d + else a, d + ) + | None -> empty, empty + end + | None -> empty, empty in + let g_perms = Permissions.elements permissions + |> List.sexp_of_t Permissions.sexp_of_elt + |> Sexp.to_string_hum in + let c_perms = Permissions.(union permissions allow + |> diff deny + |> elements) + |> List.sexp_of_t Permissions.sexp_of_elt + |> Sexp.to_string_hum in + Message.reply message (Printf.sprintf "Global Permissions: %s\nChannel Permissions: %s" g_perms c_perms) >>> ignore \ No newline at end of file diff --git a/lib/client.mli b/lib/client.mli index 4f9fdab..6d7c931 100644 --- a/lib/client.mli +++ b/lib/client.mli @@ -10,19 +10,19 @@ type t = (** Start the Client. This begins shard connections to Discord and event handlers should be registered prior to calling this. {3 Example} {[ - open Async - open Disml +open Async +open Disml - let main () = - let token = "a valid bot token" in - Client.start ~count:5 token >>> print_endline "Client launched" +let main () = + let token = "a valid bot token" in + Client.start ~count:5 token >>> print_endline "Client launched" - let _ = - Scheduler.go_main ~main () +let _ = + Scheduler.go_main ~main () ]} @param ?count Optional amount of shards to launch. Defaults to autosharding. - @param ?compress Whether to use compression over the gateway. } - @param ?large Large threshold for guilds. Default is 250. + @param ?compress Whether to use compression over the gateway. + @param ?large Large threshold for guilds. Default is 100. @param string The token used for authentication. @return A deferred client object. *) @@ -55,4 +55,4 @@ val request_guild_members : val shutdown_all : ?restart:bool -> t -> - unit list Deferred.t \ No newline at end of file + unit list Deferred.t diff --git a/lib/disml.ml b/lib/disml.ml index c142af4..a088c2a 100644 --- a/lib/disml.ml +++ b/lib/disml.ml @@ -4,25 +4,25 @@ {3 Example} {[ - open Async - open Core - open Disml - open Models - - (* Create a function to handle message_create. *) - let check_command (Event.MessageCreate.{message}) = - if String.is_prefix ~prefix:"!ping" message.content then - Message.reply message "Pong!" >>> ignore - - let main () = - (* Register the event handler *) - Client.message_create := check_command; - (* Start the client. It's recommended to load the token from an env var or other config file. *) - Client.start "My token" >>> ignore - - let _ = - (* Launch the Async scheduler. You must do this for anything to work. *) - Scheduler.go_main ~main () +open Async +open Core +open Disml +open Models + +(* Create a function to handle message_create. *) +let check_command (Event.MessageCreate.{message}) = + if String.is_prefix ~prefix:"!ping" message.content then + Message.reply message "Pong!" >>> ignore + +let main () = + (* Register the event handler *) + Client.message_create := check_command; + (* Start the client. It's recommended to load the token from an env var or other config file. *) + Client.start "My token" >>> ignore + +let _ = + (* Launch the Async scheduler. You must do this for anything to work. *) + Scheduler.go_main ~main () ]} *) @@ -125,7 +125,7 @@ module Models = struct (** Represents solely a user ID. REST operations can be performed without the full object overhead using this. *) module User_id = User_id - + (** Represents the structures received over the gateway. *) module Event = Event_models -end \ No newline at end of file +end diff --git a/lib/dune b/lib/dune index 9351197..fc44062 100644 --- a/lib/dune +++ b/lib/dune @@ -23,7 +23,6 @@ cache client client_options disml dispatch endpoints event http opcode rl sharder ) (libraries checkseum.ocaml core async_ssl cohttp-async decompress logs yojson websocket-async ppx_deriving_yojson.runtime bitmasks) - (preprocess (pps ppx_sexp_conv ppx_deriving_yojson)) -) + (preprocess (pps ppx_sexp_conv ppx_deriving_yojson))) (include_subdirs unqualified) diff --git a/lib/gateway/dispatch.mli b/lib/gateway/dispatch.mli index 18b9261..89905a6 100644 --- a/lib/gateway/dispatch.mli +++ b/lib/gateway/dispatch.mli @@ -6,14 +6,14 @@ [Client.guild_create := (fun guild -> print_endline guild.name)] {[ - open Core - open Disml - - let check_command (msg : Message.t) = - if String.is_prefix ~prefix:"!ping" msg.content then - Message.reply msg "Pong!" >>> ignore - - Client.message_create := check_command +open Core +open Disml + +let check_command (msg : Message.t) = + if String.is_prefix ~prefix:"!ping" msg.content then + Message.reply msg "Pong!" >>> ignore + +Client.message_create := check_command ]} *) @@ -117,4 +117,4 @@ val unknown : (Unknown.t -> unit) ref (**/**) (* val voice_state_update : (Yojson.Safe.t -> unit) ref *) -(* val voice_server_update : (Yojson.Safe.t -> unit) ref *) \ No newline at end of file +(* val voice_server_update : (Yojson.Safe.t -> unit) ref *) diff --git a/lib/gateway/sharder.ml b/lib/gateway/sharder.ml index 71e900d..ba865a9 100644 --- a/lib/gateway/sharder.ml +++ b/lib/gateway/sharder.ml @@ -62,7 +62,7 @@ module Shard = struct | Binary -> if compress then `Ok (decompress s.content |> Yojson.Safe.from_string) else `Error "Failed to decompress" - | Close -> `Close s.content + | Close -> `Close s | op -> let op = Frame.Opcode.to_string op in `Error ("Unexpected opcode " ^ op) @@ -311,13 +311,13 @@ let start ?count ?compress ?large_threshold () = Logs.info (fun m -> m "Connecting to %s" url); let rec ev_loop (t:Shard.shard Shard.t) = let step (t:Shard.shard Shard.t) = - Pipe.read (fst t.state.pipe) >>= fun frame -> + Pipe.read (fst t.state.pipe) >>= fun frame -> begin match Shard.parse ~compress:t.state.compress frame with | `Ok f -> Shard.handle_frame ~f t.state >>| fun s -> t.state <- s | `Close c -> - Logs.warn (fun m -> m "Close frame received. Code: %s" c); + Logs.warn (fun m -> m "Close frame received. %s" (Frame.show c)); Shard.shutdown t | `Error e -> Logs.warn (fun m -> m "Websocket soft error: %s" e); @@ -379,4 +379,4 @@ let request_guild_members ?query ?limit ~guild sharder = let shutdown_all ?restart sharder = Deferred.all @@ List.map ~f:(fun t -> Shard.shutdown ~clean:true ?restart t - ) sharder.shards \ No newline at end of file + ) sharder.shards diff --git a/lib/gateway/sharder.mli b/lib/gateway/sharder.mli index bbd8617..6249d4d 100644 --- a/lib/gateway/sharder.mli +++ b/lib/gateway/sharder.mli @@ -33,7 +33,7 @@ module Shard : sig url: string; (** The websocket URL in use. *) _internal: Reader.t * Writer.t; } - + (** Wrapper around an internal state, used to wrap {!shard}. *) type 'a t = { mutable state: 'a; diff --git a/lib/models/channel/channel.mli b/lib/models/channel/channel.mli index 9e981ae..0d7431b 100644 --- a/lib/models/channel/channel.mli +++ b/lib/models/channel/channel.mli @@ -10,15 +10,15 @@ exception No_message_found {3 Examples} {[ - open Core - open Disml +open Core +open Disml - let check_command (msg : Message.t) = - if String.is_prefix ~prefix:"!hello" msg.content then - let embed = Embed.(default |> title "Hello World!") in - Channel_id.send_message ~embed msg.channel_id >>> ignore +let check_command (msg : Message.t) = + if String.is_prefix ~prefix:"!hello" msg.content then + let embed = Embed.(default |> title "Hello World!") in + Channel_id.send_message ~embed msg.channel_id >>> ignore - Client.message_create := check_command +Client.message_create := check_command ]} *) val send_message : @@ -43,4 +43,4 @@ val get_messages : val broadcast_typing : t -> unit Deferred.Or_error.t val get_pins : t -> Message_t.t list Deferred.Or_error.t val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t -(* TODO more things related to guild channels *) \ No newline at end of file +(* TODO more things related to guild channels *) diff --git a/lib/models/channel/message/message.ml b/lib/models/channel/message/message.ml index d3917e9..41174e1 100644 --- a/lib/models/channel/message/message.ml +++ b/lib/models/channel/message/message.ml @@ -10,7 +10,7 @@ let add_reaction msg (emoji:Emoji.t) = | None -> emoji.name in Http.create_reaction channel_id id e - + let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) = let `Message_id id = msg.id in @@ -21,31 +21,31 @@ let remove_reaction msg (emoji:Emoji.t) (user:User_t.t) = | None -> emoji.name in Http.delete_reaction channel_id id e user_id - + let clear_reactions msg = let `Message_id id = msg.id in let `Channel_id channel_id = msg.channel_id in Http.delete_reactions channel_id id - + let delete msg = let `Message_id id = msg.id in let `Channel_id channel_id = msg.channel_id in Http.delete_message channel_id id - + let pin msg = let `Message_id id = msg.id in let `Channel_id channel_id = msg.channel_id in Http.pin_message channel_id id - + let unpin msg = let `Message_id id = msg.id in let `Channel_id channel_id = msg.channel_id in Http.unpin_message channel_id id - + let reply msg content = Channel_id.say content msg.channel_id @@ -58,11 +58,11 @@ let set_content msg cont = let `Channel_id channel_id = msg.channel_id in to_yojson { msg with content = cont; } |> Http.edit_message channel_id id - + let set_embed msg embed = let `Message_id id = msg.id in let `Channel_id channel_id = msg.channel_id in to_yojson { msg with embeds = [embed]; } |> Http.edit_message channel_id id - \ No newline at end of file + diff --git a/lib/models/channel/message/message.mli b/lib/models/channel/message/message.mli index 56e1c98..0eba3af 100644 --- a/lib/models/channel/message/message.mli +++ b/lib/models/channel/message/message.mli @@ -31,9 +31,9 @@ val reply_with : ?tts:bool -> t -> Message_t.t Deferred.Or_error.t - + (** Set the content of the message. *) val set_content : t -> string -> t Deferred.Or_error.t (** Set the embed of the message. *) -val set_embed : t -> Embed.t -> t Deferred.Or_error.t \ No newline at end of file +val set_embed : t -> Embed.t -> t Deferred.Or_error.t diff --git a/lib/models/event_models.ml b/lib/models/event_models.ml index 03bf79c..603f2c3 100644 --- a/lib/models/event_models.ml +++ b/lib/models/event_models.ml @@ -220,7 +220,7 @@ module GuildDelete = struct { id: Guild_id_t.t ; unavailable: bool } - + let deserialize = Guild_t.unavailable_of_yojson_exn let update_cache (cache:Cache.t) (t:t) = @@ -298,7 +298,7 @@ module GuildMemberAdd = struct let update_cache (cache:Cache.t) (t:t) = if Cache.GuildMap.mem cache.guilds t.guild_id then let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with - | Some g -> + | Some g -> let members = t :: g.members in let data = { g with members } in Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data @@ -318,7 +318,7 @@ module GuildMemberRemove = struct let update_cache (cache:Cache.t) t = if Cache.GuildMap.mem cache.guilds t.guild_id then let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with - | Some g -> + | Some g -> let members = List.filter g.members ~f:(fun m -> m.user.id <> t.user.id) in let data = { g with members } in Cache.GuildMap.set cache.guilds ~key:t.guild_id ~data @@ -340,7 +340,7 @@ module GuildMemberUpdate = struct let update_cache (cache:Cache.t) t = if Cache.GuildMap.mem cache.guilds t.guild_id then let guilds = match Cache.GuildMap.find cache.guilds t.guild_id with - | Some g -> + | Some g -> let members = List.map g.members ~f:(fun m -> if m.user.id = t.user.id then { m with nick = t.nick; roles = t.roles } @@ -518,7 +518,7 @@ module PresenceUpdate = struct end (* module PresencesReplace = struct - type t = + type t = let deserialize = of_yojson_exn end *) @@ -635,7 +635,7 @@ module Unknown = struct ; value: Yojson.Safe.t } - let deserialize kind value = { kind; value; } + let deserialize kind value = { kind; value; } end (* module VoiceHeartbeat = struct @@ -660,4 +660,4 @@ end module VoiceStateUpdate = struct -end *) \ No newline at end of file +end *) diff --git a/lib/models/guild/guild.ml b/lib/models/guild/guild.ml index bd3143e..2559df6 100644 --- a/lib/models/guild/guild.ml +++ b/lib/models/guild/guild.ml @@ -46,7 +46,7 @@ let create_channel ~mode ~name guild = ("type", `Int kind); ]) -let delete guild = +let delete guild = Http.delete_guild (get_id guild) let get_ban ~id guild = @@ -125,4 +125,4 @@ let get_channel ~(id:Channel_id_t.t) guild = (* TODO add HTTP fallback *) let get_role ~(id:Role_id.t) guild = - List.find ~f:(fun r -> r.id = id) guild.roles \ No newline at end of file + List.find ~f:(fun r -> r.id = id) guild.roles diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli index 20987c5..74010a5 100644 --- a/lib/models/id/channel_id.mli +++ b/lib/models/id/channel_id.mli @@ -10,15 +10,15 @@ exception No_message_found {3 Examples} {[ - open Core - open Disml +open Core +open Disml - let check_command (msg : Message.t) = - if String.is_prefix ~prefix:"!hello" msg.content then - let embed = Embed.(default |> title "Hello World!") in - Channel_id.send_message ~embed msg.channel_id >>> ignore +let check_command (msg : Message.t) = + if String.is_prefix ~prefix:"!hello" msg.content then + let embed = Embed.(default |> title "Hello World!") in + Channel_id.send_message ~embed msg.channel_id >>> ignore - Client.message_create := check_command +Client.message_create := check_command ]} *) val send_message : @@ -43,4 +43,4 @@ val get_messages : val broadcast_typing : t -> unit Deferred.Or_error.t val get_pins : t -> Message_t.t list Deferred.Or_error.t val bulk_delete : Snowflake.t list -> t -> unit Deferred.Or_error.t -(* TODO more things related to guild channels *) \ No newline at end of file +(* TODO more things related to guild channels *) diff --git a/lib/models/id/guild_id.ml b/lib/models/id/guild_id.ml index 6b3385c..d4db185 100644 --- a/lib/models/id/guild_id.ml +++ b/lib/models/id/guild_id.ml @@ -39,7 +39,7 @@ let create_channel ~mode ~name guild = ("type", `Int kind); ]) -let delete guild = +let delete guild = Http.delete_guild (get_id guild) let get_ban ~id guild = @@ -101,4 +101,4 @@ let unban_user ~id ?reason guild = let payload = match reason with | Some r -> `Assoc [("reason", `String r)] | None -> `Null - in Http.guild_ban_remove (get_id guild) id payload \ No newline at end of file + in Http.guild_ban_remove (get_id guild) id payload diff --git a/lib/models/permissions.ml b/lib/models/permissions.ml index 9a0567d..7a0892b 100644 --- a/lib/models/permissions.ml +++ b/lib/models/permissions.ml @@ -1,32 +1,32 @@ type elt = | CREATE_INSTANT_INVITE -| KICK_MEMBERS -| BAN_MEMBERS -| ADMINISTRATOR -| MANAGE_CHANNELS -| MANAGE_GUILD -| ADD_REACTIONS -| VIEW_AUDIT_LOG -| PRIORITY_SPEAKER +| KICK_MEMBERS +| BAN_MEMBERS +| ADMINISTRATOR +| MANAGE_CHANNELS +| MANAGE_GUILD +| ADD_REACTIONS +| VIEW_AUDIT_LOG +| PRIORITY_SPEAKER | READ_MESSAGES -| SEND_MESSAGES -| SEND_TTS_MESSAGES -| MANAGE_MESSAGES -| EMBED_LINKS -| ATTACH_FILES -| READ_MESSAGE_HISTORY -| MENTION_EVERYONE -| USE_EXTERNAL_EMOJIS -| CONNECT -| SPEAK -| MUTE_MEMBERS -| DEAFEN_MEMBERS -| MOVE_MEMBERS -| USE_VAD -| CHANGE_NICKNAME -| MANAGE_NICKNAMES -| MANAGE_ROLES -| MANAGE_WEBHOOKS +| SEND_MESSAGES +| SEND_TTS_MESSAGES +| MANAGE_MESSAGES +| EMBED_LINKS +| ATTACH_FILES +| READ_MESSAGE_HISTORY +| MENTION_EVERYONE +| USE_EXTERNAL_EMOJIS +| CONNECT +| SPEAK +| MUTE_MEMBERS +| DEAFEN_MEMBERS +| MOVE_MEMBERS +| USE_VAD +| CHANGE_NICKNAME +| MANAGE_NICKNAMES +| MANAGE_ROLES +| MANAGE_WEBHOOKS | MANAGE_EMOJIS [@@deriving sexp] @@ -56,4 +56,4 @@ let to_seq_from elt init = elt :: elements r |> List.to_seq let add_seq seq init = - of_seq seq |> union init \ No newline at end of file + of_seq seq |> union init diff --git a/lib/models/permissions.mli b/lib/models/permissions.mli index 6e4d30a..ce5913a 100644 --- a/lib/models/permissions.mli +++ b/lib/models/permissions.mli @@ -1,32 +1,32 @@ type elt = | CREATE_INSTANT_INVITE -| KICK_MEMBERS -| BAN_MEMBERS -| ADMINISTRATOR -| MANAGE_CHANNELS -| MANAGE_GUILD -| ADD_REACTIONS -| VIEW_AUDIT_LOG -| PRIORITY_SPEAKER +| KICK_MEMBERS +| BAN_MEMBERS +| ADMINISTRATOR +| MANAGE_CHANNELS +| MANAGE_GUILD +| ADD_REACTIONS +| VIEW_AUDIT_LOG +| PRIORITY_SPEAKER | READ_MESSAGES -| SEND_MESSAGES -| SEND_TTS_MESSAGES -| MANAGE_MESSAGES -| EMBED_LINKS -| ATTACH_FILES -| READ_MESSAGE_HISTORY -| MENTION_EVERYONE -| USE_EXTERNAL_EMOJIS -| CONNECT -| SPEAK -| MUTE_MEMBERS -| DEAFEN_MEMBERS -| MOVE_MEMBERS -| USE_VAD -| CHANGE_NICKNAME -| MANAGE_NICKNAMES -| MANAGE_ROLES -| MANAGE_WEBHOOKS +| SEND_MESSAGES +| SEND_TTS_MESSAGES +| MANAGE_MESSAGES +| EMBED_LINKS +| ATTACH_FILES +| READ_MESSAGE_HISTORY +| MENTION_EVERYONE +| USE_EXTERNAL_EMOJIS +| CONNECT +| SPEAK +| MUTE_MEMBERS +| DEAFEN_MEMBERS +| MOVE_MEMBERS +| USE_VAD +| CHANGE_NICKNAME +| MANAGE_NICKNAMES +| MANAGE_ROLES +| MANAGE_WEBHOOKS | MANAGE_EMOJIS [@@deriving sexp] @@ -38,4 +38,4 @@ val sexp_of_t : t -> Sexplib.Sexp.t val t_of_sexp : Sexplib.Sexp.t -> t val of_yojson_exn : Yojson.Safe.t -> t val of_yojson : Yojson.Safe.t -> (t, string) result -val to_yojson : t -> Yojson.Safe.t \ No newline at end of file +val to_yojson : t -> Yojson.Safe.t -- cgit v1.2.3