{-# 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
    -- We prefer UnliftIO.MVar functions for most MVar-related operations in
    -- DiscordHandler, but since the Voice monad doesn't have MonadUnliftIO
    -- (because it has an ExceptT transformer), we use the default
    -- Control.Concurrent.MVar functions there.
    , newEmptyMVar
    , modifyMVar_
    , readMVar
    )
import Control.Concurrent.BoundedChan qualified as Bounded
import Control.Exception.Safe ( bracket, throwTo, catch, throwIO )
import Lens.Micro
import Lens.Micro.Extras (view)
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(..)
    , EventInternalParse (..)
    )
import Discord.Internal.Types.VoiceCommon
import Discord.Internal.Types.VoiceWebsocket
    ( VoiceWebsocketSendable(Speaking)
    , SpeakingPayload(..)
    )
import Discord.Internal.Voice.CommonUtils
import Discord.Internal.Voice.WebsocketLoop

-- | @liftDiscord@ lifts a computation in DiscordHandler into a computation in
-- Voice. This is useful for performing DiscordHandler actions inside the
-- Voice monad.
--
-- Usage:
-- 
-- @
-- runVoice $ do
--     join (read "123456789012345") (read "67890123456789012")
--     liftDiscord $ void $ restCall $ R.CreateMessage (read "2938481828383") "Joined!"
--     liftIO $ threadDelay 5e6
--     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 = ReaderT
  DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
-> Voice a
forall a.
ReaderT
  DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
-> Voice a
Voice (ReaderT
   DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
 -> Voice a)
-> (DiscordHandler a
    -> ReaderT
         DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a)
-> DiscordHandler a
-> Voice a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT VoiceError DiscordHandler a
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT VoiceError DiscordHandler a
 -> ReaderT
      DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a)
-> (DiscordHandler a -> ExceptT VoiceError DiscordHandler a)
-> DiscordHandler a
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) 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.
--
-- This function may propagate and throw an 'IOException' if 'createProcess' 
-- fails for e.g. ffmpeg or youtube-dl.
runVoice :: Voice () -> DiscordHandler (Either VoiceError ())
runVoice :: Voice () -> DiscordHandler (Either VoiceError ())
runVoice Voice ()
action = do
    MVar [DiscordVoiceHandle]
voiceHandles <- [DiscordVoiceHandle]
-> ReaderT DiscordHandle IO (MVar [DiscordVoiceHandle])
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
UnliftIO.newMVar []
    MVar ()
mutEx <- () -> ReaderT DiscordHandle IO (MVar ())
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
UnliftIO.newMVar ()

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

    Either VoiceError ()
result <- 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
$ (ReaderT
   DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
 -> DiscordBroadcastHandle -> ExceptT VoiceError DiscordHandler ())
-> DiscordBroadcastHandle
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
-> ExceptT VoiceError DiscordHandler ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
-> DiscordBroadcastHandle -> ExceptT VoiceError DiscordHandler ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DiscordBroadcastHandle
initialState (ReaderT
   DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
 -> ExceptT VoiceError DiscordHandler ())
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
-> ExceptT VoiceError DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Voice ()
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
forall a.
Voice a
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a
unVoice (Voice ()
 -> ReaderT
      DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ())
-> Voice ()
-> ReaderT
     DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) ()
forall a b. (a -> b) -> a -> b
$ Voice ()
action

    -- Wrap cleanup action in @finally@ to ensure we always close the
    -- threads even if an exception occurred.
    [DiscordVoiceHandle]
finalState <- MVar [DiscordVoiceHandle]
-> ReaderT DiscordHandle IO [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UnliftIO.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
  (Traversed () DiscordHandler)
  [DiscordVoiceHandle]
  (DiscordId GuildIdType)
-> (DiscordId GuildIdType -> ReaderT DiscordHandle IO ())
-> [DiscordVoiceHandle]
-> ReaderT DiscordHandle IO ()
forall (f :: * -> *) r s a.
Functor f =>
Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()
traverseOf_ ((DiscordVoiceHandle
 -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
-> [DiscordVoiceHandle]
-> Const (Traversed () DiscordHandler) [DiscordVoiceHandle]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((DiscordVoiceHandle
  -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
 -> [DiscordVoiceHandle]
 -> Const (Traversed () DiscordHandler) [DiscordVoiceHandle])
-> ((DiscordId GuildIdType
     -> Const (Traversed () DiscordHandler) (DiscordId GuildIdType))
    -> DiscordVoiceHandle
    -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
-> Getting
     (Traversed () DiscordHandler)
     [DiscordVoiceHandle]
     (DiscordId GuildIdType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiscordId GuildIdType
 -> Const (Traversed () DiscordHandler) (DiscordId GuildIdType))
-> DiscordVoiceHandle
-> Const (Traversed () DiscordHandler) DiscordVoiceHandle
forall s a. HasGuildId s a => Lens' s a
guildId) (\DiscordId GuildIdType
x -> DiscordId GuildIdType
-> Maybe ChannelId -> Bool -> Bool -> ReaderT DiscordHandle IO ()
updateStatusVoice DiscordId GuildIdType
x Maybe ChannelId
forall a. Maybe a
Nothing Bool
False Bool
False) [DiscordVoiceHandle]
finalState
    Getting
  (Traversed () DiscordHandler) [DiscordVoiceHandle] (Weak ThreadId)
-> (Weak ThreadId -> ReaderT DiscordHandle IO ())
-> [DiscordVoiceHandle]
-> ReaderT DiscordHandle IO ()
forall (f :: * -> *) r s a.
Functor f =>
Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()
traverseOf_ ((DiscordVoiceHandle
 -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
-> [DiscordVoiceHandle]
-> Const (Traversed () DiscordHandler) [DiscordVoiceHandle]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((DiscordVoiceHandle
  -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
 -> [DiscordVoiceHandle]
 -> Const (Traversed () DiscordHandler) [DiscordVoiceHandle])
-> ((Weak ThreadId
     -> Const (Traversed () DiscordHandler) (Weak ThreadId))
    -> DiscordVoiceHandle
    -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
-> Getting
     (Traversed () DiscordHandler) [DiscordVoiceHandle] (Weak ThreadId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Weak ThreadId,
  (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
 -> Const
      (Traversed () DiscordHandler)
      (Weak ThreadId,
       (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> DiscordVoiceHandle
-> Const (Traversed () DiscordHandler) DiscordVoiceHandle
forall s a. HasWebsocket s a => Lens' s a
websocket (((Weak ThreadId,
   (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
  -> Const
       (Traversed () DiscordHandler)
       (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
 -> DiscordVoiceHandle
 -> Const (Traversed () DiscordHandler) DiscordVoiceHandle)
-> ((Weak ThreadId
     -> Const (Traversed () DiscordHandler) (Weak ThreadId))
    -> (Weak ThreadId,
        (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
    -> Const
         (Traversed () DiscordHandler)
         (Weak ThreadId,
          (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)))
-> (Weak ThreadId
    -> Const (Traversed () DiscordHandler) (Weak ThreadId))
-> DiscordVoiceHandle
-> Const (Traversed () DiscordHandler) DiscordVoiceHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Weak ThreadId
 -> Const (Traversed () DiscordHandler) (Weak ThreadId))
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> Const
     (Traversed () DiscordHandler)
     (Weak ThreadId,
      (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
forall s t a b. Field1 s t a b => Lens s t a b
_1) (IO () -> ReaderT DiscordHandle IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT DiscordHandle IO ())
-> (Weak ThreadId -> IO ())
-> Weak ThreadId
-> ReaderT DiscordHandle IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weak ThreadId -> IO ()
killWkThread) [DiscordVoiceHandle]
finalState

    Either VoiceError () -> DiscordHandler (Either VoiceError ())
forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: DiscordId GuildIdType -> ChannelId -> Voice (Voice ())
join DiscordId GuildIdType
guildId ChannelId
channelId = do
    DiscordHandle
h <- DiscordHandler DiscordHandle -> Voice DiscordHandle
forall a. DiscordHandler a -> Voice a
liftDiscord 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 EventInternalParse)
events <- IO (Chan (Either GatewayException EventInternalParse))
-> Voice (Chan (Either GatewayException EventInternalParse))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan (Either GatewayException EventInternalParse))
 -> Voice (Chan (Either GatewayException EventInternalParse)))
-> IO (Chan (Either GatewayException EventInternalParse))
-> Voice (Chan (Either GatewayException EventInternalParse))
forall a b. (a -> b) -> a -> b
$ Chan (Either GatewayException EventInternalParse)
-> IO (Chan (Either GatewayException EventInternalParse))
forall a. Chan a -> IO (Chan a)
dupChan (Chan (Either GatewayException EventInternalParse)
 -> IO (Chan (Either GatewayException EventInternalParse)))
-> Chan (Either GatewayException EventInternalParse)
-> IO (Chan (Either GatewayException EventInternalParse))
forall a b. (a -> b) -> a -> b
$ GatewayHandle -> Chan (Either GatewayException EventInternalParse)
gatewayHandleEvents (GatewayHandle
 -> Chan (Either GatewayException EventInternalParse))
-> GatewayHandle
-> Chan (Either GatewayException EventInternalParse)
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).
    ReaderT DiscordHandle IO () -> Voice ()
forall a. DiscordHandler a -> Voice a
liftDiscord (ReaderT DiscordHandle IO () -> Voice ())
-> ReaderT DiscordHandle IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ DiscordId GuildIdType
-> Maybe ChannelId -> Bool -> Bool -> ReaderT DiscordHandle IO ()
updateStatusVoice DiscordId GuildIdType
guildId (ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
channelId) Bool
False Bool
False

    (IO (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
-> Voice (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
 -> Voice (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text)))
-> (IO (Text, Text, DiscordId GuildIdType, Maybe Text)
    -> IO (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text)))
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
-> Voice (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
-> IO (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
forall a. Int -> IO a -> IO (Maybe a)
timeoutMs Int
5000) (Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
waitForVoiceStatusServerUpdate Chan (Either GatewayException EventInternalParse)
events) Voice (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text))
-> (Maybe (Text, Text, DiscordId GuildIdType, Maybe Text)
    -> Voice (Voice ()))
-> Voice (Voice ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Text, Text, DiscordId GuildIdType, 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
_, DiscordId GuildIdType
_, 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, DiscordId GuildIdType
guildId, Just Text
endpoint) -> do
            -- create the sending and receiving channels for Websocket
            (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
wsChans <- IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> Voice (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
 -> Voice (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> IO (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> Voice (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)
-> Voice (Chan VoiceUDPPacket, BoundedChan ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan VoiceUDPPacket, BoundedChan ByteString)
 -> Voice (Chan VoiceUDPPacket, BoundedChan ByteString))
-> IO (Chan VoiceUDPPacket, BoundedChan ByteString)
-> Voice (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)) -> Voice (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) -> Voice (MVar Integer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar Integer)
forall a. IO (MVar a)
newEmptyMVar

            UserId
uid <- User -> UserId
userId (User -> UserId) -> (Cache -> User) -> Cache -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache -> User
cacheCurrentUser (Cache -> UserId) -> Voice Cache -> Voice UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DiscordHandler Cache -> Voice Cache
forall a. DiscordHandler a -> Voice a
liftDiscord DiscordHandler Cache
readCache)
            let wsOpts :: WebsocketLaunchOpts
wsOpts = UserId
-> Text
-> Text
-> DiscordId GuildIdType
-> Text
-> (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)
-> MVar (Weak ThreadId)
-> (Chan VoiceUDPPacket, BoundedChan ByteString)
-> MVar Integer
-> WebsocketLaunchOpts
WebsocketLaunchOpts UserId
uid Text
sessionId Text
token DiscordId GuildIdType
guildId Text
endpoint
                    (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 -> Voice ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Voice ThreadId) -> IO ThreadId -> Voice 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) -> Voice (Weak ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak ThreadId) -> Voice (Weak ThreadId))
-> IO (Weak ThreadId) -> Voice (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) -> Voice (Weak ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak ThreadId) -> Voice (Weak ThreadId))
-> IO (Weak ThreadId) -> Voice (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 -> Voice Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> Voice Integer) -> IO Integer -> Voice 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 <- Voice 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 = DiscordId GuildIdType
-> ChannelId
-> (Weak ThreadId,
    (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))
-> (Weak ThreadId, (Chan VoiceUDPPacket, BoundedChan ByteString))
-> Integer
-> DiscordVoiceHandle
DiscordVoiceHandle DiscordId GuildIdType
guildId ChannelId
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
                ReaderT DiscordHandle IO () -> Voice ()
forall a. DiscordHandler a -> Voice a
liftDiscord (ReaderT DiscordHandle IO () -> Voice ())
-> ReaderT DiscordHandle IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ DiscordId GuildIdType
-> Maybe ChannelId -> Bool -> Bool -> ReaderT DiscordHandle IO ()
updateStatusVoice DiscordId GuildIdType
guildId Maybe ChannelId
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 EventInternalParse)
        -> IO (T.Text, T.Text, GuildId, Maybe T.Text)
    waitForVoiceStatusServerUpdate :: Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
waitForVoiceStatusServerUpdate = Maybe Text
-> Maybe (Text, DiscordId GuildIdType, Maybe Text)
-> Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
loopForBothEvents Maybe Text
forall a. Maybe a
Nothing Maybe (Text, DiscordId GuildIdType, Maybe Text)
forall a. Maybe a
Nothing
    
    loopForBothEvents
        :: Maybe T.Text
        -> Maybe (T.Text, GuildId, Maybe T.Text)
        -> Chan (Either GatewayException EventInternalParse)
        -> IO (T.Text, T.Text, GuildId, Maybe T.Text)
    loopForBothEvents :: Maybe Text
-> Maybe (Text, DiscordId GuildIdType, Maybe Text)
-> Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
loopForBothEvents (Just Text
a) (Just (Text
b, DiscordId GuildIdType
c, Maybe Text
d)) Chan (Either GatewayException EventInternalParse)
events = (Text, Text, DiscordId GuildIdType, Maybe Text)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a, Text
b, DiscordId GuildIdType
c, Maybe Text
d)
    loopForBothEvents Maybe Text
mb1 Maybe (Text, DiscordId GuildIdType, Maybe Text)
mb2 Chan (Either GatewayException EventInternalParse)
events = Chan (Either GatewayException EventInternalParse)
-> IO (Either GatewayException EventInternalParse)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
events IO (Either GatewayException EventInternalParse)
-> (Either GatewayException EventInternalParse
    -> IO (Text, Text, DiscordId GuildIdType, Maybe Text))
-> IO (Text, Text, DiscordId GuildIdType, 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 (InternalUnknownEvent 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, DiscordId GuildIdType, Maybe Text)
-> Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
loopForBothEvents Maybe Text
sessionId Maybe (Text, DiscordId GuildIdType, Maybe Text)
mb2 Chan (Either GatewayException EventInternalParse)
events
        Right (InternalUnknownEvent Text
"VOICE_SERVER_UPDATE" Object
obj) -> do
            let result :: Maybe (Text, DiscordId GuildIdType, Maybe Text)
result = ((Object -> Parser (Text, DiscordId GuildIdType, Maybe Text))
 -> Object -> Maybe (Text, DiscordId GuildIdType, Maybe Text))
-> Object
-> (Object -> Parser (Text, DiscordId GuildIdType, Maybe Text))
-> Maybe (Text, DiscordId GuildIdType, Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Object -> Parser (Text, DiscordId GuildIdType, Maybe Text))
-> Object -> Maybe (Text, DiscordId GuildIdType, Maybe Text)
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Object
obj ((Object -> Parser (Text, DiscordId GuildIdType, Maybe Text))
 -> Maybe (Text, DiscordId GuildIdType, Maybe Text))
-> (Object -> Parser (Text, DiscordId GuildIdType, Maybe Text))
-> Maybe (Text, DiscordId GuildIdType, 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"
                    DiscordId GuildIdType
guildId <- Object
o Object -> Text -> Parser (DiscordId GuildIdType)
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, DiscordId GuildIdType, Maybe Text)
-> Parser (Text, DiscordId GuildIdType, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
token, DiscordId GuildIdType
guildId, Maybe Text
endpoint)
            Maybe Text
-> Maybe (Text, DiscordId GuildIdType, Maybe Text)
-> Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
loopForBothEvents Maybe Text
mb1 Maybe (Text, DiscordId GuildIdType, Maybe Text)
result Chan (Either GatewayException EventInternalParse)
events
        Either GatewayException EventInternalParse
_ -> Maybe Text
-> Maybe (Text, DiscordId GuildIdType, Maybe Text)
-> Chan (Either GatewayException EventInternalParse)
-> IO (Text, Text, DiscordId GuildIdType, Maybe Text)
loopForBothEvents Maybe Text
mb1 Maybe (Text, DiscordId GuildIdType, Maybe Text)
mb2 Chan (Either GatewayException EventInternalParse)
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])
-> Voice DiscordBroadcastHandle
-> Voice (MVar [DiscordVoiceHandle])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Voice DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    [DiscordVoiceHandle]
handles <- MVar [DiscordVoiceHandle] -> Voice [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UnliftIO.readMVar MVar [DiscordVoiceHandle]
h
    ((DiscordVoiceHandle -> Voice ())
 -> [DiscordVoiceHandle] -> Voice ())
-> [DiscordVoiceHandle]
-> (DiscordVoiceHandle -> Voice ())
-> Voice ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Getting
  (Traversed () Voice) [DiscordVoiceHandle] DiscordVoiceHandle
-> (DiscordVoiceHandle -> Voice ())
-> [DiscordVoiceHandle]
-> Voice ()
forall (f :: * -> *) r s a.
Functor f =>
Getting (Traversed r f) s a -> (a -> f r) -> s -> f ()
traverseOf_ Getting
  (Traversed () Voice) [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
            }

-- | 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 :: DiscordId GuildIdType
-> Maybe ChannelId -> Bool -> Bool -> ReaderT DiscordHandle IO ()
updateStatusVoice DiscordId GuildIdType
a Maybe ChannelId
b Bool
c Bool
d = GatewaySendable -> ReaderT DiscordHandle IO ()
sendCommand (GatewaySendable -> ReaderT DiscordHandle IO ())
-> GatewaySendable -> ReaderT DiscordHandle IO ()
forall a b. (a -> b) -> a -> b
$ UpdateStatusVoiceOpts -> GatewaySendable
UpdateStatusVoice (UpdateStatusVoiceOpts -> GatewaySendable)
-> UpdateStatusVoiceOpts -> GatewaySendable
forall a b. (a -> b) -> a -> b
$ DiscordId GuildIdType
-> Maybe ChannelId -> Bool -> Bool -> UpdateStatusVoiceOpts
UpdateStatusVoiceOpts DiscordId GuildIdType
a Maybe ChannelId
b Bool
c Bool
d

-- | @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 <- Voice DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    DiscordHandle
dh <- DiscordHandler DiscordHandle -> Voice DiscordHandle
forall a. DiscordHandler a -> Voice a
liftDiscord DiscordHandler DiscordHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
    [DiscordVoiceHandle]
handles <- MVar [DiscordVoiceHandle] -> Voice [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UnliftIO.readMVar (MVar [DiscordVoiceHandle] -> Voice [DiscordVoiceHandle])
-> MVar [DiscordVoiceHandle] -> Voice [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
    ReaderT DiscordHandle IO () -> Voice ()
forall a. DiscordHandler a -> Voice a
liftDiscord (ReaderT DiscordHandle IO () -> Voice ())
-> ReaderT DiscordHandle IO () -> Voice ()
forall a b. (a -> b) -> a -> b
$ MVar ()
-> (() -> ReaderT DiscordHandle IO ())
-> ReaderT DiscordHandle IO ()
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) ((() -> ReaderT DiscordHandle IO ())
 -> ReaderT DiscordHandle IO ())
-> (() -> ReaderT DiscordHandle IO ())
-> ReaderT DiscordHandle IO ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
        ConduitT () Void (ResourceT DiscordHandler) ()
-> ReaderT DiscordHandle IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT DiscordHandler) ()
 -> ReaderT DiscordHandle IO ())
-> ConduitT () Void (ResourceT DiscordHandler) ()
-> ReaderT DiscordHandle IO ()
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 a s. Getting a s a -> s -> 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 = SamplingRate -> Bool -> CodingMode -> EncoderConfig
mkEncoderConfig SamplingRate
opusSR48k Bool
True CodingMode
app_audio
    -- 1275 is the max bytes an opus 20ms frame can have
    streamCfg :: StreamConfig
streamCfg = EncoderConfig -> Int -> Int -> StreamConfig
mkStreamConfig 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) -> Voice (Handle, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle, Handle) -> Voice (Handle, Handle))
-> IO (Handle, Handle) -> Voice (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)
-> Voice (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)
 -> Voice (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Voice (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 -> Voice ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
    Voice 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 -> Voice ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Voice ThreadId) -> IO ThreadId -> Voice 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 -> Voice ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Voice ByteString)
-> IO ByteString -> Voice 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