aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitlab-ci.yml2
-rw-r--r--disml.opam78
-rw-r--r--dune-project2
-rw-r--r--lib/http/http.ml38
-rw-r--r--lib/http/http.mli10
-rw-r--r--lib/models/channel/message/message.ml4
-rw-r--r--lib/models/channel/message/message.mli4
-rw-r--r--lib/models/id/channel_id.ml8
-rw-r--r--lib/models/id/channel_id.mli2
9 files changed, 80 insertions, 68 deletions
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index f6f7d73..92e28c0 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -5,7 +5,7 @@ before_script:
- opam init
- eval `opam config env`
- opam update
- - opam pin add disml .
+ - opam pin add disml . --inplace-build
build:
stage: build
diff --git a/disml.opam b/disml.opam
index 313018b..a6ce715 100644
--- a/disml.opam
+++ b/disml.opam
@@ -1,40 +1,40 @@
-opam-version: "2.0"
-name: "disml"
-version: "0.2.5"
-maintainer: "Adelyn Breedlove <[email protected]>"
-authors: "Adelyn Breedlove <[email protected]>"
-license: "MIT"
-homepage: "https://gitlab.com/Mishio595/disml"
-doc: "https://mishio595.gitlab.io/disml/"
-dev-repo: "git+https://gitlab.com/Mishio595/disml"
-bug-reports: "https://gitlab.com/Mishio595/disml/issues"
-tags: ["discord"]
-synopsis: "An OCaml library for interfacing with the Discord API"
-description: """
-Dis.ml is a library that provides a high-level interface to the Discord API.
-Key features include:
-* Automatic sharding
-* Deserialization of Discord objects to record types with related helper methods
-* Automatic rate-limiting
-
-For examples, see `/bin` in the git repo.
-"""
-depends: [
- "ocaml" {>= "4.04.1"}
- "dune" {build & >= "1.3.0"}
- "async_ssl" {>= "v0.11.0"}
- "cohttp-async" {>= "1.2.0"}
- "core" {>= "v0.11.3"}
- "decompress" {<= "0.8.1"}
- "odoc" {with-doc & >= "1.3.0"}
- "ppx_deriving_yojson" {>= "3.3"}
- "ppx_sexp_conv" {>= "v0.11.2"}
- "websocket-async" {>= "2.12"}
- "yojson" {>= "1.6.0"}
- "bitmasks" {>= "1.1.0"}
-]
-build: [
- ["dune" "subst"] {pinned}
- ["dune" "build" "-p" name "-j" jobs]
- ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc}
+opam-version: "2.0"
+name: "disml"
+version: "0.2.5"
+maintainer: "Adelyn Breedlove <[email protected]>"
+authors: "Adelyn Breedlove <[email protected]>"
+license: "MIT"
+homepage: "https://gitlab.com/Mishio595/disml"
+doc: "https://mishio595.gitlab.io/disml/"
+dev-repo: "git+https://gitlab.com/Mishio595/disml"
+bug-reports: "https://gitlab.com/Mishio595/disml/issues"
+tags: ["discord"]
+synopsis: "An OCaml library for interfacing with the Discord API"
+description: """
+Dis.ml is a library that provides a high-level interface to the Discord API.
+Key features include:
+* Automatic sharding
+* Deserialization of Discord objects to record types with related helper methods
+* Automatic rate-limiting
+
+For examples, see `/bin` in the git repo.
+"""
+depends: [
+ "ocaml" {>= "4.04.1"}
+ "dune" {build & >= "1.3.0"}
+ "async_ssl" {>= "v0.11.0"}
+ "cohttp-async" {>= "1.2.0"}
+ "core" {>= "v0.11.3"}
+ "decompress" {<= "0.8.1"}
+ "odoc" {with-doc & >= "1.3.0"}
+ "ppx_deriving_yojson" {>= "3.3"}
+ "ppx_sexp_conv" {>= "v0.11.2"}
+ "websocket-async" {>= "2.12"}
+ "yojson" {>= "1.6.0"}
+ "bitmasks" {>= "1.1.0"}
+]
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+ ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc}
] \ No newline at end of file
diff --git a/dune-project b/dune-project
index 67d26c0..6c44d05 100644
--- a/dune-project
+++ b/dune-project
@@ -1,2 +1,2 @@
(lang dune 1.3)
-(name disml)
+(name disml) \ No newline at end of file
diff --git a/lib/http/http.ml b/lib/http/http.ml
index 9feb652..3bcf04e 100644
--- a/lib/http/http.ml
+++ b/lib/http/http.ml
@@ -9,20 +9,32 @@ module Base = struct
let base_url = "https://discordapp.com/api/v7"
+ let multipart_boundary = "2a8ae6ad-f4ad-4d9a-a92c-6d217011fe0f"
+
let process_url path =
Uri.of_string (base_url ^ path)
- let process_request_body body =
- body
- |> Yojson.Safe.to_string
- |> Cohttp_async.Body.of_string
-
- let process_request_headers () =
+ let process_request_body ?(files=[]) body =
+ let json = body |> Yojson.Safe.to_string in begin
+ if List.is_empty files then
+ json
+ else
+ let boundary = "--" ^ multipart_boundary in
+ let add_file (acc, idx) (filename, file_contents) =
+ Printf.sprintf "%s\nContent-Disposition: form-data; name=\"file%i\"; filename=\"%s\"\n\n%s\n%s"
+ acc idx filename file_contents boundary, idx + 1
+ in
+ let file_data, _ = List.fold files ~init:("", 1) ~f:add_file in
+ Printf.sprintf "%s\nContent-Disposition: form-data; name=\"payload_json\"\n\n%s\n%s%s--"
+ boundary json boundary file_data
+ end |> Cohttp_async.Body.of_string
+
+ let process_request_headers ?(multipart=false) () =
let h = Header.init () in
Header.add_list h
- [ "User-Agent", "DiscordBot (https://gitlab.com/Mishio595/disml, v0.2.3)"
+ [ "User-Agent", "DiscordBot (https://gitlab.com/Mishio595/disml, v0.2.5)"
; "Authorization", ("Bot " ^ !Client_options.token)
- ; "Content-Type", "application/json"
+ ; "Content-Type", if multipart then "multipart/form-data; boundary=" ^ multipart_boundary else "application/json"
; "Connection", "keep-alive"
]
@@ -41,14 +53,14 @@ module Base = struct
Logs.warn (fun m -> m "[Unsuccessful Response] [Code: %d]\n%s\n%s" code body headers);
Deferred.Or_error.errorf "Unsuccessful response received: %d - %s" code body
- let request ?(body=`Null) ?(query=[]) m path =
+ let request ?(files=[]) ?(body=`Null) ?(query=[]) m path =
let limit, rlm = Rl.get_rl m path !rl in
rl := rlm;
Mvar.take limit >>= fun limit ->
let process () =
let uri = Uri.add_query_params' (process_url path) query in
- let headers = process_request_headers () in
- let body = process_request_body body in
+ let headers = process_request_headers ~multipart:(not (List.is_empty files)) () in
+ let body = process_request_body ~files:files body in
(match m with
| `Delete -> Cohttp_async.Client.delete ~headers ~body uri
| `Get -> Cohttp_async.Client.get ~headers uri
@@ -85,8 +97,8 @@ let get_messages channel_id limit (kind, id) =
let get_message channel_id message_id =
Base.request `Get (Endpoints.channel_message channel_id message_id) >>| Result.map ~f:Message_t.of_yojson_exn
-let create_message channel_id body =
- Base.request ~body:body `Post (Endpoints.channel_messages channel_id) >>| Result.map ~f:Message_t.of_yojson_exn
+let create_message ?(files=[]) channel_id body =
+ Base.request ~files ~body:body `Post (Endpoints.channel_messages channel_id) >>| Result.map ~f:Message_t.of_yojson_exn
let create_reaction channel_id message_id emoji =
Base.request `Put (Endpoints.channel_reaction_me channel_id message_id emoji) >>| Result.map ~f:ignore
diff --git a/lib/http/http.mli b/lib/http/http.mli
index b043854..3468272 100644
--- a/lib/http/http.mli
+++ b/lib/http/http.mli
@@ -6,8 +6,11 @@ module Base : sig
val base_url : string
val process_url : string -> Uri.t
- val process_request_body : Yojson.Safe.t -> Cohttp_async.Body.t
- val process_request_headers : unit -> Cohttp.Header.t
+ val process_request_body :
+ ?files:(string * string) list ->
+ Yojson.Safe.t ->
+ Cohttp_async.Body.t
+ val process_request_headers : ?multipart:bool -> unit -> Cohttp.Header.t
val process_response :
string ->
@@ -15,6 +18,7 @@ module Base : sig
Yojson.Safe.t Deferred.Or_error.t
val request :
+ ?files:(string * string) list ->
?body:Yojson.Safe.t ->
?query:(string * string) list ->
[ `Delete | `Get | `Patch | `Post | `Put ] ->
@@ -31,7 +35,7 @@ val delete_channel : int -> Channel_t.t Deferred.Or_error.t
val get_messages : int -> int -> string * int -> Message_t.t list Deferred.Or_error.t
val get_message : int -> int -> Message_t.t Deferred.Or_error.t
val create_message :
- int -> Yojson.Safe.t -> Message_t.t Deferred.Or_error.t
+ ?files:(string * string) list -> int -> Yojson.Safe.t -> Message_t.t Deferred.Or_error.t
val create_reaction :
int -> int -> string -> unit Deferred.Or_error.t
val delete_own_reaction :
diff --git a/lib/models/channel/message/message.ml b/lib/models/channel/message/message.ml
index 41174e1..38c9242 100644
--- a/lib/models/channel/message/message.ml
+++ b/lib/models/channel/message/message.ml
@@ -50,8 +50,8 @@ let unpin msg =
let reply msg content =
Channel_id.say content msg.channel_id
-let reply_with ?embed ?content ?file ?tts msg =
- Channel_id.send_message ?embed ?content ?file ?tts msg.channel_id
+let reply_with ?embed ?content ?files ?tts msg =
+ Channel_id.send_message ?embed ?content ?files ?tts msg.channel_id
let set_content msg cont =
let `Message_id id = msg.id in
diff --git a/lib/models/channel/message/message.mli b/lib/models/channel/message/message.mli
index 0eba3af..e0a789a 100644
--- a/lib/models/channel/message/message.mli
+++ b/lib/models/channel/message/message.mli
@@ -23,11 +23,11 @@ val unpin : t -> unit Deferred.Or_error.t
(** Sugar for [Channel_id.say msg.channel_id content]. *)
val reply : t -> string -> t Deferred.Or_error.t
-(** Sugar for [Channel_id.send_message ?embed ?content ?file ?tts msg.channel_id]. *)
+(** Sugar for [Channel_id.send_message ?embed ?content ?files ?tts msg.channel_id]. *)
val reply_with :
?embed:Embed.t ->
?content:string ->
- ?file:string ->
+ ?files:(string * string) list ->
?tts:bool ->
t ->
Message_t.t Deferred.Or_error.t
diff --git a/lib/models/id/channel_id.ml b/lib/models/id/channel_id.ml
index 1017ad1..1aa3fbb 100644
--- a/lib/models/id/channel_id.ml
+++ b/lib/models/id/channel_id.ml
@@ -4,23 +4,19 @@ include Channel_id_t
exception Invalid_message
exception No_message_found
-let send_message ?embed ?content ?file ?(tts=false) ch =
+let send_message ?embed ?content ?files ?(tts=false) ch =
let embed = match embed with
| Some e -> Embed.to_yojson e
| None -> `Null in
let content = match content with
| Some c -> `String c
| None -> `Null in
- let file = match file with
- | Some f -> `String f
- | None -> `Null in
let () = match embed, content with
| `Null, `Null -> raise Invalid_message
| _ -> () in
- Http.create_message (get_id ch) (`Assoc [
+ Http.create_message ?files (get_id ch) (`Assoc [
("embed", embed);
("content", content);
- ("file", file);
("tts", `Bool tts);
])
diff --git a/lib/models/id/channel_id.mli b/lib/models/id/channel_id.mli
index 74010a5..a05d282 100644
--- a/lib/models/id/channel_id.mli
+++ b/lib/models/id/channel_id.mli
@@ -24,7 +24,7 @@ Client.message_create := check_command
val send_message :
?embed:Embed.t ->
?content:string ->
- ?file:string ->
+ ?files:(string * string) list ->
?tts:bool ->
t ->
Message_t.t Deferred.Or_error.t
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-11 01:20:20 +0000