From afa6b297bd7bf9361727ae78794d9310d3678d13 Mon Sep 17 00:00:00 2001 From: Adelyn Breelove Date: Wed, 13 Feb 2019 10:58:39 -0700 Subject: Re-arrange and whatnot --- bin/bot.ml | 125 ++++++------------------------------------------------- bin/commands.ml | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ bin/dune | 2 +- lib/cache.mli | 4 +- lib/http/rl.ml | 30 +++++++++++++ lib/http/rl.mli | 37 +++++++++++++++++ lib/rl.ml | 30 ------------- lib/rl.mli | 37 ----------------- 8 files changed, 210 insertions(+), 182 deletions(-) create mode 100644 bin/commands.ml create mode 100644 lib/http/rl.ml create mode 100644 lib/http/rl.mli delete mode 100644 lib/rl.ml delete mode 100644 lib/rl.mli diff --git a/bin/bot.ml b/bin/bot.ml index 8f57b1f..64d9ead 100644 --- a/bin/bot.ml +++ b/bin/bot.ml @@ -3,9 +3,6 @@ open Core open Disml open Models -(* Client object will be stored here after creation. *) -let client = Ivar.create () - (* Define a function to handle message_create *) let check_command (message:Message.t) = (* Simple example of command parsing. *) @@ -13,115 +10,17 @@ let check_command (message:Message.t) = | hd::tl -> hd, tl | [] -> "", [] in match cmd with - | "!ping" -> (* Example ping command with REST round trip time edited into the response. *) - Message.reply message "Pong!" >>> begin function - | Ok message -> - let diff = Time.diff (Time.now ()) (Time.of_string message.timestamp) in - Message.set_content message (Printf.sprintf "Pong! `%d ms`" (Time.Span.to_ms diff |> Float.abs |> Float.to_int)) >>> ignore - | Error e -> Error.raise e - end - | "!spam" -> (* Send a list of consecutive integers of N size with 1 message per list item. *) - let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in - List.range 0 count - |> List.iter ~f:(fun i -> Message.reply message (string_of_int i) >>> ignore) - | "!list" -> (* Send a list of consecutive integers of N size in a single message. *) - let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in - let list = List.range 0 count - |> List.sexp_of_t Int.sexp_of_t - |> Sexp.to_string_hum in - Message.reply message list >>> begin function - | Ok msg -> print_endline msg.content - | Error err -> print_endline (Error.to_string_hum err) - end - | "!fold" -> (* Sum a consecutive list of integers of N size and send the result. *) - let count = Option.((List.hd rest >>| Int.of_string) |> value ~default:0) in - let list = List.range 0 count - |> List.fold ~init:0 ~f:(+) - |> Int.to_string in - Message.reply message list >>> ignore - | "!embed" -> (* Example of setting pretty much everything in an embed using the Embed module builders *) - let image_url = "https://cdn.discordapp.com/avatars/345316276098433025/17ccdc992814cc6e21a9e7d743a30e37.png" in - let embed = Embed.(default - |> title "Foo" - |> description "Bar" - |> url "https://gitlab.com/Mishio595/disml" - |> timestamp Time.(now () |> to_string_iso8601_basic ~zone:Time.Zone.utc) - |> colour 0xff - |> footer (fun f -> footer_text "boop" f) - |> image image_url - |> thumbnail image_url - |> author (fun a -> a - |> author_name "Adelyn" - |> author_icon image_url - |> author_url "https://gitlab.com/Mishio595/disml") - |> field ("field 3", "test", true) - |> field ("field 2", "test", true) - |> field ("field 1", "test", true) - ) in - Message.reply_with ~embed message >>> ignore - | "!status" -> (* Set the status of all shards to a given string. *) - let status = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) rest in - Ivar.read client >>> fun client -> - Client.set_status ~status:(`String status) client - >>> fun _ -> - Message.reply message "Updated status" >>> ignore - | "!test" -> (* Basic send message to channel ID, can use any ID as `Channel_id some_snowflake *) - Channel_id.say "Testing..." message.channel_id >>> ignore - | "!echo" -> (* Fetches a message by ID in the current channel, defaulting to the sent message, and prints in s-expr form. *) - let `Message_id id = message.id in - let id = Option.((List.hd rest >>| Int.of_string) |> value ~default:id) in - Channel_id.get_message ~id message.channel_id >>> begin function - | Ok msg -> - let str = Message.sexp_of_t msg |> Sexp.to_string_hum in - print_endline str; - Message.reply message (Printf.sprintf "```lisp\n%s```" str) >>> ignore - | _ -> () - end - | "!cache" -> (* Output cache counts as a a basic embed. *) - let module C = Cache.ChannelMap in - let module G = Cache.GuildMap in - let module U = Cache.UserMap in - let cache = Mvar.peek_exn Cache.cache in - let gc = G.length cache.guilds in - let tc = C.length cache.text_channels in - let vc = C.length cache.voice_channels in - let cs = C.length cache.categories in - let gr = C.length cache.groups in - let pr = C.length cache.private_channels in - let uc = U.length cache.users in - let pre = U.length cache.presences in - let user = Option.(value ~default:"None" (cache.user >>| User.tag)) in - let embed = Embed.(default - |> description (Printf.sprintf "Guilds: %d\nText Channels: %d\nVoice Channels: %d\nCategories: %d\nGroups: %d\nPrivate Channels: %d\nUsers: %d\nPresences: %d\nCurrent User: %s" gc tc vc cs gr pr uc pre user)) in - Message.reply_with ~embed message >>> ignore - | "!shutdown" -> (* Issue a shutdown to all shards. It is expected that they will restart if `?restart` is not false. *) - Ivar.read client >>> fun client -> - Sharder.shutdown_all client.sharder >>> ignore - | "!rgm" -> (* 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. *) - Ivar.read client >>> fun client -> - (match message.guild_id with - | Some guild -> Client.request_guild_members ~guild client >>> ignore - | None -> ()) - | "!rep" -> - let input = Option.(List.hd rest |> value ~default:"a") in - let list = List.(range 0 2000 >>| (fun _ -> input) |> fold ~init:"" ~f:(^)) in - Message.reply message list >>= begin function - | Ok m -> - String.length m.content - |> Int.to_string - |> (^) "Bytes: " - |> Message.reply m - | Error e -> Message.reply message (Error.to_string_hum e) - end >>> ignore - | "!new" -> (* Creates a guild named testing *) - Guild.create [ "name", `String "testing" ] >>= begin function - | Ok _ -> Message.reply message "Guild created" - | Error e -> Message.reply message (Printf.sprintf "Failed to create guild. Error: %s" (Error.to_string_hum e)) - end >>> ignore - | "!delall" -> (* Deletes all guilds named testing *) - let cache = Mvar.peek_exn Cache.cache in - let guilds = Cache.GuildMap.filter cache.guilds ~f:(fun g -> g.name = "testing") in - let _ = Cache.GuildMap.map guilds ~f:Guild.delete in () + | "!ping" -> Commands.ping message rest + | "!spam" -> Commands.spam message rest + | "!list" -> Commands.list message rest + | "!embed" -> Commands.embed message rest + | "!status" -> Commands.status message rest + | "!echo" -> Commands.echo message rest + | "!cache" -> Commands.cache message rest + | "!shutdown" -> Commands.shutdown message rest + | "!rgm" -> Commands.request_members message rest + | "!new" -> Commands.new_guild message rest + | "!delall" -> Commands.delete_guilds message rest | _ -> () (* Fallback case, no matched command. *) (* Example logs setup *) @@ -144,7 +43,7 @@ let main () = (* Start client. *) Client.start ~large:250 ~compress:true token (* Fill that ivar once its done *) - >>> Ivar.fill client + >>> Ivar.fill Commands.client (* Lastly, we have to register this to the Async Scheduler for anything to work *) let _ = diff --git a/bin/commands.ml b/bin/commands.ml new file mode 100644 index 0000000..93cebbc --- /dev/null +++ b/bin/commands.ml @@ -0,0 +1,127 @@ +open Async +open Core +open Disml +open Models + +(* Client object will be stored here after creation. *) +let client = Ivar.create () + +(* Example ping command with REST round trip time edited into the response. *) +let ping message _args = + Message.reply message "Pong!" >>> function + | Ok message -> + let diff = Time.diff (Time.now ()) (Time.of_string message.timestamp) in + Message.set_content message (Printf.sprintf "Pong! `%d ms`" (Time.Span.to_ms diff |> Float.abs |> Float.to_int)) >>> ignore + | Error e -> Error.raise e + +(* Send a list of consecutive integers of N size with 1 message per list item. *) +let spam message args = + let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in + List.range 0 count + |> List.iter ~f:(fun i -> Message.reply message (string_of_int i) >>> ignore) + +(* Send a list of consecutive integers of N size in a single message. *) +let list message args = + let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in + let list = List.range 0 count + |> List.sexp_of_t Int.sexp_of_t + |> Sexp.to_string_hum in + Message.reply message list >>> function + | Ok msg -> print_endline msg.content + | Error err -> print_endline (Error.to_string_hum err) + +(* Example of setting pretty much everything in an embed using the Embed module builders *) +let embed message _args = + let image_url = "https://cdn.discordapp.com/avatars/345316276098433025/17ccdc992814cc6e21a9e7d743a30e37.png" in + let embed = Embed.(default + |> title "Foo" + |> description "Bar" + |> url "https://gitlab.com/Mishio595/disml" + |> timestamp Time.(now () |> to_string_iso8601_basic ~zone:Time.Zone.utc) + |> colour 0xff + |> footer (fun f -> footer_text "boop" f) + |> image image_url + |> thumbnail image_url + |> author (fun a -> a + |> author_name "Adelyn" + |> author_icon image_url + |> author_url "https://gitlab.com/Mishio595/disml") + |> field ("field 3", "test", true) + |> field ("field 2", "test", true) + |> field ("field 1", "test", true) + ) in + Message.reply_with ~embed message >>> ignore + +(* Set the status of all shards to a given string. *) +let status message args = + let status = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in + Ivar.read client >>> fun client -> + Client.set_status ~status:(`String status) client + >>> fun _ -> + Message.reply message "Updated status" >>> ignore + +(* Fetches a message by ID in the current channel, defaulting to the sent message, and prints in s-expr form. *) +let echo (message:Message.t) args = + let `Message_id id = message.id in + let id = Option.((List.hd args >>| Int.of_string) |> value ~default:id) in + Channel_id.get_message ~id message.channel_id >>> function + | Ok msg -> + let str = Message.sexp_of_t msg |> Sexp.to_string_hum in + print_endline str; + Message.reply message (Printf.sprintf "```lisp\n%s```" str) >>> ignore + | _ -> () + +(* Output cache counts as a a basic embed. *) +let cache message _args = + let module C = Cache.ChannelMap in + let module G = Cache.GuildMap in + let module U = Cache.UserMap in + let cache = Mvar.peek_exn Cache.cache in + let gc = G.length cache.guilds in + let tc = C.length cache.text_channels in + let vc = C.length cache.voice_channels in + let cs = C.length cache.categories in + let gr = C.length cache.groups in + let pr = C.length cache.private_channels in + let uc = U.length cache.users in + let pre = U.length cache.presences in + let user = Option.(value ~default:"None" (cache.user >>| User.tag)) in + let embed = Embed.(default + |> description (Printf.sprintf "Guilds: %d\nText Channels: %d\nVoice Channels: %d\nCategories: %d\nGroups: %d\nPrivate Channels: %d\nUsers: %d\nPresences: %d\nCurrent User: %s" gc tc vc cs gr pr uc pre user)) in + Message.reply_with ~embed message >>> ignore + +(* Issue a shutdown to all shards. It is expected that they will restart if `?restart` is not false. *) +let shutdown _message _args = + Ivar.read client >>> fun client -> + Sharder.shutdown_all client.sharder >>> ignore + +(* 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. *) +let request_members (message:Message.t) _args = + Ivar.read client >>> fun client -> + match message.guild_id with + | Some guild -> Client.request_guild_members ~guild client >>> ignore + | None -> () + +(* Creates a guild named testing or what the user provided *) +let new_guild message args = + let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in + let name = if String.length name = 0 then "Testing" else name in + Guild.create [ "name", `String name ] >>= begin function + | Ok g -> Message.reply message (Printf.sprintf "Created guild %s" g.name) + | Error e -> Message.reply message (Printf.sprintf "Failed to create guild. Error: %s" (Error.to_string_hum e)) + end >>> ignore + +(* Deletes all guilds made by the bot *) +let delete_guilds message _args = + let cache = Mvar.peek_exn Cache.cache in + let uid = match cache.user with + | Some u -> u.id + | None -> `User_id 0 + in + let guilds = Cache.GuildMap.filter cache.guilds ~f:(fun g -> g.owner_id = uid) in + let res = ref "" in + let all = Cache.GuildMap.(map guilds ~f:(fun g -> Guild.delete g >>| function + | Ok () -> res := Printf.sprintf "%s\nDeleted %s" !res g.name + | Error _ -> ()) |> to_alist) |> List.map ~f:(snd) in + Deferred.all all >>> fun _ -> + Message.reply message !res >>> ignore \ No newline at end of file diff --git a/bin/dune b/bin/dune index 65360bc..fc8788f 100644 --- a/bin/dune +++ b/bin/dune @@ -1,5 +1,5 @@ (executable (name bot) - (modules bot) + (modules bot commands) (libraries core async_ssl disml) ) \ No newline at end of file diff --git a/lib/cache.mli b/lib/cache.mli index 460afd0..1909303 100644 --- a/lib/cache.mli +++ b/lib/cache.mli @@ -10,7 +10,9 @@ module GuildMap : module type of Map.Make(Guild_id_t) (** Represents a Map of {!User_id.t} keys. *) module UserMap : module type of Map.Make(User_id_t) -(** The full cache record. Immutable and intended to be wrapped in a concurrency-safe wrapper such as {{!Async.Mvar.Read_write.t}Mvar}. *) +(** The full cache record. Immutable and intended to be wrapped in a concurrency-safe wrapper such as {{!Async.Mvar.Read_write.t}Mvar}. + Channels are split by type so it isn't necessary to match them later on. +*) type t = { text_channels: Channel_t.guild_text ChannelMap.t ; voice_channels: Channel_t.guild_voice ChannelMap.t diff --git a/lib/http/rl.ml b/lib/http/rl.ml new file mode 100644 index 0000000..f0c15be --- /dev/null +++ b/lib/http/rl.ml @@ -0,0 +1,30 @@ +open Core +open Async + +module RouteMap = Map.Make(String) + +type rl = { + limit: int; + remaining: int; + reset: int; +} + +type t = ((rl, read_write) Mvar.t) RouteMap.t + +let rl_of_header h = + let module C = Cohttp.Header in + match C.get h "X-RateLimit-Limit", C.get h "X-RateLimit-Remaining", C.get h "X-RateLimit-Reset" with + | Some lim, Some rem, Some re -> + let limit = Int.of_string lim in + let remaining = Int.of_string rem in + let reset = Int.of_string re in + Some { limit; remaining; reset; } + | _ -> None + +let default = { limit = 1; remaining = 1; reset = 0; } +let empty : t = RouteMap.empty +let update = RouteMap.update +let find = RouteMap.find +let find_exn m s = match find m s with + | Some r -> r + | None -> raise (Not_found_s (String.sexp_of_t s)) \ No newline at end of file diff --git a/lib/http/rl.mli b/lib/http/rl.mli new file mode 100644 index 0000000..973f02f --- /dev/null +++ b/lib/http/rl.mli @@ -0,0 +1,37 @@ +(** Internal ratelimit route mapping. *) + +open Core +open Async + +(** Type for mapping route -> {!rl}. *) +module RouteMap : module type of Map.Make(String) + +(** Type representing ratelimit information. *) +type rl = { + limit: int; + remaining: int; + reset: int; +} + +(** Type representing the specific case of {!RouteMap}. *) +type t = ((rl, read_write) Mvar.t) RouteMap.t + +(** Converts Cohttp header data into ratelimit information. + @return Some of ratelimit information or None on bad headers +*) +val rl_of_header : Cohttp.Header.t -> rl option + +(** Default for type rl. Used for prepopulating routes. *) +val default : rl + +(** Empty ratelimit route map. *) +val empty : t + +(** Analogous to {!RouteMap.update}. *) +val update : 'a RouteMap.t -> string -> f:('a option -> 'a) -> 'a RouteMap.t + +(** Analogous to {!RouteMap.find}. *) +val find : 'a RouteMap.t -> string -> 'a option + +(** Analogous to {!RouteMap.find_exn}. *) +val find_exn : 'a RouteMap.t -> string -> 'a \ No newline at end of file diff --git a/lib/rl.ml b/lib/rl.ml deleted file mode 100644 index f0c15be..0000000 --- a/lib/rl.ml +++ /dev/null @@ -1,30 +0,0 @@ -open Core -open Async - -module RouteMap = Map.Make(String) - -type rl = { - limit: int; - remaining: int; - reset: int; -} - -type t = ((rl, read_write) Mvar.t) RouteMap.t - -let rl_of_header h = - let module C = Cohttp.Header in - match C.get h "X-RateLimit-Limit", C.get h "X-RateLimit-Remaining", C.get h "X-RateLimit-Reset" with - | Some lim, Some rem, Some re -> - let limit = Int.of_string lim in - let remaining = Int.of_string rem in - let reset = Int.of_string re in - Some { limit; remaining; reset; } - | _ -> None - -let default = { limit = 1; remaining = 1; reset = 0; } -let empty : t = RouteMap.empty -let update = RouteMap.update -let find = RouteMap.find -let find_exn m s = match find m s with - | Some r -> r - | None -> raise (Not_found_s (String.sexp_of_t s)) \ No newline at end of file diff --git a/lib/rl.mli b/lib/rl.mli deleted file mode 100644 index 973f02f..0000000 --- a/lib/rl.mli +++ /dev/null @@ -1,37 +0,0 @@ -(** Internal ratelimit route mapping. *) - -open Core -open Async - -(** Type for mapping route -> {!rl}. *) -module RouteMap : module type of Map.Make(String) - -(** Type representing ratelimit information. *) -type rl = { - limit: int; - remaining: int; - reset: int; -} - -(** Type representing the specific case of {!RouteMap}. *) -type t = ((rl, read_write) Mvar.t) RouteMap.t - -(** Converts Cohttp header data into ratelimit information. - @return Some of ratelimit information or None on bad headers -*) -val rl_of_header : Cohttp.Header.t -> rl option - -(** Default for type rl. Used for prepopulating routes. *) -val default : rl - -(** Empty ratelimit route map. *) -val empty : t - -(** Analogous to {!RouteMap.update}. *) -val update : 'a RouteMap.t -> string -> f:('a option -> 'a) -> 'a RouteMap.t - -(** Analogous to {!RouteMap.find}. *) -val find : 'a RouteMap.t -> string -> 'a option - -(** Analogous to {!RouteMap.find_exn}. *) -val find_exn : 'a RouteMap.t -> string -> 'a \ No newline at end of file -- cgit v1.2.3