{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Discord.Internal.Rest.ApplicationCommands where

import Data.Aeson (Value)
import Discord.Internal.Rest.Prelude
import Discord.Internal.Types
import Discord.Internal.Types.ApplicationCommands
    ( ApplicationCommandPermissions,
      GuildApplicationCommandPermissions(GuildApplicationCommandPermissions),
      EditApplicationCommand,
      CreateApplicationCommand,
      ApplicationCommand )
import Network.HTTP.Req as R

instance Request (ApplicationCommandRequest a) where
  jsonRequest :: ApplicationCommandRequest a -> JsonRequest
jsonRequest = ApplicationCommandRequest a -> JsonRequest
forall a. ApplicationCommandRequest a -> JsonRequest
applicationCommandJsonRequest
  majorRoute :: ApplicationCommandRequest a -> String
majorRoute = ApplicationCommandRequest a -> String
forall a. ApplicationCommandRequest a -> String
applicationCommandMajorRoute

-- | Requests related to application commands
data ApplicationCommandRequest a where
  -- | Fetch all of the global commands for your application. Returns an list of 'ApplicationCommand's.
  GetGlobalApplicationCommands :: ApplicationId
                               -> ApplicationCommandRequest [ApplicationCommand]
  -- | Create a new global command. Returns an 'ApplicationCommand'.
  --
  -- __Note__: Creating a command with the same name as an existing command for your application will overwrite the old command.
  CreateGlobalApplicationCommand :: ApplicationId
                                 -> CreateApplicationCommand
                                 -> ApplicationCommandRequest ApplicationCommand
  -- | Fetch a global command for your application. Returns an 'ApplicationCommand'.
  GetGlobalApplicationCommand :: ApplicationId
                              -> ApplicationCommandId
                              -> ApplicationCommandRequest ApplicationCommand
  -- | Edit a global command. Returns an 'ApplicationCommand'.
  --
  -- All fields are optional, but any fields provided will entirely overwrite the existing values of those fields.
  EditGlobalApplicationCommand :: ApplicationId
                               -> ApplicationCommandId
                               -> EditApplicationCommand
                               -> ApplicationCommandRequest ApplicationCommand
  -- | Delete a global command.
  DeleteGlobalApplicationCommand :: ApplicationId
                                 -> ApplicationCommandId
                                 -> ApplicationCommandRequest ()
  -- | Takes a list of 'CreateApplicationCommand', overwriting the existing global command list for this application.
  --
  -- __Note__: This will overwrite __all__ types of application commands: slash commands, user commands, and message commands.
  BulkOverWriteGlobalApplicationCommand :: ApplicationId
                                        -> [CreateApplicationCommand]
                                        -> ApplicationCommandRequest ()
  -- | Fetch all of the guild commands for your application for a specific guild. Returns an list of 'ApplicationCommands'.
  GetGuildApplicationCommands :: ApplicationId
                              -> GuildId
                              -> ApplicationCommandRequest [ApplicationCommand]
  -- | Create a new guild command. New guild commands will be available in the guild immediately.
  -- Returns an 'ApplicationCommand'.
  -- If the command did not already exist, it will count toward daily application command create limits.
  --
  -- __Note__: Creating a command with the same name as an existing command for your application will overwrite the old command.
  CreateGuildApplicationCommand :: ApplicationId
                                -> GuildId
                                -> CreateApplicationCommand
                                -> ApplicationCommandRequest ApplicationCommand
  -- | Fetch a guild command for your application. Returns an 'ApplicationCommand'
  GetGuildApplicationCommand :: ApplicationId
                             -> GuildId
                             -> ApplicationCommandId
                             -> ApplicationCommandRequest ApplicationCommand
  -- | Edit a guild command. Updates for guild commands will be available immediately. Returns an 'ApplicationCommand'.
  -- All fields are optional, but any fields provided will entirely overwrite the existing values of those fields.
  EditGuildApplicationCommand :: ApplicationId
                              -> GuildId
                              -> ApplicationCommandId
                              -> CreateApplicationCommand
                              -> ApplicationCommandRequest ApplicationCommand
  -- | Delete a guild command.
  DeleteGuildApplicationCommand :: ApplicationId
                                -> GuildId
                                -> ApplicationCommandId
                                -> ApplicationCommandRequest ()
  -- | Takes a list of `CreateApplicationCommand`, overwriting the existing command list for this application for the targeted guild.
  --
  -- __Note__: This will overwrite __all__ types of application commands: slash commands, user commands, and message commands.
  BulkOverWriteGuildApplicationCommand :: ApplicationId
                                       -> GuildId
                                       -> [CreateApplicationCommand]
                                       -> ApplicationCommandRequest ()
  -- | Fetches permissions for all commands for your application in a guild. 
  GetGuildApplicationCommandPermissions :: ApplicationId
                                        -> GuildId
                                        -> ApplicationCommandRequest GuildApplicationCommandPermissions
  -- | Fetches permissions for a specific command for your application in a guild.
  GetApplicationCommandPermissions :: ApplicationId
                                   -> GuildId
                                   -> ApplicationCommandId
                                   -> ApplicationCommandRequest GuildApplicationCommandPermissions
  -- | Edits command permissions for a specific command for your application.
  -- You can add up to 100 permission overwrites for a command.
  -- __Notes__:
  --
  --   * This endpoint will overwrite existing permissions for the command in that guild
  --   * This endpoint requires authentication with a Bearer token that has permission to manage the guild and its roles.
  --   * Deleting or renaming a command will permanently delete all permissions for the command
  EditApplicationCommandPermissions :: ApplicationId
                                    -> GuildId
                                    -> ApplicationCommandId
                                    -> [ApplicationCommandPermissions]
                                    -> ApplicationCommandRequest GuildApplicationCommandPermissions

-- | The base url for application commands
applications :: ApplicationId -> R.Url 'R.Https
applications :: ApplicationId -> Url 'Https
applications ApplicationId
s = Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"applications" Url 'Https -> ApplicationId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationId
s

-- | The major routes identifiers for `ApplicationCommandRequest`s
applicationCommandMajorRoute :: ApplicationCommandRequest a -> String
applicationCommandMajorRoute :: ApplicationCommandRequest a -> String
applicationCommandMajorRoute ApplicationCommandRequest a
a = case ApplicationCommandRequest a
a of
  (GetGlobalApplicationCommands ApplicationId
aid) -> String
"get_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (CreateGlobalApplicationCommand ApplicationId
aid CreateApplicationCommand
_) -> String
"write_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (GetGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
_) -> String
"get_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (EditGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
_ EditApplicationCommand
_) -> String
"write_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (DeleteGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
_) -> String
"write_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (BulkOverWriteGlobalApplicationCommand ApplicationId
aid [CreateApplicationCommand]
_) -> String
"write_glob_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (GetGuildApplicationCommands ApplicationId
aid GuildId
_) -> String
"get_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (CreateGuildApplicationCommand ApplicationId
aid GuildId
_ CreateApplicationCommand
_) -> String
"write_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (GetGuildApplicationCommand ApplicationId
aid GuildId
_ ApplicationCommandId
_) -> String
"get_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (EditGuildApplicationCommand ApplicationId
aid GuildId
_ ApplicationCommandId
_ CreateApplicationCommand
_) -> String
"write_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (DeleteGuildApplicationCommand ApplicationId
aid GuildId
_ ApplicationCommandId
_) -> String
"write_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (BulkOverWriteGuildApplicationCommand ApplicationId
aid GuildId
_ [CreateApplicationCommand]
_) -> String
"write_appcomm" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (GetGuildApplicationCommandPermissions ApplicationId
aid GuildId
_) -> String
"appcom_perm " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (GetApplicationCommandPermissions ApplicationId
aid GuildId
_ ApplicationCommandId
_) -> String
"appcom_perm " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid
  (EditApplicationCommandPermissions ApplicationId
aid GuildId
_ ApplicationCommandId
_ [ApplicationCommandPermissions]
_) -> String
"appcom_perm " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ApplicationId -> String
forall a. Show a => a -> String
show ApplicationId
aid

-- | The `JsonRequest`s for `ApplicationCommandRequest`s
applicationCommandJsonRequest :: ApplicationCommandRequest a -> JsonRequest
applicationCommandJsonRequest :: ApplicationCommandRequest a -> JsonRequest
applicationCommandJsonRequest ApplicationCommandRequest a
a = case ApplicationCommandRequest a
a of
  (GetGlobalApplicationCommands ApplicationId
aid) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") Option 'Https
forall a. Monoid a => a
mempty
  (CreateGlobalApplicationCommand ApplicationId
aid CreateApplicationCommand
cac) ->
    Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") (CreateApplicationCommand -> RestIO (ReqBodyJson Value)
forall a. ToJSON a => a -> RestIO (ReqBodyJson Value)
convert CreateApplicationCommand
cac) Option 'Https
forall a. Monoid a => a
mempty
  (GetGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
aci) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) Option 'Https
forall a. Monoid a => a
mempty
  (EditGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
aci EditApplicationCommand
eac) ->
    Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) (EditApplicationCommand -> RestIO (ReqBodyJson Value)
forall a. ToJSON a => a -> RestIO (ReqBodyJson Value)
convert EditApplicationCommand
eac) Option 'Https
forall a. Monoid a => a
mempty
  (DeleteGlobalApplicationCommand ApplicationId
aid ApplicationCommandId
aci) ->
    Url 'Https -> Option 'Https -> JsonRequest
Delete (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) Option 'Https
forall a. Monoid a => a
mempty
  (BulkOverWriteGlobalApplicationCommand ApplicationId
aid [CreateApplicationCommand]
cacs) ->
    Url 'Https -> ReqBodyJson Value -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> ReqBodyJson Value) -> Value -> ReqBodyJson Value
forall a b. (a -> b) -> a -> b
$ [CreateApplicationCommand] -> Value
forall a. ToJSON a => a -> Value
toJSON [CreateApplicationCommand]
cacs) Option 'Https
forall a. Monoid a => a
mempty
  (GetGuildApplicationCommands ApplicationId
aid GuildId
gid) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") Option 'Https
forall a. Monoid a => a
mempty
  (CreateGuildApplicationCommand ApplicationId
aid GuildId
gid CreateApplicationCommand
cac) ->
    Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") (CreateApplicationCommand -> RestIO (ReqBodyJson Value)
forall a. ToJSON a => a -> RestIO (ReqBodyJson Value)
convert CreateApplicationCommand
cac) Option 'Https
forall a. Monoid a => a
mempty
  (GetGuildApplicationCommand ApplicationId
aid GuildId
gid ApplicationCommandId
aci) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) Option 'Https
forall a. Monoid a => a
mempty
  (EditGuildApplicationCommand ApplicationId
aid GuildId
gid ApplicationCommandId
aci CreateApplicationCommand
eac) ->
    Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) (CreateApplicationCommand -> RestIO (ReqBodyJson Value)
forall a. ToJSON a => a -> RestIO (ReqBodyJson Value)
convert CreateApplicationCommand
eac) Option 'Https
forall a. Monoid a => a
mempty
  (DeleteGuildApplicationCommand ApplicationId
aid GuildId
gid ApplicationCommandId
aci) ->
    Url 'Https -> Option 'Https -> JsonRequest
Delete (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
aci) Option 'Https
forall a. Monoid a => a
mempty
  (BulkOverWriteGuildApplicationCommand ApplicationId
aid GuildId
gid [CreateApplicationCommand]
cacs) ->
    Url 'Https -> ReqBodyJson Value -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands") (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> ReqBodyJson Value) -> Value -> ReqBodyJson Value
forall a b. (a -> b) -> a -> b
$ [CreateApplicationCommand] -> Value
forall a. ToJSON a => a -> Value
toJSON [CreateApplicationCommand]
cacs) Option 'Https
forall a. Monoid a => a
mempty
  (GetGuildApplicationCommandPermissions ApplicationId
aid GuildId
gid) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions") Option 'Https
forall a. Monoid a => a
mempty
  (GetApplicationCommandPermissions ApplicationId
aid GuildId
gid ApplicationCommandId
cid) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
cid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions") Option 'Https
forall a. Monoid a => a
mempty
  (EditApplicationCommandPermissions ApplicationId
aid GuildId
gid ApplicationCommandId
cid [ApplicationCommandPermissions]
ps) ->
    Url 'Https -> ReqBodyJson Value -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (ApplicationId -> Url 'Https
applications ApplicationId
aid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
gid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commands" Url 'Https -> ApplicationCommandId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ApplicationCommandId
cid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions") (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> ReqBodyJson Value) -> Value -> ReqBodyJson Value
forall a b. (a -> b) -> a -> b
$ GuildApplicationCommandPermissions -> Value
forall a. ToJSON a => a -> Value
toJSON (ApplicationCommandId
-> ApplicationId
-> GuildId
-> [ApplicationCommandPermissions]
-> GuildApplicationCommandPermissions
GuildApplicationCommandPermissions ApplicationCommandId
cid ApplicationId
aid GuildId
gid [ApplicationCommandPermissions]
ps)) Option 'Https
forall a. Monoid a => a
mempty
  where
    convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)
    convert :: a -> RestIO (ReqBodyJson Value)
convert = (forall a. Applicative RestIO => a -> RestIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure @RestIO) (ReqBodyJson Value -> RestIO (ReqBodyJson Value))
-> (a -> ReqBodyJson Value) -> a -> RestIO (ReqBodyJson Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> ReqBodyJson Value)
-> (a -> Value) -> a -> ReqBodyJson Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON