Fixed sending file attachments by adding multiform support

6 files changed, 39 insertions, 27 deletions

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