blob: 44e41d177337410a60a12b12c23a76b0c328e6bf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Discord.Internal.Rest.Interactions (InteractionResponseRequest(..)) where
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy as BL
import Discord.Internal.Rest.Prelude
( RestIO,
Request(..),
JsonRequest(Delete, Post, Get, Patch),
baseUrl)
import Discord.Internal.Types
import Discord.Internal.Types.Interactions
import Network.HTTP.Client.MultipartFormData (PartM, partBS)
import Network.HTTP.Req ((/:), (/~))
import qualified Network.HTTP.Req as R
-- | Data constructor for Interaction response requests
data InteractionResponseRequest a where
-- | Create a response to an Interaction from the gateway.
--
-- This endpoint also supports file attachments similar to the webhook endpoints.
-- Refer to [Uploading files](https://discord.com/developers/docs/reference#uploading-files)
-- for details on uploading files and @multipart/form-data@ requests.
CreateInteractionResponse :: InteractionId -> InteractionToken -> InteractionResponse -> InteractionResponseRequest ()
-- | Returns the initial Interaction response.
GetOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest Message
-- | Edits the initial Interaction response.
EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message
-- | Deletes the initial Interaction response.
DeleteOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest ()
-- | Create a followup message for an Interaction
CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message
-- | Returns a followup message for an Interaction.
GetFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest Message
-- | Edits a followup message for an Interaction.
EditFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponse -> InteractionResponseRequest Message
-- | Deletes a followup message for an Interaction.
DeleteFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest ()
instance Request (InteractionResponseRequest a) where
jsonRequest = interactionResponseJsonRequest
majorRoute = interactionResponseMajorRoute
interactionResponseMajorRoute :: InteractionResponseRequest a -> String
interactionResponseMajorRoute a = case a of
(CreateInteractionResponse iid _ _) -> "intresp " <> show iid
(GetOriginalInteractionResponse aid _) -> "intresp " <> show aid
(EditOriginalInteractionResponse aid _ _) -> "intresp " <> show aid
(DeleteOriginalInteractionResponse aid _) -> "intresp " <> show aid
(CreateFollowupInteractionMessage iid _ _) -> "intrespf " <> show iid
(GetFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid
(EditFollowupInteractionMessage aid _ _ _) -> "intrespf " <> show aid
(DeleteFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid
interaction :: ApplicationId -> InteractionToken -> R.Url 'R.Https
interaction aid it = baseUrl /: "webhooks" /~ aid /~ it /: "messages"
interactionResponseJsonRequest :: InteractionResponseRequest a -> JsonRequest
interactionResponseJsonRequest a = case a of
(CreateInteractionResponse iid it i) ->
Post (baseUrl /: "interactions" /~ iid /~ it /: "callback") (convert i) mempty
(GetOriginalInteractionResponse aid it) ->
Get (interaction aid it /: "@original") mempty
(EditOriginalInteractionResponse aid it i) ->
Patch (interaction aid it /: "@original") (convertIRM i) mempty
(DeleteOriginalInteractionResponse aid it) ->
Delete (interaction aid it /: "@original") mempty
(CreateFollowupInteractionMessage aid it i) ->
Post (baseUrl /: "webhooks" /~ aid /~ it) (convertIRM i) mempty
(GetFollowupInteractionMessage aid it mid) ->
Get (interaction aid it /~ mid) mempty
(EditFollowupInteractionMessage aid it mid i) ->
Patch (interaction aid it /~ mid) (convert i) mempty
(DeleteFollowupInteractionMessage aid it mid) ->
Delete (interaction aid it /~ mid) mempty
where
convert :: InteractionResponse -> RestIO R.ReqBodyMultipart
convert ir@(InteractionResponseChannelMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)
convert ir@(InteractionResponseUpdateMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)
convert ir = R.reqBodyMultipart [partBS "payload_json" $ BL.toStrict $ encode ir]
convertIRM :: InteractionResponseMessage -> RestIO R.ReqBodyMultipart
convertIRM irm = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode irm) : convert' irm)
convert' :: InteractionResponseMessage -> [PartM IO]
convert' InteractionResponseMessage {..} = case interactionResponseMessageEmbeds of
Nothing -> []
Just f -> (maybeEmbed . Just) =<< f
|