{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | User endpoints module Calamity.HTTP.User ( UserRequest (..), ModifyUserData (..), GetCurrentUserGuildsOptions (..), ) where import Calamity.HTTP.Internal.Request import Calamity.HTTP.Internal.Route import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.?=)) import Calamity.Types.Model.Channel import Calamity.Types.Model.Guild import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson qualified as Aeson import Data.Default.Class import Data.Function ((&)) import Data.Text (Text) import Network.HTTP.Req import Optics.TH data ModifyUserData = ModifyUserData { username :: Maybe Text , avatar :: Maybe Text -- ^ The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data } deriving (Show) deriving (Aeson.ToJSON) via CalamityToJSON ModifyUserData instance CalamityToJSON' ModifyUserData where toPairs ModifyUserData {..} = [ "username" .?= username , "avatar" .?= avatar ] instance Default ModifyUserData where def = ModifyUserData Nothing Nothing data GetCurrentUserGuildsOptions = GetCurrentUserGuildsOptions { before :: Maybe (Snowflake Guild) , after :: Maybe (Snowflake Guild) , limit :: Maybe Integer } deriving (Show) instance Default GetCurrentUserGuildsOptions where def = GetCurrentUserGuildsOptions Nothing Nothing Nothing data UserRequest a where GetCurrentUser :: UserRequest User GetUser :: (HasID User u) => u -> UserRequest User ModifyCurrentUser :: ModifyUserData -> UserRequest User GetCurrentUserGuilds :: GetCurrentUserGuildsOptions -> UserRequest [Partial Guild] LeaveGuild :: (HasID Guild g) => g -> UserRequest () CreateDM :: (HasID User u) => u -> UserRequest DMChannel baseRoute :: RouteBuilder _ baseRoute = mkRouteBuilder // S "users" // S "@me" instance Request (UserRequest a) where type Result (UserRequest a) = a route GetCurrentUser = baseRoute & buildRoute route (GetUser (getID @User -> uid)) = mkRouteBuilder // S "users" // ID @User & giveID uid & buildRoute route (ModifyCurrentUser _) = baseRoute & buildRoute route (GetCurrentUserGuilds _) = baseRoute // S "guilds" & buildRoute route (LeaveGuild (getID @Guild -> gid)) = baseRoute // S "guilds" // ID @Guild & giveID gid & buildRoute route (CreateDM _) = baseRoute // S "channels" & buildRoute action GetCurrentUser = getWith action (GetUser _) = getWith action (ModifyCurrentUser o) = patchWith' $ ReqBodyJson o action (GetCurrentUserGuilds GetCurrentUserGuildsOptions {before, after, limit}) = getWithP ( "before" =:? (fromSnowflake <$> before) <> "after" =:? (fromSnowflake <$> after) <> "limit" =:? limit ) action (LeaveGuild _) = deleteWith action (CreateDM (getID @User -> uid)) = postWith' $ ReqBodyJson (Aeson.object ["recipient_id" Aeson..= uid]) $(makeFieldLabelsNoPrefix ''ModifyUserData) $(makeFieldLabelsNoPrefix ''GetCurrentUserGuildsOptions)