{-# LANGUAGE ImportQualifiedPost #-}
module Discord.Internal.Voice.UDPLoop
( launchUdp
) where
import Codec.Audio.Opus.Decoder
import Crypto.Saltine.Core.SecretBox
( Key(..)
, Nonce(..)
, secretboxOpen
, secretbox
)
import Crypto.Saltine.Class qualified as SC
import Control.Concurrent
( Chan
, readChan
, writeChan
, MVar
, readMVar
, forkIO
, killThread
, threadDelay
, myThreadId
)
import Control.Concurrent.BoundedChan qualified as Bounded
import Control.Exception.Safe ( handle, SomeException, finally, try, bracket )
import Control.Lens
import Control.Monad.IO.Class ( MonadIO )
import Data.Binary ( encode, decode )
import Data.ByteString.Lazy qualified as BL
import Data.ByteString.Builder
import Data.ByteString qualified as B
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time.Clock.POSIX
import Data.Time
import Data.Maybe ( fromJust )
import Data.Word ( Word8 )
import Network.Socket hiding ( socket )
import Network.Socket qualified as S ( socket )
import Network.Socket.ByteString.Lazy ( sendAll, recv )
import Discord.Internal.Types.VoiceCommon
import Discord.Internal.Types.VoiceUDP
import Discord.Internal.Voice.CommonUtils
data UDPState
= UDPClosed
| UDPStart
| UDPReconnect
(✍) :: Chan T.Text -> T.Text -> IO ()
Chan Text
logChan ✍ :: Chan Text -> Text -> IO ()
✍ Text
log = do
String
t <- TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T %q" (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
ThreadId
tid <- IO ThreadId
myThreadId
Chan Text -> Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Text
logChan (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> Text
T.pack String
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ThreadId -> Text
forall a. Show a => a -> Text
tshow ThreadId
tid) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
log
(✍!) :: Chan T.Text -> T.Text -> IO ()
Chan Text
logChan ✍! :: Chan Text -> Text -> IO ()
✍! Text
log = Chan Text
logChan Chan Text -> Text -> IO ()
✍ (Text
"!!! Voice UDP Error - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
log)
runUDPClient :: AddrInfo -> (Socket -> IO a) -> IO a
runUDPClient :: AddrInfo -> (Socket -> IO a) -> IO a
runUDPClient AddrInfo
addr Socket -> IO a
things = IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr))
Socket -> IO ()
close ((Socket -> IO a) -> IO a) -> (Socket -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
Socket -> SockAddr -> IO ()
Network.Socket.connect Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
Socket -> IO a
things Socket
sock
launchUdp :: UDPLaunchOpts -> Chan T.Text -> IO ()
launchUdp :: UDPLaunchOpts -> Chan Text -> IO ()
launchUdp UDPLaunchOpts
opts Chan Text
log = UDPState -> Int -> IO ()
loop UDPState
UDPStart Int
0
where
loop :: UDPState -> Int -> IO ()
loop :: UDPState -> Int -> IO ()
loop UDPState
UDPClosed Int
retries = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
loop UDPState
UDPStart Int
retries = do
Either SomeException UDPState
next <- IO UDPState -> IO (Either SomeException UDPState)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO UDPState -> IO (Either SomeException UDPState))
-> IO UDPState -> IO (Either SomeException UDPState)
forall a b. (a -> b) -> a -> b
$ do
let hints :: AddrInfo
hints = AddrInfo
defaultHints
{ addrSocketType :: SocketType
addrSocketType = SocketType
Datagram
}
AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo
(AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ UDPLaunchOpts
opts UDPLaunchOpts -> Getting Text UDPLaunchOpts Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text UDPLaunchOpts Text
forall s a. HasIp s a => Lens' s a
ip)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ UDPLaunchOpts
opts UDPLaunchOpts -> Getting Integer UDPLaunchOpts Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer UDPLaunchOpts Integer
forall s a. HasPort s a => Lens' s a
port)
AddrInfo -> (Socket -> IO UDPState) -> IO UDPState
forall a. AddrInfo -> (Socket -> IO a) -> IO a
runUDPClient AddrInfo
addr ((Socket -> IO UDPState) -> IO UDPState)
-> (Socket -> IO UDPState) -> IO UDPState
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
Chan Text
log Chan Text -> Text -> IO ()
✍ Text
"UDP Connection initialised."
Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ VoiceUDPPacket -> ByteString
forall a. Binary a => a -> ByteString
encode (VoiceUDPPacket -> ByteString) -> VoiceUDPPacket -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> Text -> Integer -> VoiceUDPPacket
IPDiscovery (UDPLaunchOpts
opts UDPLaunchOpts -> Getting Integer UDPLaunchOpts Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer UDPLaunchOpts Integer
forall s a. HasSsrc s a => Lens' s a
ssrc) Text
"" Integer
0
VoiceUDPPacket
msg <- ByteString -> VoiceUDPPacket
forall a. Binary a => ByteString -> a
decode (ByteString -> VoiceUDPPacket)
-> IO ByteString -> IO VoiceUDPPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int64 -> IO ByteString
recv Socket
sock Int64
74
Chan VoiceUDPPacket -> VoiceUDPPacket -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (UDPLaunchOpts
opts UDPLaunchOpts
-> Getting
(Chan VoiceUDPPacket) UDPLaunchOpts (Chan VoiceUDPPacket)
-> Chan VoiceUDPPacket
forall s a. s -> Getting a s a -> a
^. ((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts
forall s a. HasUdpHandle s a => Lens' s a
udpHandle (((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts)
-> ((Chan VoiceUDPPacket
-> Const (Chan VoiceUDPPacket) (Chan VoiceUDPPacket))
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> Getting
(Chan VoiceUDPPacket) UDPLaunchOpts (Chan VoiceUDPPacket)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chan VoiceUDPPacket
-> Const (Chan VoiceUDPPacket) (Chan VoiceUDPPacket))
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan)
forall s t a b. Field1 s t a b => Lens s t a b
_1) VoiceUDPPacket
msg
UDPConn -> Chan Text -> IO UDPState
startForks (UDPLaunchOpts -> Socket -> UDPConn
UDPConn UDPLaunchOpts
opts Socket
sock) Chan Text
log
case Either SomeException UDPState
next :: Either SomeException UDPState of
Left SomeException
e -> do
Chan Text -> Text -> IO ()
(✍!) Chan Text
log (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"could not start UDP conn due to an exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
UDPState -> Int -> IO ()
loop UDPState
UDPClosed Int
0
Right UDPState
n -> UDPState -> Int -> IO ()
loop UDPState
n Int
0
loop UDPState
UDPReconnect Int
retries = do
Either SomeException UDPState
next <- IO UDPState -> IO (Either SomeException UDPState)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO UDPState -> IO (Either SomeException UDPState))
-> IO UDPState -> IO (Either SomeException UDPState)
forall a b. (a -> b) -> a -> b
$ do
let hints :: AddrInfo
hints = AddrInfo
defaultHints
{ addrSocketType :: SocketType
addrSocketType = SocketType
Datagram
}
AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo
(AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ UDPLaunchOpts
opts UDPLaunchOpts -> Getting Text UDPLaunchOpts Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text UDPLaunchOpts Text
forall s a. HasIp s a => Lens' s a
ip)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ UDPLaunchOpts
opts UDPLaunchOpts -> Getting Integer UDPLaunchOpts Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer UDPLaunchOpts Integer
forall s a. HasPort s a => Lens' s a
port)
AddrInfo -> (Socket -> IO UDPState) -> IO UDPState
forall a. AddrInfo -> (Socket -> IO a) -> IO a
runUDPClient AddrInfo
addr ((Socket -> IO UDPState) -> IO UDPState)
-> (Socket -> IO UDPState) -> IO UDPState
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
Chan Text
log Chan Text -> Text -> IO ()
✍ Text
"UDP Connection re-initialised."
UDPConn -> Chan Text -> IO UDPState
startForks (UDPLaunchOpts -> Socket -> UDPConn
UDPConn UDPLaunchOpts
opts Socket
sock) Chan Text
log
case Either SomeException UDPState
next :: Either SomeException UDPState of
Left SomeException
e -> do
Chan Text
log Chan Text -> Text -> IO ()
✍! Text
"could not reconnect to UDP, will restart in 10 secs."
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int))
UDPState -> Int -> IO ()
loop UDPState
UDPReconnect (Int
retries Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Right UDPState
n -> UDPState -> Int -> IO ()
loop UDPState
n Int
1
startForks
:: UDPConn
-> Chan T.Text
-> IO UDPState
startForks :: UDPConn -> Chan Text -> IO UDPState
startForks UDPConn
conn Chan Text
log = do
POSIXTime
currentTime <- IO POSIXTime
getPOSIXTime
ThreadId
sendLoopId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ UDPConn -> Chan Text -> Integer -> Integer -> POSIXTime -> IO ()
sendableLoop UDPConn
conn Chan Text
log Integer
0 Integer
0 POSIXTime
currentTime
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO () -> [IO ()]
forall a. Int -> a -> [a]
replicate Int
5 (IO () -> [IO ()]) -> IO () -> [IO ()]
forall a b. (a -> b) -> a -> b
$ VoiceUDPSendChan -> ByteString -> IO ()
forall a. BoundedChan a -> a -> IO ()
Bounded.writeChan (UDPConn
conn UDPConn
-> Getting VoiceUDPSendChan UDPConn VoiceUDPSendChan
-> VoiceUDPSendChan
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> UDPConn -> Const VoiceUDPSendChan UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> UDPConn -> Const VoiceUDPSendChan UDPConn)
-> ((VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> Getting VoiceUDPSendChan UDPConn VoiceUDPSendChan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts
forall s a. HasUdpHandle s a => Lens' s a
udpHandle (((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> ((VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> (VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> UDPLaunchOpts
-> Const VoiceUDPSendChan UDPLaunchOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan)
forall s t a b. Field2 s t a b => Lens s t a b
_2) ByteString
"\248\255\254"
IO UDPState -> IO () -> IO UDPState
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally (UDPConn -> Chan Text -> IO ()
receivableLoop UDPConn
conn Chan Text
log IO () -> IO UDPState -> IO UDPState
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UDPState -> IO UDPState
forall (f :: * -> *) a. Applicative f => a -> f a
pure UDPState
UDPClosed)
(ThreadId -> IO ()
killThread ThreadId
sendLoopId)
receivableLoop
:: UDPConn
-> Chan T.Text
-> IO ()
receivableLoop :: UDPConn -> Chan Text -> IO ()
receivableLoop UDPConn
conn Chan Text
log = do
VoiceUDPPacket
msg'' <- ByteString -> VoiceUDPPacket
forall a. Binary a => ByteString -> a
decode (ByteString -> VoiceUDPPacket)
-> IO ByteString -> IO VoiceUDPPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int64 -> IO ByteString
recv (UDPConn
conn UDPConn -> Getting Socket UDPConn Socket -> Socket
forall s a. s -> Getting a s a -> a
^. Getting Socket UDPConn Socket
forall s a. HasSocket s a => Lens' s a
socket) Int64
999
VoiceUDPPacket
msg' <- case VoiceUDPPacket
msg'' of
SpeakingDataEncrypted ByteString
header ByteString
og -> do
[Word8]
byteKey <- MVar [Word8] -> IO [Word8]
forall a. MVar a -> IO a
readMVar (UDPConn
conn UDPConn
-> Getting (MVar [Word8]) UDPConn (MVar [Word8]) -> MVar [Word8]
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn)
-> ((MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> Getting (MVar [Word8]) UDPConn (MVar [Word8])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts
forall s a. HasSecretKey s a => Lens' s a
secretKey)
let nonce :: ByteString
nonce = ByteString -> ByteString
createNonceFromHeader ByteString
header
let deciphered :: Maybe ByteString
deciphered = [Word8] -> ByteString -> ByteString -> Maybe ByteString
decrypt [Word8]
byteKey ByteString
nonce (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
og
case Maybe ByteString
deciphered of
Maybe ByteString
Nothing -> do
Chan Text
log Chan Text -> Text -> IO ()
✍! Text
"could not decipher audio message!"
VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> IO VoiceUDPPacket)
-> VoiceUDPPacket -> IO VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> VoiceUDPPacket
MalformedPacket (ByteString -> VoiceUDPPacket) -> ByteString -> VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict ByteString
header) ByteString
og
Just ByteString
x -> VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> IO VoiceUDPPacket)
-> VoiceUDPPacket -> IO VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> VoiceUDPPacket
SpeakingData ByteString
x
SpeakingDataEncryptedExtra ByteString
header ByteString
og -> do
[Word8]
byteKey <- MVar [Word8] -> IO [Word8]
forall a. MVar a -> IO a
readMVar (UDPConn
conn UDPConn
-> Getting (MVar [Word8]) UDPConn (MVar [Word8]) -> MVar [Word8]
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn)
-> ((MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> Getting (MVar [Word8]) UDPConn (MVar [Word8])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts
forall s a. HasSecretKey s a => Lens' s a
secretKey)
let nonce :: ByteString
nonce = ByteString -> ByteString
createNonceFromHeader ByteString
header
let deciphered :: Maybe ByteString
deciphered = [Word8] -> ByteString -> ByteString -> Maybe ByteString
decrypt [Word8]
byteKey ByteString
nonce (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
og
case Maybe ByteString
deciphered of
Maybe ByteString
Nothing -> do
Chan Text
log Chan Text -> Text -> IO ()
✍! Text
"could not decipher audio message!"
VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> IO VoiceUDPPacket)
-> VoiceUDPPacket -> IO VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> VoiceUDPPacket
MalformedPacket (ByteString -> VoiceUDPPacket) -> ByteString -> VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict ByteString
header) ByteString
og
Just ByteString
x -> VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VoiceUDPPacket -> IO VoiceUDPPacket)
-> VoiceUDPPacket -> IO VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ ByteString -> VoiceUDPPacket
SpeakingData (ByteString -> VoiceUDPPacket) -> ByteString -> VoiceUDPPacket
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
8 ByteString
x
VoiceUDPPacket
other -> VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceUDPPacket
other
VoiceUDPPacket
msg <- case VoiceUDPPacket
msg' of
SpeakingData ByteString
bytes -> ByteString -> VoiceUDPPacket
SpeakingData (ByteString -> VoiceUDPPacket)
-> IO ByteString -> IO VoiceUDPPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO ByteString
decodeOpusData ByteString
bytes
VoiceUDPPacket
other -> VoiceUDPPacket -> IO VoiceUDPPacket
forall (f :: * -> *) a. Applicative f => a -> f a
pure VoiceUDPPacket
other
Chan VoiceUDPPacket -> VoiceUDPPacket -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (UDPConn
conn UDPConn
-> Getting (Chan VoiceUDPPacket) UDPConn (Chan VoiceUDPPacket)
-> Chan VoiceUDPPacket
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts)
-> UDPConn -> Const (Chan VoiceUDPPacket) UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts)
-> UDPConn -> Const (Chan VoiceUDPPacket) UDPConn)
-> Getting
(Chan VoiceUDPPacket) UDPLaunchOpts (Chan VoiceUDPPacket)
-> Getting (Chan VoiceUDPPacket) UDPConn (Chan VoiceUDPPacket)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts
forall s a. HasUdpHandle s a => Lens' s a
udpHandle (((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const (Chan VoiceUDPPacket) UDPLaunchOpts)
-> ((Chan VoiceUDPPacket
-> Const (Chan VoiceUDPPacket) (Chan VoiceUDPPacket))
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> Getting
(Chan VoiceUDPPacket) UDPLaunchOpts (Chan VoiceUDPPacket)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chan VoiceUDPPacket
-> Const (Chan VoiceUDPPacket) (Chan VoiceUDPPacket))
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const
(Chan VoiceUDPPacket) (Chan VoiceUDPPacket, VoiceUDPSendChan)
forall s t a b. Field1 s t a b => Lens s t a b
_1) VoiceUDPPacket
msg
UDPConn -> Chan Text -> IO ()
receivableLoop UDPConn
conn Chan Text
log
createNonceFromHeader :: B.ByteString -> B.ByteString
ByteString
h = ByteString -> ByteString -> ByteString
B.append ByteString
h (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate Int
12 (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
B.singleton Word8
0
sendableLoop
:: UDPConn
-> Chan T.Text
-> Integer
-> Integer
-> POSIXTime
-> IO ()
sendableLoop :: UDPConn -> Chan Text -> Integer -> Integer -> POSIXTime -> IO ()
sendableLoop UDPConn
conn Chan Text
log Integer
sequence Integer
timestamp POSIXTime
startTime = do
Maybe ByteString
mbOpusBytes <- VoiceUDPSendChan -> IO (Maybe ByteString)
forall a. BoundedChan a -> IO (Maybe a)
Bounded.tryReadChan (VoiceUDPSendChan -> IO (Maybe ByteString))
-> VoiceUDPSendChan -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ UDPConn
conn UDPConn
-> Getting VoiceUDPSendChan UDPConn VoiceUDPSendChan
-> VoiceUDPSendChan
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> UDPConn -> Const VoiceUDPSendChan UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> UDPConn -> Const VoiceUDPSendChan UDPConn)
-> ((VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> Getting VoiceUDPSendChan UDPConn VoiceUDPSendChan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts
forall s a. HasUdpHandle s a => Lens' s a
udpHandle (((Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> UDPLaunchOpts -> Const VoiceUDPSendChan UDPLaunchOpts)
-> ((VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan))
-> (VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> UDPLaunchOpts
-> Const VoiceUDPSendChan UDPLaunchOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VoiceUDPSendChan -> Const VoiceUDPSendChan VoiceUDPSendChan)
-> (Chan VoiceUDPPacket, VoiceUDPSendChan)
-> Const VoiceUDPSendChan (Chan VoiceUDPPacket, VoiceUDPSendChan)
forall s t a b. Field2 s t a b => Lens s t a b
_2
case Maybe ByteString
mbOpusBytes of
Maybe ByteString
Nothing -> do
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
20 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3 :: Int)
POSIXTime
currentTime <- IO POSIXTime
getPOSIXTime
UDPConn -> Chan Text -> Integer -> Integer -> POSIXTime -> IO ()
sendableLoop UDPConn
conn Chan Text
log Integer
sequence Integer
timestamp POSIXTime
currentTime
Just ByteString
opusBytes -> do
let header :: ByteString
header = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ VoiceUDPPacketHeader -> ByteString
forall a. Binary a => a -> ByteString
encode (VoiceUDPPacketHeader -> ByteString)
-> VoiceUDPPacketHeader -> ByteString
forall a b. (a -> b) -> a -> b
$
Word8
-> Word8 -> Word16 -> Word32 -> Word32 -> VoiceUDPPacketHeader
Header Word8
0x80 Word8
0x78 (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sequence) (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
timestamp) (Word32 -> VoiceUDPPacketHeader) -> Word32 -> VoiceUDPPacketHeader
forall a b. (a -> b) -> a -> b
$
Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ UDPConn
conn UDPConn -> Getting Integer UDPConn Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const Integer UDPLaunchOpts)
-> UDPConn -> Const Integer UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const Integer UDPLaunchOpts)
-> UDPConn -> Const Integer UDPConn)
-> Getting Integer UDPLaunchOpts Integer
-> Getting Integer UDPConn Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Integer UDPLaunchOpts Integer
forall s a. HasSsrc s a => Lens' s a
ssrc
let nonce :: ByteString
nonce = ByteString -> ByteString
createNonceFromHeader ByteString
header
[Word8]
byteKey <- MVar [Word8] -> IO [Word8]
forall a. MVar a -> IO a
readMVar (MVar [Word8] -> IO [Word8]) -> MVar [Word8] -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ UDPConn
conn UDPConn
-> Getting (MVar [Word8]) UDPConn (MVar [Word8]) -> MVar [Word8]
forall s a. s -> Getting a s a -> a
^. (UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn
forall s a. HasLaunchOpts s a => Lens' s a
launchOpts ((UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> UDPConn -> Const (MVar [Word8]) UDPConn)
-> ((MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts)
-> Getting (MVar [Word8]) UDPConn (MVar [Word8])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar [Word8] -> Const (MVar [Word8]) (MVar [Word8]))
-> UDPLaunchOpts -> Const (MVar [Word8]) UDPLaunchOpts
forall s a. HasSecretKey s a => Lens' s a
secretKey
let encryptedOpus :: ByteString
encryptedOpus = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString -> ByteString -> ByteString
encrypt [Word8]
byteKey ByteString
nonce ByteString
opusBytes
Socket -> ByteString -> IO ()
sendAll (UDPConn
conn UDPConn -> Getting Socket UDPConn Socket -> Socket
forall s a. s -> Getting a s a -> a
^. Getting Socket UDPConn Socket
forall s a. HasSocket s a => Lens' s a
socket) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
VoiceUDPPacket -> ByteString
forall a. Binary a => a -> ByteString
encode (VoiceUDPPacket -> ByteString) -> VoiceUDPPacket -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> VoiceUDPPacket
SpeakingDataEncrypted ByteString
header ByteString
encryptedOpus
let theoreticalNextTime :: POSIXTime
theoreticalNextTime = POSIXTime
startTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ (POSIXTime
20 POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
1000)
POSIXTime
currentTime <- IO POSIXTime
getPOSIXTime
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> POSIXTime -> Int
forall a b. (a -> b) -> a -> b
$ (POSIXTime -> POSIXTime -> POSIXTime
forall a. Ord a => a -> a -> a
max POSIXTime
0 (POSIXTime -> POSIXTime) -> POSIXTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ POSIXTime
theoreticalNextTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
currentTime) POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
10POSIXTime -> Int -> POSIXTime
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)
UDPConn -> Chan Text -> Integer -> Integer -> POSIXTime -> IO ()
sendableLoop UDPConn
conn Chan Text
log
(Integer
sequence Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
0xFFFF) (Integer
timestamp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
48Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
20 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
0xFFFFFFFF) POSIXTime
theoreticalNextTime
decrypt :: [Word8] -> B.ByteString -> B.ByteString -> Maybe B.ByteString
decrypt :: [Word8] -> ByteString -> ByteString -> Maybe ByteString
decrypt [Word8]
byteKey ByteString
byteNonce ByteString
og = Key -> Nonce -> ByteString -> Maybe ByteString
secretboxOpen Key
key Nonce
nonce ByteString
og
where
key :: Key
key = Maybe Key -> Key
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Key -> Key) -> Maybe Key -> Key
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Key
forall a. IsEncoding a => ByteString -> Maybe a
SC.decode (ByteString -> Maybe Key) -> ByteString -> Maybe Key
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8]
byteKey
nonce :: Nonce
nonce = Maybe Nonce -> Nonce
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Nonce -> Nonce) -> Maybe Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Nonce
forall a. IsEncoding a => ByteString -> Maybe a
SC.decode ByteString
byteNonce
encrypt :: [Word8] -> B.ByteString -> B.ByteString -> B.ByteString
encrypt :: [Word8] -> ByteString -> ByteString -> ByteString
encrypt [Word8]
byteKey ByteString
byteNonce ByteString
og = Key -> Nonce -> ByteString -> ByteString
secretbox Key
key Nonce
nonce ByteString
og
where
key :: Key
key = Maybe Key -> Key
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Key -> Key) -> Maybe Key -> Key
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Key
forall a. IsEncoding a => ByteString -> Maybe a
SC.decode (ByteString -> Maybe Key) -> ByteString -> Maybe Key
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8]
byteKey
nonce :: Nonce
nonce = Maybe Nonce -> Nonce
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Nonce -> Nonce) -> Maybe Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Nonce
forall a. IsEncoding a => ByteString -> Maybe a
SC.decode ByteString
byteNonce
decodeOpusData :: B.ByteString -> IO B.ByteString
decodeOpusData :: ByteString -> IO ByteString
decodeOpusData ByteString
bytes = do
let deCfg :: DecoderConfig
deCfg = Tagged (SamplingRate, Bool) (Identity (SamplingRate, Bool))
-> Tagged DecoderConfig (Identity DecoderConfig)
Iso' DecoderConfig (SamplingRate, Bool)
_DecoderConfig (Tagged (SamplingRate, Bool) (Identity (SamplingRate, Bool))
-> Tagged DecoderConfig (Identity DecoderConfig))
-> (SamplingRate, Bool) -> DecoderConfig
forall t b. AReview t b -> b -> t
# (SamplingRate
opusSR48k, Bool
True)
let deStreamCfg :: DecoderStreamConfig
deStreamCfg = Tagged
(DecoderConfig, Int, Int) (Identity (DecoderConfig, Int, Int))
-> Tagged DecoderStreamConfig (Identity DecoderStreamConfig)
Iso' DecoderStreamConfig (DecoderConfig, Int, Int)
_DecoderStreamConfig (Tagged
(DecoderConfig, Int, Int) (Identity (DecoderConfig, Int, Int))
-> Tagged DecoderStreamConfig (Identity DecoderStreamConfig))
-> (DecoderConfig, Int, Int) -> DecoderStreamConfig
forall t b. AReview t b -> b -> t
# (DecoderConfig
deCfg, Int
48Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
20, Int
0)
Decoder
decoder <- DecoderConfig -> IO Decoder
forall cfg (m :: * -> *).
(HasDecoderConfig cfg, MonadIO m) =>
cfg -> m Decoder
opusDecoderCreate DecoderConfig
deCfg
ByteString
decoded <- Decoder -> DecoderStreamConfig -> ByteString -> IO ByteString
forall cfg (m :: * -> *).
(HasDecoderStreamConfig cfg, MonadIO m) =>
Decoder -> cfg -> ByteString -> m ByteString
opusDecode Decoder
decoder DecoderStreamConfig
deStreamCfg ByteString
bytes
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
decoded