{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-|
Module      : Discord.Internal.Types.VoiceWebsocket
Description : Strictly for internal use only. See Discord.Voice for the public interface.
Copyright   : (c) Yuto Takano (2021)
License     : MIT
Maintainer  : moa17stock@gmail.com

= WARNING

This module is considered __internal__.

The Package Versioning Policy __does not apply__.

The contents of this module may change __in any way whatsoever__ and __without__
__any warning__ between minor versions of this package.

= Description

This module defines basic types for the communication packets in the Discord
Voice Gateway. Some ToJSON and FromJSON instances are defined, as according to
the official Discord documentation for v4 of the gateway.

Prisms are defined using TemplateHaskell for VoiceWebsocketReceivable.
-}
module Discord.Internal.Types.VoiceWebsocket where

import Control.Applicative ( (<|>) )
import Lens.Micro
import Data.Aeson
import Data.Aeson.Types
import Data.Text qualified as T
import Data.ByteString qualified as B
import Data.Word ( Word8 )

import Discord.Internal.Types.Prelude

data VoiceWebsocketReceivable
    = Ready ReadyPayload                            -- Opcode 2
    | SessionDescription T.Text [Word8]             -- Opcode 4
    | SpeakingR SpeakingPayload                     -- Opcode 5
    | HeartbeatAck Int                              -- Opcode 6
    | Hello Int                                     -- Opcode 8
      -- ^ Int because this is heartbeat, and threadDelay uses it
    | Resumed                                       -- Opcode 9
    | ClientDisconnect UserId                       -- Opcode 13
    | UnknownOPCode Integer Object                  -- Opcode unknown
    | ParseError T.Text                             -- Internal use
    | Reconnect                                     -- Internal use
    deriving (Int -> VoiceWebsocketReceivable -> ShowS
[VoiceWebsocketReceivable] -> ShowS
VoiceWebsocketReceivable -> String
(Int -> VoiceWebsocketReceivable -> ShowS)
-> (VoiceWebsocketReceivable -> String)
-> ([VoiceWebsocketReceivable] -> ShowS)
-> Show VoiceWebsocketReceivable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceWebsocketReceivable] -> ShowS
$cshowList :: [VoiceWebsocketReceivable] -> ShowS
show :: VoiceWebsocketReceivable -> String
$cshow :: VoiceWebsocketReceivable -> String
showsPrec :: Int -> VoiceWebsocketReceivable -> ShowS
$cshowsPrec :: Int -> VoiceWebsocketReceivable -> ShowS
Show, VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool
(VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool)
-> (VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool)
-> Eq VoiceWebsocketReceivable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool
$c/= :: VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool
== :: VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool
$c== :: VoiceWebsocketReceivable -> VoiceWebsocketReceivable -> Bool
Eq)

_Ready :: Traversal' VoiceWebsocketReceivable ReadyPayload
_Ready :: (ReadyPayload -> f ReadyPayload)
-> VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
_Ready ReadyPayload -> f ReadyPayload
f (Ready ReadyPayload
rp) = ReadyPayload -> VoiceWebsocketReceivable
Ready (ReadyPayload -> VoiceWebsocketReceivable)
-> f ReadyPayload -> f VoiceWebsocketReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadyPayload -> f ReadyPayload
f ReadyPayload
rp
_Ready ReadyPayload -> f ReadyPayload
f VoiceWebsocketReceivable
rp = VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceWebsocketReceivable
rp

_SessionDescription :: Traversal' VoiceWebsocketReceivable (T.Text, [Word8])
_SessionDescription :: ((Text, [Word8]) -> f (Text, [Word8]))
-> VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
_SessionDescription (Text, [Word8]) -> f (Text, [Word8])
f (SessionDescription Text
t [Word8]
bytes) = (Text -> [Word8] -> VoiceWebsocketReceivable)
-> (Text, [Word8]) -> VoiceWebsocketReceivable
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [Word8] -> VoiceWebsocketReceivable
SessionDescription ((Text, [Word8]) -> VoiceWebsocketReceivable)
-> f (Text, [Word8]) -> f VoiceWebsocketReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, [Word8]) -> f (Text, [Word8])
f (Text
t, [Word8]
bytes)
_SessionDescription (Text, [Word8]) -> f (Text, [Word8])
f VoiceWebsocketReceivable
sd = VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceWebsocketReceivable
sd

_Hello :: Traversal' VoiceWebsocketReceivable Int
_Hello :: (Int -> f Int)
-> VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
_Hello Int -> f Int
f (Hello Int
a) = Int -> VoiceWebsocketReceivable
Hello (Int -> VoiceWebsocketReceivable)
-> f Int -> f VoiceWebsocketReceivable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f Int
a
_Hello Int -> f Int
f VoiceWebsocketReceivable
a = VoiceWebsocketReceivable -> f VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceWebsocketReceivable
a


data VoiceWebsocketSendable
    = Identify IdentifyPayload                      -- Opcode 0
    | SelectProtocol SelectProtocolPayload          -- Opcode 1
    | Heartbeat Int                                 -- Opcode 3
      -- ^ Int because threadDelay uses it
    | Speaking SpeakingPayload                      -- Opcode 5
    | Resume GuildId T.Text T.Text                  -- Opcode 7
    deriving (Int -> VoiceWebsocketSendable -> ShowS
[VoiceWebsocketSendable] -> ShowS
VoiceWebsocketSendable -> String
(Int -> VoiceWebsocketSendable -> ShowS)
-> (VoiceWebsocketSendable -> String)
-> ([VoiceWebsocketSendable] -> ShowS)
-> Show VoiceWebsocketSendable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceWebsocketSendable] -> ShowS
$cshowList :: [VoiceWebsocketSendable] -> ShowS
show :: VoiceWebsocketSendable -> String
$cshow :: VoiceWebsocketSendable -> String
showsPrec :: Int -> VoiceWebsocketSendable -> ShowS
$cshowsPrec :: Int -> VoiceWebsocketSendable -> ShowS
Show, VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool
(VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool)
-> (VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool)
-> Eq VoiceWebsocketSendable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool
$c/= :: VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool
== :: VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool
$c== :: VoiceWebsocketSendable -> VoiceWebsocketSendable -> Bool
Eq)

data ReadyPayload = ReadyPayload
    { ReadyPayload -> Integer
readyPayloadSSRC  :: Integer -- contains the 32-bit SSRC identifier
    , ReadyPayload -> Text
readyPayloadIP    :: T.Text
    , ReadyPayload -> Integer
readyPayloadPort  :: Integer
    , ReadyPayload -> [Text]
readyPayloadModes :: [T.Text]
    -- , readyPayloadHeartbeatInterval <- This should not be used, as per Discord documentation
    }
    deriving (Int -> ReadyPayload -> ShowS
[ReadyPayload] -> ShowS
ReadyPayload -> String
(Int -> ReadyPayload -> ShowS)
-> (ReadyPayload -> String)
-> ([ReadyPayload] -> ShowS)
-> Show ReadyPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadyPayload] -> ShowS
$cshowList :: [ReadyPayload] -> ShowS
show :: ReadyPayload -> String
$cshow :: ReadyPayload -> String
showsPrec :: Int -> ReadyPayload -> ShowS
$cshowsPrec :: Int -> ReadyPayload -> ShowS
Show, ReadyPayload -> ReadyPayload -> Bool
(ReadyPayload -> ReadyPayload -> Bool)
-> (ReadyPayload -> ReadyPayload -> Bool) -> Eq ReadyPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadyPayload -> ReadyPayload -> Bool
$c/= :: ReadyPayload -> ReadyPayload -> Bool
== :: ReadyPayload -> ReadyPayload -> Bool
$c== :: ReadyPayload -> ReadyPayload -> Bool
Eq)

data SpeakingPayload = SpeakingPayload
    { SpeakingPayload -> Bool
speakingPayloadMicrophone :: Bool
    , SpeakingPayload -> Bool
speakingPayloadSoundshare :: Bool
    , SpeakingPayload -> Bool
speakingPayloadPriority   :: Bool
    , SpeakingPayload -> Integer
speakingPayloadDelay      :: Integer
    , SpeakingPayload -> Integer
speakingPayloadSSRC       :: Integer
    }
    deriving (Int -> SpeakingPayload -> ShowS
[SpeakingPayload] -> ShowS
SpeakingPayload -> String
(Int -> SpeakingPayload -> ShowS)
-> (SpeakingPayload -> String)
-> ([SpeakingPayload] -> ShowS)
-> Show SpeakingPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpeakingPayload] -> ShowS
$cshowList :: [SpeakingPayload] -> ShowS
show :: SpeakingPayload -> String
$cshow :: SpeakingPayload -> String
showsPrec :: Int -> SpeakingPayload -> ShowS
$cshowsPrec :: Int -> SpeakingPayload -> ShowS
Show, SpeakingPayload -> SpeakingPayload -> Bool
(SpeakingPayload -> SpeakingPayload -> Bool)
-> (SpeakingPayload -> SpeakingPayload -> Bool)
-> Eq SpeakingPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeakingPayload -> SpeakingPayload -> Bool
$c/= :: SpeakingPayload -> SpeakingPayload -> Bool
== :: SpeakingPayload -> SpeakingPayload -> Bool
$c== :: SpeakingPayload -> SpeakingPayload -> Bool
Eq)

data IdentifyPayload = IdentifyPayload
    { IdentifyPayload -> GuildId
identifyPayloadServerId  :: GuildId
    , IdentifyPayload -> UserId
identifyPayloadUserId    :: UserId
    , IdentifyPayload -> Text
identifyPayloadSessionId :: T.Text
    , IdentifyPayload -> Text
identifyPayloadToken     :: T.Text
    }
    deriving (Int -> IdentifyPayload -> ShowS
[IdentifyPayload] -> ShowS
IdentifyPayload -> String
(Int -> IdentifyPayload -> ShowS)
-> (IdentifyPayload -> String)
-> ([IdentifyPayload] -> ShowS)
-> Show IdentifyPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifyPayload] -> ShowS
$cshowList :: [IdentifyPayload] -> ShowS
show :: IdentifyPayload -> String
$cshow :: IdentifyPayload -> String
showsPrec :: Int -> IdentifyPayload -> ShowS
$cshowsPrec :: Int -> IdentifyPayload -> ShowS
Show, IdentifyPayload -> IdentifyPayload -> Bool
(IdentifyPayload -> IdentifyPayload -> Bool)
-> (IdentifyPayload -> IdentifyPayload -> Bool)
-> Eq IdentifyPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentifyPayload -> IdentifyPayload -> Bool
$c/= :: IdentifyPayload -> IdentifyPayload -> Bool
== :: IdentifyPayload -> IdentifyPayload -> Bool
$c== :: IdentifyPayload -> IdentifyPayload -> Bool
Eq)

data SelectProtocolPayload = SelectProtocolPayload
    { SelectProtocolPayload -> Text
selectProtocolPayloadProtocol :: T.Text
    , SelectProtocolPayload -> Text
selectProtocolPayloadIP       :: T.Text
    , SelectProtocolPayload -> Integer
selectProtocolPayloadPort     :: Integer
    , SelectProtocolPayload -> Text
selectProtocolPayloadMode     :: T.Text
    }
    deriving (Int -> SelectProtocolPayload -> ShowS
[SelectProtocolPayload] -> ShowS
SelectProtocolPayload -> String
(Int -> SelectProtocolPayload -> ShowS)
-> (SelectProtocolPayload -> String)
-> ([SelectProtocolPayload] -> ShowS)
-> Show SelectProtocolPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectProtocolPayload] -> ShowS
$cshowList :: [SelectProtocolPayload] -> ShowS
show :: SelectProtocolPayload -> String
$cshow :: SelectProtocolPayload -> String
showsPrec :: Int -> SelectProtocolPayload -> ShowS
$cshowsPrec :: Int -> SelectProtocolPayload -> ShowS
Show, SelectProtocolPayload -> SelectProtocolPayload -> Bool
(SelectProtocolPayload -> SelectProtocolPayload -> Bool)
-> (SelectProtocolPayload -> SelectProtocolPayload -> Bool)
-> Eq SelectProtocolPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectProtocolPayload -> SelectProtocolPayload -> Bool
$c/= :: SelectProtocolPayload -> SelectProtocolPayload -> Bool
== :: SelectProtocolPayload -> SelectProtocolPayload -> Bool
$c== :: SelectProtocolPayload -> SelectProtocolPayload -> Bool
Eq)

instance FromJSON VoiceWebsocketReceivable where
    parseJSON :: Value -> Parser VoiceWebsocketReceivable
parseJSON = String
-> (Object -> Parser VoiceWebsocketReceivable)
-> Value
-> Parser VoiceWebsocketReceivable
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"payload" ((Object -> Parser VoiceWebsocketReceivable)
 -> Value -> Parser VoiceWebsocketReceivable)
-> (Object -> Parser VoiceWebsocketReceivable)
-> Value
-> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
op <- Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"op" :: Parser Integer
        case Integer
op of
            Integer
2 -> do
                Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                Integer
ssrc <- Object
od Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ssrc"
                Text
ip <- Object
od Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ip"
                Integer
port <- Object
od Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"port"
                [Text]
modes <- Object
od Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"modes"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ ReadyPayload -> VoiceWebsocketReceivable
Ready (ReadyPayload -> VoiceWebsocketReceivable)
-> ReadyPayload -> VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ Integer -> Text -> Integer -> [Text] -> ReadyPayload
ReadyPayload Integer
ssrc Text
ip Integer
port [Text]
modes
            Integer
4 -> do
                Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                Text
mode <- Object
od Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mode"
                [Word8]
secretKey <- Object
od Object -> Text -> Parser [Word8]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"secret_key"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ Text -> [Word8] -> VoiceWebsocketReceivable
SessionDescription Text
mode [Word8]
secretKey
            Integer
5 -> do
                Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                Int
speaking <-
                    -- speaking field can be a number or a boolean.
                    -- This is undocumented in the docs. God, discord.
                    (Object
od Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"speaking" :: Parser Int) Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                        (do
                            Bool
s <- Object
od Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"speaking" :: Parser Bool
                            case Bool
s of
                                Bool
True  -> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
                                Bool
False -> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
                        )

                let (Int
priority, Int
rest1) = Int
speaking Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4
                let (Int
soundshare, Int
rest2) = Int
rest1 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2
                let microphone :: Int
microphone = Int
rest2
                Integer
delay <- Object
od Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"delay" Parser (Maybe Integer) -> Integer -> Parser Integer
forall a. Parser (Maybe a) -> a -> Parser a
.!= Integer
0
                -- The delay key is not present when we receive this data, but
                -- present when we send it, I think? not documented anywhere.
                Integer
ssrc <- Object
od Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ssrc"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ SpeakingPayload -> VoiceWebsocketReceivable
SpeakingR (SpeakingPayload -> VoiceWebsocketReceivable)
-> SpeakingPayload -> VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ SpeakingPayload :: Bool -> Bool -> Bool -> Integer -> Integer -> SpeakingPayload
SpeakingPayload
                    { speakingPayloadMicrophone :: Bool
speakingPayloadMicrophone = Int -> Bool
forall a. Enum a => Int -> a
toEnum Int
microphone
                    , speakingPayloadSoundshare :: Bool
speakingPayloadSoundshare = Int -> Bool
forall a. Enum a => Int -> a
toEnum Int
soundshare
                    , speakingPayloadPriority :: Bool
speakingPayloadPriority   = Int -> Bool
forall a. Enum a => Int -> a
toEnum Int
priority
                    , speakingPayloadDelay :: Integer
speakingPayloadDelay      = Integer
delay
                    , speakingPayloadSSRC :: Integer
speakingPayloadSSRC       = Integer
ssrc
                    }
            Integer
6 -> do
                Int
od <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ Int -> VoiceWebsocketReceivable
HeartbeatAck Int
od
            Integer
8 -> do
                Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                Int
interval <- Object
od Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"heartbeat_interval"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ Int -> VoiceWebsocketReceivable
Hello Int
interval
            Integer
9 -> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceWebsocketReceivable
Resumed
            Integer
13 -> do
                Object
od <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
                UserId
uid <- Object
od Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
                VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ UserId -> VoiceWebsocketReceivable
ClientDisconnect UserId
uid
            Integer
_ -> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable)
-> VoiceWebsocketReceivable -> Parser VoiceWebsocketReceivable
forall a b. (a -> b) -> a -> b
$ Integer -> Object -> VoiceWebsocketReceivable
UnknownOPCode Integer
op Object
o

instance ToJSON VoiceWebsocketSendable where
    toJSON :: VoiceWebsocketSendable -> Value
toJSON (Identify IdentifyPayload
payload) = [Pair] -> Value
object
        [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
0 :: Int)
        , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"server_id"  Text -> GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= IdentifyPayload -> GuildId
identifyPayloadServerId IdentifyPayload
payload
            , Text
"user_id"    Text -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= IdentifyPayload -> UserId
identifyPayloadUserId IdentifyPayload
payload
            , Text
"session_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= IdentifyPayload -> Text
identifyPayloadSessionId IdentifyPayload
payload
            , Text
"token"      Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= IdentifyPayload -> Text
identifyPayloadToken IdentifyPayload
payload
            ]
        ]
    toJSON (SelectProtocol SelectProtocolPayload
payload) = [Pair] -> Value
object
        [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
1 :: Int)
        , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"protocol" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectProtocolPayload -> Text
selectProtocolPayloadProtocol SelectProtocolPayload
payload
            , Text
"data"     Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
                [ Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectProtocolPayload -> Text
selectProtocolPayloadIP SelectProtocolPayload
payload
                , Text
"port"    Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectProtocolPayload -> Integer
selectProtocolPayloadPort SelectProtocolPayload
payload
                , Text
"mode"    Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectProtocolPayload -> Text
selectProtocolPayloadMode SelectProtocolPayload
payload
                ]
            ]
        ]
    toJSON (Heartbeat Int
i) = [Pair] -> Value
object
        [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
3 :: Int)
        , Text
"d"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
i
        ]
    toJSON (Speaking SpeakingPayload
payload) = [Pair] -> Value
object
        [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
5 :: Int)
        , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"speaking" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
                ( Bool -> Int
forall a. Enum a => a -> Int
fromEnum (SpeakingPayload -> Bool
speakingPayloadMicrophone SpeakingPayload
payload)
                Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum (SpeakingPayload -> Bool
speakingPayloadSoundshare SpeakingPayload
payload) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
                Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum (SpeakingPayload -> Bool
speakingPayloadPriority SpeakingPayload
payload) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
                )
            , Text
"delay"    Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SpeakingPayload -> Integer
speakingPayloadDelay SpeakingPayload
payload
            , Text
"ssrc"     Text -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SpeakingPayload -> Integer
speakingPayloadSSRC SpeakingPayload
payload
            ]
        ]
    toJSON (Resume GuildId
gid Text
session Text
token) = [Pair] -> Value
object
        [ Text
"op" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
7 :: Int)
        , Text
"d"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"server_id"  Text -> GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GuildId
gid
            , Text
"session_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
session
            , Text
"token"      Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
token
            ]
        ]

-- $(makePrisms ''VoiceWebsocketReceivable)