{-# LANGUAGE TemplateHaskell #-}

-- | Interaction endpoints
module Calamity.HTTP.Interaction (
  InteractionRequest (..),
  InteractionCallbackMessageOptions (..),
  InteractionCallbackAutocomplete (..),
  InteractionCallbackAutocompleteChoice (..),
  InteractionCallbackModal (..),
) where

import Calamity.HTTP.Channel (AllowedMentions, CreateMessageAttachment (..))
import Calamity.HTTP.Internal.Request
import Calamity.HTTP.Internal.Route
import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=))
import Calamity.Types.Model.Channel.Component (Component, CustomID)
import Calamity.Types.Model.Channel.Embed (Embed)
import Calamity.Types.Model.Channel.Message (Message)
import Calamity.Types.Model.Interaction
import Calamity.Types.Snowflake
import qualified Data.Aeson as Aeson
import Data.Bits (shiftL, (.|.))
import Data.Default.Class
import qualified Data.HashMap.Strict as H
import Data.Maybe (fromMaybe)
import Data.Monoid (First (First, getFirst))
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Client.MultipartFormData
import Network.HTTP.Req
import Network.Mime
import Optics
import PyF

data InteractionCallback = InteractionCallback
  { InteractionCallback -> InteractionCallbackType
type_ :: InteractionCallbackType
  , InteractionCallback -> Maybe Value
data_ :: Maybe Aeson.Value
  }
  deriving (Int -> InteractionCallback -> ShowS
[InteractionCallback] -> ShowS
InteractionCallback -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallback] -> ShowS
$cshowList :: [InteractionCallback] -> ShowS
show :: InteractionCallback -> String
$cshow :: InteractionCallback -> String
showsPrec :: Int -> InteractionCallback -> ShowS
$cshowsPrec :: Int -> InteractionCallback -> ShowS
Show)
  deriving ([InteractionCallback] -> Encoding
[InteractionCallback] -> Value
InteractionCallback -> Encoding
InteractionCallback -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InteractionCallback] -> Encoding
$ctoEncodingList :: [InteractionCallback] -> Encoding
toJSONList :: [InteractionCallback] -> Value
$ctoJSONList :: [InteractionCallback] -> Value
toEncoding :: InteractionCallback -> Encoding
$ctoEncoding :: InteractionCallback -> Encoding
toJSON :: InteractionCallback -> Value
$ctoJSON :: InteractionCallback -> Value
Aeson.ToJSON) via CalamityToJSON InteractionCallback

instance CalamityToJSON' InteractionCallback where
  toPairs :: forall kv. KeyValue kv => InteractionCallback -> [Maybe kv]
toPairs InteractionCallback {Maybe Value
InteractionCallbackType
data_ :: Maybe Value
type_ :: InteractionCallbackType
$sel:data_:InteractionCallback :: InteractionCallback -> Maybe Value
$sel:type_:InteractionCallback :: InteractionCallback -> InteractionCallbackType
..} =
    [ Key
"type" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= InteractionCallbackType
type_
    , Key
"data" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Value
data_
    ]

data InteractionCallbackMessageOptions = InteractionCallbackMessageOptions
  { InteractionCallbackMessageOptions -> Maybe Bool
tts :: Maybe Bool
  , InteractionCallbackMessageOptions -> Maybe Text
content :: Maybe Text
  , InteractionCallbackMessageOptions -> Maybe [Embed]
embeds :: Maybe [Embed]
  , InteractionCallbackMessageOptions -> Maybe AllowedMentions
allowedMentions :: Maybe AllowedMentions
  , InteractionCallbackMessageOptions -> Maybe Bool
ephemeral :: Maybe Bool
  , InteractionCallbackMessageOptions -> Maybe Bool
suppressEmbeds :: Maybe Bool
  , InteractionCallbackMessageOptions -> Maybe [Component]
components :: Maybe [Component]
  , InteractionCallbackMessageOptions
-> Maybe [CreateMessageAttachment]
attachments :: Maybe [CreateMessageAttachment]
  }
  deriving (Int -> InteractionCallbackMessageOptions -> ShowS
[InteractionCallbackMessageOptions] -> ShowS
InteractionCallbackMessageOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackMessageOptions] -> ShowS
$cshowList :: [InteractionCallbackMessageOptions] -> ShowS
show :: InteractionCallbackMessageOptions -> String
$cshow :: InteractionCallbackMessageOptions -> String
showsPrec :: Int -> InteractionCallbackMessageOptions -> ShowS
$cshowsPrec :: Int -> InteractionCallbackMessageOptions -> ShowS
Show)

instance Default InteractionCallbackMessageOptions where
  def :: InteractionCallbackMessageOptions
def = Maybe Bool
-> Maybe Text
-> Maybe [Embed]
-> Maybe AllowedMentions
-> Maybe Bool
-> Maybe Bool
-> Maybe [Component]
-> Maybe [CreateMessageAttachment]
-> InteractionCallbackMessageOptions
InteractionCallbackMessageOptions forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

data CreateMessageAttachmentJson = CreateMessageAttachmentJson
  { CreateMessageAttachmentJson -> Int
id :: Int
  , CreateMessageAttachmentJson -> Text
filename :: Text
  , CreateMessageAttachmentJson -> Maybe Text
description :: Maybe Text
  }
  deriving (Int -> CreateMessageAttachmentJson -> ShowS
[CreateMessageAttachmentJson] -> ShowS
CreateMessageAttachmentJson -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMessageAttachmentJson] -> ShowS
$cshowList :: [CreateMessageAttachmentJson] -> ShowS
show :: CreateMessageAttachmentJson -> String
$cshow :: CreateMessageAttachmentJson -> String
showsPrec :: Int -> CreateMessageAttachmentJson -> ShowS
$cshowsPrec :: Int -> CreateMessageAttachmentJson -> ShowS
Show)
  deriving ([CreateMessageAttachmentJson] -> Encoding
[CreateMessageAttachmentJson] -> Value
CreateMessageAttachmentJson -> Encoding
CreateMessageAttachmentJson -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateMessageAttachmentJson] -> Encoding
$ctoEncodingList :: [CreateMessageAttachmentJson] -> Encoding
toJSONList :: [CreateMessageAttachmentJson] -> Value
$ctoJSONList :: [CreateMessageAttachmentJson] -> Value
toEncoding :: CreateMessageAttachmentJson -> Encoding
$ctoEncoding :: CreateMessageAttachmentJson -> Encoding
toJSON :: CreateMessageAttachmentJson -> Value
$ctoJSON :: CreateMessageAttachmentJson -> Value
Aeson.ToJSON) via CalamityToJSON CreateMessageAttachmentJson

instance CalamityToJSON' CreateMessageAttachmentJson where
  toPairs :: forall kv. KeyValue kv => CreateMessageAttachmentJson -> [Maybe kv]
toPairs CreateMessageAttachmentJson {Int
Maybe Text
Text
description :: Maybe Text
filename :: Text
id :: Int
$sel:description:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Maybe Text
$sel:filename:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Text
$sel:id:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Int
..} =
    [ Key
"id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Int
id
    , Key
"filename" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
filename
    , Key
"description" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
description
    ]

data CreateResponseMessageJson = CreateResponseMessageJson
  { CreateResponseMessageJson -> Maybe Bool
tts :: Maybe Bool
  , CreateResponseMessageJson -> Maybe Text
content :: Maybe Text
  , CreateResponseMessageJson -> Maybe [Embed]
embeds :: Maybe [Embed]
  , CreateResponseMessageJson -> Maybe AllowedMentions
allowedMentions :: Maybe AllowedMentions
  , CreateResponseMessageJson -> Maybe Int
flags :: Maybe Int
  , CreateResponseMessageJson -> Maybe [Component]
components :: Maybe [Component]
  , CreateResponseMessageJson -> Maybe [CreateMessageAttachmentJson]
attachments :: Maybe [CreateMessageAttachmentJson]
  }
  deriving (Int -> CreateResponseMessageJson -> ShowS
[CreateResponseMessageJson] -> ShowS
CreateResponseMessageJson -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResponseMessageJson] -> ShowS
$cshowList :: [CreateResponseMessageJson] -> ShowS
show :: CreateResponseMessageJson -> String
$cshow :: CreateResponseMessageJson -> String
showsPrec :: Int -> CreateResponseMessageJson -> ShowS
$cshowsPrec :: Int -> CreateResponseMessageJson -> ShowS
Show)
  deriving ([CreateResponseMessageJson] -> Encoding
[CreateResponseMessageJson] -> Value
CreateResponseMessageJson -> Encoding
CreateResponseMessageJson -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateResponseMessageJson] -> Encoding
$ctoEncodingList :: [CreateResponseMessageJson] -> Encoding
toJSONList :: [CreateResponseMessageJson] -> Value
$ctoJSONList :: [CreateResponseMessageJson] -> Value
toEncoding :: CreateResponseMessageJson -> Encoding
$ctoEncoding :: CreateResponseMessageJson -> Encoding
toJSON :: CreateResponseMessageJson -> Value
$ctoJSON :: CreateResponseMessageJson -> Value
Aeson.ToJSON) via CalamityToJSON CreateResponseMessageJson

instance CalamityToJSON' CreateResponseMessageJson where
  toPairs :: forall kv. KeyValue kv => CreateResponseMessageJson -> [Maybe kv]
toPairs CreateResponseMessageJson {Maybe Bool
Maybe Int
Maybe [Embed]
Maybe [Component]
Maybe [CreateMessageAttachmentJson]
Maybe Text
Maybe AllowedMentions
attachments :: Maybe [CreateMessageAttachmentJson]
components :: Maybe [Component]
flags :: Maybe Int
allowedMentions :: Maybe AllowedMentions
embeds :: Maybe [Embed]
content :: Maybe Text
tts :: Maybe Bool
$sel:attachments:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe [CreateMessageAttachmentJson]
$sel:components:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe [Component]
$sel:flags:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe Int
$sel:allowedMentions:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe AllowedMentions
$sel:embeds:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe [Embed]
$sel:content:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe Text
$sel:tts:CreateResponseMessageJson :: CreateResponseMessageJson -> Maybe Bool
..} =
    [ Key
"tts" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Bool
tts
    , Key
"content" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
content
    , Key
"embeds" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe [Embed]
embeds
    , Key
"allowed_mentions" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe AllowedMentions
allowedMentions
    , Key
"flags" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Int
flags
    , Key
"components" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe [Component]
components
    , Key
"attachments" forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe [CreateMessageAttachmentJson]
attachments
    ]

newtype InteractionCallbackAutocomplete = InteractionCallbackAutocomplete
  { InteractionCallbackAutocomplete
-> [InteractionCallbackAutocompleteChoice]
choices :: [InteractionCallbackAutocompleteChoice]
  }
  deriving stock (Int -> InteractionCallbackAutocomplete -> ShowS
[InteractionCallbackAutocomplete] -> ShowS
InteractionCallbackAutocomplete -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackAutocomplete] -> ShowS
$cshowList :: [InteractionCallbackAutocomplete] -> ShowS
show :: InteractionCallbackAutocomplete -> String
$cshow :: InteractionCallbackAutocomplete -> String
showsPrec :: Int -> InteractionCallbackAutocomplete -> ShowS
$cshowsPrec :: Int -> InteractionCallbackAutocomplete -> ShowS
Show)
  deriving ([InteractionCallbackAutocomplete] -> Encoding
[InteractionCallbackAutocomplete] -> Value
InteractionCallbackAutocomplete -> Encoding
InteractionCallbackAutocomplete -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InteractionCallbackAutocomplete] -> Encoding
$ctoEncodingList :: [InteractionCallbackAutocomplete] -> Encoding
toJSONList :: [InteractionCallbackAutocomplete] -> Value
$ctoJSONList :: [InteractionCallbackAutocomplete] -> Value
toEncoding :: InteractionCallbackAutocomplete -> Encoding
$ctoEncoding :: InteractionCallbackAutocomplete -> Encoding
toJSON :: InteractionCallbackAutocomplete -> Value
$ctoJSON :: InteractionCallbackAutocomplete -> Value
Aeson.ToJSON) via CalamityToJSON InteractionCallbackAutocomplete

instance CalamityToJSON' InteractionCallbackAutocomplete where
  toPairs :: forall kv.
KeyValue kv =>
InteractionCallbackAutocomplete -> [Maybe kv]
toPairs InteractionCallbackAutocomplete {[InteractionCallbackAutocompleteChoice]
choices :: [InteractionCallbackAutocompleteChoice]
$sel:choices:InteractionCallbackAutocomplete :: InteractionCallbackAutocomplete
-> [InteractionCallbackAutocompleteChoice]
..} = [Key
"choices" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= [InteractionCallbackAutocompleteChoice]
choices]

data InteractionCallbackAutocompleteChoice = InteractionCallbackAutocompleteChoice
  { InteractionCallbackAutocompleteChoice -> Text
name :: Text
  , InteractionCallbackAutocompleteChoice -> HashMap Text Text
nameLocalizations :: H.HashMap Text Text
  , -- | Either text or numeric
    InteractionCallbackAutocompleteChoice -> Value
value :: Aeson.Value
  }
  deriving stock (Int -> InteractionCallbackAutocompleteChoice -> ShowS
[InteractionCallbackAutocompleteChoice] -> ShowS
InteractionCallbackAutocompleteChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackAutocompleteChoice] -> ShowS
$cshowList :: [InteractionCallbackAutocompleteChoice] -> ShowS
show :: InteractionCallbackAutocompleteChoice -> String
$cshow :: InteractionCallbackAutocompleteChoice -> String
showsPrec :: Int -> InteractionCallbackAutocompleteChoice -> ShowS
$cshowsPrec :: Int -> InteractionCallbackAutocompleteChoice -> ShowS
Show)
  deriving ([InteractionCallbackAutocompleteChoice] -> Encoding
[InteractionCallbackAutocompleteChoice] -> Value
InteractionCallbackAutocompleteChoice -> Encoding
InteractionCallbackAutocompleteChoice -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InteractionCallbackAutocompleteChoice] -> Encoding
$ctoEncodingList :: [InteractionCallbackAutocompleteChoice] -> Encoding
toJSONList :: [InteractionCallbackAutocompleteChoice] -> Value
$ctoJSONList :: [InteractionCallbackAutocompleteChoice] -> Value
toEncoding :: InteractionCallbackAutocompleteChoice -> Encoding
$ctoEncoding :: InteractionCallbackAutocompleteChoice -> Encoding
toJSON :: InteractionCallbackAutocompleteChoice -> Value
$ctoJSON :: InteractionCallbackAutocompleteChoice -> Value
Aeson.ToJSON) via CalamityToJSON InteractionCallbackAutocompleteChoice

instance CalamityToJSON' InteractionCallbackAutocompleteChoice where
  toPairs :: forall kv.
KeyValue kv =>
InteractionCallbackAutocompleteChoice -> [Maybe kv]
toPairs InteractionCallbackAutocompleteChoice {Text
HashMap Text Text
Value
value :: Value
nameLocalizations :: HashMap Text Text
name :: Text
$sel:value:InteractionCallbackAutocompleteChoice :: InteractionCallbackAutocompleteChoice -> Value
$sel:nameLocalizations:InteractionCallbackAutocompleteChoice :: InteractionCallbackAutocompleteChoice -> HashMap Text Text
$sel:name:InteractionCallbackAutocompleteChoice :: InteractionCallbackAutocompleteChoice -> Text
..} =
    [ Key
"name" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
name
    , Key
"name_localizations" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= HashMap Text Text
nameLocalizations
    , Key
"value" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Value
value
    ]

data InteractionCallbackModal = InteractionCallbackModal
  { InteractionCallbackModal -> CustomID
customID :: CustomID
  , InteractionCallbackModal -> Text
title :: Text
  , InteractionCallbackModal -> [Component]
components :: [Component]
  }
  deriving stock (Int -> InteractionCallbackModal -> ShowS
[InteractionCallbackModal] -> ShowS
InteractionCallbackModal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackModal] -> ShowS
$cshowList :: [InteractionCallbackModal] -> ShowS
show :: InteractionCallbackModal -> String
$cshow :: InteractionCallbackModal -> String
showsPrec :: Int -> InteractionCallbackModal -> ShowS
$cshowsPrec :: Int -> InteractionCallbackModal -> ShowS
Show)
  deriving ([InteractionCallbackModal] -> Encoding
[InteractionCallbackModal] -> Value
InteractionCallbackModal -> Encoding
InteractionCallbackModal -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InteractionCallbackModal] -> Encoding
$ctoEncodingList :: [InteractionCallbackModal] -> Encoding
toJSONList :: [InteractionCallbackModal] -> Value
$ctoJSONList :: [InteractionCallbackModal] -> Value
toEncoding :: InteractionCallbackModal -> Encoding
$ctoEncoding :: InteractionCallbackModal -> Encoding
toJSON :: InteractionCallbackModal -> Value
$ctoJSON :: InteractionCallbackModal -> Value
Aeson.ToJSON) via CalamityToJSON InteractionCallbackModal

instance CalamityToJSON' InteractionCallbackModal where
  toPairs :: forall kv. KeyValue kv => InteractionCallbackModal -> [Maybe kv]
toPairs InteractionCallbackModal {[Component]
Text
CustomID
components :: [Component]
title :: Text
customID :: CustomID
$sel:components:InteractionCallbackModal :: InteractionCallbackModal -> [Component]
$sel:title:InteractionCallbackModal :: InteractionCallbackModal -> Text
$sel:customID:InteractionCallbackModal :: InteractionCallbackModal -> CustomID
..} =
    [ Key
"custom_id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= CustomID
customID
    , Key
"title" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
title
    , Key
"components" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= [Component]
components
    ]

data InteractionCallbackType
  = PongType
  | ChannelMessageWithSourceType
  | DeferredChannelMessageWithSourceType
  | DeferredUpdateMessageType
  | UpdateMessageType
  | ApplicationCommandAutocompleteResultType
  | ModalType
  deriving (Int -> InteractionCallbackType -> ShowS
[InteractionCallbackType] -> ShowS
InteractionCallbackType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackType] -> ShowS
$cshowList :: [InteractionCallbackType] -> ShowS
show :: InteractionCallbackType -> String
$cshow :: InteractionCallbackType -> String
showsPrec :: Int -> InteractionCallbackType -> ShowS
$cshowsPrec :: Int -> InteractionCallbackType -> ShowS
Show)

instance Aeson.ToJSON InteractionCallbackType where
  toJSON :: InteractionCallbackType -> Value
toJSON InteractionCallbackType
ty = forall a. ToJSON a => a -> Value
Aeson.toJSON @Int forall a b. (a -> b) -> a -> b
$ case InteractionCallbackType
ty of
    InteractionCallbackType
PongType -> Int
1
    InteractionCallbackType
ChannelMessageWithSourceType -> Int
4
    InteractionCallbackType
DeferredChannelMessageWithSourceType -> Int
5
    InteractionCallbackType
DeferredUpdateMessageType -> Int
6
    InteractionCallbackType
UpdateMessageType -> Int
7
    InteractionCallbackType
ApplicationCommandAutocompleteResultType -> Int
8
    InteractionCallbackType
ModalType -> Int
9
  toEncoding :: InteractionCallbackType -> Encoding
toEncoding InteractionCallbackType
ty = forall a. ToJSON a => a -> Encoding
Aeson.toEncoding @Int forall a b. (a -> b) -> a -> b
$ case InteractionCallbackType
ty of
    InteractionCallbackType
PongType -> Int
1
    InteractionCallbackType
ChannelMessageWithSourceType -> Int
4
    InteractionCallbackType
DeferredChannelMessageWithSourceType -> Int
5
    InteractionCallbackType
DeferredUpdateMessageType -> Int
6
    InteractionCallbackType
UpdateMessageType -> Int
7
    InteractionCallbackType
ApplicationCommandAutocompleteResultType -> Int
8
    InteractionCallbackType
ModalType -> Int
9

$(makeFieldLabelsNoPrefix ''InteractionCallbackMessageOptions)
$(makeFieldLabelsNoPrefix ''InteractionCallbackAutocomplete)
$(makeFieldLabelsNoPrefix ''InteractionCallbackAutocompleteChoice)
$(makeFieldLabelsNoPrefix ''InteractionCallbackModal)

data InteractionRequest a where
  CreateResponseMessage ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    InteractionCallbackMessageOptions ->
    InteractionRequest ()
  -- | Ack an interaction and defer the response
  --
  -- This route triggers the 'thinking' message
  CreateResponseDefer ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    -- | Ephemeral
    Bool ->
    InteractionRequest ()
  -- | Ack an interaction and defer the response
  --
  -- This route is only usable by component interactions, and doesn't trigger a
  -- 'thinking' message
  CreateResponseDeferComponent ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    InteractionRequest ()
  CreateResponseUpdate ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    InteractionCallbackMessageOptions ->
    InteractionRequest ()
  CreateResponseAutocomplete ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    InteractionCallbackAutocomplete ->
    InteractionRequest ()
  CreateResponseModal ::
    (HasID Interaction i) =>
    i ->
    InteractionToken ->
    InteractionCallbackModal ->
    InteractionRequest ()
  GetOriginalInteractionResponse ::
    (HasID Application i) =>
    i ->
    InteractionToken ->
    InteractionRequest Message
  EditOriginalInteractionResponse ::
    (HasID Application i) =>
    i ->
    InteractionToken ->
    InteractionCallbackMessageOptions ->
    InteractionRequest Message
  DeleteOriginalInteractionResponse ::
    (HasID Application i) =>
    i ->
    InteractionToken ->
    InteractionRequest ()
  CreateFollowupMessage ::
    (HasID Application i) =>
    i ->
    InteractionToken ->
    InteractionCallbackMessageOptions ->
    InteractionRequest ()
  GetFollowupMessage ::
    (HasID Application i, HasID Message m) =>
    i ->
    m ->
    InteractionToken ->
    InteractionRequest Message
  EditFollowupMessage ::
    (HasID Application i, HasID Message m) =>
    i ->
    m ->
    InteractionToken ->
    InteractionCallbackMessageOptions ->
    InteractionRequest ()
  DeleteFollowupMessage ::
    (HasID Application i, HasID Message m) =>
    i ->
    m ->
    InteractionToken ->
    InteractionRequest ()

baseRoute :: Snowflake Application -> InteractionToken -> RouteBuilder _
baseRoute :: Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application,
           AddRequiredInner (Lookup ('IDRequirement Application) '[]))]
baseRoute Snowflake Application
id (InteractionToken Text
token) =
  RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"webhooks" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Application forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token
    forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Application
id

foo :: Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo :: forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo (Just a
x) (Just a
y) a -> a -> a
f = forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y)
foo Maybe a
x Maybe a
y a -> a -> a
_ = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> First a
First Maybe a
x forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> First a
First Maybe a
y

instance Request (InteractionRequest a) where
  type Result (InteractionRequest a) = a

  route :: InteractionRequest a -> Route
route (CreateResponseDefer (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token) Bool
_) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateResponseDeferComponent (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token)) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateResponseMessage (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token) InteractionCallbackMessageOptions
_) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateResponseUpdate (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token) InteractionCallbackMessageOptions
_) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateResponseAutocomplete (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token) InteractionCallbackAutocomplete
_) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateResponseModal (forall b a. HasID b a => a -> Snowflake b
getID @Interaction -> Snowflake Interaction
iid) (InteractionToken Text
token) InteractionCallbackModal
_) =
    RouteBuilder '[]
mkRouteBuilder forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"interactions" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Interaction forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"callback"
      forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Interaction
iid
      forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetOriginalInteractionResponse (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) InteractionToken
token) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@original" forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (EditOriginalInteractionResponse (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) InteractionToken
token InteractionCallbackMessageOptions
_) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@original" forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteOriginalInteractionResponse (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) InteractionToken
token) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@original" forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateFollowupMessage (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) InteractionToken
token InteractionCallbackMessageOptions
_) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetFollowupMessage (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) (forall b a. HasID b a => a -> Snowflake b
getID @Message -> Snowflake Message
mid) InteractionToken
token) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Message forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (EditFollowupMessage (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) (forall b a. HasID b a => a -> Snowflake b
getID @Message -> Snowflake Message
mid) InteractionToken
token InteractionCallbackMessageOptions
_) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Message forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteFollowupMessage (forall b a. HasID b a => a -> Snowflake b
getID @Application -> Snowflake Application
aid) (forall b a. HasID b a => a -> Snowflake b
getID @Message -> Snowflake Message
mid) InteractionToken
token) =
    Snowflake Application
-> InteractionToken
-> RouteBuilder
     '[ '( 'IDRequirement Application, 'Satisfied),
        '( 'IDRequirement Application, 'Required)]
baseRoute Snowflake Application
aid InteractionToken
token forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k} (a :: k). ID a
ID @Message forall a b. a -> (a -> b) -> b
& forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid forall a b. a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute

  action :: InteractionRequest a
-> Url 'Https -> Option 'Https -> Req LbsResponse
action (CreateResponseDefer i
_ InteractionToken
_ Bool
ephemeral) =
    let jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
DeferredChannelMessageWithSourceType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = if Bool
ephemeral then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$ [(Key
"flags", Scientific -> Value
Aeson.Number Scientific
64)] else forall a. Maybe a
Nothing
            }
     in forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall a. a -> ReqBodyJson a
ReqBodyJson InteractionCallback
jsonBody)
  action (CreateResponseDeferComponent i
_ InteractionToken
_) =
    let jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
DeferredUpdateMessageType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. Maybe a
Nothing
            }
     in forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall a. a -> ReqBodyJson a
ReqBodyJson InteractionCallback
jsonBody)
  action (CreateResponseMessage i
_ InteractionToken
_ InteractionCallbackMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename :: Text
filename, ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content :: ByteString
content} a
n =
          (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"files[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall a. a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description :: Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => CreateMessageAttachment -> a -> PartM IO
filePart (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments
        ephemeral :: Maybe Int
ephemeral = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ephemeral" a => a
#ephemeral
        suppressEmbeds :: Maybe Int
suppressEmbeds = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "suppressEmbeds" a => a
#suppressEmbeds
        flags :: Maybe Int
flags = forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo Maybe Int
ephemeral Maybe Int
suppressEmbeds forall a. Bits a => a -> a -> a
(.|.)
        jsonData :: CreateResponseMessageJson
jsonData =
          CreateResponseMessageJson
            { $sel:content:CreateResponseMessageJson :: Maybe Text
content = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "content" a => a
#content
            , $sel:tts:CreateResponseMessageJson :: Maybe Bool
tts = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateResponseMessageJson :: Maybe [Embed]
embeds = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateResponseMessageJson :: Maybe AllowedMentions
allowedMentions = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:components:CreateResponseMessageJson :: Maybe [Component]
components = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "components" a => a
#components
            , $sel:attachments:CreateResponseMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            , $sel:flags:CreateResponseMessageJson :: Maybe Int
flags = Maybe Int
flags
            }
        jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
ChannelMessageWithSourceType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ CreateResponseMessageJson
jsonData
            }
    ReqBodyMultipart
body <- forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall a. ToJSON a => a -> ByteString
Aeson.encode InteractionCallback
jsonBody) forall a. a -> [a] -> [a]
: [PartM IO]
files)
    forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action (CreateResponseUpdate i
_ InteractionToken
_ InteractionCallbackMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, ByteString
content :: ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content} a
n =
          (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"files[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall a. a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
description :: Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => CreateMessageAttachment -> a -> PartM IO
filePart (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments
        ephemeral :: Maybe Int
ephemeral = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ephemeral" a => a
#ephemeral
        suppressEmbeds :: Maybe Int
suppressEmbeds = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "suppressEmbeds" a => a
#suppressEmbeds
        flags :: Maybe Int
flags = forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo Maybe Int
ephemeral Maybe Int
suppressEmbeds forall a. Bits a => a -> a -> a
(.|.)
        jsonData :: CreateResponseMessageJson
jsonData =
          CreateResponseMessageJson
            { $sel:content:CreateResponseMessageJson :: Maybe Text
content = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "content" a => a
#content
            , $sel:tts:CreateResponseMessageJson :: Maybe Bool
tts = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateResponseMessageJson :: Maybe [Embed]
embeds = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateResponseMessageJson :: Maybe AllowedMentions
allowedMentions = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:components:CreateResponseMessageJson :: Maybe [Component]
components = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "components" a => a
#components
            , $sel:attachments:CreateResponseMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            , $sel:flags:CreateResponseMessageJson :: Maybe Int
flags = Maybe Int
flags
            }
        jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
UpdateMessageType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ CreateResponseMessageJson
jsonData
            }
    ReqBodyMultipart
body <- forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall a. ToJSON a => a -> ByteString
Aeson.encode InteractionCallback
jsonBody) forall a. a -> [a] -> [a]
: [PartM IO]
files)
    forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action (CreateResponseAutocomplete i
_ InteractionToken
_ InteractionCallbackAutocomplete
ao) =
    let jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
ApplicationCommandAutocompleteResultType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ InteractionCallbackAutocomplete
ao
            }
     in forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall a. a -> ReqBodyJson a
ReqBodyJson InteractionCallback
jsonBody)
  action (CreateResponseModal i
_ InteractionToken
_ InteractionCallbackModal
mo) =
    let jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
ModalType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ InteractionCallbackModal
mo
            }
     in forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall a. a -> ReqBodyJson a
ReqBodyJson InteractionCallback
jsonBody)
  action (GetOriginalInteractionResponse i
_ InteractionToken
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (EditOriginalInteractionResponse i
_ InteractionToken
_ InteractionCallbackMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, ByteString
content :: ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content} a
n =
          (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"files[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall a. a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
description :: Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => CreateMessageAttachment -> a -> PartM IO
filePart (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments
        ephemeral :: Maybe Int
ephemeral = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ephemeral" a => a
#ephemeral
        suppressEmbeds :: Maybe Int
suppressEmbeds = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "suppressEmbeds" a => a
#suppressEmbeds
        flags :: Maybe Int
flags = forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo Maybe Int
ephemeral Maybe Int
suppressEmbeds forall a. Bits a => a -> a -> a
(.|.)
        jsonData :: CreateResponseMessageJson
jsonData =
          CreateResponseMessageJson
            { $sel:content:CreateResponseMessageJson :: Maybe Text
content = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "content" a => a
#content
            , $sel:tts:CreateResponseMessageJson :: Maybe Bool
tts = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateResponseMessageJson :: Maybe [Embed]
embeds = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateResponseMessageJson :: Maybe AllowedMentions
allowedMentions = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:components:CreateResponseMessageJson :: Maybe [Component]
components = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "components" a => a
#components
            , $sel:attachments:CreateResponseMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            , $sel:flags:CreateResponseMessageJson :: Maybe Int
flags = Maybe Int
flags
            }
        jsonBody :: InteractionCallback
jsonBody =
          InteractionCallback
            { $sel:type_:InteractionCallback :: InteractionCallbackType
type_ = InteractionCallbackType
UpdateMessageType
            , $sel:data_:InteractionCallback :: Maybe Value
data_ = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ CreateResponseMessageJson
jsonData
            }
    ReqBodyMultipart
body <- forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall a. ToJSON a => a -> ByteString
Aeson.encode InteractionCallback
jsonBody) forall a. a -> [a] -> [a]
: [PartM IO]
files)
    forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
patchWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action (DeleteOriginalInteractionResponse i
_ InteractionToken
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (CreateFollowupMessage i
_ InteractionToken
_ InteractionCallbackMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, ByteString
content :: ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content} a
n =
          (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"files[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall a. a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
description :: Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => CreateMessageAttachment -> a -> PartM IO
filePart (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments
        ephemeral :: Maybe Int
ephemeral = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ephemeral" a => a
#ephemeral
        suppressEmbeds :: Maybe Int
suppressEmbeds = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "suppressEmbeds" a => a
#suppressEmbeds
        flags :: Maybe Int
flags = forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo Maybe Int
ephemeral Maybe Int
suppressEmbeds forall a. Bits a => a -> a -> a
(.|.)
        jsonData :: CreateResponseMessageJson
jsonData =
          CreateResponseMessageJson
            { $sel:content:CreateResponseMessageJson :: Maybe Text
content = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "content" a => a
#content
            , $sel:tts:CreateResponseMessageJson :: Maybe Bool
tts = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateResponseMessageJson :: Maybe [Embed]
embeds = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateResponseMessageJson :: Maybe AllowedMentions
allowedMentions = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:components:CreateResponseMessageJson :: Maybe [Component]
components = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "components" a => a
#components
            , $sel:attachments:CreateResponseMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            , $sel:flags:CreateResponseMessageJson :: Maybe Int
flags = Maybe Int
flags
            }
    ReqBodyMultipart
body <- forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall a. ToJSON a => a -> ByteString
Aeson.encode CreateResponseMessageJson
jsonData) forall a. a -> [a] -> [a]
: [PartM IO]
files)
    forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action GetFollowupMessage {} = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (EditFollowupMessage i
_ m
_ InteractionToken
_ InteractionCallbackMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, ByteString
content :: ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content} a
n =
          (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"files[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall a. a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
description :: Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => CreateMessageAttachment -> a -> PartM IO
filePart (forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "attachments" a => a
#attachments
        ephemeral :: Maybe Int
ephemeral = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ephemeral" a => a
#ephemeral
        suppressEmbeds :: Maybe Int
suppressEmbeds = (\Bool
f -> if Bool
f then Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 else Int
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "suppressEmbeds" a => a
#suppressEmbeds
        flags :: Maybe Int
flags = forall a. Maybe a -> Maybe a -> (a -> a -> a) -> Maybe a
foo Maybe Int
ephemeral Maybe Int
suppressEmbeds forall a. Bits a => a -> a -> a
(.|.)
        jsonData :: CreateResponseMessageJson
jsonData =
          CreateResponseMessageJson
            { $sel:content:CreateResponseMessageJson :: Maybe Text
content = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "content" a => a
#content
            , $sel:tts:CreateResponseMessageJson :: Maybe Bool
tts = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateResponseMessageJson :: Maybe [Embed]
embeds = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateResponseMessageJson :: Maybe AllowedMentions
allowedMentions = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:components:CreateResponseMessageJson :: Maybe [Component]
components = InteractionCallbackMessageOptions
cm forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "components" a => a
#components
            , $sel:attachments:CreateResponseMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            , $sel:flags:CreateResponseMessageJson :: Maybe Int
flags = Maybe Int
flags
            }
    ReqBodyMultipart
body <- forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall a. ToJSON a => a -> ByteString
Aeson.encode CreateResponseMessageJson
jsonData) forall a. a -> [a] -> [a]
: [PartM IO]
files)
    forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
patchWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action DeleteFollowupMessage {} = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith