{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE RecordWildCards #-}

-- | Data structures needed for interfacing with the Websocket
--   Gateway
module Discord.Internal.Types.Gateway where

import System.Info

import qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Aeson
import Data.Aeson.Types
import Data.Default (Default, def)
import Data.Maybe (fromMaybe)
import Data.Functor
import Text.Read (readMaybe)

import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Events
import Discord.Internal.Types.Guild (Activity (..))

-- | Messages that can be sent by gateway to the library
data GatewayReceivable
  = Dispatch EventInternalParse Integer
  | HeartbeatRequest Integer
  | Reconnect
  | InvalidSession Bool
  | Hello Integer
  | HeartbeatAck
  | ParseError T.Text
  deriving (Int -> GatewayReceivable -> ShowS
[GatewayReceivable] -> ShowS
GatewayReceivable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewayReceivable] -> ShowS
$cshowList :: [GatewayReceivable] -> ShowS
show :: GatewayReceivable -> String
$cshow :: GatewayReceivable -> String
showsPrec :: Int -> GatewayReceivable -> ShowS
$cshowsPrec :: Int -> GatewayReceivable -> ShowS
Show, GatewayReceivable -> GatewayReceivable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewayReceivable -> GatewayReceivable -> Bool
$c/= :: GatewayReceivable -> GatewayReceivable -> Bool
== :: GatewayReceivable -> GatewayReceivable -> Bool
$c== :: GatewayReceivable -> GatewayReceivable -> Bool
Eq, ReadPrec [GatewayReceivable]
ReadPrec GatewayReceivable
Int -> ReadS GatewayReceivable
ReadS [GatewayReceivable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GatewayReceivable]
$creadListPrec :: ReadPrec [GatewayReceivable]
readPrec :: ReadPrec GatewayReceivable
$creadPrec :: ReadPrec GatewayReceivable
readList :: ReadS [GatewayReceivable]
$creadList :: ReadS [GatewayReceivable]
readsPrec :: Int -> ReadS GatewayReceivable
$creadsPrec :: Int -> ReadS GatewayReceivable
Read)

-- | Sent to gateway by our library
data GatewaySendableInternal
  = Heartbeat Integer
  | Identify Auth GatewayIntent (Int, Int)
  | Resume Auth T.Text Integer
  deriving (Int -> GatewaySendableInternal -> ShowS
[GatewaySendableInternal] -> ShowS
GatewaySendableInternal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewaySendableInternal] -> ShowS
$cshowList :: [GatewaySendableInternal] -> ShowS
show :: GatewaySendableInternal -> String
$cshow :: GatewaySendableInternal -> String
showsPrec :: Int -> GatewaySendableInternal -> ShowS
$cshowsPrec :: Int -> GatewaySendableInternal -> ShowS
Show, ReadPrec [GatewaySendableInternal]
ReadPrec GatewaySendableInternal
Int -> ReadS GatewaySendableInternal
ReadS [GatewaySendableInternal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GatewaySendableInternal]
$creadListPrec :: ReadPrec [GatewaySendableInternal]
readPrec :: ReadPrec GatewaySendableInternal
$creadPrec :: ReadPrec GatewaySendableInternal
readList :: ReadS [GatewaySendableInternal]
$creadList :: ReadS [GatewaySendableInternal]
readsPrec :: Int -> ReadS GatewaySendableInternal
$creadsPrec :: Int -> ReadS GatewaySendableInternal
Read, GatewaySendableInternal -> GatewaySendableInternal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c/= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
== :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c== :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
Eq, Eq GatewaySendableInternal
GatewaySendableInternal -> GatewaySendableInternal -> Bool
GatewaySendableInternal -> GatewaySendableInternal -> Ordering
GatewaySendableInternal
-> GatewaySendableInternal -> GatewaySendableInternal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GatewaySendableInternal
-> GatewaySendableInternal -> GatewaySendableInternal
$cmin :: GatewaySendableInternal
-> GatewaySendableInternal -> GatewaySendableInternal
max :: GatewaySendableInternal
-> GatewaySendableInternal -> GatewaySendableInternal
$cmax :: GatewaySendableInternal
-> GatewaySendableInternal -> GatewaySendableInternal
>= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c>= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
> :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c> :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
<= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c<= :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
< :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
$c< :: GatewaySendableInternal -> GatewaySendableInternal -> Bool
compare :: GatewaySendableInternal -> GatewaySendableInternal -> Ordering
$ccompare :: GatewaySendableInternal -> GatewaySendableInternal -> Ordering
Ord)


-- | Gateway intents to subrscribe to
-- 
-- Details of which intent englobs what data is avalilable at
-- [the official Discord documentation](https://discord.com/developers/docs/topics/gateway#list-of-intents)
data GatewayIntent = GatewayIntent
  { GatewayIntent -> Bool
gatewayIntentGuilds :: Bool
  , GatewayIntent -> Bool
gatewayIntentMembers :: Bool
  , GatewayIntent -> Bool
gatewayIntentBans :: Bool
  , GatewayIntent -> Bool
gatewayIntentEmojis :: Bool
  , GatewayIntent -> Bool
gatewayIntentIntegrations :: Bool
  , GatewayIntent -> Bool
gatewayIntentWebhooks :: Bool
  , GatewayIntent -> Bool
gatewayIntentInvites :: Bool
  , GatewayIntent -> Bool
gatewayIntentVoiceStates :: Bool
  , GatewayIntent -> Bool
gatewayIntentPresences :: Bool
  , GatewayIntent -> Bool
gatewayIntentMessageChanges :: Bool
  , GatewayIntent -> Bool
gatewayIntentMessageReactions :: Bool
  , GatewayIntent -> Bool
gatewayIntentMessageTyping :: Bool
  , GatewayIntent -> Bool
gatewayIntentDirectMessageChanges :: Bool
  , GatewayIntent -> Bool
gatewayIntentDirectMessageReactions :: Bool
  , GatewayIntent -> Bool
gatewayIntentDirectMessageTyping :: Bool
  , GatewayIntent -> Bool
gatewayIntentMessageContent :: Bool
  } deriving (Int -> GatewayIntent -> ShowS
[GatewayIntent] -> ShowS
GatewayIntent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewayIntent] -> ShowS
$cshowList :: [GatewayIntent] -> ShowS
show :: GatewayIntent -> String
$cshow :: GatewayIntent -> String
showsPrec :: Int -> GatewayIntent -> ShowS
$cshowsPrec :: Int -> GatewayIntent -> ShowS
Show, ReadPrec [GatewayIntent]
ReadPrec GatewayIntent
Int -> ReadS GatewayIntent
ReadS [GatewayIntent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GatewayIntent]
$creadListPrec :: ReadPrec [GatewayIntent]
readPrec :: ReadPrec GatewayIntent
$creadPrec :: ReadPrec GatewayIntent
readList :: ReadS [GatewayIntent]
$creadList :: ReadS [GatewayIntent]
readsPrec :: Int -> ReadS GatewayIntent
$creadsPrec :: Int -> ReadS GatewayIntent
Read, GatewayIntent -> GatewayIntent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewayIntent -> GatewayIntent -> Bool
$c/= :: GatewayIntent -> GatewayIntent -> Bool
== :: GatewayIntent -> GatewayIntent -> Bool
$c== :: GatewayIntent -> GatewayIntent -> Bool
Eq, Eq GatewayIntent
GatewayIntent -> GatewayIntent -> Bool
GatewayIntent -> GatewayIntent -> Ordering
GatewayIntent -> GatewayIntent -> GatewayIntent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GatewayIntent -> GatewayIntent -> GatewayIntent
$cmin :: GatewayIntent -> GatewayIntent -> GatewayIntent
max :: GatewayIntent -> GatewayIntent -> GatewayIntent
$cmax :: GatewayIntent -> GatewayIntent -> GatewayIntent
>= :: GatewayIntent -> GatewayIntent -> Bool
$c>= :: GatewayIntent -> GatewayIntent -> Bool
> :: GatewayIntent -> GatewayIntent -> Bool
$c> :: GatewayIntent -> GatewayIntent -> Bool
<= :: GatewayIntent -> GatewayIntent -> Bool
$c<= :: GatewayIntent -> GatewayIntent -> Bool
< :: GatewayIntent -> GatewayIntent -> Bool
$c< :: GatewayIntent -> GatewayIntent -> Bool
compare :: GatewayIntent -> GatewayIntent -> Ordering
$ccompare :: GatewayIntent -> GatewayIntent -> Ordering
Ord)

instance Default GatewayIntent where
  def :: GatewayIntent
def = GatewayIntent { gatewayIntentGuilds :: Bool
gatewayIntentGuilds                 = Bool
True
                      , gatewayIntentMembers :: Bool
gatewayIntentMembers                = Bool
False -- false
                      , gatewayIntentBans :: Bool
gatewayIntentBans                   = Bool
True
                      , gatewayIntentEmojis :: Bool
gatewayIntentEmojis                 = Bool
True
                      , gatewayIntentIntegrations :: Bool
gatewayIntentIntegrations           = Bool
True
                      , gatewayIntentWebhooks :: Bool
gatewayIntentWebhooks               = Bool
True
                      , gatewayIntentInvites :: Bool
gatewayIntentInvites                = Bool
True
                      , gatewayIntentVoiceStates :: Bool
gatewayIntentVoiceStates            = Bool
True
                      , gatewayIntentPresences :: Bool
gatewayIntentPresences              = Bool
False  -- false
                      , gatewayIntentMessageChanges :: Bool
gatewayIntentMessageChanges         = Bool
True
                      , gatewayIntentMessageReactions :: Bool
gatewayIntentMessageReactions       = Bool
True
                      , gatewayIntentMessageTyping :: Bool
gatewayIntentMessageTyping          = Bool
True
                      , gatewayIntentDirectMessageChanges :: Bool
gatewayIntentDirectMessageChanges   = Bool
True
                      , gatewayIntentDirectMessageReactions :: Bool
gatewayIntentDirectMessageReactions = Bool
True
                      , gatewayIntentDirectMessageTyping :: Bool
gatewayIntentDirectMessageTyping    = Bool
True
                      , gatewayIntentMessageContent :: Bool
gatewayIntentMessageContent         = Bool
True
                      }

compileGatewayIntent :: GatewayIntent -> Int
compileGatewayIntent :: GatewayIntent -> Int
compileGatewayIntent GatewayIntent{Bool
gatewayIntentMessageContent :: Bool
gatewayIntentDirectMessageTyping :: Bool
gatewayIntentDirectMessageReactions :: Bool
gatewayIntentDirectMessageChanges :: Bool
gatewayIntentMessageTyping :: Bool
gatewayIntentMessageReactions :: Bool
gatewayIntentMessageChanges :: Bool
gatewayIntentPresences :: Bool
gatewayIntentVoiceStates :: Bool
gatewayIntentInvites :: Bool
gatewayIntentWebhooks :: Bool
gatewayIntentIntegrations :: Bool
gatewayIntentEmojis :: Bool
gatewayIntentBans :: Bool
gatewayIntentMembers :: Bool
gatewayIntentGuilds :: Bool
gatewayIntentMessageContent :: GatewayIntent -> Bool
gatewayIntentDirectMessageTyping :: GatewayIntent -> Bool
gatewayIntentDirectMessageReactions :: GatewayIntent -> Bool
gatewayIntentDirectMessageChanges :: GatewayIntent -> Bool
gatewayIntentMessageTyping :: GatewayIntent -> Bool
gatewayIntentMessageReactions :: GatewayIntent -> Bool
gatewayIntentMessageChanges :: GatewayIntent -> Bool
gatewayIntentPresences :: GatewayIntent -> Bool
gatewayIntentVoiceStates :: GatewayIntent -> Bool
gatewayIntentInvites :: GatewayIntent -> Bool
gatewayIntentWebhooks :: GatewayIntent -> Bool
gatewayIntentIntegrations :: GatewayIntent -> Bool
gatewayIntentEmojis :: GatewayIntent -> Bool
gatewayIntentBans :: GatewayIntent -> Bool
gatewayIntentMembers :: GatewayIntent -> Bool
gatewayIntentGuilds :: GatewayIntent -> Bool
..} =
 forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ [ if Bool
on then Int
flag else Int
0
       | (Int
flag, Bool
on) <- [ (     Int
1, Bool
gatewayIntentGuilds)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
1, Bool
gatewayIntentMembers)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
2, Bool
gatewayIntentBans)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
3, Bool
gatewayIntentEmojis)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
4, Bool
gatewayIntentIntegrations)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
5, Bool
gatewayIntentWebhooks)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
6, Bool
gatewayIntentInvites)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
7, Bool
gatewayIntentVoiceStates)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
8, Bool
gatewayIntentPresences)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^  Integer
9, Bool
gatewayIntentMessageChanges)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
10, Bool
gatewayIntentMessageReactions)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
11, Bool
gatewayIntentMessageTyping)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12, Bool
gatewayIntentDirectMessageChanges)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
13, Bool
gatewayIntentDirectMessageReactions)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
14, Bool
gatewayIntentDirectMessageTyping)
                       , (Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
15, Bool
gatewayIntentMessageContent)
                       ]
       ]

-- | Sent to gateway by a user
data GatewaySendable
  = RequestGuildMembers RequestGuildMembersOpts
  | UpdateStatus UpdateStatusOpts
  | UpdateStatusVoice UpdateStatusVoiceOpts
  deriving (Int -> GatewaySendable -> ShowS
[GatewaySendable] -> ShowS
GatewaySendable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewaySendable] -> ShowS
$cshowList :: [GatewaySendable] -> ShowS
show :: GatewaySendable -> String
$cshow :: GatewaySendable -> String
showsPrec :: Int -> GatewaySendable -> ShowS
$cshowsPrec :: Int -> GatewaySendable -> ShowS
Show, ReadPrec [GatewaySendable]
ReadPrec GatewaySendable
Int -> ReadS GatewaySendable
ReadS [GatewaySendable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GatewaySendable]
$creadListPrec :: ReadPrec [GatewaySendable]
readPrec :: ReadPrec GatewaySendable
$creadPrec :: ReadPrec GatewaySendable
readList :: ReadS [GatewaySendable]
$creadList :: ReadS [GatewaySendable]
readsPrec :: Int -> ReadS GatewaySendable
$creadsPrec :: Int -> ReadS GatewaySendable
Read, GatewaySendable -> GatewaySendable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GatewaySendable -> GatewaySendable -> Bool
$c/= :: GatewaySendable -> GatewaySendable -> Bool
== :: GatewaySendable -> GatewaySendable -> Bool
$c== :: GatewaySendable -> GatewaySendable -> Bool
Eq, Eq GatewaySendable
GatewaySendable -> GatewaySendable -> Bool
GatewaySendable -> GatewaySendable -> Ordering
GatewaySendable -> GatewaySendable -> GatewaySendable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GatewaySendable -> GatewaySendable -> GatewaySendable
$cmin :: GatewaySendable -> GatewaySendable -> GatewaySendable
max :: GatewaySendable -> GatewaySendable -> GatewaySendable
$cmax :: GatewaySendable -> GatewaySendable -> GatewaySendable
>= :: GatewaySendable -> GatewaySendable -> Bool
$c>= :: GatewaySendable -> GatewaySendable -> Bool
> :: GatewaySendable -> GatewaySendable -> Bool
$c> :: GatewaySendable -> GatewaySendable -> Bool
<= :: GatewaySendable -> GatewaySendable -> Bool
$c<= :: GatewaySendable -> GatewaySendable -> Bool
< :: GatewaySendable -> GatewaySendable -> Bool
$c< :: GatewaySendable -> GatewaySendable -> Bool
compare :: GatewaySendable -> GatewaySendable -> Ordering
$ccompare :: GatewaySendable -> GatewaySendable -> Ordering
Ord)

-- | Options for `RequestGuildMembers`
data RequestGuildMembersOpts = RequestGuildMembersOpts
                             { RequestGuildMembersOpts -> GuildId
requestGuildMembersOptsGuildId :: GuildId
                             , RequestGuildMembersOpts -> Text
requestGuildMembersOptsNamesStartingWith :: T.Text
                             , RequestGuildMembersOpts -> Integer
requestGuildMembersOptsLimit :: Integer }
  deriving (Int -> RequestGuildMembersOpts -> ShowS
[RequestGuildMembersOpts] -> ShowS
RequestGuildMembersOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestGuildMembersOpts] -> ShowS
$cshowList :: [RequestGuildMembersOpts] -> ShowS
show :: RequestGuildMembersOpts -> String
$cshow :: RequestGuildMembersOpts -> String
showsPrec :: Int -> RequestGuildMembersOpts -> ShowS
$cshowsPrec :: Int -> RequestGuildMembersOpts -> ShowS
Show, ReadPrec [RequestGuildMembersOpts]
ReadPrec RequestGuildMembersOpts
Int -> ReadS RequestGuildMembersOpts
ReadS [RequestGuildMembersOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestGuildMembersOpts]
$creadListPrec :: ReadPrec [RequestGuildMembersOpts]
readPrec :: ReadPrec RequestGuildMembersOpts
$creadPrec :: ReadPrec RequestGuildMembersOpts
readList :: ReadS [RequestGuildMembersOpts]
$creadList :: ReadS [RequestGuildMembersOpts]
readsPrec :: Int -> ReadS RequestGuildMembersOpts
$creadsPrec :: Int -> ReadS RequestGuildMembersOpts
Read, RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c/= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
== :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c== :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
Eq, Eq RequestGuildMembersOpts
RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
$cmin :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
max :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
$cmax :: RequestGuildMembersOpts
-> RequestGuildMembersOpts -> RequestGuildMembersOpts
>= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c>= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
> :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c> :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
<= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c<= :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
< :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
$c< :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Bool
compare :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
$ccompare :: RequestGuildMembersOpts -> RequestGuildMembersOpts -> Ordering
Ord)

-- | Options for `UpdateStatusVoice`
data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts
                           { UpdateStatusVoiceOpts -> GuildId
updateStatusVoiceOptsGuildId :: GuildId
                           , UpdateStatusVoiceOpts -> Maybe ChannelId
updateStatusVoiceOptsChannelId :: Maybe ChannelId
                           , UpdateStatusVoiceOpts -> Bool
updateStatusVoiceOptsIsMuted :: Bool
                           , UpdateStatusVoiceOpts -> Bool
updateStatusVoiceOptsIsDeaf :: Bool
                           }
  deriving (Int -> UpdateStatusVoiceOpts -> ShowS
[UpdateStatusVoiceOpts] -> ShowS
UpdateStatusVoiceOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusVoiceOpts] -> ShowS
$cshowList :: [UpdateStatusVoiceOpts] -> ShowS
show :: UpdateStatusVoiceOpts -> String
$cshow :: UpdateStatusVoiceOpts -> String
showsPrec :: Int -> UpdateStatusVoiceOpts -> ShowS
$cshowsPrec :: Int -> UpdateStatusVoiceOpts -> ShowS
Show, ReadPrec [UpdateStatusVoiceOpts]
ReadPrec UpdateStatusVoiceOpts
Int -> ReadS UpdateStatusVoiceOpts
ReadS [UpdateStatusVoiceOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStatusVoiceOpts]
$creadListPrec :: ReadPrec [UpdateStatusVoiceOpts]
readPrec :: ReadPrec UpdateStatusVoiceOpts
$creadPrec :: ReadPrec UpdateStatusVoiceOpts
readList :: ReadS [UpdateStatusVoiceOpts]
$creadList :: ReadS [UpdateStatusVoiceOpts]
readsPrec :: Int -> ReadS UpdateStatusVoiceOpts
$creadsPrec :: Int -> ReadS UpdateStatusVoiceOpts
Read, UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c/= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
== :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c== :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
Eq, Eq UpdateStatusVoiceOpts
UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
$cmin :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
max :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
$cmax :: UpdateStatusVoiceOpts
-> UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts
>= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c>= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
> :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c> :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
<= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c<= :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
< :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
$c< :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Bool
compare :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
$ccompare :: UpdateStatusVoiceOpts -> UpdateStatusVoiceOpts -> Ordering
Ord)

-- | Options for `UpdateStatus`
data UpdateStatusOpts = UpdateStatusOpts
                      { UpdateStatusOpts -> Maybe UTCTime
updateStatusOptsSince :: Maybe UTCTime
                      , UpdateStatusOpts -> Maybe Activity
updateStatusOptsGame :: Maybe Activity
                      , UpdateStatusOpts -> UpdateStatusType
updateStatusOptsNewStatus :: UpdateStatusType
                      , UpdateStatusOpts -> Bool
updateStatusOptsAFK :: Bool
                      }
  deriving (Int -> UpdateStatusOpts -> ShowS
[UpdateStatusOpts] -> ShowS
UpdateStatusOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusOpts] -> ShowS
$cshowList :: [UpdateStatusOpts] -> ShowS
show :: UpdateStatusOpts -> String
$cshow :: UpdateStatusOpts -> String
showsPrec :: Int -> UpdateStatusOpts -> ShowS
$cshowsPrec :: Int -> UpdateStatusOpts -> ShowS
Show, ReadPrec [UpdateStatusOpts]
ReadPrec UpdateStatusOpts
Int -> ReadS UpdateStatusOpts
ReadS [UpdateStatusOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStatusOpts]
$creadListPrec :: ReadPrec [UpdateStatusOpts]
readPrec :: ReadPrec UpdateStatusOpts
$creadPrec :: ReadPrec UpdateStatusOpts
readList :: ReadS [UpdateStatusOpts]
$creadList :: ReadS [UpdateStatusOpts]
readsPrec :: Int -> ReadS UpdateStatusOpts
$creadsPrec :: Int -> ReadS UpdateStatusOpts
Read, UpdateStatusOpts -> UpdateStatusOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c/= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
== :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c== :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
Eq, Eq UpdateStatusOpts
UpdateStatusOpts -> UpdateStatusOpts -> Bool
UpdateStatusOpts -> UpdateStatusOpts -> Ordering
UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
$cmin :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
max :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
$cmax :: UpdateStatusOpts -> UpdateStatusOpts -> UpdateStatusOpts
>= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c>= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
> :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c> :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
<= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c<= :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
< :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
$c< :: UpdateStatusOpts -> UpdateStatusOpts -> Bool
compare :: UpdateStatusOpts -> UpdateStatusOpts -> Ordering
$ccompare :: UpdateStatusOpts -> UpdateStatusOpts -> Ordering
Ord)

-- | Possible values for `updateStatusOptsNewStatus`
data UpdateStatusType = UpdateStatusOnline
                      | UpdateStatusDoNotDisturb
                      | UpdateStatusAwayFromKeyboard
                      | UpdateStatusInvisibleOffline
                      | UpdateStatusOffline
  deriving (Int -> UpdateStatusType -> ShowS
[UpdateStatusType] -> ShowS
UpdateStatusType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStatusType] -> ShowS
$cshowList :: [UpdateStatusType] -> ShowS
show :: UpdateStatusType -> String
$cshow :: UpdateStatusType -> String
showsPrec :: Int -> UpdateStatusType -> ShowS
$cshowsPrec :: Int -> UpdateStatusType -> ShowS
Show, ReadPrec [UpdateStatusType]
ReadPrec UpdateStatusType
Int -> ReadS UpdateStatusType
ReadS [UpdateStatusType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStatusType]
$creadListPrec :: ReadPrec [UpdateStatusType]
readPrec :: ReadPrec UpdateStatusType
$creadPrec :: ReadPrec UpdateStatusType
readList :: ReadS [UpdateStatusType]
$creadList :: ReadS [UpdateStatusType]
readsPrec :: Int -> ReadS UpdateStatusType
$creadsPrec :: Int -> ReadS UpdateStatusType
Read, UpdateStatusType -> UpdateStatusType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStatusType -> UpdateStatusType -> Bool
$c/= :: UpdateStatusType -> UpdateStatusType -> Bool
== :: UpdateStatusType -> UpdateStatusType -> Bool
$c== :: UpdateStatusType -> UpdateStatusType -> Bool
Eq, Eq UpdateStatusType
UpdateStatusType -> UpdateStatusType -> Bool
UpdateStatusType -> UpdateStatusType -> Ordering
UpdateStatusType -> UpdateStatusType -> UpdateStatusType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
$cmin :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
max :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
$cmax :: UpdateStatusType -> UpdateStatusType -> UpdateStatusType
>= :: UpdateStatusType -> UpdateStatusType -> Bool
$c>= :: UpdateStatusType -> UpdateStatusType -> Bool
> :: UpdateStatusType -> UpdateStatusType -> Bool
$c> :: UpdateStatusType -> UpdateStatusType -> Bool
<= :: UpdateStatusType -> UpdateStatusType -> Bool
$c<= :: UpdateStatusType -> UpdateStatusType -> Bool
< :: UpdateStatusType -> UpdateStatusType -> Bool
$c< :: UpdateStatusType -> UpdateStatusType -> Bool
compare :: UpdateStatusType -> UpdateStatusType -> Ordering
$ccompare :: UpdateStatusType -> UpdateStatusType -> Ordering
Ord, Int -> UpdateStatusType
UpdateStatusType -> Int
UpdateStatusType -> [UpdateStatusType]
UpdateStatusType -> UpdateStatusType
UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromThenTo :: UpdateStatusType
-> UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFromTo :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromTo :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFromThen :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
$cenumFromThen :: UpdateStatusType -> UpdateStatusType -> [UpdateStatusType]
enumFrom :: UpdateStatusType -> [UpdateStatusType]
$cenumFrom :: UpdateStatusType -> [UpdateStatusType]
fromEnum :: UpdateStatusType -> Int
$cfromEnum :: UpdateStatusType -> Int
toEnum :: Int -> UpdateStatusType
$ctoEnum :: Int -> UpdateStatusType
pred :: UpdateStatusType -> UpdateStatusType
$cpred :: UpdateStatusType -> UpdateStatusType
succ :: UpdateStatusType -> UpdateStatusType
$csucc :: UpdateStatusType -> UpdateStatusType
Enum)


-- | Converts an UpdateStatusType to a textual representation
statusString :: UpdateStatusType -> T.Text
statusString :: UpdateStatusType -> Text
statusString UpdateStatusType
s = case UpdateStatusType
s of
  UpdateStatusType
UpdateStatusOnline -> Text
"online"
  UpdateStatusType
UpdateStatusDoNotDisturb -> Text
"dnd"
  UpdateStatusType
UpdateStatusAwayFromKeyboard -> Text
"idle"
  UpdateStatusType
UpdateStatusInvisibleOffline -> Text
"invisible"
  UpdateStatusType
UpdateStatusOffline -> Text
"offline"

instance FromJSON GatewayReceivable where
  parseJSON :: Value -> Parser GatewayReceivable
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"payload" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
op <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"op" :: Parser Int
    case Int
op of
      Int
0  -> do Text
etype <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"t"
               Value
ejson <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d"
               case Value
ejson of
                 Object Object
hm -> EventInternalParse -> Integer -> GatewayReceivable
Dispatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Parser EventInternalParse
eventParse Text
etype Object
hm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"s"
                 Value
_other -> EventInternalParse -> Integer -> GatewayReceivable
Dispatch (Text -> Object -> EventInternalParse
InternalUnknownEvent Text
"Dispatch payload wasn't an object" Object
o)
                                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"s"
      Int
1  -> Integer -> GatewayReceivable
HeartbeatRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d"
      Int
7  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GatewayReceivable
Reconnect
      Int
9  -> Bool -> GatewayReceivable
InvalidSession forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d"
      Int
10 -> do Object
od <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d"
               Integer
int <- Object
od forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heartbeat_interval"
               forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> GatewayReceivable
Hello Integer
int)
      Int
11 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GatewayReceivable
HeartbeatAck
      Int
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown Receivable payload ID:" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
op)

-- instance FromJSON GatewaySendable where
--   parseJSON = withObject "payload" $ \o -> do
--     op <- o .: "op" :: Parser Int
--     case op of
--       1  -> Heartbeat . fromMaybe 0 . readMaybe <$> o .: "d"
--       2  -> do od <- o .: "d"
--                tok <- od .: "token"
--                compress <- od .:? "compress" .!= False
--
--       _  -> fail ("Unknown Sendable payload ID:" <> show op)

instance ToJSON GatewaySendableInternal where
  toJSON :: GatewaySendableInternal -> Value
toJSON (Heartbeat Integer
i) = [Pair] -> Value
object [ Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
1 :: Int), Key
"d" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
0 then String
"null" else forall a. Show a => a -> String
show Integer
i ]
  toJSON (Identify Auth
token GatewayIntent
intent (Int, Int)
shard) = [Pair] -> Value
object [
      Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
2 :: Int)
    , Key
"d"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
        Key
"token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Auth -> Text
authToken Auth
token
      , Key
"intents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GatewayIntent -> Int
compileGatewayIntent GatewayIntent
intent
      , Key
"properties" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
          Key
"$os"                forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
os
        , Key
"$browser"           forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"discord-haskell" :: T.Text)
        , Key
"$device"            forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"discord-haskell" :: T.Text)
        , Key
"$referrer"          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
""                :: T.Text)
        , Key
"$referring_domain"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
""                :: T.Text)
        ]
      , Key
"compress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False
      , Key
"large_threshold" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
50 :: Int) -- stop sending offline members over 50
      , Key
"shard" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int, Int)
shard
      ]
    ]
  toJSON (Resume Auth
token Text
session Integer
seqId) = [Pair] -> Value
object [
      Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
6 :: Int)
    , Key
"d"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
        Key
"token"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Auth -> Text
authToken Auth
token
      , Key
"session_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
session
      , Key
"seq"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
seqId
      ]
    ]

instance ToJSON GatewaySendable where
  toJSON :: GatewaySendable -> Value
toJSON (UpdateStatus (UpdateStatusOpts Maybe UTCTime
since Maybe Activity
game UpdateStatusType
status Bool
afk)) = [Pair] -> Value
object [
      Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
3 :: Int)
    , Key
"d"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
        Key
"since" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe UTCTime
since forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \UTCTime
s -> POSIXTime
1000 forall a. Num a => a -> a -> a
* UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
s) -- takes UTCTime and returns unix time (in milliseconds)
      , Key
"afk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
afk
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UpdateStatusType -> Text
statusString UpdateStatusType
status
      , Key
"game" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe Activity
game forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Activity
a -> [Pair] -> Value
object [
                                Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Activity -> Text
activityName Activity
a
                              , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. InternalDiscordEnum a => a -> Int
fromDiscordType (Activity -> ActivityType
activityType Activity
a)
                              , Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Activity -> Maybe Text
activityUrl Activity
a
                              ])
      ]
    ]
  toJSON (UpdateStatusVoice (UpdateStatusVoiceOpts GuildId
guild Maybe ChannelId
channel Bool
mute Bool
deaf)) =
    [Pair] -> Value
object [
      Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
4 :: Int)
    , Key
"d"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
        Key
"guild_id"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GuildId
guild
      , Key
"channel_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ChannelId
channel
      , Key
"self_mute"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
mute
      , Key
"self_deaf"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
deaf
      ]
    ]
  toJSON (RequestGuildMembers (RequestGuildMembersOpts GuildId
guild Text
query Integer
limit)) =
    [Pair] -> Value
object [
      Key
"op" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
8 :: Int)
    , Key
"d"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
        Key
"guild_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GuildId
guild
      , Key
"query"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
query
      , Key
"limit"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
limit
      ]
    ]