{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Discord.Internal.Voice
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 is the internal entry point into @discord-haskell-voice@. Any use of
this module (or other Internal modules) is discouraged. Please see "Discord.Voice"
for the public interface.
-}
module Discord.Internal.Voice where

import Codec.Audio.Opus.Encoder
import Conduit
import Control.Concurrent.Async ( race )
import Control.Concurrent
    ( ThreadId
    , myThreadId
    , threadDelay
    , killThread
    , forkIO
    , mkWeakThreadId
    , Chan
    , dupChan
    , newChan
    , readChan
    , writeChan
    , MVar
    , newEmptyMVar
    , newMVar
    , readMVar
    , putMVar
    , withMVar
    , tryPutMVar
    , modifyMVar_
    )
import Control.Concurrent.BoundedChan qualified as Bounded
import Control.Exception.Safe ( finally, bracket, throwTo, catch, throwIO )
import Control.Lens
import Control.Monad.Reader ( ask, liftIO, runReaderT )
import Control.Monad.Except ( runExceptT, throwError )
import Control.Monad.Trans ( lift )
import Control.Monad ( when, void )
import Data.Aeson
import Data.Aeson.Types ( parseMaybe )
import Data.ByteString qualified as B
import Data.Foldable ( traverse_ )
import Data.List ( partition )
import Data.Maybe ( fromJust )
import Data.Text qualified as T
import GHC.Weak ( deRefWeak, Weak )
import System.Exit ( ExitCode(..) )
import System.IO ( hClose, hGetContents, hWaitForInput, hIsOpen )
import System.IO.Error ( isEOFError )
import System.Process
import UnliftIO qualified as UnliftIO

import Discord ( DiscordHandler, sendCommand, readCache )
import Discord.Handle ( discordHandleGateway, discordHandleLog )
import Discord.Internal.Gateway.Cache ( Cache(..) )
import Discord.Internal.Gateway.EventLoop
    ( GatewayException(..)
    , GatewayHandle(..)
    )
import Discord.Internal.Types
    ( GuildId
    , ChannelId
    , UserId
    , User(..)
    , GatewaySendable(..)
    , UpdateStatusVoiceOpts(..)
    , Event(..)
    )
import Discord.Internal.Types.VoiceCommon
import Discord.Internal.Types.VoiceWebsocket
    ( VoiceWebsocketSendable(Speaking)
    , SpeakingPayload(..)
    )
import Discord.Internal.Voice.CommonUtils
import Discord.Internal.Voice.WebsocketLoop

-- | Send a Gateway Websocket Update Voice State command (Opcode 4). Used to
-- indicate that the client voice status (deaf/mute) as well as the channel
-- they are active on.
-- This is not in the Voice monad because it has to be used after all voice
-- actions end, to quit the voice channels. It also has no benefit, since it
-- would cause extra transformer wrapping/unwrapping.
updateStatusVoice
    :: GuildId
    -- ^ Id of Guild
    -> Maybe ChannelId
    -- ^ Id of the voice channel client wants to join (Nothing if disconnecting)
    -> Bool
    -- ^ Whether the client muted
    -> Bool
    -- ^ Whether the client deafened
    -> DiscordHandler ()
updateStatusVoice :: GuildId -> Maybe GuildId -> Bool -> Bool -> DiscordHandler ()
updateStatusVoice GuildId
a Maybe GuildId
b Bool
c Bool
d = GatewaySendable -> DiscordHandler ()
sendCommand (GatewaySendable -> DiscordHandler ())
-> GatewaySendable -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ UpdateStatusVoiceOpts -> GatewaySendable
UpdateStatusVoice (UpdateStatusVoiceOpts -> GatewaySendable)
-> UpdateStatusVoiceOpts -> GatewaySendable
forall a b. (a -> b) -> a -> b
$ GuildId -> Maybe GuildId -> Bool -> Bool -> UpdateStatusVoiceOpts
UpdateStatusVoiceOpts GuildId
a Maybe GuildId
b Bool
c Bool
d

-- | @liftDiscord@ lifts a computation in DiscordHandler into a computation in
-- Voice. This is useful for performing DiscordHandler/IO actions inside the
-- Voice monad.
--
-- > liftDiscord ≡ lift . lift
--
-- Usage:
-- 
-- @
-- runVoice $ do
--     join (read "123456789012345") (read "67890123456789012")
--     liftDiscord $ void $ restCall $ R.CreateMessage (read "2938481828383") "Joined!"
--     playYouTube "Rate of Reaction of Sodium Hydroxide and Hydrochloric Acid"
--     liftDiscord $ void $ restCall $ R.CreateMessage (read "2938481828383") "Finished!"
-- void $ restCall $ R.CreateMessage (read "2938481828383") "Finished all voice actions!"
-- @
--
liftDiscord :: DiscordHandler a -> Voice a
liftDiscord :: DiscordHandler a -> Voice a
liftDiscord = ExceptT VoiceError DiscordHandler a -> Voice a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler a -> Voice a)
-> (DiscordHandler a -> ExceptT VoiceError DiscordHandler a)
-> DiscordHandler a
-> Voice a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscordHandler a -> ExceptT VoiceError DiscordHandler a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Execute the voice actions stored in the Voice monad.
--
-- A single mutex and sending packet channel is used throughout all voice
-- connections within the actions, which enables multi-channel broadcasting.
-- The following demonstrates how a single playback is streamed to multiple
-- connections.
--
-- @
-- runVoice $ do
--     join (read "123456789012345") (read "67890123456789012")
--     join (read "098765432123456") (read "12345698765456709")
--     playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"
-- @
--
-- The return type of @runVoice@ represents result status of the voice computation.
-- It is isomorphic to @Maybe@, but the use of Either explicitly denotes that
-- the correct\/successful\/"Right" behaviour is (), and that the potentially-
-- existing value is of failure.
runVoice :: Voice () -> DiscordHandler (Either VoiceError ())
runVoice :: Voice () -> DiscordHandler (Either VoiceError ())
runVoice Voice ()
action = do
    MVar [DiscordVoiceHandle]
voiceHandles <- IO (MVar [DiscordVoiceHandle])
-> ReaderT DiscordHandle IO (MVar [DiscordVoiceHandle])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar [DiscordVoiceHandle])
 -> ReaderT DiscordHandle IO (MVar [DiscordVoiceHandle]))
-> IO (MVar [DiscordVoiceHandle])
-> ReaderT DiscordHandle IO (MVar [DiscordVoiceHandle])
forall a b. (a -> b) -> a -> b
$ [DiscordVoiceHandle] -> IO (MVar [DiscordVoiceHandle])
forall a. a -> IO (MVar a)
newMVar []
    MVar ()
mutEx <- IO (MVar ()) -> ReaderT DiscordHandle IO (MVar ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> ReaderT DiscordHandle IO (MVar ()))
-> IO (MVar ()) -> ReaderT DiscordHandle IO (MVar ())
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()

    let initialState :: DiscordBroadcastHandle
initialState = MVar [DiscordVoiceHandle] -> MVar () -> DiscordBroadcastHandle
DiscordBroadcastHandle MVar [DiscordVoiceHandle]
voiceHandles MVar ()
mutEx

    Either VoiceError ()
result <- DiscordHandler (Either VoiceError ())
-> DiscordHandler () -> DiscordHandler (Either VoiceError ())
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally (ExceptT VoiceError DiscordHandler ()
-> DiscordHandler (Either VoiceError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT VoiceError DiscordHandler ()
 -> DiscordHandler (Either VoiceError ()))
-> ExceptT VoiceError DiscordHandler ()
-> DiscordHandler (Either VoiceError ())
forall a b. (a -> b) -> a -> b
$ (Voice ()
 -> DiscordBroadcastHandle -> ExceptT VoiceError DiscordHandler ())
-> DiscordBroadcastHandle
-> Voice ()
-> ExceptT VoiceError DiscordHandler ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Voice ()
-> DiscordBroadcastHandle -> ExceptT VoiceError DiscordHandler ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DiscordBroadcastHandle
initialState (Voice () -> ExceptT VoiceError DiscordHandler ())
-> Voice () -> ExceptT VoiceError DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Voice ()
action) (DiscordHandler () -> DiscordHandler (Either VoiceError ()))
-> DiscordHandler () -> DiscordHandler (Either VoiceError ())
forall a b. (a -> b) -> a -> b
$ do
        -- Wrap cleanup action in @finally@ to ensure we always close the
        -- threads even if an exception occurred.
        [DiscordVoiceHandle]
finalState <- IO [DiscordVoiceHandle] -> DiscordHandler [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscordVoiceHandle] -> DiscordHandler [DiscordVoiceHandle])
-> IO [DiscordVoiceHandle] -> DiscordHandler [DiscordVoiceHandle]
forall a b. (a -> b) -> a -> b
$ MVar [DiscordVoiceHandle] -> IO [DiscordVoiceHandle]
forall a. MVar a -> IO a
readMVar MVar [DiscordVoiceHandle]
voiceHandles

        -- Unfortunately, the following updateStatusVoice doesn't always run
        -- when we have entered this @finally@ block through a SIGINT or other
        -- asynchronous exception. The reason is that sometimes, the
        -- discord-haskell websocket sendable thread is killed before this.
        -- There is no way to prevent it, so as a consequence, the bot may
        -- linger in the voice call for a few minutes after the bot program is
        -- killed.
        Getting (Sequenced () DiscordHandler) [DiscordVoiceHandle] GuildId
-> (GuildId -> DiscordHandler ())
-> [DiscordVoiceHandle]
-> DiscordHandler ()
forall (m :: * -> *) r s a.
Monad m =>
Getting (Sequenced r m) s a -> (a -> m r) -> s -> m ()
mapMOf_ ((DiscordVoiceHandle
 -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
-> [DiscordVoiceHandle]
-> Const (Sequenced () DiscordHandler) [DiscordVoiceHandle]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((DiscordVoiceHandle
  -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
 -> [DiscordVoiceHandle]
 -> Const (Sequenced () DiscordHandler) [DiscordVoiceHandle])
-> ((GuildId -> Const (Sequenced () DiscordHandler) GuildId)
    -> DiscordVoiceHandle
    -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
-> Getting
     (Sequenced () DiscordHandler) [DiscordVoiceHandle] GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuildId -> Const (Sequenced () DiscordHandler) GuildId)
-> DiscordVoiceHandle
-> Const (Sequenced () DiscordHandler) DiscordVoiceHandle
forall s a. HasGuildId s a => Lens' s a
guildId) (\GuildId
x -> GuildId -> Maybe GuildId -> Bool -> Bool -> DiscordHandler ()
updateStatusVoice GuildId
x Maybe GuildId
forall a. Maybe a
Nothing Bool
False Bool
False) [DiscordVoiceHandle]
finalState
        Getting
  (Sequenced () DiscordHandler) [DiscordVoiceHandle] (Weak ThreadId)
-> (Weak ThreadId -> DiscordHandler ())
-> [DiscordVoiceHandle]
-> DiscordHandler ()
forall (m :: * -> *) r s a.
Monad m =>
Getting (Sequenced r m) s a -> (a -> m r) -> s -> m ()
mapMOf_ ((DiscordVoiceHandle
 -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
-> [DiscordVoiceHandle]
-> Const (Sequenced () DiscordHandler) [DiscordVoiceHandle]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((DiscordVoiceHandle
  -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
 -> [DiscordVoiceHandle]
 -> Const (Sequenced () DiscordHandler) [DiscordVoiceHandle])
-> ((Weak ThreadId
     -> Const (Sequenced () DiscordHandler) (Weak ThreadId))
    -> DiscordVoiceHandle
    -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
-> Getting
     (Sequenced () DiscordHandler) [DiscordVoiceHandle] (Weak ThreadId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Weak ThreadId,
  (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
 -> Const
      (Sequenced () DiscordHandler)
      (Weak ThreadId,
       (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> DiscordVoiceHandle
-> Const (Sequenced () DiscordHandler) DiscordVoiceHandle
forall s a. HasWebsocket s a => Lens' s a
websocket (((Weak ThreadId,
   (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
  -> Const
       (Sequenced () DiscordHandler)
       (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
 -> DiscordVoiceHandle
 -> Const (Sequenced () DiscordHandler) DiscordVoiceHandle)
-> ((Weak ThreadId
     -> Const (Sequenced () DiscordHandler) (Weak ThreadId))
    -> (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
    -> Const
         (Sequenced () DiscordHandler)
         (Weak ThreadId,
          (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> (Weak ThreadId
    -> Const (Sequenced () DiscordHandler) (Weak ThreadId))
-> DiscordVoiceHandle
-> Const (Sequenced () DiscordHandler) DiscordVoiceHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Weak ThreadId
 -> Const (Sequenced () DiscordHandler) (Weak ThreadId))
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> Const
     (Sequenced () DiscordHandler)
     (Weak ThreadId,
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
forall s t a b. Field1 s t a b => Lens s t a b
_1) (IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ())
-> (Weak ThreadId -> IO ()) -> Weak ThreadId -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weak ThreadId -> IO ()
killWkThread) [DiscordVoiceHandle]
finalState

    Either VoiceError () -> DiscordHandler (Either VoiceError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either VoiceError ()
result

-- | Join a specific voice channel, given the Guild and Channel ID of the voice
-- channel. Since the Channel ID is globally unique, there is theoretically no
-- need to specify the Guild ID, but it is provided until discord-haskell fully
-- caches the mappings internally.
--
-- This function returns a Voice action that, when executed, will leave the
-- joined voice channel. For example:
--
-- @
-- runVoice $ do
--   leave <- join (read "123456789012345") (read "67890123456789012")
--   playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"
--   leave
-- @
--
-- The above use is not meaningful in practice, since @runVoice@ will perform
-- the appropriate cleanup and leaving as necessary at the end of all actions.
-- However, it may be useful to interleave @leave@ with other Voice actions.
--
-- Since the @leave@ function will gracefully do nothing if the voice connection
-- is already severed, it is safe to escape this function from the Voice monad
-- and use it in a different context. That is, the following is allowed and
-- is encouraged if you are building a @\/leave@ command of any sort:
--
-- @
-- -- On \/play
-- runVoice $ do
--   leave <- join (read "123456789012345") (read "67890123456789012")
--   liftIO $ putMVar futureLeaveFunc leave
--   forever $
--     playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"
--
-- -- On \/leave, from a different thread
-- leave <- liftIO $ takeMVar futureLeaveFunc
-- runVoice leave
-- @
--
-- The above will join a voice channel, play a YouTube video, but immediately
-- quit and leave the channel when the @\/leave@ command is received, regardless
-- of the playback status.
join :: GuildId -> ChannelId -> Voice (Voice ())
join :: GuildId -> GuildId -> Voice (Voice ())
join GuildId
guildId GuildId
channelId = do
    DiscordHandle
h <- ExceptT VoiceError DiscordHandler DiscordHandle
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     DiscordHandle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler DiscordHandle
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      DiscordHandle)
-> ExceptT VoiceError DiscordHandler DiscordHandle
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     DiscordHandle
forall a b. (a -> b) -> a -> b
$ DiscordHandler DiscordHandle
-> ExceptT VoiceError DiscordHandler DiscordHandle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DiscordHandler DiscordHandle
 -> ExceptT VoiceError DiscordHandler DiscordHandle)
-> DiscordHandler DiscordHandle
-> ExceptT VoiceError DiscordHandler DiscordHandle
forall a b. (a -> b) -> a -> b
$ DiscordHandler DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    -- Duplicate the event channel, so we can read without taking data from event handlers
    Chan (Either GatewayException Event)
events <- IO (Chan (Either GatewayException Event))
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Chan (Either GatewayException Event))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan (Either GatewayException Event))
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Chan (Either GatewayException Event)))
-> IO (Chan (Either GatewayException Event))
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Chan (Either GatewayException Event))
forall a b. (a -> b) -> a -> b
$ Chan (Either GatewayException Event)
-> IO (Chan (Either GatewayException Event))
forall a. Chan a -> IO (Chan a)
dupChan (Chan (Either GatewayException Event)
 -> IO (Chan (Either GatewayException Event)))
-> Chan (Either GatewayException Event)
-> IO (Chan (Either GatewayException Event))
forall a b. (a -> b) -> a -> b
$ GatewayHandle -> Chan (Either GatewayException Event)
gatewayHandleEvents (GatewayHandle -> Chan (Either GatewayException Event))
-> GatewayHandle -> Chan (Either GatewayException Event)
forall a b. (a -> b) -> a -> b
$ DiscordHandle -> GatewayHandle
discordHandleGateway DiscordHandle
h

    -- To join a voice channel, we first need to send Voice State Update (Opcode
    -- 4) to the gateway, which will then send us two responses, Dispatch Event
    -- (Voice State Update) and Dispatch Event (Voice Server Update).
    ExceptT VoiceError DiscordHandler () -> Voice ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler () -> Voice ())
-> ExceptT VoiceError DiscordHandler () -> Voice ()
forall a b. (a -> b) -> a -> b
$ DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DiscordHandler () -> ExceptT VoiceError DiscordHandler ())
-> DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ GuildId -> Maybe GuildId -> Bool -> Bool -> DiscordHandler ()
updateStatusVoice GuildId
guildId (GuildId -> Maybe GuildId
forall a. a -> Maybe a
Just GuildId
channelId) Bool
False Bool
False

    (IO (Maybe (Text, Text, GuildId, Maybe Text))
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Maybe (Text, Text, GuildId, Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Text, Text, GuildId, Maybe Text))
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Maybe (Text, Text, GuildId, Maybe Text)))
-> (IO (Text, Text, GuildId, Maybe Text)
    -> IO (Maybe (Text, Text, GuildId, Maybe Text)))
-> IO (Text, Text, GuildId, Maybe Text)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Maybe (Text, Text, GuildId, Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IO (Text, Text, GuildId, Maybe Text)
-> IO (Maybe (Text, Text, GuildId, Maybe Text))
forall a. Int -> IO a -> IO (Maybe a)
doOrTimeout Int
5000) (Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
waitForVoiceStatusServerUpdate Chan (Either GatewayException Event)
events) ReaderT
  DiscordBroadcastHandle
  (ExceptT VoiceError DiscordHandler)
  (Maybe (Text, Text, GuildId, Maybe Text))
-> (Maybe (Text, Text, GuildId, Maybe Text) -> Voice (Voice ()))
-> Voice (Voice ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Text, Text, GuildId, Maybe Text)
Nothing -> do
            -- did not respond in time: no permission? or discord offline?
            VoiceError -> Voice (Voice ())
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError VoiceError
VoiceNotAvailable
        Just (Text
_, Text
_, GuildId
_, Maybe Text
Nothing) -> do
            -- If endpoint is null, according to Docs, no servers are available.
            VoiceError -> Voice (Voice ())
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError VoiceError
NoServerAvailable
        Just (Text
sessionId, Text
token, GuildId
guildId, Just Text
endpoint) -> do
            -- create the sending and receiving channels for Websocket
            (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
wsChans <- IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
forall a b. (a -> b) -> a -> b
$ (,) (VoiceWebsocketReceiveChan
 -> VoiceWebsocketSendChan
 -> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> IO VoiceWebsocketReceiveChan
-> IO
     (VoiceWebsocketSendChan
      -> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO VoiceWebsocketReceiveChan
forall a. IO (Chan a)
newChan IO
  (VoiceWebsocketSendChan
   -> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> IO VoiceWebsocketSendChan
-> IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO VoiceWebsocketSendChan
forall a. IO (Chan a)
newChan
            -- thread id and handles for UDP. 100 packets will contain 2
            -- seconds worth of 20ms audio. Each packet (20ms) contains
            -- (48000 / 1000 * 20 =) 960 frames, for which each frame has
            -- 2 channels and 16 bits (2 bytes) in each channel. So, the total
            -- amount of memory required for each BoundedChan is 2*2*960*100=
            -- 384 kB (kilobytes).
            (Chan VoiceUDPPacket, BoundedChan ByteString)
udpChans <- IO (Chan VoiceUDPPacket, BoundedChan ByteString)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Chan VoiceUDPPacket, BoundedChan ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan VoiceUDPPacket, BoundedChan ByteString)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Chan VoiceUDPPacket, BoundedChan ByteString))
-> IO (Chan VoiceUDPPacket, BoundedChan ByteString)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Chan VoiceUDPPacket, BoundedChan ByteString)
forall a b. (a -> b) -> a -> b
$ (,) (Chan VoiceUDPPacket
 -> BoundedChan ByteString
 -> (Chan VoiceUDPPacket, BoundedChan ByteString))
-> IO (Chan VoiceUDPPacket)
-> IO
     (BoundedChan ByteString
      -> (Chan VoiceUDPPacket, BoundedChan ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Chan VoiceUDPPacket)
forall a. IO (Chan a)
newChan IO
  (BoundedChan ByteString
   -> (Chan VoiceUDPPacket, BoundedChan ByteString))
-> IO (BoundedChan ByteString)
-> IO (Chan VoiceUDPPacket, BoundedChan ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (BoundedChan ByteString)
forall a. Int -> IO (BoundedChan a)
Bounded.newBoundedChan Int
100
            MVar (Weak ThreadId)
udpTidM <- IO (MVar (Weak ThreadId))
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (MVar (Weak ThreadId))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (Weak ThreadId))
forall a. IO (MVar a)
newEmptyMVar
            -- ssrc to be filled in during initial handshake
            MVar Integer
ssrcM <- IO (MVar Integer)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (MVar Integer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Integer)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (MVar Integer))
-> IO (MVar Integer)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (MVar Integer)
forall a b. (a -> b) -> a -> b
$ IO (MVar Integer)
forall a. IO (MVar a)
newEmptyMVar

            GuildId
uid <- User -> GuildId
userId (User -> GuildId) -> (Cache -> User) -> Cache -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> User
cacheCurrentUser (Cache -> GuildId)
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Cache
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) GuildId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExceptT VoiceError DiscordHandler Cache
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Cache
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler Cache
 -> ReaderT
      DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Cache)
-> ExceptT VoiceError DiscordHandler Cache
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Cache
forall a b. (a -> b) -> a -> b
$ ReaderT DiscordHandle IO Cache
-> ExceptT VoiceError DiscordHandler Cache
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT DiscordHandle IO Cache
 -> ExceptT VoiceError DiscordHandler Cache)
-> ReaderT DiscordHandle IO Cache
-> ExceptT VoiceError DiscordHandler Cache
forall a b. (a -> b) -> a -> b
$ ReaderT DiscordHandle IO Cache
readCache)
            let wsOpts :: WebsocketLaunchOpts
wsOpts = GuildId
-> Text
-> Text
-> GuildId
-> Text
-> Chan (Either GatewayException Event)
-> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> MVar (Weak ThreadId)
-> (Chan VoiceUDPPacket, BoundedChan ByteString)
-> MVar Integer
-> WebsocketLaunchOpts
WebsocketLaunchOpts GuildId
uid Text
sessionId Text
token GuildId
guildId Text
endpoint
                    Chan (Either GatewayException Event)
events (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
wsChans MVar (Weak ThreadId)
udpTidM (Chan VoiceUDPPacket, BoundedChan ByteString)
udpChans MVar Integer
ssrcM

            -- fork a thread to start the websocket thread in the DiscordHandler
            -- monad using the current Reader state. Not much of a problem
            -- since many of the fields are mutable references.
            ThreadId
wsTid <- IO ThreadId
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      ThreadId)
-> IO ThreadId
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ WebsocketLaunchOpts -> Chan Text -> IO ()
launchWebsocket WebsocketLaunchOpts
wsOpts (Chan Text -> IO ()) -> Chan Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DiscordHandle -> Chan Text
discordHandleLog DiscordHandle
h
            
            Weak ThreadId
wsTidWeak <- IO (Weak ThreadId)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Weak ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak ThreadId)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Weak ThreadId))
-> IO (Weak ThreadId)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Weak ThreadId)
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
wsTid

            -- TODO: check if readMVar ever blocks if the UDP thread fails to
            -- launch. Handle somehow? Perhaps with exception throwTo?
            Weak ThreadId
udpTid <- IO (Weak ThreadId)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Weak ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak ThreadId)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Weak ThreadId))
-> IO (Weak ThreadId)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Weak ThreadId)
forall a b. (a -> b) -> a -> b
$ MVar (Weak ThreadId) -> IO (Weak ThreadId)
forall a. MVar a -> IO a
readMVar MVar (Weak ThreadId)
udpTidM
            Integer
ssrc <- IO Integer
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer
 -> ReaderT
      DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Integer)
-> IO Integer
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) Integer
forall a b. (a -> b) -> a -> b
$ MVar Integer -> IO Integer
forall a. MVar a -> IO a
readMVar MVar Integer
ssrcM

            -- modify the current Voice monad state to add the newly created
            -- UDP and Websocket handles (a handle consists of thread id and
            -- send/receive channels).
            DiscordBroadcastHandle
voiceState <- ReaderT
  DiscordBroadcastHandle
  (ExceptT VoiceError DiscordHandler)
  DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
            -- Add the new voice handles to the list of handles
            IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ MVar [DiscordVoiceHandle]
-> ([DiscordVoiceHandle] -> IO [DiscordVoiceHandle]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (DiscordBroadcastHandle
voiceState DiscordBroadcastHandle
-> Getting
     (MVar [DiscordVoiceHandle])
     DiscordBroadcastHandle
     (MVar [DiscordVoiceHandle])
-> MVar [DiscordVoiceHandle]
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar [DiscordVoiceHandle])
  DiscordBroadcastHandle
  (MVar [DiscordVoiceHandle])
forall s a. HasVoiceHandles s a => Lens' s a
voiceHandles) (([DiscordVoiceHandle] -> IO [DiscordVoiceHandle]) -> IO ())
-> ([DiscordVoiceHandle] -> IO [DiscordVoiceHandle]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[DiscordVoiceHandle]
handles -> do
                let newHandle :: DiscordVoiceHandle
newHandle = GuildId
-> GuildId
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
-> Integer
-> DiscordVoiceHandle
DiscordVoiceHandle GuildId
guildId GuildId
channelId
                        (Weak ThreadId
wsTidWeak, (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
wsChans) (Weak ThreadId
udpTid, (Chan VoiceUDPPacket, BoundedChan ByteString)
udpChans) Integer
ssrc
                [DiscordVoiceHandle] -> IO [DiscordVoiceHandle]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiscordVoiceHandle
newHandle DiscordVoiceHandle -> [DiscordVoiceHandle] -> [DiscordVoiceHandle]
forall a. a -> [a] -> [a]
: [DiscordVoiceHandle]
handles)

            -- Give back a function used for leaving this voice channel.
            Voice () -> Voice (Voice ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Voice () -> Voice (Voice ())) -> Voice () -> Voice (Voice ())
forall a b. (a -> b) -> a -> b
$ do
                ExceptT VoiceError DiscordHandler () -> Voice ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler () -> Voice ())
-> ExceptT VoiceError DiscordHandler () -> Voice ()
forall a b. (a -> b) -> a -> b
$ DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DiscordHandler () -> ExceptT VoiceError DiscordHandler ())
-> DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ GuildId -> Maybe GuildId -> Bool -> Bool -> DiscordHandler ()
updateStatusVoice GuildId
guildId Maybe GuildId
forall a. Maybe a
Nothing Bool
False Bool
False
                IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ Weak ThreadId -> IO ()
killWkThread Weak ThreadId
wsTidWeak
  where
    -- | Continuously take the top item in the gateway event channel until both
    -- Dispatch Event VOICE_STATE_UPDATE and Dispatch Event VOICE_SERVER_UPDATE
    -- are received.
    --
    -- The order is undefined in docs, so this function will block until both
    -- are received in any order.
    waitForVoiceStatusServerUpdate
        :: Chan (Either GatewayException Event)
        -> IO (T.Text, T.Text, GuildId, Maybe T.Text)
    waitForVoiceStatusServerUpdate :: Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
waitForVoiceStatusServerUpdate = Maybe Text
-> Maybe (Text, GuildId, Maybe Text)
-> Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
loopForBothEvents Maybe Text
forall a. Maybe a
Nothing Maybe (Text, GuildId, Maybe Text)
forall a. Maybe a
Nothing
    
    loopForBothEvents
        :: Maybe T.Text
        -> Maybe (T.Text, GuildId, Maybe T.Text)
        -> Chan (Either GatewayException Event)
        -> IO (T.Text, T.Text, GuildId, Maybe T.Text)
    loopForBothEvents :: Maybe Text
-> Maybe (Text, GuildId, Maybe Text)
-> Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
loopForBothEvents (Just Text
a) (Just (Text
b, GuildId
c, Maybe Text
d)) Chan (Either GatewayException Event)
events = (Text, Text, GuildId, Maybe Text)
-> IO (Text, Text, GuildId, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a, Text
b, GuildId
c, Maybe Text
d)
    loopForBothEvents Maybe Text
mb1 Maybe (Text, GuildId, Maybe Text)
mb2 Chan (Either GatewayException Event)
events = Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException Event)
events IO (Either GatewayException Event)
-> (Either GatewayException Event
    -> IO (Text, Text, GuildId, Maybe Text))
-> IO (Text, Text, GuildId, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- Parse UnknownEvent, which are events not handled by discord-haskell.
        Right (UnknownEvent Text
"VOICE_STATE_UPDATE" Object
obj) -> do
            -- Conveniently, we can just pass the result of parseMaybe
            -- back recursively.
            let sessionId :: Maybe Text
sessionId = ((Object -> Parser Text) -> Object -> Maybe Text)
-> Object -> (Object -> Parser Text) -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Object -> Parser Text) -> Object -> Maybe Text
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Object
obj ((Object -> Parser Text) -> Maybe Text)
-> (Object -> Parser Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
                    Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"session_id"
            Maybe Text
-> Maybe (Text, GuildId, Maybe Text)
-> Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
loopForBothEvents Maybe Text
sessionId Maybe (Text, GuildId, Maybe Text)
mb2 Chan (Either GatewayException Event)
events
        Right (UnknownEvent Text
"VOICE_SERVER_UPDATE" Object
obj) -> do
            let result :: Maybe (Text, GuildId, Maybe Text)
result = ((Object -> Parser (Text, GuildId, Maybe Text))
 -> Object -> Maybe (Text, GuildId, Maybe Text))
-> Object
-> (Object -> Parser (Text, GuildId, Maybe Text))
-> Maybe (Text, GuildId, Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Object -> Parser (Text, GuildId, Maybe Text))
-> Object -> Maybe (Text, GuildId, Maybe Text)
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Object
obj ((Object -> Parser (Text, GuildId, Maybe Text))
 -> Maybe (Text, GuildId, Maybe Text))
-> (Object -> Parser (Text, GuildId, Maybe Text))
-> Maybe (Text, GuildId, Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
                    Text
token <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"token"
                    GuildId
guildId <- Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id"
                    Maybe Text
endpoint <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"endpoint"
                    (Text, GuildId, Maybe Text) -> Parser (Text, GuildId, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
token, GuildId
guildId, Maybe Text
endpoint)
            Maybe Text
-> Maybe (Text, GuildId, Maybe Text)
-> Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
loopForBothEvents Maybe Text
mb1 Maybe (Text, GuildId, Maybe Text)
result Chan (Either GatewayException Event)
events
        Either GatewayException Event
_ -> Maybe Text
-> Maybe (Text, GuildId, Maybe Text)
-> Chan (Either GatewayException Event)
-> IO (Text, Text, GuildId, Maybe Text)
loopForBothEvents Maybe Text
mb1 Maybe (Text, GuildId, Maybe Text)
mb2 Chan (Either GatewayException Event)
events

-- | Helper function to update the speaking indicator for the bot. Setting the
-- microphone status to True is required for Discord to transmit the bot's
-- voice to other clients. It is done automatically in all of the @play*@
-- functions, so there should be no use for this function in practice.
--
-- Note: Soundshare and priority are const as False in the payload because I
-- don't see bots needing them. If and when required, add Bool signatures to
-- this function.
updateSpeakingStatus :: Bool -> Voice ()
updateSpeakingStatus :: Bool -> Voice ()
updateSpeakingStatus Bool
micStatus = do
    MVar [DiscordVoiceHandle]
h <- (DiscordBroadcastHandle
-> Getting
     (MVar [DiscordVoiceHandle])
     DiscordBroadcastHandle
     (MVar [DiscordVoiceHandle])
-> MVar [DiscordVoiceHandle]
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar [DiscordVoiceHandle])
  DiscordBroadcastHandle
  (MVar [DiscordVoiceHandle])
forall s a. HasVoiceHandles s a => Lens' s a
voiceHandles) (DiscordBroadcastHandle -> MVar [DiscordVoiceHandle])
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     DiscordBroadcastHandle
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (MVar [DiscordVoiceHandle])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  DiscordBroadcastHandle
  (ExceptT VoiceError DiscordHandler)
  DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    [DiscordVoiceHandle]
handles <- IO [DiscordVoiceHandle]
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscordVoiceHandle]
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      [DiscordVoiceHandle])
-> IO [DiscordVoiceHandle]
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     [DiscordVoiceHandle]
forall a b. (a -> b) -> a -> b
$ MVar [DiscordVoiceHandle] -> IO [DiscordVoiceHandle]
forall a. MVar a -> IO a
readMVar MVar [DiscordVoiceHandle]
h
    ((DiscordVoiceHandle -> Voice ())
 -> [DiscordVoiceHandle] -> Voice ())
-> [DiscordVoiceHandle]
-> (DiscordVoiceHandle -> Voice ())
-> Voice ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Getting
  (Sequenced
     ()
     (ReaderT
        DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler)))
  [DiscordVoiceHandle]
  DiscordVoiceHandle
-> (DiscordVoiceHandle -> Voice ())
-> [DiscordVoiceHandle]
-> Voice ()
forall (m :: * -> *) r s a.
Monad m =>
Getting (Sequenced r m) s a -> (a -> m r) -> s -> m ()
mapMOf_ Getting
  (Sequenced
     ()
     (ReaderT
        DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler)))
  [DiscordVoiceHandle]
  DiscordVoiceHandle
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) [DiscordVoiceHandle]
handles ((DiscordVoiceHandle -> Voice ()) -> Voice ())
-> (DiscordVoiceHandle -> Voice ()) -> Voice ()
forall a b. (a -> b) -> a -> b
$ \DiscordVoiceHandle
handle ->
        IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ VoiceWebsocketSendChan -> VoiceWebsocketSendable -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (DiscordVoiceHandle
handle DiscordVoiceHandle
-> Getting
     VoiceWebsocketSendChan DiscordVoiceHandle VoiceWebsocketSendChan
-> VoiceWebsocketSendChan
forall s a. s -> Getting a s a -> a
^. ((Weak ThreadId,
  (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
 -> Const
      VoiceWebsocketSendChan
      (Weak ThreadId,
       (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> DiscordVoiceHandle
-> Const VoiceWebsocketSendChan DiscordVoiceHandle
forall s a. HasWebsocket s a => Lens' s a
websocket (((Weak ThreadId,
   (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
  -> Const
       VoiceWebsocketSendChan
       (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
 -> DiscordVoiceHandle
 -> Const VoiceWebsocketSendChan DiscordVoiceHandle)
-> ((VoiceWebsocketSendChan
     -> Const VoiceWebsocketSendChan VoiceWebsocketSendChan)
    -> (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
    -> Const
         VoiceWebsocketSendChan
         (Weak ThreadId,
          (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> Getting
     VoiceWebsocketSendChan DiscordVoiceHandle VoiceWebsocketSendChan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
 -> Const
      VoiceWebsocketSendChan
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> Const
     VoiceWebsocketSendChan
     (Weak ThreadId,
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
  -> Const
       VoiceWebsocketSendChan
       (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
 -> (Weak ThreadId,
     (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
 -> Const
      VoiceWebsocketSendChan
      (Weak ThreadId,
       (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> ((VoiceWebsocketSendChan
     -> Const VoiceWebsocketSendChan VoiceWebsocketSendChan)
    -> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
    -> Const
         VoiceWebsocketSendChan
         (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> (VoiceWebsocketSendChan
    -> Const VoiceWebsocketSendChan VoiceWebsocketSendChan)
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> Const
     VoiceWebsocketSendChan
     (Weak ThreadId,
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VoiceWebsocketSendChan
 -> Const VoiceWebsocketSendChan VoiceWebsocketSendChan)
-> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> Const
     VoiceWebsocketSendChan
     (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
forall s t a b. Field2 s t a b => Lens s t a b
_2) (VoiceWebsocketSendable -> IO ())
-> VoiceWebsocketSendable -> IO ()
forall a b. (a -> b) -> a -> b
$ SpeakingPayload -> VoiceWebsocketSendable
Speaking (SpeakingPayload -> VoiceWebsocketSendable)
-> SpeakingPayload -> VoiceWebsocketSendable
forall a b. (a -> b) -> a -> b
$ SpeakingPayload :: Bool -> Bool -> Bool -> Integer -> Integer -> SpeakingPayload
SpeakingPayload
            { speakingPayloadMicrophone :: Bool
speakingPayloadMicrophone = Bool
micStatus
            , speakingPayloadSoundshare :: Bool
speakingPayloadSoundshare = Bool
False
            , speakingPayloadPriority :: Bool
speakingPayloadPriority   = Bool
False
            , speakingPayloadDelay :: Integer
speakingPayloadDelay      = Integer
0
            , speakingPayloadSSRC :: Integer
speakingPayloadSSRC       = DiscordVoiceHandle
handle DiscordVoiceHandle
-> Getting Integer DiscordVoiceHandle Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer DiscordVoiceHandle Integer
forall s a. HasSsrc s a => Lens' s a
ssrc
            }

-- | @play source@ plays some sound from the conduit @source@, provided in the
-- form of 16-bit Little Endian PCM. The use of Conduit allows you to perform
-- arbitrary lazy transformations of audio data, using all the advantages that
-- Conduit brings. As the base monad for the Conduit is @ResourceT DiscordHandler@,
-- you can access any DiscordHandler effects (through @lift@) or IO effects
-- (through @liftIO@) in the conduit as well.
--
-- For a more specific interface that is easier to use, see the 'playPCMFile',
-- 'playFile', and 'playYouTube' functions.
--
-- @
-- import Conduit ( sourceFile )
--
-- runVoice $ do
--   join gid cid
--   play $ sourceFile ".\/audio\/example.pcm"
-- @
play :: ConduitT () B.ByteString (ResourceT DiscordHandler) () -> Voice ()
play :: ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
play ConduitT () ByteString (ResourceT DiscordHandler) ()
source = do
    DiscordBroadcastHandle
h <- ReaderT
  DiscordBroadcastHandle
  (ExceptT VoiceError DiscordHandler)
  DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    DiscordHandle
dh <- ExceptT VoiceError DiscordHandler DiscordHandle
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     DiscordHandle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler DiscordHandle
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      DiscordHandle)
-> ExceptT VoiceError DiscordHandler DiscordHandle
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     DiscordHandle
forall a b. (a -> b) -> a -> b
$ DiscordHandler DiscordHandle
-> ExceptT VoiceError DiscordHandler DiscordHandle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DiscordHandler DiscordHandle
 -> ExceptT VoiceError DiscordHandler DiscordHandle)
-> DiscordHandler DiscordHandle
-> ExceptT VoiceError DiscordHandler DiscordHandle
forall a b. (a -> b) -> a -> b
$ DiscordHandler DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    [DiscordVoiceHandle]
handles <- IO [DiscordVoiceHandle]
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscordVoiceHandle]
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      [DiscordVoiceHandle])
-> IO [DiscordVoiceHandle]
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     [DiscordVoiceHandle]
forall a b. (a -> b) -> a -> b
$ MVar [DiscordVoiceHandle] -> IO [DiscordVoiceHandle]
forall a. MVar a -> IO a
readMVar (MVar [DiscordVoiceHandle] -> IO [DiscordVoiceHandle])
-> MVar [DiscordVoiceHandle] -> IO [DiscordVoiceHandle]
forall a b. (a -> b) -> a -> b
$ DiscordBroadcastHandle
h DiscordBroadcastHandle
-> Getting
     (MVar [DiscordVoiceHandle])
     DiscordBroadcastHandle
     (MVar [DiscordVoiceHandle])
-> MVar [DiscordVoiceHandle]
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar [DiscordVoiceHandle])
  DiscordBroadcastHandle
  (MVar [DiscordVoiceHandle])
forall s a. HasVoiceHandles s a => Lens' s a
voiceHandles

    Bool -> Voice ()
updateSpeakingStatus Bool
True
    ExceptT VoiceError DiscordHandler () -> Voice ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler () -> Voice ())
-> ExceptT VoiceError DiscordHandler () -> Voice ()
forall a b. (a -> b) -> a -> b
$ DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DiscordHandler () -> ExceptT VoiceError DiscordHandler ())
-> DiscordHandler () -> ExceptT VoiceError DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ MVar () -> (() -> DiscordHandler ()) -> DiscordHandler ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
UnliftIO.withMVar (DiscordBroadcastHandle
h DiscordBroadcastHandle
-> Getting (MVar ()) DiscordBroadcastHandle (MVar ()) -> MVar ()
forall s a. s -> Getting a s a -> a
^. Getting (MVar ()) DiscordBroadcastHandle (MVar ())
forall s a. HasMutEx s a => Lens' s a
mutEx) ((() -> DiscordHandler ()) -> DiscordHandler ())
-> (() -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
        ConduitT () Void (ResourceT DiscordHandler) () -> DiscordHandler ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT DiscordHandler) ()
 -> DiscordHandler ())
-> ConduitT () Void (ResourceT DiscordHandler) ()
-> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT DiscordHandler) ()
source ConduitT () ByteString (ResourceT DiscordHandler) ()
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
-> ConduitT () Void (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
encodeOpusC ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| [DiscordVoiceHandle]
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
sinkHandles [DiscordVoiceHandle]
handles
    Bool -> Voice ()
updateSpeakingStatus Bool
False
  where
    sinkHandles
        :: [DiscordVoiceHandle]
        -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()
    sinkHandles :: [DiscordVoiceHandle]
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
sinkHandles [DiscordVoiceHandle]
handles = ZipSink ByteString (ResourceT DiscordHandler) ()
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall i (m :: * -> *) r. ZipSink i m r -> Sink i m r
getZipSink (ZipSink ByteString (ResourceT DiscordHandler) ()
 -> ConduitM ByteString Void (ResourceT DiscordHandler) ())
-> ZipSink ByteString (ResourceT DiscordHandler) ()
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall a b. (a -> b) -> a -> b
$
        (DiscordVoiceHandle
 -> ZipSink ByteString (ResourceT DiscordHandler) ())
-> [DiscordVoiceHandle]
-> ZipSink ByteString (ResourceT DiscordHandler) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConduitM ByteString Void (ResourceT DiscordHandler) ()
-> ZipSink ByteString (ResourceT DiscordHandler) ()
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink (ConduitM ByteString Void (ResourceT DiscordHandler) ()
 -> ZipSink ByteString (ResourceT DiscordHandler) ())
-> (DiscordVoiceHandle
    -> ConduitM ByteString Void (ResourceT DiscordHandler) ())
-> DiscordVoiceHandle
-> ZipSink ByteString (ResourceT DiscordHandler) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedChan ByteString
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
sinkChan (BoundedChan ByteString
 -> ConduitM ByteString Void (ResourceT DiscordHandler) ())
-> (DiscordVoiceHandle -> BoundedChan ByteString)
-> DiscordVoiceHandle
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (BoundedChan ByteString)
  DiscordVoiceHandle
  (BoundedChan ByteString)
-> DiscordVoiceHandle -> BoundedChan ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (((Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
 -> Const
      (BoundedChan ByteString)
      (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString)))
-> DiscordVoiceHandle
-> Const (BoundedChan ByteString) DiscordVoiceHandle
forall s a. HasUdp s a => Lens' s a
udp (((Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
  -> Const
       (BoundedChan ByteString)
       (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString)))
 -> DiscordVoiceHandle
 -> Const (BoundedChan ByteString) DiscordVoiceHandle)
-> ((BoundedChan ByteString
     -> Const (BoundedChan ByteString) (BoundedChan ByteString))
    -> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
    -> Const
         (BoundedChan ByteString)
         (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString)))
-> Getting
     (BoundedChan ByteString)
     DiscordVoiceHandle
     (BoundedChan ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chan VoiceUDPPacket, BoundedChan ByteString)
 -> Const
      (BoundedChan ByteString)
      (Chan VoiceUDPPacket, BoundedChan ByteString))
-> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
-> Const
     (BoundedChan ByteString)
     (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((Chan VoiceUDPPacket, BoundedChan ByteString)
  -> Const
       (BoundedChan ByteString)
       (Chan VoiceUDPPacket, BoundedChan ByteString))
 -> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
 -> Const
      (BoundedChan ByteString)
      (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString)))
-> ((BoundedChan ByteString
     -> Const (BoundedChan ByteString) (BoundedChan ByteString))
    -> (Chan VoiceUDPPacket, BoundedChan ByteString)
    -> Const
         (BoundedChan ByteString)
         (Chan VoiceUDPPacket, BoundedChan ByteString))
-> (BoundedChan ByteString
    -> Const (BoundedChan ByteString) (BoundedChan ByteString))
-> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
-> Const
     (BoundedChan ByteString)
     (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundedChan ByteString
 -> Const (BoundedChan ByteString) (BoundedChan ByteString))
-> (Chan VoiceUDPPacket, BoundedChan ByteString)
-> Const
     (BoundedChan ByteString)
     (Chan VoiceUDPPacket, BoundedChan ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2)) [DiscordVoiceHandle]
handles

    sinkChan
        :: Bounded.BoundedChan B.ByteString
        -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()
    sinkChan :: BoundedChan ByteString
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
sinkChan BoundedChan ByteString
chan = ConduitT
  ByteString Void (ResourceT DiscordHandler) (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT
  ByteString Void (ResourceT DiscordHandler) (Maybe ByteString)
-> (Maybe ByteString
    -> ConduitM ByteString Void (ResourceT DiscordHandler) ())
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ByteString
Nothing -> () -> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ByteString
bs -> do
            IO () -> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM ByteString Void (ResourceT DiscordHandler) ())
-> IO () -> ConduitM ByteString Void (ResourceT DiscordHandler) ()
forall a b. (a -> b) -> a -> b
$ BoundedChan ByteString -> ByteString -> IO ()
forall a. BoundedChan a -> a -> IO ()
Bounded.writeChan BoundedChan ByteString
chan ByteString
bs
            BoundedChan ByteString
-> ConduitM ByteString Void (ResourceT DiscordHandler) ()
sinkChan BoundedChan ByteString
chan

-- | @encodeOpusC@ is a conduit that splits the ByteString into chunks of
-- (frame size * no of channels * 16/8) bytes, and encodes each chunk into
-- OPUS format. ByteStrings are made of CChars (Int8)s, but the data is 16-bit
-- so this is why we multiply by two to get the right amount of bytes instead of
-- prematurely cutting off at the half-way point.
encodeOpusC :: ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
encodeOpusC :: ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
encodeOpusC = Index ByteString
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
chunksOfCE (Int
48Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
20Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| do
    Encoder
encoder <- IO Encoder
-> ConduitT
     ByteString ByteString (ResourceT DiscordHandler) Encoder
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Encoder
 -> ConduitT
      ByteString ByteString (ResourceT DiscordHandler) Encoder)
-> IO Encoder
-> ConduitT
     ByteString ByteString (ResourceT DiscordHandler) Encoder
forall a b. (a -> b) -> a -> b
$ EncoderConfig -> IO Encoder
forall cfg (m :: * -> *).
(HasEncoderConfig cfg, MonadIO m) =>
cfg -> m Encoder
opusEncoderCreate EncoderConfig
enCfg
    Encoder
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *).
MonadIO m =>
Encoder -> ConduitT ByteString ByteString m ()
loop Encoder
encoder
  where
    enCfg :: EncoderConfig
enCfg = Tagged
  (SamplingRate, Bool, CodingMode)
  (Identity (SamplingRate, Bool, CodingMode))
-> Tagged EncoderConfig (Identity EncoderConfig)
Iso' EncoderConfig (SamplingRate, Bool, CodingMode)
_EncoderConfig (Tagged
   (SamplingRate, Bool, CodingMode)
   (Identity (SamplingRate, Bool, CodingMode))
 -> Tagged EncoderConfig (Identity EncoderConfig))
-> (SamplingRate, Bool, CodingMode) -> EncoderConfig
forall t b. AReview t b -> b -> t
# (SamplingRate
opusSR48k, Bool
True, CodingMode
app_audio)
    -- 1275 is the max bytes an opus 20ms frame can have
    streamCfg :: StreamConfig
streamCfg = Tagged
  (EncoderConfig, Int, Int) (Identity (EncoderConfig, Int, Int))
-> Tagged StreamConfig (Identity StreamConfig)
Iso' StreamConfig (EncoderConfig, Int, Int)
_StreamConfig (Tagged
   (EncoderConfig, Int, Int) (Identity (EncoderConfig, Int, Int))
 -> Tagged StreamConfig (Identity StreamConfig))
-> (EncoderConfig, Int, Int) -> StreamConfig
forall t b. AReview t b -> b -> t
# (EncoderConfig
enCfg, Int
48Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
20, Int
1276)
    loop :: Encoder -> ConduitT ByteString ByteString m ()
loop Encoder
encoder = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ByteString
Nothing -> do
            -- Send at least 5 blank frames (20ms * 5 = 100 ms)
            let frame :: ByteString
frame = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word8]] -> [Word8]) -> [[Word8]] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [[Word8]]
forall a. Int -> a -> [a]
replicate Int
1280 [Word8
0xF8, Word8
0xFF, Word8
0xFE]
            ByteString
encoded <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Encoder -> StreamConfig -> ByteString -> IO ByteString
forall cfg (m :: * -> *).
(HasStreamConfig cfg, MonadIO m) =>
Encoder -> cfg -> ByteString -> m ByteString
opusEncode Encoder
encoder StreamConfig
streamCfg ByteString
frame
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
        Just ByteString
frame -> do
            -- encode the audio
            ByteString
encoded <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Encoder -> StreamConfig -> ByteString -> IO ByteString
forall cfg (m :: * -> *).
(HasStreamConfig cfg, MonadIO m) =>
Encoder -> cfg -> ByteString -> m ByteString
opusEncode Encoder
encoder StreamConfig
streamCfg ByteString
frame
            -- send it
            ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
encoded
            Encoder -> ConduitT ByteString ByteString m ()
loop Encoder
encoder

-- | @playPCMFile file@ plays the sound stored in the file located at @file@,
-- provided it is in the form of 16-bit Little Endian PCM. @playPCMFile@ is
-- defined as a handy alias for the following:
--
-- > playPCMFile ≡ play . sourceFile
--
-- For a variant of this function that allows arbitrary transformations of the
-- audio data through a conduit component, see 'playPCMFile''.
--
-- To play any other format, it will need to be transcoded using FFmpeg. See
-- 'playFile' for such usage.
playPCMFile
    :: FilePath
    -- ^ The path to the PCM file to play
    -> Voice ()
playPCMFile :: FilePath -> Voice ()
playPCMFile = ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
play (ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ())
-> (FilePath
    -> ConduitT () ByteString (ResourceT DiscordHandler) ())
-> FilePath
-> Voice ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ConduitT () ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile

-- | @playPCMFile' file processor@ plays the sound stored in the file located at
-- @file@, provided it is in the form of 16-bit Little Endian PCM. Audio data
-- will be passed through the @processor@ conduit component, allowing arbitrary
-- transformations to audio data before playback. @playPCMFile'@ is defined as
-- the following:
--
-- > playPCMFile' file processor ≡ play $ sourceFile file .| processor
--
-- For a variant of this function with no processing, see 'playPCMFile'.
--
-- To play any other format, it will need to be transcoded using FFmpeg. See
-- 'playFile' for such usage.
playPCMFile'
    :: FilePath
    -- ^ The path to the PCM file to play
    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
    -- ^ Any processing that needs to be done on the audio data
    -> Voice ()
playPCMFile' :: FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playPCMFile' FilePath
fp ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor = ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
play (ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ())
-> ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT () ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile FilePath
fp ConduitT () ByteString (ResourceT DiscordHandler) ()
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> ConduitT () ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor

-- | @playFile file@ plays the sound stored in the file located at @file@. It
-- supports any format supported by FFmpeg by transcoding it, which means it can
-- play a wide range of file types. This function expects "@ffmpeg@" to be
-- available in the system PATH.
--
-- For a variant that allows you to specify the executable and/or any arguments,
-- see 'playFileWith'.
--
-- For a variant of this function that allows arbitrary transformations of the
-- audio data through a conduit component, see 'playFile''.
--
-- If the file is already known to be in 16-bit little endian PCM, using
-- 'playPCMFile' is much more efficient as it does not go through FFmpeg.
playFile
    :: FilePath
    -- ^ The path to the audio file to play
    -> Voice ()
playFile :: FilePath -> Voice ()
playFile FilePath
fp = FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFile' FilePath
fp ((ByteString
 -> ConduitT ByteString ByteString (ResourceT DiscordHandler) ())
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ByteString
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield)

-- | @playFile' file processor@ plays the sound stored in the file located at
-- @file@. It supports any format supported by FFmpeg by transcoding it, which
-- means it can play a wide range of file types. This function expects
-- "@ffmpeg@" to be available in the system PATH. Audio data will be passed
-- through the @processor@ conduit component, allowing arbitrary transformations
-- to audio data before playback.
--
-- For a variant that allows you to specify the executable and/or any arguments,
-- see 'playFileWith''.
--
-- For a variant of this function with no processing, see 'playFile'.
--
-- If the file is already known to be in 16-bit little endian PCM, using
-- 'playPCMFile'' is much more efficient as it does not go through FFmpeg.
playFile'
    :: FilePath
    -- ^ The path to the audio file to play
    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
    -- ^ Any processing that needs to be done on the audio data
    -> Voice ()
playFile' :: FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFile' FilePath
fp = FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFileWith' FilePath
"ffmpeg" FilePath -> [FilePath]
defaultFFmpegArgs FilePath
fp

-- | @defaultFFmpegArgs@ is a generator function for the default FFmpeg
-- arguments used when streaming audio into 16-bit little endian PCM on stdout.
--
-- This function takes in the input file path as an argument, because FFmpeg
-- arguments are position sensitive in relation to the placement of @-i@.
--
-- It is defined semantically as:
--
-- > defaultFFmpegArgs FILE ≡ "-i FILE -f s16le -ar 48000 -ac 2 -loglevel warning pipe:1"
defaultFFmpegArgs :: FilePath -> [String]
defaultFFmpegArgs :: FilePath -> [FilePath]
defaultFFmpegArgs FilePath
fp =
    [ FilePath
"-i", FilePath
fp
    , FilePath
"-f", FilePath
"s16le"
    , FilePath
"-ar", FilePath
"48000"
    , FilePath
"-ac", FilePath
"2"
    , FilePath
"-loglevel", FilePath
"warning"
    , FilePath
"pipe:1"
    ]

-- | @playFileWith exe args file@ plays the sound stored in the file located at
-- @file@, using the specified FFmpeg executable @exe@ and an argument generator
-- function @args@ (see @defaultFFmpegArgs@ for the default). It supports any
-- format supported by FFmpeg by transcoding it, which means it can play a wide
-- range of file types.
-- 
-- For a variant of this function that uses the "@ffmpeg@" executable in your
-- PATH automatically, see 'playFile'.
--
-- For a variant of this function that allows arbitrary transformations of the
-- audio data through a conduit component, see 'playFileWith''.
--
-- If the file is known to be in 16-bit little endian PCM, using 'playPCMFile'
-- is more efficient as it does not go through FFmpeg.
playFileWith
    :: String
    -- ^ The name of the FFmpeg executable
    -> (String -> [String])
    -- ^ FFmpeg argument generator function, given the filepath
    -> FilePath
    -- ^ The path to the audio file to play
    -> Voice ()
playFileWith :: FilePath -> (FilePath -> [FilePath]) -> FilePath -> Voice ()
playFileWith FilePath
exe FilePath -> [FilePath]
args FilePath
fp = FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFileWith' FilePath
exe FilePath -> [FilePath]
args FilePath
fp ((ByteString
 -> ConduitT ByteString ByteString (ResourceT DiscordHandler) ())
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ByteString
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield)

-- | @playFileWith' exe args file processor@ plays the sound stored in the file
-- located at @file@, using the specified FFmpeg executable @exe@ and an
-- argument generator function @args@ (see @defaultFFmpegArgs@ for the default).
-- It supports any format supported by FFmpeg by transcoding it, which means it
-- can play a wide range of file types. Audio data will be passed through the
-- @processor@ conduit component, allowing arbitrary transformations to audio
-- data before playback.
-- 
-- For a variant of this function that uses the "@ffmpeg@" executable in your
-- PATH automatically, see 'playFile''.
--
-- For a variant of this function with no processing, see 'playFileWith'.
--
-- If the file is known to be in 16-bit little endian PCM, using 'playPCMFile''
-- is more efficient as it does not go through FFmpeg.
playFileWith'
    :: String
    -- ^ The name of the FFmpeg executable
    -> (String -> [String])
    -- ^ FFmpeg argument generator function, given the filepath
    -> String
    -- ^ The path to the audio file to play
    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
    -- ^ Any processing that needs to be done on the audio data
    -> Voice ()
playFileWith' :: FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFileWith' FilePath
exe FilePath -> [FilePath]
argsGen FilePath
path ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor = do
    let args :: [FilePath]
args = FilePath -> [FilePath]
argsGen FilePath
path
    -- NOTE: We use CreatePipe for the stdout handle of ffmpeg, but a preexisting
    -- handle for stderr. This is because we want to retain the stderr output
    -- when ffmpeg has exited with an error code, and capture it before manually
    -- closing the handle. Otherwise, the stderr of ffmpeg may be lost. Using
    -- a preexisting handle for stdout is however, avoided, because createProcess_
    -- does not automatically close UseHandles when done, while conduit's
    -- sourceHandle will patiently wait and block forever for the handle to close.
    -- We may use createProcess (notice the lack of underscore) to automatically
    -- close the UseHandles passed into it, but then we 1. lose the error output
    -- for stderr, and 2. there have been frequent occasions of ffmpeg trying to
    -- write to the closed pipe, causing a "broken pipe" fatal error. We want to
    -- therefore make sure that even if that happens, the error is captured and
    -- stored. Perhaps this explanation makes no sense, but I have suffered too
    -- long on this problem (of calling a subprocess, streaming its output,
    -- storing its errors, and making sure they gracefully kill themselves upon
    -- the parent thread being killed) and I am hoping that this is something
    -- I don't have to touch again.
    (Handle
errorReadEnd, Handle
errorWriteEnd) <- IO (Handle, Handle)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Handle, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle, Handle)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Handle, Handle))
-> IO (Handle, Handle)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Handle, Handle)
forall a b. (a -> b) -> a -> b
$ IO (Handle, Handle)
createPipe
    (Maybe Handle
a, Just Handle
stdout, Maybe Handle
c, ProcessHandle
ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ FilePath
"the ffmpeg process" (FilePath -> [FilePath] -> CreateProcess
proc FilePath
exe [FilePath]
args)
        { std_out :: StdStream
std_out = StdStream
CreatePipe
        , std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
errorWriteEnd
        }
    -- We maintain a forked thread that constantly monitors the stderr output,
    -- and if it sees an error, it kills the ffmpeg process so it doesn't block
    -- (sometimes ffmpeg outputs a fatal error but still tries to continue,
    -- especially during streams), and then rethrows the error as a
    -- SubprocessException to the parent (this) thread. The idea is for the
    -- @bracket@ to handle it, properly clean up any remnants, then rethrow it
    -- further up so that user code can handle it, or let it propagate to
    -- the "discord-haskell encountered an exception" handler. However in
    -- practice, I have not seen this exception appear in the logs even once,
    -- even when the preceding putStrLn executes.
    ThreadId
myTid <- IO ThreadId
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
    ReaderT
  DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
-> (ThreadId -> Voice ()) -> (ThreadId -> Voice ()) -> Voice ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO ThreadId
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      ThreadId)
-> IO ThreadId
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        Bool
thereIsAnError <- Handle -> Int -> IO Bool
hWaitForInput Handle
errorReadEnd (-Int
1) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \IOError
e ->
            if IOError -> Bool
isEOFError IOError
e then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else IOError -> IO Bool
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOError
e
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
thereIsAnError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            ExitCode
exitCode <- ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
            case ExitCode
exitCode of
                ExitCode
ExitSuccess -> do
                    FilePath -> IO ()
putStrLn FilePath
"ffmpeg exited successfully"
                    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                ExitFailure Int
i -> do
                    FilePath
err <- Handle -> IO FilePath
hGetContents Handle
errorReadEnd
                    ExitCode
exitCode <- ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
                    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"ffmpeg exited with code " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exitCode FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
                    ThreadId -> SubprocessException -> IO ()
forall e (m :: * -> *).
(Exception e, MonadIO m) =>
ThreadId -> e -> m ()
throwTo ThreadId
myTid (SubprocessException -> IO ()) -> SubprocessException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SubprocessException
SubprocessException FilePath
err
        ) (\ThreadId
tid -> do
            IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess (Maybe Handle
a, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
stdout, Maybe Handle
c, ProcessHandle
ph)
            IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread ThreadId
tid
        ) ((ThreadId -> Voice ()) -> Voice ())
-> (ThreadId -> Voice ()) -> Voice ()
forall a b. (a -> b) -> a -> b
$ Voice () -> ThreadId -> Voice ()
forall a b. a -> b -> a
const (Voice () -> ThreadId -> Voice ())
-> Voice () -> ThreadId -> Voice ()
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
play (ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ())
-> ConduitT () ByteString (ResourceT DiscordHandler) () -> Voice ()
forall a b. (a -> b) -> a -> b
$ Handle -> ConduitT () ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
stdout ConduitT () ByteString (ResourceT DiscordHandler) ()
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> ConduitT () ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor
    IO () -> Voice ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Voice ()) -> IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
errorReadEnd IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
errorWriteEnd

-- | @playYouTube query@ plays the first result of searching @query@ on YouTube.
-- If a direct video URL is given, YouTube will always return that as the first
-- result, which means @playYouTube@ also supports playing links. It supports
-- all videos, by automatically transcoding to PCM using FFmpeg. Since it
-- streams the data instead of downloading it first, it can play live videos as
-- well. This function expects "@ffmpeg@" and "@youtube-dl@" to be available in
-- the system PATH.
--
-- For a variant that allows you to specify the executable and/or any arguments,
-- see 'playYouTubeWith'.
--
-- For a variant of this function that allows arbitrary transformations of the
-- audio data through a conduit component, see 'playYouTube''.
playYouTube
    :: String
    -- ^ Search query (or video URL)
    -> Voice ()
playYouTube :: FilePath -> Voice ()
playYouTube FilePath
query = FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playYouTube' FilePath
query ((ByteString
 -> ConduitT ByteString ByteString (ResourceT DiscordHandler) ())
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ByteString
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield)

-- | @playYouTube' query processor@ plays the first result of searching @query@
-- on YouTube. If a direct video URL is given, YouTube will always return that
-- as the first result, which means @playYouTube@ also supports playing links.
-- It supports all videos, by automatically transcoding to PCM using FFmpeg.
-- Since it streams the data instead of downloading it first, it can play live
-- videos as well. This function expects "@ffmpeg@" and "@youtube-dl@" to be
-- available in the system PATH. Audio data will be passed through the
-- @processor@ conduit component, allowing arbitrary transformations to audio
-- data before playback.
--
-- For a variant that allows you to specify the executable and/or any arguments,
-- see 'playYouTubeWith''.
--
-- For a variant of this function with no processing, see 'playYouTube'.
playYouTube'
    :: String
    -- ^ Search query (or video URL)
    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
    -- ^ Any processing that needs to be done on the audio data
    -> Voice ()
playYouTube' :: FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playYouTube' FilePath
query ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor =
  let
    customArgGen :: FilePath -> [FilePath]
customArgGen FilePath
url = 
        [ FilePath
"-reconnect", FilePath
"1"
        , FilePath
"-reconnect_streamed", FilePath
"1"
        , FilePath
"-reconnect_delay_max", FilePath
"2"
        ] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath]
defaultFFmpegArgs FilePath
url
  in
    FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playYouTubeWith' FilePath
"ffmpeg" FilePath -> [FilePath]
customArgGen FilePath
"youtube-dl" FilePath
query ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor

-- | @playYouTubeWith fexe fargs yexe query@ plays the first result of searching
-- @query@ on YouTube, using the specified @youtube-dl@ executable @yexe@,
-- FFmpeg executable @fexe@ and an argument generator function @fargs@ (see
-- @defaultFFmpegArgs@ for the default). If a direct video URL is given, YouTube
-- will always return that as the first result, which means @playYouTube@ also
-- supports playing links. It supports all videos, by automatically transcoding
-- to PCM using FFmpeg. Since it streams the data instead of downloading it
-- first, it can play live videos as well.
--
-- For a variant of this function that uses the "@ffmpeg@" executable and 
-- "@youtube-dl@" executable in your PATH automatically, see 'playYouTube'.
--
-- For a variant of this function that allows arbitrary transformations of the
-- audio data through a conduit component, see 'playYouTubeWith''.
playYouTubeWith
    :: String
    -- ^ The name of the FFmpeg executable
    -> (String -> [String])
    -- ^ FFmpeg argument generator function, given the URL
    -> String
    -- ^ The name of the youtube-dl executable
    -> String
    -- ^ The search query (or video URL)
    -> Voice ()
playYouTubeWith :: FilePath
-> (FilePath -> [FilePath]) -> FilePath -> FilePath -> Voice ()
playYouTubeWith FilePath
fexe FilePath -> [FilePath]
fargsGen FilePath
yexe FilePath
query = FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playYouTubeWith' FilePath
fexe FilePath -> [FilePath]
fargsGen FilePath
yexe FilePath
query ((ByteString
 -> ConduitT ByteString ByteString (ResourceT DiscordHandler) ())
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ByteString
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield)

-- | @playYouTubeWith' fexe fargs yexe query processor@ plays the first result
-- of searching @query@ on YouTube, using the specified @youtube-dl@ executable
-- @yexe@, FFmpeg executable @fexe@ and an argument generator function @fargs@
-- (see @defaultFFmpegArgs@ for the default). If a direct video URL is given,
-- YouTube will always return that as the first result, which means
-- @playYouTube@ also supports playing links. It supports all videos, by
-- automatically transcoding to PCM using FFmpeg. Since it streams the data
-- instead of downloading it first, it can play live videos as well. Audio data
-- will be passed through the @processor@ conduit component, allowing arbitrary
-- transformations to audio data before playback.
--
-- For a variant of this function that uses the "@ffmpeg@" executable and 
-- "@youtube-dl@" executable in your PATH automatically, see 'playYouTube''.
--
-- For a variant of this function with no processing, see 'playYouTubeWith'.
playYouTubeWith'
    :: String
    -- ^ The name of the FFmpeg executable
    -> (String -> [String])
    -- ^ The arguments to pass to FFmpeg
    -> String
    -- ^ The name of the youtube-dl executable
    -> String
    -- ^ The search query (or video URL)
    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
    -- ^ Any processing that needs to be done on the audio data
    -> Voice ()
playYouTubeWith' :: FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playYouTubeWith' FilePath
fexe FilePath -> [FilePath]
fargsGen FilePath
yexe FilePath
query ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor = do
    ByteString
extractedInfo <- IO ByteString
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ReaderT
      DiscordBroadcastHandle
      (ExceptT VoiceError DiscordHandler)
      ByteString)
-> IO ByteString
-> ReaderT
     DiscordBroadcastHandle
     (ExceptT VoiceError DiscordHandler)
     ByteString
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ByteString)
-> IO ByteString
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess (FilePath -> [FilePath] -> CreateProcess
proc FilePath
yexe
        [ FilePath
"-j"
        , FilePath
"--default-search", FilePath
"ytsearch"
        , FilePath
"--format", FilePath
"bestaudio/best"
        , FilePath
query
        ]) { std_out :: StdStream
std_out = StdStream
CreatePipe } ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ByteString)
 -> IO ByteString)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ByteString)
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
stdin (Just Handle
stdout) Maybe Handle
stderr ProcessHandle
ph ->
            Handle -> IO ByteString
B.hGetContents Handle
stdout

    let perhapsUrl :: Maybe FilePath
perhapsUrl = do
            Object
result <- ByteString -> Maybe Object
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict ByteString
extractedInfo
            ((Object -> Parser FilePath) -> Object -> Maybe FilePath)
-> Object -> (Object -> Parser FilePath) -> Maybe FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Object -> Parser FilePath) -> Object -> Maybe FilePath
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Object
result ((Object -> Parser FilePath) -> Maybe FilePath)
-> (Object -> Parser FilePath) -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Object
obj Object -> Text -> Parser FilePath
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
    case Maybe FilePath
perhapsUrl of
        -- no matching url found
        Maybe FilePath
Nothing  -> () -> Voice ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just FilePath
url -> FilePath
-> (FilePath -> [FilePath])
-> FilePath
-> ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
-> Voice ()
playFileWith' FilePath
fexe FilePath -> [FilePath]
fargsGen FilePath
url ConduitT ByteString ByteString (ResourceT DiscordHandler) ()
processor