use RequestBody for attachment content

simmsb · Jul 17, 2023 · 6a0efe0 · 6a0efe0
1 parent b7079e7
commit 6a0efe0
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 10 deletions.
diff --git a/calamity/Calamity/HTTP/Channel.hs b/calamity/Calamity/HTTP/Channel.hs
@@ -34,12 +34,12 @@ import Calamity.Types.Model.User
 import Calamity.Types.Snowflake
 import Data.Aeson qualified as Aeson
 import Data.Aeson.KeyMap qualified as K
-import Data.ByteString.Lazy (ByteString)
 import Data.Default.Class
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Word
+import Network.HTTP.Client (RequestBody)
 import Network.HTTP.Client.MultipartFormData
 import Network.HTTP.Req
 import Network.Mime
@@ -49,9 +49,17 @@ import TextShow
 data CreateMessageAttachment = CreateMessageAttachment
   { filename :: Text
   , description :: Maybe Text
-  , content :: ByteString
+  , content :: RequestBody
   }
-  deriving (Show)
+
+instance Show CreateMessageAttachment where
+  show (CreateMessageAttachment filename description _) = mconcat
+    [ "CreateMessageAttachment {filename = "
+    , show filename
+    , ", description = "
+    , show description
+    , ", content = <body>}"
+    ]
 
 data CreateMessageOptions = CreateMessageOptions
   { content :: Maybe Text
@@ -418,7 +426,7 @@ instance Request (ChannelRequest a) where
       & buildRoute
   action (CreateMessage _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }

diff --git a/calamity/Calamity/HTTP/Interaction.hs b/calamity/Calamity/HTTP/Interaction.hs
@@ -324,7 +324,7 @@ instance Request (InteractionRequest a) where
      in postWith' (ReqBodyJson jsonBody)
   action (CreateResponseMessage _ _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }
@@ -354,7 +354,7 @@ instance Request (InteractionRequest a) where
     postWith' body u o
   action (CreateResponseUpdate _ _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }
@@ -399,7 +399,7 @@ instance Request (InteractionRequest a) where
   action (GetOriginalInteractionResponse _ _) = getWith
   action (EditOriginalInteractionResponse _ _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }
@@ -430,7 +430,7 @@ instance Request (InteractionRequest a) where
   action (DeleteOriginalInteractionResponse _ _) = deleteWith
   action (CreateFollowupMessage _ _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }
@@ -456,7 +456,7 @@ instance Request (InteractionRequest a) where
   action GetFollowupMessage {} = getWith
   action (EditFollowupMessage _ _ _ cm) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }

diff --git a/calamity/Calamity/HTTP/Webhook.hs b/calamity/Calamity/HTTP/Webhook.hs
@@ -183,7 +183,7 @@ instance Request (WebhookRequest a) where
   action (DeleteWebhookToken _ _) = deleteWith
   action (ExecuteWebhook _ _ wh) = \u o -> do
     let filePart CreateMessageAttachment {filename, content} n =
-          (partLBS @IO (T.pack $ "files[" <> show n <> "]") content)
+          (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
             { partFilename = Just (T.unpack filename)
             , partContentType = Just (defaultMimeLookup filename)
             }