{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
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
, 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 :: 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
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
[DiscordVoiceHandle]
finalState <- MVar [DiscordVoiceHandle]
-> ReaderT DiscordHandle IO [DiscordVoiceHandle]
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
UnliftIO.readMVar MVar [DiscordVoiceHandle]
voiceHandles
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 :: 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
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
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
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
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
(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
(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
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
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
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
DiscordBroadcastHandle
voiceState <- Voice DiscordBroadcastHandle
forall r (m :: * -> *). MonadReader r m => m r
ask
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)
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
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
Right (InternalUnknownEvent Text
"VOICE_STATE_UPDATE" Object
obj) -> do
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
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
}
updateStatusVoice
:: GuildId
-> Maybe ChannelId
-> Bool
-> Bool
-> 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 :: 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 :: 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
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
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
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
Encoder -> ConduitT ByteString ByteString m ()
loop Encoder
encoder
playPCMFile
:: FilePath
-> 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'
:: FilePath
-> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
-> 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
:: FilePath
-> 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'
:: FilePath
-> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
-> 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 :: 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
:: String
-> (String -> [String])
-> FilePath
-> 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'
:: String
-> (String -> [String])
-> String
-> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
-> 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
(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
}
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
:: String
-> 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'
:: String
-> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
-> 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
:: String
-> (String -> [String])
-> String
-> String
-> 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'
:: String
-> (String -> [String])
-> String
-> String
-> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()
-> 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
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