{-# 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
  { ModifyUserData -> Maybe Text
username :: Maybe Text
  , ModifyUserData -> 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 (Int -> ModifyUserData -> ShowS
[ModifyUserData] -> ShowS
ModifyUserData -> String
(Int -> ModifyUserData -> ShowS)
-> (ModifyUserData -> String)
-> ([ModifyUserData] -> ShowS)
-> Show ModifyUserData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModifyUserData -> ShowS
showsPrec :: Int -> ModifyUserData -> ShowS
$cshow :: ModifyUserData -> String
show :: ModifyUserData -> String
$cshowList :: [ModifyUserData] -> ShowS
showList :: [ModifyUserData] -> ShowS
Show)
  deriving ([ModifyUserData] -> Value
[ModifyUserData] -> Encoding
ModifyUserData -> Value
ModifyUserData -> Encoding
(ModifyUserData -> Value)
-> (ModifyUserData -> Encoding)
-> ([ModifyUserData] -> Value)
-> ([ModifyUserData] -> Encoding)
-> ToJSON ModifyUserData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ModifyUserData -> Value
toJSON :: ModifyUserData -> Value
$ctoEncoding :: ModifyUserData -> Encoding
toEncoding :: ModifyUserData -> Encoding
$ctoJSONList :: [ModifyUserData] -> Value
toJSONList :: [ModifyUserData] -> Value
$ctoEncodingList :: [ModifyUserData] -> Encoding
toEncodingList :: [ModifyUserData] -> Encoding
Aeson.ToJSON) via CalamityToJSON ModifyUserData

instance CalamityToJSON' ModifyUserData where
  toPairs :: forall kv. KeyValue kv => ModifyUserData -> [Maybe kv]
toPairs ModifyUserData {Maybe Text
$sel:username:ModifyUserData :: ModifyUserData -> Maybe Text
$sel:avatar:ModifyUserData :: ModifyUserData -> Maybe Text
username :: Maybe Text
avatar :: Maybe Text
..} =
    [ Key
"username" Key -> Maybe Text -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
username
    , Key
"avatar" Key -> Maybe Text -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Maybe Text
avatar
    ]

instance Default ModifyUserData where
  def :: ModifyUserData
def = Maybe Text -> Maybe Text -> ModifyUserData
ModifyUserData Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

data GetCurrentUserGuildsOptions = GetCurrentUserGuildsOptions
  { GetCurrentUserGuildsOptions -> Maybe (Snowflake Guild)
before :: Maybe (Snowflake Guild)
  , GetCurrentUserGuildsOptions -> Maybe (Snowflake Guild)
after :: Maybe (Snowflake Guild)
  , GetCurrentUserGuildsOptions -> Maybe Integer
limit :: Maybe Integer
  }
  deriving (Int -> GetCurrentUserGuildsOptions -> ShowS
[GetCurrentUserGuildsOptions] -> ShowS
GetCurrentUserGuildsOptions -> String
(Int -> GetCurrentUserGuildsOptions -> ShowS)
-> (GetCurrentUserGuildsOptions -> String)
-> ([GetCurrentUserGuildsOptions] -> ShowS)
-> Show GetCurrentUserGuildsOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetCurrentUserGuildsOptions -> ShowS
showsPrec :: Int -> GetCurrentUserGuildsOptions -> ShowS
$cshow :: GetCurrentUserGuildsOptions -> String
show :: GetCurrentUserGuildsOptions -> String
$cshowList :: [GetCurrentUserGuildsOptions] -> ShowS
showList :: [GetCurrentUserGuildsOptions] -> ShowS
Show)

instance Default GetCurrentUserGuildsOptions where
  def :: GetCurrentUserGuildsOptions
def = Maybe (Snowflake Guild)
-> Maybe (Snowflake Guild)
-> Maybe Integer
-> GetCurrentUserGuildsOptions
GetCurrentUserGuildsOptions Maybe (Snowflake Guild)
forall a. Maybe a
Nothing Maybe (Snowflake Guild)
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
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 :: RouteBuilder '[]
baseRoute = RouteBuilder '[]
mkRouteBuilder RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"users" RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@me"

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

  route :: UserRequest a -> Route
route UserRequest a
GetCurrentUser =
    RouteBuilder '[]
baseRoute
      RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetUser (forall b a. HasID b a => a -> Snowflake b
getID @User -> Snowflake User
uid)) =
    RouteBuilder '[]
mkRouteBuilder RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"users" RouteBuilder '[] -> ID User -> ConsRes (ID User) '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall a. ID a
forall {k} (a :: k). ID a
ID @User
      RouteBuilder
  '[ '( 'IDRequirement User,
        AddRequiredInner (Lookup ('IDRequirement User) '[]))]
-> (RouteBuilder
      '[ '( 'IDRequirement User,
            AddRequiredInner (Lookup ('IDRequirement User) '[]))]
    -> RouteBuilder
         '[ '( 'IDRequirement User, 'Satisfied),
            '( 'IDRequirement User,
               AddRequiredInner (Lookup ('IDRequirement User) '[]))])
-> RouteBuilder
     '[ '( 'IDRequirement User, 'Satisfied),
        '( 'IDRequirement User,
           AddRequiredInner (Lookup ('IDRequirement User) '[]))]
forall a b. a -> (a -> b) -> b
& Snowflake User
-> RouteBuilder
     '[ '( 'IDRequirement User,
           AddRequiredInner (Lookup ('IDRequirement User) '[]))]
-> RouteBuilder
     '[ '( 'IDRequirement User, 'Satisfied),
        '( 'IDRequirement User,
           AddRequiredInner (Lookup ('IDRequirement User) '[]))]
forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake User
uid
      RouteBuilder
  '[ '( 'IDRequirement User, 'Satisfied),
     '( 'IDRequirement User,
        AddRequiredInner (Lookup ('IDRequirement User) '[]))]
-> (RouteBuilder
      '[ '( 'IDRequirement User, 'Satisfied),
         '( 'IDRequirement User,
            AddRequiredInner (Lookup ('IDRequirement User) '[]))]
    -> Route)
-> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder
  '[ '( 'IDRequirement User, 'Satisfied),
     '( 'IDRequirement User,
        AddRequiredInner (Lookup ('IDRequirement User) '[]))]
-> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (ModifyCurrentUser ModifyUserData
_) =
    RouteBuilder '[]
baseRoute
      RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetCurrentUserGuilds GetCurrentUserGuildsOptions
_) =
    RouteBuilder '[]
baseRoute RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"guilds"
      RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (LeaveGuild (forall b a. HasID b a => a -> Snowflake b
getID @Guild -> Snowflake Guild
gid)) =
    RouteBuilder '[]
baseRoute RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"guilds" RouteBuilder '[] -> ID Guild -> ConsRes (ID Guild) '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall a. ID a
forall {k} (a :: k). ID a
ID @Guild
      RouteBuilder
  '[ '( 'IDRequirement Guild,
        AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
-> (RouteBuilder
      '[ '( 'IDRequirement Guild,
            AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
    -> RouteBuilder
         '[ '( 'IDRequirement Guild, 'Satisfied),
            '( 'IDRequirement Guild,
               AddRequiredInner (Lookup ('IDRequirement Guild) '[]))])
-> RouteBuilder
     '[ '( 'IDRequirement Guild, 'Satisfied),
        '( 'IDRequirement Guild,
           AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
forall a b. a -> (a -> b) -> b
& Snowflake Guild
-> RouteBuilder
     '[ '( 'IDRequirement Guild,
           AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
-> RouteBuilder
     '[ '( 'IDRequirement Guild, 'Satisfied),
        '( 'IDRequirement Guild,
           AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
forall t (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Guild
gid
      RouteBuilder
  '[ '( 'IDRequirement Guild, 'Satisfied),
     '( 'IDRequirement Guild,
        AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
-> (RouteBuilder
      '[ '( 'IDRequirement Guild, 'Satisfied),
         '( 'IDRequirement Guild,
            AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
    -> Route)
-> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder
  '[ '( 'IDRequirement Guild, 'Satisfied),
     '( 'IDRequirement Guild,
        AddRequiredInner (Lookup ('IDRequirement Guild) '[]))]
-> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateDM u
_) =
    RouteBuilder '[]
baseRoute RouteBuilder '[] -> S -> ConsRes S '[]
forall a (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"channels"
      RouteBuilder '[] -> (RouteBuilder '[] -> Route) -> Route
forall a b. a -> (a -> b) -> b
& RouteBuilder '[] -> Route
forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute

  action :: UserRequest a -> Url 'Https -> Option 'Https -> Req LbsResponse
action UserRequest a
GetCurrentUser = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (GetUser u
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (ModifyCurrentUser ModifyUserData
o) = ReqBodyJson ModifyUserData
-> Url 'Https -> Option 'Https -> Req LbsResponse
forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
patchWith' (ReqBodyJson ModifyUserData
 -> Url 'Https -> Option 'Https -> Req LbsResponse)
-> ReqBodyJson ModifyUserData
-> Url 'Https
-> Option 'Https
-> Req LbsResponse
forall a b. (a -> b) -> a -> b
$ ModifyUserData -> ReqBodyJson ModifyUserData
forall a. a -> ReqBodyJson a
ReqBodyJson ModifyUserData
o
  action (GetCurrentUserGuilds GetCurrentUserGuildsOptions {Maybe (Snowflake Guild)
$sel:before:GetCurrentUserGuildsOptions :: GetCurrentUserGuildsOptions -> Maybe (Snowflake Guild)
before :: Maybe (Snowflake Guild)
before, Maybe (Snowflake Guild)
$sel:after:GetCurrentUserGuildsOptions :: GetCurrentUserGuildsOptions -> Maybe (Snowflake Guild)
after :: Maybe (Snowflake Guild)
after, Maybe Integer
$sel:limit:GetCurrentUserGuildsOptions :: GetCurrentUserGuildsOptions -> Maybe Integer
limit :: Maybe Integer
limit}) =
    Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP
      ( Text
"before" Text -> Maybe Word64 -> Option 'Https
forall a. ToHttpApiData a => Text -> Maybe a -> Option 'Https
=:? (Snowflake Guild -> Word64
forall t. Snowflake t -> Word64
fromSnowflake (Snowflake Guild -> Word64)
-> Maybe (Snowflake Guild) -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Snowflake Guild)
before)
          Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"after" Text -> Maybe Word64 -> Option 'Https
forall a. ToHttpApiData a => Text -> Maybe a -> Option 'Https
=:? (Snowflake Guild -> Word64
forall t. Snowflake t -> Word64
fromSnowflake (Snowflake Guild -> Word64)
-> Maybe (Snowflake Guild) -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Snowflake Guild)
after)
          Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"limit" Text -> Maybe Integer -> Option 'Https
forall a. ToHttpApiData a => Text -> Maybe a -> Option 'Https
=:? Maybe Integer
limit
      )
  action (LeaveGuild g
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (CreateDM (forall b a. HasID b a => a -> Snowflake b
getID @User -> Snowflake User
uid)) = ReqBodyJson Value -> Url 'Https -> Option 'Https -> Req LbsResponse
forall a.
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (ReqBodyJson Value
 -> Url 'Https -> Option 'Https -> Req LbsResponse)
-> ReqBodyJson Value
-> Url 'Https
-> Option 'Https
-> Req LbsResponse
forall a b. (a -> b) -> a -> b
$ Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
ReqBodyJson ([Pair] -> Value
Aeson.object [Key
"recipient_id" Key -> Snowflake User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Snowflake User
uid])

$(makeFieldLabelsNoPrefix ''ModifyUserData)
$(makeFieldLabelsNoPrefix ''GetCurrentUserGuildsOptions)