module Network.Discord.Rest.Channel
(
ChannelRequest(..)
) where
import Data.Aeson
import Data.ByteString.Lazy
import Data.Hashable
import Data.Monoid (mempty, (<>))
import Data.Text as T
import Network.HTTP.Client (RequestBody (..))
import Network.HTTP.Client.MultipartFormData (partFileRequestBody)
import Network.HTTP.Req (reqBodyMultipart)
import Network.Discord.Rest.Prelude
import Network.Discord.Types
import Network.Discord.Rest.HTTP
data ChannelRequest a where
GetChannel :: Snowflake -> ChannelRequest Channel
ModifyChannel :: ToJSON a => Snowflake -> a -> ChannelRequest Channel
DeleteChannel :: Snowflake -> ChannelRequest Channel
GetChannelMessages :: Snowflake -> Range -> ChannelRequest [Message]
GetChannelMessage :: Snowflake -> Snowflake -> ChannelRequest Message
CreateMessage :: Snowflake -> Text -> Maybe Embed -> ChannelRequest Message
UploadFile :: Snowflake -> FilePath -> ByteString -> ChannelRequest Message
EditMessage :: Message -> Text -> Maybe Embed -> ChannelRequest Message
DeleteMessage :: Message -> ChannelRequest ()
BulkDeleteMessage :: Snowflake -> [Message] -> ChannelRequest ()
EditChannelPermissions :: ToJSON a => Snowflake -> Snowflake -> a -> ChannelRequest ()
GetChannelInvites :: Snowflake -> ChannelRequest Object
CreateChannelInvite :: ToJSON a => Snowflake -> a -> ChannelRequest Object
DeleteChannelPermission :: Snowflake -> Snowflake -> ChannelRequest ()
TriggerTypingIndicator :: Snowflake -> ChannelRequest ()
GetPinnedMessages :: Snowflake -> ChannelRequest [Message]
AddPinnedMessage :: Snowflake -> Snowflake -> ChannelRequest ()
DeletePinnedMessage :: Snowflake -> Snowflake -> ChannelRequest ()
instance Hashable (ChannelRequest a) where
hashWithSalt s (GetChannel chan) = hashWithSalt s ("get_chan"::Text, chan)
hashWithSalt s (ModifyChannel chan _) = hashWithSalt s ("mod_chan"::Text, chan)
hashWithSalt s (DeleteChannel chan) = hashWithSalt s ("mod_chan"::Text, chan)
hashWithSalt s (GetChannelMessages chan _) = hashWithSalt s ("msg"::Text, chan)
hashWithSalt s (GetChannelMessage chan _) = hashWithSalt s ("get_msg"::Text, chan)
hashWithSalt s (CreateMessage chan _ _) = hashWithSalt s ("msg"::Text, chan)
hashWithSalt s (UploadFile chan _ _) = hashWithSalt s ("msg"::Text, chan)
hashWithSalt s (EditMessage (Message _ chan _ _ _ _ _ _ _ _ _ _ _ _) _ _) =
hashWithSalt s ("get_msg"::Text, chan)
hashWithSalt s (DeleteMessage (Message _ chan _ _ _ _ _ _ _ _ _ _ _ _)) =
hashWithSalt s ("get_msg"::Text, chan)
hashWithSalt s (BulkDeleteMessage chan _) = hashWithSalt s ("del_msgs"::Text, chan)
hashWithSalt s (EditChannelPermissions chan _ _) = hashWithSalt s ("perms"::Text, chan)
hashWithSalt s (GetChannelInvites chan) = hashWithSalt s ("invites"::Text, chan)
hashWithSalt s (CreateChannelInvite chan _) = hashWithSalt s ("invites"::Text, chan)
hashWithSalt s (DeleteChannelPermission chan _) = hashWithSalt s ("perms"::Text, chan)
hashWithSalt s (TriggerTypingIndicator chan) = hashWithSalt s ("tti"::Text, chan)
hashWithSalt s (GetPinnedMessages chan) = hashWithSalt s ("pins"::Text, chan)
hashWithSalt s (AddPinnedMessage chan _) = hashWithSalt s ("pin"::Text, chan)
hashWithSalt s (DeletePinnedMessage chan _) = hashWithSalt s ("pin"::Text, chan)
instance (FromJSON a) => DoFetch ChannelRequest a where
doFetch req = go req
where
maybeEmbed :: Maybe Embed -> [(Text, Value)]
maybeEmbed = maybe [] $ \embed -> ["embed" .= embed]
url = baseUrl /: "channels"
go :: DiscordRest m => ChannelRequest a -> m a
go r@(GetChannel chan) = makeRequest r
$ Get (url // chan) mempty
go r@(ModifyChannel chan patch) = makeRequest r
$ Patch (url // chan)
(ReqBodyJson patch) mempty
go r@(DeleteChannel chan) = makeRequest r
$ Delete (url // chan) mempty
go r@(GetChannelMessages chan range) = makeRequest r
$ Get (url // chan /: "messages") (toQueryString range)
go r@(GetChannelMessage chan msg) = makeRequest r
$ Get (url // chan /: "messages" // msg) mempty
go r@(CreateMessage chan msg embed) = makeRequest r
$ Post (url // chan /: "messages")
(ReqBodyJson . object $ ["content" .= msg] <> maybeEmbed embed)
mempty
go r@(UploadFile chan fileName file) = do
body <- reqBodyMultipart [partFileRequestBody "file" fileName $ RequestBodyLBS file]
makeRequest r $ Post (url // chan /: "messages")
body mempty
go r@(EditMessage (Message msg chan _ _ _ _ _ _ _ _ _ _ _ _) new embed) = makeRequest r
$ Patch (url // chan /: "messages" // msg)
(ReqBodyJson . object $ ["content" .= new] <> maybeEmbed embed)
mempty
go r@(DeleteMessage (Message msg chan _ _ _ _ _ _ _ _ _ _ _ _)) = makeRequest r
$ Delete (url // chan /: "messages" // msg) mempty
go r@(BulkDeleteMessage chan msgs) = makeRequest r
$ Post (url // chan /: "messages" /: "bulk-delete")
(ReqBodyJson $ object ["messages" .= Prelude.map messageId msgs])
mempty
go r@(EditChannelPermissions chan perm patch) = makeRequest r
$ Put (url // chan /: "permissions" // perm)
(ReqBodyJson patch) mempty
go r@(GetChannelInvites chan) = makeRequest r
$ Get (url // chan /: "invites") mempty
go r@(CreateChannelInvite chan patch) = makeRequest r
$ Post (url // chan /: "invites")
(ReqBodyJson patch) mempty
go r@(DeleteChannelPermission chan perm) = makeRequest r
$ Delete (url // chan /: "permissions" // perm) mempty
go r@(TriggerTypingIndicator chan) = makeRequest r
$ Post (url // chan /: "typing")
NoReqBody mempty
go r@(GetPinnedMessages chan) = makeRequest r
$ Get (url // chan /: "pins") mempty
go r@(AddPinnedMessage chan msg) = makeRequest r
$ Put (url // chan /: "pins" // msg)
NoReqBody mempty
go r@(DeletePinnedMessage chan msg) = makeRequest r
$ Delete (url // chan /: "pins" // msg) mempty