{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-|
Module      : Discord.Internal.Types.VoiceUDP
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 UDP socket. Binary instances are defined for the header and the body
payload, as according to the official Discord documentation for v4 of the gateway.

Prisms are defined using TemplateHaskell for VoiceUDPPacket.
-}
module Discord.Internal.Types.VoiceUDP where

import Lens.Micro
import Data.Binary.Get
import Data.Binary.Put
import Data.Binary
import Data.ByteString.Lazy qualified as BL
import Data.ByteString qualified as B
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE

data VoiceUDPPacket
    = IPDiscovery Integer T.Text Integer
    -- ^ ssrc, ip, port
    | SpeakingData B.ByteString
    | SpeakingDataEncrypted B.ByteString BL.ByteString
    -- ^ header, and encrypted audio bytes
    | SpeakingDataEncryptedExtra B.ByteString BL.ByteString
    -- ^ header, and encrypted audio bytes with extended header inside
    | UnknownPacket BL.ByteString
    | MalformedPacket BL.ByteString
    deriving (Int -> VoiceUDPPacket -> ShowS
[VoiceUDPPacket] -> ShowS
VoiceUDPPacket -> String
(Int -> VoiceUDPPacket -> ShowS)
-> (VoiceUDPPacket -> String)
-> ([VoiceUDPPacket] -> ShowS)
-> Show VoiceUDPPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceUDPPacket] -> ShowS
$cshowList :: [VoiceUDPPacket] -> ShowS
show :: VoiceUDPPacket -> String
$cshow :: VoiceUDPPacket -> String
showsPrec :: Int -> VoiceUDPPacket -> ShowS
$cshowsPrec :: Int -> VoiceUDPPacket -> ShowS
Show, VoiceUDPPacket -> VoiceUDPPacket -> Bool
(VoiceUDPPacket -> VoiceUDPPacket -> Bool)
-> (VoiceUDPPacket -> VoiceUDPPacket -> Bool) -> Eq VoiceUDPPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceUDPPacket -> VoiceUDPPacket -> Bool
$c/= :: VoiceUDPPacket -> VoiceUDPPacket -> Bool
== :: VoiceUDPPacket -> VoiceUDPPacket -> Bool
$c== :: VoiceUDPPacket -> VoiceUDPPacket -> Bool
Eq)

_IPDiscovery :: Traversal' VoiceUDPPacket (Integer, T.Text, Integer)
_IPDiscovery :: ((Integer, Text, Integer) -> f (Integer, Text, Integer))
-> VoiceUDPPacket -> f VoiceUDPPacket
_IPDiscovery (Integer, Text, Integer) -> f (Integer, Text, Integer)
f (IPDiscovery Integer
ssrc Text
ip Integer
port) = (\(Integer
a, Text
b, Integer
c) -> Integer -> Text -> Integer -> VoiceUDPPacket
IPDiscovery Integer
a Text
b Integer
c) ((Integer, Text, Integer) -> VoiceUDPPacket)
-> f (Integer, Text, Integer) -> f VoiceUDPPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Text, Integer) -> f (Integer, Text, Integer)
f (Integer
ssrc, Text
ip, Integer
port)
_IPDiscovery (Integer, Text, Integer) -> f (Integer, Text, Integer)
f VoiceUDPPacket
packet = VoiceUDPPacket -> f VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceUDPPacket
packet

data VoiceUDPPacketHeader
    = Header Word8 Word8 Word16 Word32 Word32 

instance Binary VoiceUDPPacketHeader where
    get :: Get VoiceUDPPacketHeader
get = do
        Word8
ver <- Get Word8
getWord8
        Word8
pl <- Get Word8
getWord8
        Word16
seq <- Get Word16
getWord16be
        Word32
timestamp <- Get Word32
getWord32be
        Word32
ssrc <- Get Word32
getWord32be
        VoiceUDPPacketHeader -> Get VoiceUDPPacketHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacketHeader -> Get VoiceUDPPacketHeader)
-> VoiceUDPPacketHeader -> Get VoiceUDPPacketHeader
forall a b. (a -> b) -> a -> b
$ Word8
-> Word8 -> Word16 -> Word32 -> Word32 -> VoiceUDPPacketHeader
Header Word8
ver Word8
pl Word16
seq Word32
timestamp Word32
ssrc
    put :: VoiceUDPPacketHeader -> Put
put (Header Word8
ver Word8
pl Word16
seq Word32
timestamp Word32
ssrc) = do
        Word8 -> Put
putWord8 Word8
ver
        Word8 -> Put
putWord8 Word8
pl
        Word16 -> Put
putWord16be Word16
seq
        Word32 -> Put
putWord32be Word32
timestamp
        Word32 -> Put
putWord32be Word32
ssrc

instance Binary VoiceUDPPacket where
    get :: Get VoiceUDPPacket
get = do
        Word8
flags <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
        case Word8
flags of
            Word8
0x0 -> do
                Word16
_ <- Get Word16
getWord16be
                Word16
_ <- Get Word16
getWord16be
                Integer
ssrc <- Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> Get Word32 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
                Text
ip <- ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
64
                Integer
port <- Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                VoiceUDPPacket -> Get VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> Get VoiceUDPPacket)
-> VoiceUDPPacket -> Get VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ Integer -> Text -> Integer -> VoiceUDPPacket
IPDiscovery Integer
ssrc Text
ip Integer
port
            Word8
0x80 -> do
                -- Receiving audio is undocumented but should be pretty much
                -- the same as sending, according to several GitHub issues.
                ByteString
header <- Int -> Get ByteString
getByteString Int
12
                ByteString
a <- Get ByteString
getRemainingLazyByteString
                VoiceUDPPacket -> Get VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> Get VoiceUDPPacket)
-> VoiceUDPPacket -> Get VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> VoiceUDPPacket
SpeakingDataEncrypted ByteString
header ByteString
a
            Word8
0x90 -> do
                -- undocumented, but it seems to also be audio data
                -- When it is 0x90, the encrypted spoken data contains an
                -- extended header (0x90 is sent from Chromium on browser Discord
                -- but 0x80 is from Desktop Discord)
                --
                -- https://github.com/bwmarrin/discordgo/issues/423
                -- https://github.com/discord/discord-api-docs/issues/231
                ByteString
header <- Int -> Get ByteString
getByteString Int
12
                ByteString
a <- Get ByteString
getRemainingLazyByteString
                VoiceUDPPacket -> Get VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> Get VoiceUDPPacket)
-> VoiceUDPPacket -> Get VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> VoiceUDPPacket
SpeakingDataEncryptedExtra ByteString
header ByteString
a
            Word8
other -> do
                ByteString
a <- Get ByteString
getRemainingLazyByteString
                VoiceUDPPacket -> Get VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> Get VoiceUDPPacket)
-> VoiceUDPPacket -> Get VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> VoiceUDPPacket
UnknownPacket ByteString
a
    put :: VoiceUDPPacket -> Put
put (IPDiscovery Integer
ssrc Text
ip Integer
port) = do
        Word16 -> Put
putWord16be Word16
1 -- 1 is request, 2 is response
        Word16 -> Put
putWord16be Word16
70 -- specified in docs
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ssrc
        ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8 -> ByteString
BL.replicate Int64
64 Word8
0 -- 64 empty bytes
        Word16 -> Put
putWord16be (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
port
    put (SpeakingDataEncrypted ByteString
header ByteString
a) = do
        ByteString -> Put
putByteString ByteString
header
        ByteString -> Put
putLazyByteString ByteString
a
    put (MalformedPacket ByteString
a) = ByteString -> Put
putLazyByteString ByteString
a

-- $(makePrisms ''VoiceUDPPacket)