{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
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.Text.Encoding as TE
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 :: UserRequest a -> String
majorRoute = forall a. UserRequest a -> String
userMajorRoute
jsonRequest :: UserRequest a -> JsonRequest
jsonRequest = forall a. UserRequest a -> JsonRequest
userJsonRequest
data UserRequest a where
GetCurrentUser :: UserRequest User
GetUser :: UserId -> UserRequest User
ModifyCurrentUser :: T.Text -> Base64Image User -> UserRequest User
GetCurrentUserGuilds :: UserRequest [PartialGuild]
LeaveGuild :: GuildId -> UserRequest ()
GetUserDMs :: UserRequest [Channel]
CreateDM :: UserId -> UserRequest Channel
GetUserConnections :: UserRequest [ConnectionObject]
parseAvatarImage :: B.ByteString -> Either T.Text (Base64Image User)
parseAvatarImage :: ByteString -> Either Text (Base64Image User)
parseAvatarImage ByteString
bs
| Just Text
mime <- ByteString -> Maybe Text
getMimeType ByteString
bs = forall a b. b -> Either a b
Right (forall a. Text -> Text -> Base64Image a
Base64Image Text
mime (ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
B64.encode ByteString
bs)))
| Bool
otherwise = forall a b. a -> Either a b
Left Text
"Unsupported image format provided"
userMajorRoute :: UserRequest a -> String
userMajorRoute :: forall a. UserRequest a -> String
userMajorRoute UserRequest a
c = case UserRequest a
c of
(UserRequest a
GetCurrentUser) -> String
"me "
(GetUser UserId
_) -> String
"user "
(ModifyCurrentUser Text
_ Base64Image User
_) -> String
"modify_user "
(UserRequest a
GetCurrentUserGuilds) -> String
"get_user_guilds "
(LeaveGuild GuildId
g) -> String
"leave_guild " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
(UserRequest a
GetUserDMs) -> String
"get_dms "
(CreateDM UserId
_) -> String
"make_dm "
(UserRequest a
GetUserConnections) -> String
"connections "
users :: R.Url 'R.Https
users :: Url 'Https
users = Url 'Https
baseUrl forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"users"
userJsonRequest :: UserRequest r -> JsonRequest
userJsonRequest :: forall a. UserRequest a -> JsonRequest
userJsonRequest UserRequest r
c = case UserRequest r
c of
(UserRequest r
GetCurrentUser) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me") forall a. Monoid a => a
mempty
(GetUser UserId
user) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
users forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user ) forall a. Monoid a => a
mempty
(ModifyCurrentUser Text
name Base64Image User
b64im) ->
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ([Pair] -> Value
object [ Key
"username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
, Key
"avatar" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Image User
b64im ]))) forall a. Monoid a => a
mempty
(UserRequest r
GetCurrentUserGuilds) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds") forall a. Monoid a => a
mempty
(LeaveGuild GuildId
guild) -> Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild) forall a. Monoid a => a
mempty
(UserRequest r
GetUserDMs) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels") forall a. Monoid a => a
mempty
(CreateDM UserId
user) ->
let body :: ReqBodyJson Value
body = forall a. a -> ReqBodyJson a
R.ReqBodyJson forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"recipient_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UserId
user]
in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels") (forall (f :: * -> *) a. Applicative f => a -> f a
pure ReqBodyJson Value
body) forall a. Monoid a => a
mempty
(UserRequest r
GetUserConnections) ->
Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
users forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"connections") forall a. Monoid a => a
mempty