blob: 2ab9c2423f674c53ede38b522d8d442f9380172d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Provides actions for Channel API interactions
module Discord.Internal.Rest.User
( UserRequest(..)
, parseAvatarImage
) where
import Data.Aeson
import Network.HTTP.Req ((/:), (/~))
import qualified Network.HTTP.Req as R
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import Discord.Internal.Rest.Prelude
import Discord.Internal.Types
instance Request (UserRequest a) where
majorRoute = userMajorRoute
jsonRequest = userJsonRequest
-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data UserRequest a where
-- | Returns the 'User' object of the requester's account. For OAuth2, this requires
-- the identify scope, which will return the object without an email, and optionally
-- the email scope, which returns the object with an email.
GetCurrentUser :: UserRequest User
-- | Returns a 'User' for a given user ID
GetUser :: UserId -> UserRequest User
-- | Modify user's username & avatar pic
ModifyCurrentUser :: T.Text -> Base64Image User -> UserRequest User
-- | Returns a list of user 'Guild' objects the current user is a member of.
-- Requires the guilds OAuth2 scope.
GetCurrentUserGuilds :: UserRequest [PartialGuild]
-- | Leave a guild.
LeaveGuild :: GuildId -> UserRequest ()
-- | Returns a list of DM 'Channel' objects
GetUserDMs :: UserRequest [Channel]
-- | Create a new DM channel with a user. Returns a DM 'Channel' object.
CreateDM :: UserId -> UserRequest Channel
GetUserConnections :: UserRequest [ConnectionObject]
-- | @parseAvatarImage bs@ will attempt to convert the given image bytestring
-- @bs@ to the base64 format expected by the Discord API. It may return Left
-- with an error reason if the image format could not be predetermined from the
-- opening magic bytes. This function does /not/ validate the rest of the image,
-- and this is up to the library user to check themselves.
--
-- This function accepts all file types accepted by 'getMimeType'.
parseAvatarImage :: B.ByteString -> Either T.Text (Base64Image User)
parseAvatarImage bs
| Just mime <- getMimeType bs = Right (Base64Image mime (B64.encode bs))
| otherwise = Left "Unsupported image format provided"
userMajorRoute :: UserRequest a -> String
userMajorRoute c = case c of
(GetCurrentUser) -> "me "
(GetUser _) -> "user "
(ModifyCurrentUser _ _) -> "modify_user "
(GetCurrentUserGuilds) -> "get_user_guilds "
(LeaveGuild g) -> "leave_guild " <> show g
(GetUserDMs) -> "get_dms "
(CreateDM _) -> "make_dm "
(GetUserConnections) -> "connections "
users :: R.Url 'R.Https
users = baseUrl /: "users"
userJsonRequest :: UserRequest r -> JsonRequest
userJsonRequest c = case c of
(GetCurrentUser) -> Get (users /: "@me") mempty
(GetUser user) -> Get (users /~ user ) mempty
(ModifyCurrentUser name b64im) ->
Patch (users /: "@me") (pure (R.ReqBodyJson (object [ "username" .= name
, "avatar" .= b64im ]))) mempty
(GetCurrentUserGuilds) -> Get (users /: "@me" /: "guilds") mempty
(LeaveGuild guild) -> Delete (users /: "@me" /: "guilds" /~ guild) mempty
(GetUserDMs) -> Get (users /: "@me" /: "channels") mempty
(CreateDM user) ->
let body = R.ReqBodyJson $ object ["recipient_id" .= user]
in Post (users /: "@me" /: "channels") (pure body) mempty
(GetUserConnections) ->
Get (users /: "@me" /: "connections") mempty
|
