{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-|
Module      : Discord.Internal.Types.VoiceCommon
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 the types for handles, errors, base monads, and other types
applicable to both the UPD and Websocket components of the Voice API. Many of
the structures defined in this module have Lenses derived for them using
Template Haskell.
-}
module Discord.Internal.Types.VoiceCommon where

import Control.Concurrent ( Chan, MVar, ThreadId )
import Control.Concurrent.BoundedChan qualified as Bounded
import Control.Exception.Safe ( Exception, MonadMask, MonadCatch, MonadThrow )
import Lens.Micro.TH ( makeFields )
import Control.Monad.Except
import Control.Monad.Reader
import Data.ByteString qualified as B
import Data.Text qualified as T
import Data.Word ( Word8 )
import GHC.Weak ( Weak )
import Network.Socket
import Network.WebSockets ( ConnectionException, Connection )

import Discord
import Discord.Types
import Discord.Internal.Gateway.EventLoop ( GatewayException(..) )
import Discord.Internal.Types.VoiceUDP
import Discord.Internal.Types.VoiceWebsocket

-- | @Voice@ is a newtype Monad containing a composition of ReaderT and ExceptT
-- transformers over the @DiscordHandler@ monad. It holds references to
-- voice connections/threads. The content of the reader handle is strictly
-- internal and is hidden deliberately behind the newtype wrapper.
--
-- Developer Note: ExceptT is on the base rather than ReaderT, so that when a
-- critical exception/error occurs in @Voice@, it can propagate down the
-- transformer stack, kill the threads referenced in the Reader state as
-- necessary, and halt the entire computation and return to @DiscordHandler@.
-- If ExceptT were on top of ReaderT, then errors would be swallowed before it
-- propagates below ReaderT, and the monad would not halt there, continuing
-- computation with an unstable state.
newtype Voice a = Voice
    { Voice a
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
unVoice :: ReaderT DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
    } deriving
    ( a -> Voice b -> Voice a
(a -> b) -> Voice a -> Voice b
(forall a b. (a -> b) -> Voice a -> Voice b)
-> (forall a b. a -> Voice b -> Voice a) -> Functor Voice
forall a b. a -> Voice b -> Voice a
forall a b. (a -> b) -> Voice a -> Voice b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Voice b -> Voice a
$c<$ :: forall a b. a -> Voice b -> Voice a
fmap :: (a -> b) -> Voice a -> Voice b
$cfmap :: forall a b. (a -> b) -> Voice a -> Voice b
Functor
    , Functor Voice
a -> Voice a
Functor Voice
-> (forall a. a -> Voice a)
-> (forall a b. Voice (a -> b) -> Voice a -> Voice b)
-> (forall a b c. (a -> b -> c) -> Voice a -> Voice b -> Voice c)
-> (forall a b. Voice a -> Voice b -> Voice b)
-> (forall a b. Voice a -> Voice b -> Voice a)
-> Applicative Voice
Voice a -> Voice b -> Voice b
Voice a -> Voice b -> Voice a
Voice (a -> b) -> Voice a -> Voice b
(a -> b -> c) -> Voice a -> Voice b -> Voice c
forall a. a -> Voice a
forall a b. Voice a -> Voice b -> Voice a
forall a b. Voice a -> Voice b -> Voice b
forall a b. Voice (a -> b) -> Voice a -> Voice b
forall a b c. (a -> b -> c) -> Voice a -> Voice b -> Voice c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Voice a -> Voice b -> Voice a
$c<* :: forall a b. Voice a -> Voice b -> Voice a
*> :: Voice a -> Voice b -> Voice b
$c*> :: forall a b. Voice a -> Voice b -> Voice b
liftA2 :: (a -> b -> c) -> Voice a -> Voice b -> Voice c
$cliftA2 :: forall a b c. (a -> b -> c) -> Voice a -> Voice b -> Voice c
<*> :: Voice (a -> b) -> Voice a -> Voice b
$c<*> :: forall a b. Voice (a -> b) -> Voice a -> Voice b
pure :: a -> Voice a
$cpure :: forall a. a -> Voice a
$cp1Applicative :: Functor Voice
Applicative
    , Applicative Voice
a -> Voice a
Applicative Voice
-> (forall a b. Voice a -> (a -> Voice b) -> Voice b)
-> (forall a b. Voice a -> Voice b -> Voice b)
-> (forall a. a -> Voice a)
-> Monad Voice
Voice a -> (a -> Voice b) -> Voice b
Voice a -> Voice b -> Voice b
forall a. a -> Voice a
forall a b. Voice a -> Voice b -> Voice b
forall a b. Voice a -> (a -> Voice b) -> Voice b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Voice a
$creturn :: forall a. a -> Voice a
>> :: Voice a -> Voice b -> Voice b
$c>> :: forall a b. Voice a -> Voice b -> Voice b
>>= :: Voice a -> (a -> Voice b) -> Voice b
$c>>= :: forall a b. Voice a -> (a -> Voice b) -> Voice b
$cp1Monad :: Applicative Voice
Monad
    , MonadIO
    -- ^ MonadIO gives the ability to perform 'liftIO'.
    , MonadReader DiscordBroadcastHandle
    -- ^ MonadReader is for internal use, to read the held broadcast handle.
    , MonadError VoiceError
    -- ^ MonadError is for internal use, to propagate errors.
    , MonadFail
    -- ^ MonadFail is for internal use, identical in function to the MonadFail
    -- instance of ReaderT.
    , MonadThrow
    -- ^ MonadThrow, MonadCatch, and MonadMask are for internal use, to utilise
    -- exception handling functions like @bracket@.
    , MonadThrow Voice
MonadThrow Voice
-> (forall e a.
    Exception e =>
    Voice a -> (e -> Voice a) -> Voice a)
-> MonadCatch Voice
Voice a -> (e -> Voice a) -> Voice a
forall e a. Exception e => Voice a -> (e -> Voice a) -> Voice a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Voice a -> (e -> Voice a) -> Voice a
$ccatch :: forall e a. Exception e => Voice a -> (e -> Voice a) -> Voice a
$cp1MonadCatch :: MonadThrow Voice
MonadCatch
    , MonadCatch Voice
MonadCatch Voice
-> (forall b.
    ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b)
-> (forall b.
    ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b)
-> (forall a b c.
    Voice a
    -> (a -> ExitCase b -> Voice c) -> (a -> Voice b) -> Voice (b, c))
-> MonadMask Voice
Voice a
-> (a -> ExitCase b -> Voice c) -> (a -> Voice b) -> Voice (b, c)
((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
forall b. ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
forall a b c.
Voice a
-> (a -> ExitCase b -> Voice c) -> (a -> Voice b) -> Voice (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Voice a
-> (a -> ExitCase b -> Voice c) -> (a -> Voice b) -> Voice (b, c)
$cgeneralBracket :: forall a b c.
Voice a
-> (a -> ExitCase b -> Voice c) -> (a -> Voice b) -> Voice (b, c)
uninterruptibleMask :: ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
$cuninterruptibleMask :: forall b. ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
mask :: ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
$cmask :: forall b. ((forall a. Voice a -> Voice a) -> Voice b) -> Voice b
$cp1MonadMask :: MonadCatch Voice
MonadMask
    )

-- | @VoiceError@ represents the potential errors when initialising a voice
-- connection. It does /not/ account for errors that occur after the initial
-- handshake (technically, because they are in IO and not ExceptT).
data VoiceError
    = VoiceNotAvailable
    | NoServerAvailable
    | InvalidPayloadOrder
    deriving (Int -> VoiceError -> ShowS
[VoiceError] -> ShowS
VoiceError -> String
(Int -> VoiceError -> ShowS)
-> (VoiceError -> String)
-> ([VoiceError] -> ShowS)
-> Show VoiceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceError] -> ShowS
$cshowList :: [VoiceError] -> ShowS
show :: VoiceError -> String
$cshow :: VoiceError -> String
showsPrec :: Int -> VoiceError -> ShowS
$cshowsPrec :: Int -> VoiceError -> ShowS
Show, VoiceError -> VoiceError -> Bool
(VoiceError -> VoiceError -> Bool)
-> (VoiceError -> VoiceError -> Bool) -> Eq VoiceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceError -> VoiceError -> Bool
$c/= :: VoiceError -> VoiceError -> Bool
== :: VoiceError -> VoiceError -> Bool
$c== :: VoiceError -> VoiceError -> Bool
Eq)

-- | @SubprocessException@ is an Exception that may be thrown when a subprocess
-- such as FFmpeg encounters an error.
--
-- TODO: This has never actually been seen, so it's untested whether it works.
data SubprocessException = SubprocessException String deriving (SubprocessException -> SubprocessException -> Bool
(SubprocessException -> SubprocessException -> Bool)
-> (SubprocessException -> SubprocessException -> Bool)
-> Eq SubprocessException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubprocessException -> SubprocessException -> Bool
$c/= :: SubprocessException -> SubprocessException -> Bool
== :: SubprocessException -> SubprocessException -> Bool
$c== :: SubprocessException -> SubprocessException -> Bool
Eq, Int -> SubprocessException -> ShowS
[SubprocessException] -> ShowS
SubprocessException -> String
(Int -> SubprocessException -> ShowS)
-> (SubprocessException -> String)
-> ([SubprocessException] -> ShowS)
-> Show SubprocessException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubprocessException] -> ShowS
$cshowList :: [SubprocessException] -> ShowS
show :: SubprocessException -> String
$cshow :: SubprocessException -> String
showsPrec :: Int -> SubprocessException -> ShowS
$cshowsPrec :: Int -> SubprocessException -> ShowS
Show)
instance Exception SubprocessException

-- | @DiscordVoiceHandle@ represents the handles for a single voice connection
-- (to a specific voice channel).
--
-- Lenses are defined for this type using Template Haskell.
data DiscordVoiceHandle = DiscordVoiceHandle
    { DiscordVoiceHandle -> GuildId
discordVoiceHandleGuildId :: GuildId
      -- ^ The guild id of the voice channel.
    , DiscordVoiceHandle -> ChannelId
discordVoiceHandleChannelId :: ChannelId
      -- ^ The channel id of the voice channel.
    , DiscordVoiceHandle
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
discordVoiceHandleWebsocket :: (Weak ThreadId, (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
      -- ^ The websocket thread id and handle.
    , DiscordVoiceHandle
-> (Weak ThreadId, (VoiceUDPReceiveChan, VoiceUDPSendChan))
discordVoiceHandleUdp :: (Weak ThreadId, (VoiceUDPReceiveChan, VoiceUDPSendChan))
      -- ^ The UDP thread id and handle.
    , DiscordVoiceHandle -> Integer
discordVoiceHandleSsrc :: Integer
      -- ^ The SSRC of the voice connection, specified by Discord. This is
      -- required in the packet sent when updating the Speaking indicator, so is
      -- maintained in this handle.
    }

-- | @DiscordBroadcastHandle@ represents a "stream" or a "broadcast", which is
-- a mutable list of voice connection handles that share the same audio stream.
--
-- Lenses are defined for this type using Template Haskell.
data DiscordBroadcastHandle = DiscordBroadcastHandle
    { DiscordBroadcastHandle -> MVar [DiscordVoiceHandle]
discordBroadcastHandleVoiceHandles :: MVar [DiscordVoiceHandle]
      -- ^ The list of voice connection handles.
    , DiscordBroadcastHandle -> MVar ()
discordBroadcastHandleMutEx :: MVar ()
      -- ^ The mutex used to synchronize access to the list of voice connection
    }

-- | Deprecated.
-- TODO: remove, unused
data VoiceWebsocketException
    = VoiceWebsocketCouldNotConnect T.Text
    | VoiceWebsocketEventParseError T.Text
    | VoiceWebsocketUnexpected VoiceWebsocketReceivable T.Text
    | VoiceWebsocketConnection ConnectionException T.Text
    deriving (Int -> VoiceWebsocketException -> ShowS
[VoiceWebsocketException] -> ShowS
VoiceWebsocketException -> String
(Int -> VoiceWebsocketException -> ShowS)
-> (VoiceWebsocketException -> String)
-> ([VoiceWebsocketException] -> ShowS)
-> Show VoiceWebsocketException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceWebsocketException] -> ShowS
$cshowList :: [VoiceWebsocketException] -> ShowS
show :: VoiceWebsocketException -> String
$cshow :: VoiceWebsocketException -> String
showsPrec :: Int -> VoiceWebsocketException -> ShowS
$cshowsPrec :: Int -> VoiceWebsocketException -> ShowS
Show)

type VoiceWebsocketReceiveChan =
    Chan (Either VoiceWebsocketException VoiceWebsocketReceivable)

type VoiceWebsocketSendChan = Chan VoiceWebsocketSendable

type VoiceUDPReceiveChan = Chan VoiceUDPPacket

type VoiceUDPSendChan = Bounded.BoundedChan B.ByteString

-- | @WebsocketLaunchOpts@ represents all the data necessary to start a
-- Websocket connection to Discord's Voice Gateway.
--
-- Lenses are defined for this type using Template Haskell.
data WebsocketLaunchOpts = WebsocketLaunchOpts
    { WebsocketLaunchOpts -> UserId
websocketLaunchOptsBotUserId     :: UserId
    , WebsocketLaunchOpts -> Text
websocketLaunchOptsSessionId     :: T.Text
    , WebsocketLaunchOpts -> Text
websocketLaunchOptsToken         :: T.Text
    , WebsocketLaunchOpts -> GuildId
websocketLaunchOptsGuildId       :: GuildId
    , WebsocketLaunchOpts -> Text
websocketLaunchOptsEndpoint      :: T.Text
    , WebsocketLaunchOpts
-> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
websocketLaunchOptsWsHandle      :: (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
    , WebsocketLaunchOpts -> MVar (Weak ThreadId)
websocketLaunchOptsUdpTid        :: MVar (Weak ThreadId)
    , WebsocketLaunchOpts -> (VoiceUDPReceiveChan, VoiceUDPSendChan)
websocketLaunchOptsUdpHandle     :: (VoiceUDPReceiveChan, VoiceUDPSendChan)
    , WebsocketLaunchOpts -> MVar Integer
websocketLaunchOptsSsrc          :: MVar Integer
    }

-- | @WebsocketConn@ represents an active connection to Discord's Voice Gateway
-- websocket, and contains the Connection as well as the options that launched
-- it.
--
-- Lenses are defined for this type using Template Haskell.
data WebsocketConn = WebsocketConn
    { WebsocketConn -> Connection
websocketConnConnection    :: Connection
    , WebsocketConn -> WebsocketLaunchOpts
websocketConnLaunchOpts    :: WebsocketLaunchOpts
    }

-- | @UDPLaunchOpts@ represents all the data necessary to start a UDP connection
-- to Discord. Field names for this ADT are cased weirdly because I want to keep
-- the "UDP" part uppercase in the type and data constructor. Since field
-- accessors are rarely used anyway (lenses are preferred instead), we can
-- write the field prefixes as "uDP" and take advantage of Lenses as normal.
-- 
-- Lenses are defined for this type using Template Haskell.
data UDPLaunchOpts = UDPLaunchOpts
    { UDPLaunchOpts -> Integer
uDPLaunchOptsSsrc :: Integer
    , UDPLaunchOpts -> Text
uDPLaunchOptsIp   :: T.Text
    , UDPLaunchOpts -> Integer
uDPLaunchOptsPort :: Integer
    , UDPLaunchOpts -> Text
uDPLaunchOptsMode :: T.Text
    , UDPLaunchOpts -> (VoiceUDPReceiveChan, VoiceUDPSendChan)
uDPLaunchOptsUdpHandle :: (VoiceUDPReceiveChan, VoiceUDPSendChan)
    , UDPLaunchOpts -> MVar [Word8]
uDPLaunchOptsSecretKey :: MVar [Word8]
    }

-- | @UDPConn@ represents an active UDP connection to Discord, and contains the
-- Socket as well as the options that launched it.
--
-- Lenses are defined for this type using Template Haskell.
data UDPConn = UDPConn
    { UDPConn -> UDPLaunchOpts
uDPConnLaunchOpts :: UDPLaunchOpts
    , UDPConn -> Socket
uDPConnSocket     :: Socket
    }

$(makeFields ''DiscordVoiceHandle)
$(makeFields ''DiscordBroadcastHandle)
$(makeFields ''WebsocketLaunchOpts)
$(makeFields ''WebsocketConn)
$(makeFields ''UDPLaunchOpts)
$(makeFields ''UDPConn)