discord-haskell-voice 2.3.1 → 3.0.0

raw patch · 17 files changed

+1938/−977 lines, 17 filesdep +conduit-extradep +cryptondep +crypton-boxdep −processdep ~aesondep ~bytestringdep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit-extra, crypton, crypton-box

Dependencies removed: process

Dependency ranges changed: aeson, bytestring, conduit, discord-haskell, microlens, microlens-th, mtl, optparse-applicative, opus, saltine, stm, stm-containers, text, time, websockets, wuss

API changes (from Hackage documentation)

Files

• ChangeLog.md +56/−8
• LICENSE +22/−21
• README.md +69/−52
• discord-haskell-voice.cabal +53/−71
• examples/BasicMusicBot.hs +53/−40
• examples/JoinAllVC.hs +19/−13
• src/Discord/Internal/Types/VoiceCommon.hs +270/−54
• src/Discord/Internal/Types/VoiceUDP.hs +66/−16
• src/Discord/Internal/Types/VoiceWebsocket.hs +94/−27
• src/Discord/Internal/Voice.hs +497/−440
• src/Discord/Internal/Voice/CommonUtils.hs +8/−8
• src/Discord/Internal/Voice/Encryption.hs +87/−0
• src/Discord/Internal/Voice/OggParser.hs +323/−0
• src/Discord/Internal/Voice/UDPLoop.hs +50/−69
• src/Discord/Internal/Voice/WebsocketLoop.hs +117/−86
• src/Discord/Voice.hs +132/−54
• src/Discord/Voice/Conduit.hs +22/−18

@@ -2,38 +2,86 @@  ## Unreleased changes -## 2.3.1+## 3.0.0 — 2025 March +- **Breaking API changes**+  - Replaced previously separate playing functions with a single `play` function+  - New `AudioResource` type represents a resource to be played, made with e.g. `createYoutubeResource`+  - New audio transformation abilities via FFmpeg flags and Haskell conduits+  - Use FFmpeg's direct Ogg/Opus output to skip the FFmpeg->PCM->Opus translation if there are no Haskell conduits that operate on PCM+  - Can now specify a codec in `play` to skip on using FFmpeg at all if input is already PCM or Opus+  - Can now use `ffprobe` to automatically detect if the input resource is already PCM or Opus and intelligently skip FFmpeg+  - New dependency on `typed-process` for safer external process+  - New dependency on `opus` from Hackage instead of direct git source+  - Remove ExceptT from the Voice monad stack+  - Remove `SubprocessException` type from the library as it became unused+  - Remove `InvalidPayloadOrder` from the `VoiceError` ADT since it became unused++- Bug Fixes+  - Fix `OpusBufferTooSmall` when receiving Opus data due to buffer being half the size it should be+  - Fix the library crashing when joining a call with another user already in it, which triggers Opcodes 11/18/20 before Opcode 4+  - Fix `leave` causing MVar thread deadlock due to the BoundedChan consumer thread being killed+  - Fix possibility of audio artifacts when sending multiple audio resources back-to-back due to incorrect silence frames [#45](https://github.com/yutotakano/discord-haskell-voice/pull/45)+  - Fix posibility of the last few bytes of Opus frames being cut off during transmission due to a buffer too small [#45](https://github.com/yutotakano/discord-haskell-voice/pull/45)++- Miscellaneous+  - Support GHC 8.10.7, 9.0.2, 9.2.4, and 9.6.6+  - Improve BasicMusicBot example to be less lisp-y in terms of brackets, and fix all warnings+  - Improve error messages when parsing Ogg containers fail+  - Use `DerivingStrategies` in the library code to make explicit where deriving typeclasses are from+  - Add a compile flag (`-use-crypton`) to use a `crypton`-based encryption backend, which removes the necessity for libsodium+  - Remove `containers` dependency+  - Relax package bounds:+    - `aeson` from ==1.5.6.0 to <2.3+    - `bytestring` from <0.11 to <0.13+    - `conduit` from <=1.3.4.2 to <1.4.0.0+    - `mtl` from ==2.2.2 to <2.4+    - `saltine` from <0.2 to <0.4+    - `stm` from <2.5.1 to <2.6+    - `text` from <2 to <3+    - `time` from <=1.13 to <1.15+    - `websockets` from <0.12.8 to <0.14+    - `wuss` from <=1.2 to <2.1+    - `discord-haskell` from <= 1.14.0 to <= 1.17.1+  - Add build CI for Cabal & Stack for all supported GHC versions except 9.6.6+  - Renamed `master` branch to `main`+  - Updated copyright to current year and include contributors where applicable+  - Added link to GitHub Sponsors+  - Updated Haddock for all functions and added examples and usage to many functions+  - Added upper bound of `<0.5` to microlens and microlens-th++## 2.3.1 — 2022 July+ - Update `discord-haskell` dependency bounds to `>= 1.12.0 && <= 1.14.0`. - Use `UnliftIO.MVar` functions internally for MVar operations in `DiscordHandler` - `IOException`s thrown by e.g. createProcess during `runVoice` are no longer caught and subdued - they are propagated to the user. -## 2.3.0+## 2.3.0 — 2022 May  - Export `playYouTubeWith` and `playYouTubeWith'` from `Discord.Voice`. - Update `discord-haskell` dependency bounds to `>= 1.12.0 && <= 1.13.0`. - Migrate from `lens` to `microlens`, following the `opus` package doing the same. -## 2.2.2+## 2.2.2 — 2022 February  - Update `discord-haskell` dependency to 1.12.0 - Bump copyright to 2022 - Fix incomplete pattern match crash in the example bot when using `bot --bash-completion-script` -## 2.2.1+## 2.2.1 — 2022 January  - Patch README having incorrect non-published details after Hackage publication. -## 2.2.0+## 2.2.0 — 2022 January  - Change the definition of `Voice` from a type alias exposing dangerous internal handles, to a newtype wrapper. This also changes the definition of `liftDiscord` to maintain identical behaviour. - Update `discord-haskell` dependency to 1.11.0 -## 2.1.0+## 2.1.0 — 2022 January  - Removed `updateSpeakingStatus` from the publicly exported function list for `Discord.Voice`. -## 2.0.0+## 2.0.0 — 2021 December  - Rewrite the entire library (see #1). - Introduce the `Voice` monad, and all functions in it: `join`, `play`, and all other variants of `play`.@@ -43,7 +91,7 @@ - Add package documentation to public modules, and make sure the abstraction layer is solid (don't export useless internals). - Rename the JoinSpecificVC example to BasicMusicBot and add a `bot volume` command to change the volume. -## 0.0.1+## 0.0.1 — 2021 June  - Initial release. - Implement `joinVoice`, `leaveVoice`, etc and use `DiscordVoiceHandle` to maintain a reference to the voice handle.

@@ -1,21 +1,22 @@-MIT License
-
-Copyright (c) 2021-2022 Yuto Takano
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
+MIT License++Copyright (c) 2021-2022 Yuto Takano+Copyright (c) 2025-PRESENT discord-haskell-voice Contributors++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -1,12 +1,12 @@ # discord-haskell-voice -[![hackage version](https://img.shields.io/hackage/v/discord-haskell-voice?color=%235e5184)](https://hackage.haskell.org/package/discord-haskell-voice)-[![discord-haskell version dependency](https://img.shields.io/badge/discord--haskell-%3E=1.12.0%20%26%26%20%3C=1.14.0-lightblue)](https://hackage.haskell.org/package/discord-haskell)+[![hackage version](https://img.shields.io/hackage/v/discord-haskell-voice?color=7565a8)](https://hackage.haskell.org/package/discord-haskell-voice)+[![discord-haskell version dependency](https://img.shields.io/badge/discord--haskell-%3E=1.12.0%20%26%26%20%3C=1.17.1-677eab)](https://hackage.haskell.org/package/discord-haskell)+![GitHub Actions Workflow Status](https://img.shields.io/github/actions/workflow/status/yutotakano/discord-haskell-voice/build_cabal.yml)  Welcome to `discord-haskell-voice`! This library provides you with a high-level interface for interacting with Discord's Voice API, building on top of the-[`discord-haskell`](https://hackage.haskell.org/package/discord-haskell) library-by Karl.+[`discord-haskell`](https://hackage.haskell.org/package/discord-haskell) library.  For a quick intuitive introduction to what this library enables you to do, see the following snippet of code:@@ -14,64 +14,79 @@ ```hs rickroll :: Channel -> DiscordHandler () rickroll c@(ChannelVoice {}) = do-    void $ runVoice $ do+    runVoice $ do         join (channelGuild c) (channelId c)-        playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"+        res <- createYoutubeResource "https://www.youtube.com/watch?v=dQw4w9WgXcQ" Nothing+        play res UnknownCodec ```  The library actively uses and supports conduit, which enables you to write-something like the following as well!+something like the following as well! (Spoiler: it plays 'Never Gonna Give You+Up' by Rick Astley at half the volume then prints to stdout.)  ```hs rickrollHalfVolume :: Channel -> DiscordHandler () rickrollHalfVolume c@(ChannelVoice {}) = do-    void $ runVoice $ do+    runVoice $ do         join (channelGuild c) (channelId c)         let halfAmplitude = awaitForever $ \current ->                 yield $ round $ fromIntegral current * 0.5-        playYouTube' "rickroll" $ packInt16C .| halfAmplitude .| unpackInt16C+        res <- createYoutubeResource "rickroll" $ HaskellTransformation $ packInt16C .| halfAmplitude .| unpackInt16C+        play res UnknownCodec         liftIO $ print "finished playing!" ``` +Scroll down for a more in-depth features list.+ ## Requirements -- The library uses [`saltine`](https://github.com/tel/saltine) for encryption-and decryption of audio packets. This requires libsodium to be installed on-your system. See their README for information.-- The library requires Opus libraries to be installed on your system. The-`libopus-dev` package available on package repositories should be sufficient-on most \*nix systems. The `opus` brew package suffices on Mac. Windows-is unexplored yet (WSL works).-- If you are to use any variants of `playFile`, `playYouTube`, you will need-FFmpeg installed. To specify a custom executable name, see the `-With` function-variants.-- If you are to use any variants of `playYouTube`, you will additionally need-youtube-dl installed. This is used to get the stream URL to pass to FFmpeg. To-specify a custom executable name (such as yt-dlp), use `playYouTubeWith`.+- `libsodium`: We depend on [`saltine`](https://github.com/tel/saltine) for+  encryption and decryption of audio packets. This is a NaCl binding and thus+  requires libsodium to be installed on your system. See their README for+  installation information.+  - An alternative is provided via a compile flag, which is to use `crypton` as+    a backend instead, which requires no native dependencies. The security of+    this library has not been vetted however, so use with caution.+- `libopus`: We require Opus libraries to be installed on your system. Please+  follow the README of the [Haskell Opus package](https://github.com/yutotakano/opus).+- `ffmpeg`: It is heavily recommended to have FFmpeg installed and available in+  PATH. Without FFmpeg, you will not be able to transcode any non-PCM non-Opus+  files, bytestrings, or YouTube media.+- `yt-dlp`: It is equally heavily recommended to have yt-dlp installed and+  available in PATH. Without yt-dlp, you will not be able to use+  `createYoutubeResource`.+- `ffprobe`: It is optional to have FFprobe installed and available in PATH.+  Without FFprobe, you will not be able to use `ProbeCodec` to check if a given+  file, bytestream, or YouTube video can avoid transcoding via FFmpeg if it's+  already PCM or Opus-encoded.  ## Features  What is supported: -- Can join/leave Discord voice channels. It is possible to join multiple of them-simultaneously (one per sever) and stream different contents to each.-- It is also possible to join many voice channels (across many servers) and play-the same content, radio/subscriber-style.-- You can play arbitrary PCM audio, arbitrary audio (with FFmpeg), and arbitrary-internet audio (with youtube-dl).-- You can transform audio arbitrarily using Conduit.-- As it streams content, the library /should/ use constant memory (unverified).-- OPUS encoding and specific implementation details such as handshakes and-encryption are done opaquely, and a nice abstraction layer is provided.+- Can join/leave Discord voice channels.+  - Can join multiple of them simultaneously (one per sever) and stream+    different content to each.+  - Can join many voice channels (across many servers) and simulcast the same+    content, radio/subscriber-style.+- Can play arbitrary PCM/Opus audio from a file or byte stream+- Can play arbitrary audio using FFmpeg to transcode+- Can intelligently skip transcoding based on source format using ffprobe+- Can play arbitrary internet audio using yt-dlp, including live streams+- Can transform audio arbitrarily using either FFmpeg flags or Conduits that+  operate on bytestreams+- As it streams content, the library should use constant memory (unverified) +Where possible, specific details like method of encryption, protocol handshakes,+packet encoding etc have been abstracted away. As a result, this library is able+to offer a high-level productive API interface similar to discord.js and+discord.py libraries.+ What is not supported:  - Decrypting audio packets sent from Discord (other people's voices), and-decoding them to PCM.--See `examples/BasicMusicBot.hs` for a bot that uses many advanced features of-the library, including dynamically adjusting the stream audio using a TVar-(and allowing users to change the TVar using a `/volume` command).+  decoding them to PCM. This isn't particularly well-documented by Discord and+  will thus likely never be supported by this library.  ## Installation @@ -79,43 +94,45 @@  ### Cabal -To use it in your Cabal-based project, add `discord-haskell-voice` as a dependency in your `.cabal` file:+To use it in your Cabal-based project, add `discord-haskell-voice` as a+dependency in your `.cabal` file:  ```yaml # --- myproject.cabal <truncated>  build-depends:       base >=4.7 && <5-    , discord-haskell ==1.14.0-    , discord-haskell-voice ==2.3.1+    , discord-haskell ==1.17.1+    , discord-haskell-voice ==3.0.0 ```  ### Stack -To use it in your Stack-based project, add `discord-haskell-voice` in both your `package.yaml` and `stack.yaml` files (since this library is not available in Stackage for the same reason `discord-haskell` is not on Stackage)+To use it in your Stack-based project, add `discord-haskell-voice` in both your+`package.yaml` and `stack.yaml` files (since this library is not available in+Stackage for the same reason `discord-haskell` is not on Stackage):  ```yaml # --- stack.yaml <truncated> extra-deps:-- discord-haskell-1.14.0-- discord-haskell-voice-2.3.1+- discord-haskell-1.17.1+- discord-haskell-voice-3.0.0 ```  ```yaml # --- package.yaml <truncated> dependencies: - base >= 4.7 && < 5-- discord-haskell == 1.14.0-- discord-haskell-voice == 2.3.1+- discord-haskell == 1.17.1+- discord-haskell-voice == 3.0.0 ```  ## Documentation -See the Haddock documentation on the Hackage page, at https://hackage.haskell.org/package/discord-haskell-voice/docs/Discord-Voice.html.+See the Haddock documentation on the Hackage page, at+https://hackage.haskell.org/package/discord-haskell-voice/docs/Discord-Voice.html. -## Future Plans+## Examples -- Use `stm-conduit` and `stm` for a safer Chan?-- Look into SubprocessException seemingly never been thrown (e.g. when SIGINT-is signalled to the libarry while FFmpeg is running)-- Consider, document, and improve the distinction of errors (VoiceError) vs-exceptions, and note down why any choices are made+See `examples/BasicMusicBot.hs` for a bot that uses many advanced features of+the library, including dynamically adjusting the stream audio using a TVar+(and allowing users to change the TVar using a `/volume` command).

@@ -1,19 +1,15 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.------ see: https://github.com/sol/hpack- name:           discord-haskell-voice-version:        2.3.1+version:        3.0.0 synopsis:       Voice support for discord-haskell. description:    Supplementary library to discord-haskell. See the project README on GitHub for more information. <https://github.com/yutotakano/discord-haskell-voice> category:       Network-homepage:       https://github.com/yutotakano/discord-haskell-voice#readme+homepage:       https://github.com/yutotakano/discord-haskell-voice bug-reports:    https://github.com/yutotakano/discord-haskell-voice/issues-author:         Yuto Takano-maintainer:     moa17stock@gmail.com-copyright:      2021-2022 Yuto Takano+author:         Yuto Takano <moa17stock@gmail.com>+maintainer:     Yuto Takano <moa17stock@gmail.com>+copyright:      Yuto Takano <moa17stock@gmail.com>, discord-haskell-voice Contributors license:        MIT license-file:   LICENSE build-type:     Simple@@ -25,6 +21,11 @@   type: git   location: https://github.com/yutotakano/discord-haskell-voice +flag use-crypton+  description: Use crypton and crypton-box libraries for encryption instead of saltine, which has a dependency on libsodium. While it may be tempting to use a "pure-Haskell" solution (crypton does have a lot of C though), crypton and crypton-box's security have not been vetted for attacks. Further, Discord themselves use libsodium in their infrastructure, so it's recommended to keep this flag off and use saltine.+  manual: True+  default: False+ library   exposed-modules:       Discord.Voice@@ -37,98 +38,79 @@       Discord.Internal.Voice.UDPLoop       Discord.Internal.Voice.WebsocketLoop   other-modules:-      Paths_discord_haskell_voice+      Discord.Internal.Voice.Encryption+      Discord.Internal.Voice.OggParser   hs-source-dirs:       src   default-extensions:       OverloadedStrings+    , Strict   build-depends:       BoundedChan ==1.0.3.0-    , aeson ==1.5.6.0+    , aeson >=1.5 && <1.6 || >=2.0 && <2.3     , async >=2.2.3 && <2.4     , base >=4.7 && <5     , binary ==0.8.*-    , bytestring >=0.10.12.0 && <0.11-    , conduit ==1.3.4.2-    , discord-haskell >=1.12.0 && <=1.14.0-    , microlens >=0.4.13.0-    , microlens-th >=0.4.3.10-    , mtl ==2.2.2+    , bytestring >=0.10.12.0 && <0.13+    , conduit >=1.3.4.2 && <1.4.0.0+    , conduit-extra ==1.3.6+    , discord-haskell >=1.12.0 && <=1.17.1+    , microlens >=0.4.11.2 && <0.5+    , microlens-th >=0.4.3.10 && <0.5+    , mtl <2.4     , network >=3.1.1.1 && <3.2-    , opus ==0.1.0.0-    , process >=1.6.9.0 && <1.7+    , opus ==0.3.0.0     , safe-exceptions >=0.1.7.1 && <0.1.8-    , saltine >=0.1.1.1 && <0.2-    , text >=1.2.4.1 && <2-    , time >=1.9.3 && <=1.13+    , stm >=2.5.0.0 && <=2.6.0.0+    , text >=1.2.4.1 && <3+    , time >=1.9.3 && <1.15     , unliftio >=0.2.18 && <0.3-    , websockets >=0.12.7.2 && <0.12.8-    , wuss >=1.1.18 && <=1.2+    , websockets >=0.12.7.2 && <0.14+    , wuss >=1.1.18 && <2.1.0.0   default-language: Haskell2010 +  if flag(use-crypton)+    cpp-options: -DUSE_CRYPTON+    build-depends:+        crypton >=0.32 && <1.1+      , crypton-box >=1.1.0 && <1.2+  else+    build-depends:+        saltine >=0.1.1.1 && <0.3++  if impl(ghc >= 9.6)+    -- 1.15.5 and earlier cannot build on GHC >= 9.6 since it tries to import+    -- Control.Monad functions from Control.Monad.Reader+    build-depends:+        discord-haskell  >= 1.15.6+ executable basic-music-bot   main-is: examples/BasicMusicBot.hs-  other-modules:-      Paths_discord_haskell_voice   default-extensions:       OverloadedStrings   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      BoundedChan ==1.0.3.0-    , aeson ==1.5.6.0-    , async >=2.2.3 && <2.4-    , base >=4.7 && <5-    , binary ==0.8.*-    , bytestring >=0.10.12.0 && <0.11-    , conduit ==1.3.4.2-    , discord-haskell >=1.12.0 && <=1.14.0+      base >=4.7 && <5+    , conduit >=1.3.4.2 && <=1.4.0.0+    , discord-haskell >=1.12.0 && <=1.17.1     , discord-haskell-voice-    , microlens >=0.4.13.0-    , microlens-th >=0.4.3.10-    , mtl ==2.2.2-    , network >=3.1.1.1 && <3.2-    , optparse-applicative >=0.15.1.0 && <0.17-    , opus ==0.1.0.0-    , process >=1.6.9.0 && <1.7-    , safe-exceptions >=0.1.7.1 && <0.1.8-    , saltine >=0.1.1.1 && <0.2-    , stm >=2.5.0.0 && <2.5.1-    , stm-containers ==1.2-    , text >=1.2.4.1 && <2-    , time >=1.9.3 && <=1.13+    , optparse-applicative >=0.15.1.0 && <0.19+    , stm >=2.5.0.0 && <2.6+    , stm-containers < 1.4+    , text >=1.2.4.1 && <3     , unliftio >=0.2.18 && <0.3-    , websockets >=0.12.7.2 && <0.12.8-    , wuss >=1.1.18 && <=1.2   default-language: Haskell2010  executable join-all-on-start   main-is: examples/JoinAllVC.hs-  other-modules:-      Paths_discord_haskell_voice   default-extensions:       OverloadedStrings   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      BoundedChan ==1.0.3.0-    , aeson ==1.5.6.0-    , async >=2.2.3 && <2.4-    , base >=4.7 && <5-    , binary ==0.8.*-    , bytestring >=0.10.12.0 && <0.11-    , conduit ==1.3.4.2-    , discord-haskell >=1.12.0 && <=1.14.0+      base >=4.7 && <5+    , conduit >=1.3.4.2 && <=1.4.0.0+    , discord-haskell >=1.12.0 && <=1.17.1     , discord-haskell-voice-    , microlens >=0.4.13.0-    , microlens-th >=0.4.3.10-    , mtl ==2.2.2-    , network >=3.1.1.1 && <3.2-    , opus ==0.1.0.0-    , process >=1.6.9.0 && <1.7     , safe-exceptions >=0.1.7.1 && <0.1.8-    , saltine >=0.1.1.1 && <0.2-    , text >=1.2.4.1 && <2-    , time >=1.9.3 && <=1.13-    , unliftio >=0.2.18 && <0.3-    , websockets >=0.12.7.2 && <0.12.8-    , wuss >=1.1.18 && <=1.2+    , text >=1.2.4.1 && <3   default-language: Haskell2010

@@ -1,16 +1,15 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DerivingStrategies #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Main where  import           Conduit import           Control.Concurrent.STM.TVar-import           Control.Monad              ( when-                                            , guard-                                            , void+import           Control.Monad              ( void                                             , forever                                             ) import           Data.List                  ( intercalate                                             )-import           Data.Maybe                 ( fromJust-                                            ) import qualified Data.Text.IO as TIO import qualified Data.Text as T import qualified StmContainers.Map as M@@ -20,8 +19,7 @@ import           Discord.Voice.Conduit import           Discord import           Options.Applicative-import           UnliftIO                   ( liftIO-                                            , atomically+import           UnliftIO                   ( atomically                                             )  data BotAction@@ -29,7 +27,7 @@     | LeaveVoice ChannelId     | PlayVoice String     | ChangeVolume Int-    deriving ( Read )+    deriving stock ( Read )  data GuildContext = GuildContext     { songQueries :: [String]@@ -38,33 +36,38 @@     }  parser :: ParserInfo BotAction-parser = info-    ( helper <*> subparser-        ( command "join"-            ( flip info (progDesc "Join a voice channel") $-                JoinVoice <$>-                argument auto (metavar "CHANID" <> help "Voice Channel ID"))-        <> command "leave"-            ( flip info (progDesc "Leave a voice channel") $-                LeaveVoice <$>-                argument auto (metavar "CHANID" <> help "Voice Channel ID"))-        <> command "play"-            ( flip info (progDesc "Queue something to play!") $-                PlayVoice . intercalate " " <$>-                some (argument str (metavar "QUERY" <> help "Search query/URL")))-        <> command "volume"-            ( flip info (progDesc "Change the volume for this server!") $-                ChangeVolume <$>-                argument auto (metavar "VOLUME" <> help "Integer volume"))-        )-    ) fullDesc+parser = flip info fullDesc $ helper <*> commandParser+  where+    commandParser = subparser $ mconcat+        [ joinParser+        , leaveParser+        , playParser+        , volumeParser+        ] +    joinParser = command "join" $+        flip info (progDesc "Join a voice channel") $+            JoinVoice <$>+            argument auto (metavar "CHANID" <> help "Voice Channel ID")+    leaveParser = command "leave" $+        flip info (progDesc "Leave a voice channel") $+            LeaveVoice <$>+            argument auto (metavar "CHANID" <> help "Voice Channel ID")+    playParser = command "play" $+        flip info (progDesc "Queue something to play!") $+            PlayVoice . intercalate " " <$>+            some (argument str (metavar "QUERY" <> help "Search query/URL"))+    volumeParser = command "volume" $+        flip info (progDesc "Change the volume for this server!") $+            ChangeVolume <$>+            argument auto (metavar "VOLUME" <> help "Integer volume")+ main :: IO () main = do     tok <- TIO.readFile "./examples/auth-token.secret"      queries <- M.newIO-    t <- runDiscord $ def+    void $ runDiscord $ def         { discordToken = tok         , discordOnStart = pure ()         , discordOnEnd = liftIO $ putStrLn "Ended"@@ -90,8 +93,8 @@ eventHandler _ _ = pure ()  handleCommand :: M.Map String GuildContext -> Message -> GuildId -> BotAction -> DiscordHandler ()-handleCommand contexts msg gid (JoinVoice cid) = do-    result <- runVoice $ do+handleCommand contexts _msg gid (JoinVoice cid) =+    runVoice $ do         leave <- join gid cid         volume <- liftIO $ newTVarIO 100         liftDiscord $ atomically $ M.insert (GuildContext [] volume leave) (show gid) contexts@@ -106,14 +109,24 @@                     let adjustVolume = awaitForever $ \current -> do                             v' <- liftIO $ readTVarIO volume                             yield $ round $ fromIntegral current * (fromIntegral v' / 100)-                    playYouTubeWith' "ffmpeg" defaultFFmpegArgs "yt-dlp" x $-                        packInt16C .| adjustVolume .| unpackInt16C -    case result of-        Left e -> liftIO $ print e >> pure ()-        Right _ -> pure ()+                    resource <- createYoutubeResource x $ Just $ HaskellTransformation $ packInt16C .| adjustVolume .| unpackInt16C -handleCommand contexts msg gid (LeaveVoice cid) = do+                    -- Try for a reverb effect.+                    -- Use the impulse response file from https://medium.com/@glynn_bird/applying-reverb-to-audio-with-ffmpeg-and-impulse-responses-81b4480cf5aa+                    -- resource <- createYoutubeResource x $ Just $ FFmpegTransformation $ \file ->+                    --     [ "-i", file+                    --     , "-guess_layout_max", "0"+                    --     , "-i", "static/st-patricks-church-patrington.wav"+                    --     , "-filter_complex", "[0] [1] afir=dry=10:wet=10 [reverb]; [0] [reverb] amix=inputs=2:weights=10 100 [result]"+                    --     , "-map", "[result]"+                    --     ]++                    case resource of+                        Nothing -> liftIO $ print "whoops"+                        Just re -> play re UnknownCodec++handleCommand contexts _msg gid (LeaveVoice _cid) = do     context <- atomically $ M.lookup (show gid) contexts     case context of         Nothing -> pure ()@@ -131,13 +144,13 @@                 pure $ xs ++ [q]     void $ restCall $ R.CreateMessage (messageChannelId msg) $ case resultQueue of         [] -> T.pack $ "Can't play something when I'm not in a voice channel!"-        xs -> T.pack $ "Queued for playback: " <> show resultQueue+        _ -> T.pack $ "Queued for playback: " <> show resultQueue  handleCommand contexts msg gid (ChangeVolume amount) = do     context <- atomically $ M.lookup (show gid) contexts     case context of         Nothing -> pure ()-        Just (GuildContext q v l) -> do-            atomically $ swapTVar v amount+        Just (GuildContext _q v _l) -> do+            void $ atomically $ swapTVar v amount             void $ restCall $ R.CreateMessage (messageChannelId msg) $                 (T.pack $ "Volume set to " <> show amount <> " / 100")

@@ -1,25 +1,28 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Main where +import           Conduit+import           Control.Concurrent         ( threadDelay+                                            )+import           Control.Exception.Safe     ( catch+                                            , SomeException+                                            ) import           Control.Monad              ( forM_-                                            , forever                                             , void+                                            -- , forever                                             )-import           Control.Monad.Trans        ( lift )-import           Conduit import qualified Data.Text.IO as TIO import           Discord import           Discord.Voice import qualified Discord.Requests as R import           Discord.Types-import           UnliftIO                   ( liftIO-                                            )-import Control.Concurrent  main :: IO () main = do     tok <- TIO.readFile "./examples/production.secret" -    t <- runDiscord $ def+    void $ runDiscord $ def         { discordToken = tok         , discordOnStart = startHandler         , discordOnEnd = liftIO $ putStrLn "Ended"@@ -29,14 +32,15 @@     putStrLn "Finished!"  eventHandler :: Event -> DiscordHandler ()-eventHandler event = pure ()+eventHandler _event = pure ()  startHandler :: DiscordHandler () startHandler = do     Right partialGuilds <- restCall R.GetCurrentUserGuilds -    result <- runVoice $ do+    runVoice $ do         forM_ partialGuilds $ \pg -> do+            liftIO $ putStrLn $ "Joining guild: " <> show (partialGuildName pg)             Right guild <- liftDiscord $ restCall $ R.GetGuild (partialGuildId pg)             Right chans <- liftDiscord $ restCall $ R.GetGuildChannels (guildId guild) @@ -45,11 +49,13 @@                 _     -> pure ()          -- play something, then sit around in silence for 30 seconds-        playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"-        liftIO $ threadDelay $ 30 * 1000 * 1000+        -- forever $ do+        resource <- createYoutubeResource "https://www.youtube.com/watch?v=BZP1rYjoBgI" Nothing+        case resource of+            Nothing -> liftIO $ print "whoops"+            Just re -> catch (play re UnknownCodec) (\(e :: SomeException) -> liftIO $ print e) -    liftIO $ print result-    pure ()+        liftIO $ threadDelay $ 30 * 1000 * 1000  isTextChannel :: Channel -> Bool isTextChannel (ChannelText {}) = True

@@ -1,15 +1,16 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE DerivingStrategies #-} {-| Module      : Discord.Internal.Types.VoiceCommon Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -18,24 +19,30 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description  This module defines the types for handles, errors, base monads, and other types-applicable to both the UPD and Websocket components of the Voice API. Many of+applicable to both the UDP and Websocket components of the Voice API. Many of the structures defined in this module have Lenses derived for them using-Template Haskell.+Template Haskell for easier field access. -}-module Discord.Internal.Types.VoiceCommon where+module Discord.Internal.Types.VoiceCommon+    ( module Discord.Internal.Types.VoiceCommon+    ) where +import Conduit import Control.Concurrent ( Chan, MVar, ThreadId ) import Control.Concurrent.BoundedChan qualified as Bounded-import Control.Exception.Safe ( Exception, MonadMask, MonadCatch, MonadThrow )+import Control.Exception.Safe ( Exception, MonadMask, MonadCatch ) import Lens.Micro.TH ( makeFields ) import Control.Monad.Except import Control.Monad.Reader import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.List.NonEmpty import Data.Text qualified as T import Data.Word ( Word8 ) import GHC.Weak ( Weak )@@ -44,34 +51,42 @@  import Discord import Discord.Types-import Discord.Internal.Gateway.EventLoop ( GatewayException(..) ) import Discord.Internal.Types.VoiceUDP import Discord.Internal.Types.VoiceWebsocket --- | @Voice@ is a newtype Monad containing a composition of ReaderT and ExceptT--- transformers over the @DiscordHandler@ monad. It holds references to--- voice connections/threads. The content of the reader handle is strictly--- internal and is hidden deliberately behind the newtype wrapper.+-- | @Voice@ is a newtype Monad containing a ReaderT transformer over the+-- @'Discord.DiscordHandler'@ monad. You can think of it as another layer of+-- possible actions: The first layer is 'Discord.DiscordHandler' which gives you+-- Discord API capabilities on top of IO, and the second layer is 'Voice' which+-- gives you voice capabilities on top of 'DiscordHandler'. As such, you can+-- only run a 'Voice' monad computation from within 'DiscordHandler' using a+-- function called 'Discord.Voice.runVoice'. ----- Developer Note: ExceptT is on the base rather than ReaderT, so that when a--- critical exception/error occurs in @Voice@, it can propagate down the--- transformer stack, kill the threads referenced in the Reader state as--- necessary, and halt the entire computation and return to @DiscordHandler@.--- If ExceptT were on top of ReaderT, then errors would be swallowed before it--- propagates below ReaderT, and the monad would not halt there, continuing--- computation with an unstable state.+-- This monad's ReaderT transformer holds references to voice connections and+-- thread handles. The content of the reader handle is strictly+-- internal and is hidden deliberately behind the newtype wrapper. If you'd like+-- experiment with the internals, importing "Discord.Internal.Types.VoiceCommon"+-- will give you access to the 'unVoice' function to unwrap the internal handles.+-- Please submit pull requests on GitHub for any cool functionality you've built+-- that might fit the library! newtype Voice a = Voice-    { unVoice :: ReaderT DiscordBroadcastHandle (ExceptT VoiceError DiscordHandler) a-    } deriving+    { unVoice :: ReaderT DiscordBroadcastHandle DiscordHandler a+    } deriving newtype -- we use the newtype strategy so it's mostly ReaderT     ( Functor     , Applicative     , Monad     , MonadIO-    -- ^ MonadIO gives the ability to perform 'liftIO'.+    -- ^ MonadIO gives the ability to perform 'liftIO' and run IO actions. To+    -- run 'DiscordHandler' actions from within Voice, use+    -- 'Discord.Voice.liftDiscord'.+    , MonadUnliftIO+    -- ^ MonadUnliftIO gives us the ability to come back into the monadic+    -- context from within a lifted IO context. We don't need it in internal+    -- code, but the instance is provided to make it more convenient for users+    -- to use e.g. UnliftIO.forkIO from inside Voice without having to manually+    -- unwrap and capture state.     , MonadReader DiscordBroadcastHandle     -- ^ MonadReader is for internal use, to read the held broadcast handle.-    , MonadError VoiceError-    -- ^ MonadError is for internal use, to propagate errors.     , MonadFail     -- ^ MonadFail is for internal use, identical in function to the MonadFail     -- instance of ReaderT.@@ -82,35 +97,177 @@     , MonadMask     ) +-- | A type to hint the library at your audio resource's codec. This is used with+-- 'Discord.Voice.play' to guide the library about the audio codec if you+-- already know it, which might prevent unnecessary transcoding or probing. For+-- example, if you already have a bytestream or file that is known to be encoded+-- with Opus/Ogg, you can choose 'OPUSCodec'. For web media and other unknown+-- sources, a safe choice is either 'UnknownCodec' or 'ProbeCodec'.+--+-- Note that choosing 'OPUSCodec' or 'PCMCodec' doesn't necessarily exclude the+-- possibility of transcoding using FFmpeg, since you may have specified some+-- audio transformations (like custom FFmpeg flags) which will need FFmpeg. The+-- purpose of hinting the library of the codec using this datatype is so that in+-- the best-case, when you haven't specified any transformation, we don't have+-- to shell out to FFmpeg.+data AudioCodec+    = OPUSCodec+    -- ^ The audio is known to be in OPUS format which can be directly sent to+    -- Discord if there are no transformations to apply.+    | PCMCodec+    -- ^ The audio is known to be in 16-bit little-endian PCM format which can+    -- be encoded within the library and sent to Discord. You will require+    -- @libopus@ to be installed. See the library README which should guide to+    -- you to installation instructions for each OS.+    | ProbeCodec String+    -- ^ The audio is in an unknown format, but we want to probe it using+    -- @ffprobe@ (specifying the execuable name) first to determine the best+    -- codec hint automatically. For example, @ffprobe@ can discover that the+    -- resource is already in Opus format, in which case the behaviour becomes+    -- identical to 'OPUSCodec'. This can sometimes result in more efficient+    -- audio processing with minimal transcoding, but requires an initial delay+    -- to probe the codec.+    | UnknownCodec+    -- ^ The audio is in an unknown format, and we want to unconditionally+    -- run FFmpeg on it to convert it to OPUS which we can send to Discord. This+    -- is a safe bet for every purpose. It requires @ffmpeg@ to be installed.+    deriving stock (Eq)++-- | A datatype representing whether an audio transformation pipeline segment+-- should finish with Opus or PCM bytes before reaching into the Haskell side.+-- If we are using FFmpeg, this refers to what FFmpeg should output. If we+-- aren't using FFmpeg, this represents what the input file codec is, since that+-- is what will be processed in the Haskell side.+data AudioCodecNoFurtherFFmpeg+    = OPUSFinalOutput+    -- ^ The pipeline segment ends in Opus format. Usually this means we'll just+    -- send the output to Discord afterwards.+    | PCMFinalOutput+    -- ^ The pipeline segment ends in PCM format. Usually this means we have+    -- some transformation to operate on PCM before encoding it and sending it+    -- to Discord within the library.+    deriving stock (Eq)++-- | The pipeline of the audio processing before it is given to the Haskell side.+--+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- need = pipeline ^. needFFmpeg+-- @+data AudioPipeline = AudioPipeline+    { audioPipelineNeedsFFmpeg :: Bool+    -- ^ Whether the pipeline needs FFmpeg to do transformations or transcoding.+    , audioPipelineOutputCodec :: AudioCodecNoFurtherFFmpeg+    -- ^ What format the pipeline will output its audio. If FFmpeg is required,+    -- this is the codec that FFmpeg will output. If FFmpeg is not required, this+    -- is the original codec of the file/input.+    }++-- | Possible transformations to apply to the audio resource. You can choose+-- an 'FFmpegTransformation', which is essentially just arbitrary flags to pass+-- to FFmpeg, or 'HaskellTransformation', which is a conduit to operate on PCM+-- bytes. You can also do a combination.+data AudioTransformation+    = FFmpegTransformation (FilePath -> [String])+    -- ^ Transform the audio using FFmpeg with custom arguments. The no-op+    -- transformation here is to use 'Discord.Voice.defaultFfmpegArgs' as the+    -- transformation.+    --+    -- By using 'FFmpegTransformation', the audio resource will unconditionally+    -- go through FFmpeg (and thus requires @ffmpeg@ to be installed), even if+    -- your resource is already in Opus format, and even if you specified+    -- 'OpusCodec' or 'PCMCodec'.+    | HaskellTransformation (ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ())+    -- ^ Transform the audio using a Haskell conduit that operates on PCM audio.+    -- We recommend using this in conjunction with+    -- 'Discord.Voice.Conduit.packInt16CT' and 'Discord.Voice.Conduit.unpackInt16CT',+    -- so that you can operate on each 16-bit sample at a time instead of a byte+    -- at a time.+    --+    -- By using 'HaskellTransformation', the audio resource will be transcoded+    -- to PCM if it wasn't already, which means it will go through FFmpeg (and+    -- thus requires @ffmpeg@ to be installed) if you didn't specify 'PCMCodec'.+    | (FilePath -> [String]) :.->: (ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ())+    -- ^ Transform the audio using a FFmpeg with custom arguments first, then+    -- make FFmpeg output PCM bytes and apply a custom Haskell conduit+    -- transformation on the result. This is a combination of+    -- 'FFmpegTransformation' and 'HaskellTransformation', and will+    -- unconditionally shell out into FFmpeg (and thus requires @ffmpeg@ to be+    -- installed) even if the source is PCM or Opus.++-- | The show instance is just for debugging purposes: it does not show the+-- actual contents of the transformation, and is thus unlawful (the output of+-- 'show' cannot be parsed back using 'read').+instance Show AudioTransformation where+    show (FFmpegTransformation func) = "<FFmpeg Flags Transformation>"+    show (HaskellTransformation _conduit) = "<Haskell Conduit Byte Transformations>"+    show (_a :.->: _b) = "<FFmpeg Flags Transformation> :FollowedBy: <Haskell Conduit Byte Transformations>"++-- | A data type that represents an audio resource to be played. You can+-- construct this type using functions such as+-- 'Discord.Voice.createYoutubeResource' or 'Discord.Voice.createFileResource'.+--+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- metadata = res ^. youtubeDLInfo+-- @+data AudioResource = AudioResource+    { audioResourceStream :: Either String BL.ByteString+    -- ^ The stream source. If it's Left, the value is a URL or filepath that+    -- will be passed to FFmpeg. If it is Right, it contains the lazy ByteString+    -- for the entire audio.+    , audioResourceYouTubeDLInfo :: Maybe Object+    -- ^ If this audio resource was created through yt-dlp using+    -- 'Discord.Voice.createYoutubeResource', then this field will be Just, and+    -- will contain JSON metadata returned by yt-dlp, such as the uploader,+    -- date, etc. We make no promises on the specific keys or data present in+    -- this field, as it's entirely populated by yt-dlp -- please see their+    -- documentation for the output of the @-j@ flag (which we use).+    --+    -- Use Aeson functions to parse the keys in this field. For example, to find+    -- the URL of the resource (which is also contained in 'audioResourceStream',+    -- run:+    --+    -- @+    -- url :: Maybe String+    -- url = flip parseMaybe (audioResourceYouTubeDLInfo res) $ \o -> o .: "url"+    -- @+    , audioResourceTransform :: Maybe AudioTransformation+    -- ^ Any transformations to perform on the audio resource.+    }+    deriving stock Show+ -- | @VoiceError@ represents the potential errors when initialising a voice -- connection. It does /not/ account for errors that occur after the initial -- handshake (technically, because they are in IO and not ExceptT). data VoiceError     = VoiceNotAvailable     | NoServerAvailable-    | InvalidPayloadOrder-    deriving (Show, Eq)+    deriving stock (Show, Eq) --- | @SubprocessException@ is an Exception that may be thrown when a subprocess--- such as FFmpeg encounters an error.------ TODO: This has never actually been seen, so it's untested whether it works.-data SubprocessException = SubprocessException String deriving (Eq, Show)-instance Exception SubprocessException+instance Exception VoiceError  -- | @DiscordVoiceHandle@ represents the handles for a single voice connection--- (to a specific voice channel).+-- to a specific voice channel. This is all the information that is maintained+-- by the main thread, and contains thread ID and bidirectional communication+-- channels for Voice Websocket and Voice UDP threads. ----- Lenses are defined for this type using Template Haskell.+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- mySSRC = handle ^. ssrc+-- @ data DiscordVoiceHandle = DiscordVoiceHandle     { discordVoiceHandleGuildId :: GuildId       -- ^ The guild id of the voice channel.     , discordVoiceHandleChannelId :: ChannelId       -- ^ The channel id of the voice channel.     , discordVoiceHandleWebsocket :: (Weak ThreadId, (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan))-      -- ^ The websocket thread id and handle.+      -- ^ The websocket thread id and bidirectional communication handles.     , discordVoiceHandleUdp :: (Weak ThreadId, (VoiceUDPReceiveChan, VoiceUDPSendChan))-      -- ^ The UDP thread id and handle.+      -- ^ The UDP thread id and bidirectional communication handles.     , discordVoiceHandleSsrc :: Integer       -- ^ The SSRC of the voice connection, specified by Discord. This is       -- required in the packet sent when updating the Speaking indicator, so is@@ -120,10 +277,15 @@ -- | @DiscordBroadcastHandle@ represents a "stream" or a "broadcast", which is -- a mutable list of voice connection handles that share the same audio stream. ----- Lenses are defined for this type using Template Haskell.+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- myHandles = broadcastHandle ^. voiceHandles+-- @ data DiscordBroadcastHandle = DiscordBroadcastHandle     { discordBroadcastHandleVoiceHandles :: MVar [DiscordVoiceHandle]-      -- ^ The list of voice connection handles.+      -- ^ The list of voice connection handles. Do not modify this list without+      -- having acquired 'discordBroadcastHandleMutEx'.     , discordBroadcastHandleMutEx :: MVar ()       -- ^ The mutex used to synchronize access to the list of voice connection     }@@ -135,50 +297,98 @@     | VoiceWebsocketEventParseError T.Text     | VoiceWebsocketUnexpected VoiceWebsocketReceivable T.Text     | VoiceWebsocketConnection ConnectionException T.Text-    deriving (Show)+    deriving stock (Show) +-- | A type alias for a communication channel from the Websocket thread to the+-- main thread, which may contain an error or a received websocket message. type VoiceWebsocketReceiveChan =     Chan (Either VoiceWebsocketException VoiceWebsocketReceivable) +-- | A type alias for a communication channel from the main thread to the+-- Websocket thread, which can contain messages to be sent. type VoiceWebsocketSendChan = Chan VoiceWebsocketSendable +-- | A type alias for a communication channel from the UDP thread to the main+-- thread, which may contain received voice data. Note that we don't support+-- voice receive in this library so this channel is provided only for type+-- completeness and isn't very useful. type VoiceUDPReceiveChan = Chan VoiceUDPPacket +-- | A type alias for a communication channel from the main thread to the UDP+-- thread, which can contain Opus packets to be sent. type VoiceUDPSendChan = Bounded.BoundedChan B.ByteString --- | @WebsocketLaunchOpts@ represents all the data necessary to start a--- Websocket connection to Discord's Voice Gateway.+-- | @WebsocketLaunchOpts@ represents all the data necessary to start the+-- Websocket thread, which will connect to Discord Voice Gateway for the voice+-- control plane. ----- Lenses are defined for this type using Template Haskell.+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- myId = opts ^. botUserId+-- @ data WebsocketLaunchOpts = WebsocketLaunchOpts     { websocketLaunchOptsBotUserId     :: UserId+    -- ^ The user ID of the running bot, which is needed for the voice gateway+    -- uplink Opcode 0 Voice Identify.     , websocketLaunchOptsSessionId     :: T.Text+    -- ^ The session ID obtained from the normal gateway in downlink Opcode 0+    -- Dispatch (event: Voice State Update). We need this for the voice gateway+    -- uplink Opcode 0 Voice Identify.     , websocketLaunchOptsToken         :: T.Text+    -- ^ The join token obtained from the normal gateway in downlink Opcode 0+    -- Dispatch (event: Voice Server Update). We need this for the voice gateway+    -- uplink Opcode 0 Voice Identify.     , websocketLaunchOptsGuildId       :: GuildId+    -- ^ The guild ID for where we are joining the voice call, obtained from+    -- the normal gateway in downlink Opcode 0 Dispatch (event: Voice Server+    -- Update). We need this for the voice gateway uplink Opcode 0 Voice Identify.     , websocketLaunchOptsEndpoint      :: T.Text+    -- ^ The endpoint to open the websocket connection to. This is obtained from+    -- the normal gateway in downlink Opcode 0 Dispatch (event: Voice Server+    -- Update).     , websocketLaunchOptsWsHandle      :: (VoiceWebsocketReceiveChan, VoiceWebsocketSendChan)+    -- ^ Communication channels to the main thread that launches the websocket+    -- thread. The first tuple item is for voice gateway messages received from+    -- Discord, and the second is for messages to be sent to Discord.     , websocketLaunchOptsUdpTid        :: MVar (Weak ThreadId)+    -- ^ A reference to the thread ID of the UDP thread, launched by the+    -- websocket thread once the control plane has been set up.     , websocketLaunchOptsUdpHandle     :: (VoiceUDPReceiveChan, VoiceUDPSendChan)+    -- ^ Communication channels to the UDP thread that we launch from the+    -- websocket thread. The first tuple item is for UDP packets to be received+    -- from  Discord, and the second is for those to be sent to Discord.     , websocketLaunchOptsSsrc          :: MVar Integer+    -- ^ The SSRC for the websocket connection, which is a sort of identifier.+    -- This is obtained as part of the voice websocket setup, in the voice+    -- gateway Opcode 2 Ready payload.     } --- | @WebsocketConn@ represents an active connection to Discord's Voice Gateway--- websocket, and contains the Connection as well as the options that launched+-- | @WebsocketConn@ represents an active connection to Discord's Voice gateway+-- websocket, and contains the 'Connection' as well as the options that launched -- it. ----- Lenses are defined for this type using Template Haskell.+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- opts = wsConn ^. launchOpts+-- @ data WebsocketConn = WebsocketConn     { websocketConnConnection    :: Connection     , websocketConnLaunchOpts    :: WebsocketLaunchOpts     }  -- | @UDPLaunchOpts@ represents all the data necessary to start a UDP connection--- to Discord. Field names for this ADT are cased weirdly because I want to keep--- the "UDP" part uppercase in the type and data constructor. Since field--- accessors are rarely used anyway (lenses are preferred instead), we can--- write the field prefixes as "uDP" and take advantage of Lenses as normal.--- --- Lenses are defined for this type using Template Haskell.+-- to Discord. This is constructed in the websocket thread using information+-- gathered mainly from the voice gateway downlink Opcode 2 Ready payload.+-- Field names for this ADT are cased weirdly, because we want to generate+-- lenses for them using Template Haskell.+--+-- Lenses are defined for this type using Template Haskell. You can use them+-- to make accessing fields easier, like:+-- @+-- mySsrc = opts ^. ssrc+-- @ data UDPLaunchOpts = UDPLaunchOpts     { uDPLaunchOptsSsrc :: Integer     , uDPLaunchOptsIp   :: T.Text@@ -189,14 +399,20 @@     }  -- | @UDPConn@ represents an active UDP connection to Discord, and contains the--- Socket as well as the options that launched it.+-- 'Socket' as well as the options that launched it. ----- Lenses are defined for this type using Template Haskell.+-- Lenses are defined for this type using Template Haskell.You can use them+-- to make accessing fields easier, like:+-- @+-- sock = opts ^. socket+-- @ data UDPConn = UDPConn     { uDPConnLaunchOpts :: UDPLaunchOpts     , uDPConnSocket     :: Socket     } +$(makeFields ''AudioPipeline)+$(makeFields ''AudioResource) $(makeFields ''DiscordVoiceHandle) $(makeFields ''DiscordBroadcastHandle) $(makeFields ''WebsocketLaunchOpts)

@@ -1,11 +1,12 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE DerivingStrategies #-} {-| Module      : Discord.Internal.Types.VoiceUDP Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -14,17 +15,18 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description  This module defines basic types for the communication packets in the Discord Voice UDP socket. Binary instances are defined for the header and the body payload, as according to the official Discord documentation for v4 of the gateway.--Prisms are defined using TemplateHaskell for VoiceUDPPacket. -}-module Discord.Internal.Types.VoiceUDP where+module Discord.Internal.Types.VoiceUDP+    ( module Discord.Internal.Types.VoiceUDP+    ) where  import Lens.Micro import Data.Binary.Get@@ -35,25 +37,63 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as TE +-- | @VoiceUDPPacket@ represents a UDP packet that may be sent to or received+-- from Discord's voice UDP connection. Technically, some of these like+-- 'UnknownPacket' or 'MalformedPacket' will only ever be received and never+-- sent, so this type unifies two slightly different concepts into one. Perhaps+-- in the future it might be split into different types.+--+-- Binary instances are defined for packing and unpacking to bytes. data VoiceUDPPacket     = IPDiscovery Integer T.Text Integer-    -- ^ ssrc, ip, port+    -- ^ Uplink and Downlink IP discovery packet for performing IP discovery.+    -- The three fields are for SSRC, IP and port. For uplink, specify the+    -- client SSRC and leave the rest blank/0. The downlink packet will contain+    -- the discovered client IP and port.     | SpeakingData B.ByteString+    -- ^ Decrypted speaking data in Opus or PCM format. This is implemented for+    -- completeness and is never used in the uplink. We thus make no guarantees+    -- over its format or decoding.     | SpeakingDataEncrypted B.ByteString BL.ByteString-    -- ^ header, and encrypted audio bytes+    -- ^ RTP Header followed by encrypted Opus audio bytes. This is used both in+    -- the uplink and downlink. In downlink, it is decrypted into 'SpeakingData'.     | SpeakingDataEncryptedExtra B.ByteString BL.ByteString-    -- ^ header, and encrypted audio bytes with extended header inside+    -- ^ RTP Header followed by encrypted Opus audio bytes with an extended+    -- header inside. This is implemented for completeness and is never used in+    -- the uplink. It is similar to 'SpeakingDataEncrypted' but contains some+    -- extra data alongside audio. Anecdotally, it seems to be that users on+    -- Discord Desktop send 'SpeakingDataEncrypted' to bots, while users on+    -- Discord on Chromium browsers send 'SpeakingDataEncryptedExtra' to bots.     | UnknownPacket BL.ByteString+    -- ^ A packet that couldn't be decoded into any of the other options.     | MalformedPacket BL.ByteString-    deriving (Show, Eq)+    -- ^ A packet that could be decoded into encrypted audio data, but for which+    -- decryption failed.+    deriving stock (Show, Eq) +-- | @_IPDiscovery@ is a 'Traversal'' for manipulating the fields of the+-- 'IPDiscovery' UDP packet. It is a no-op for other packet types.+--+-- The following code returns @Just IPDiscovery(..)@ for IPDiscovery packets and+-- Nothing for all other packet types.+--+-- @+-- payload :: Maybe VoiceUDPPacket+-- payload = packet ^? _IPDiscovery+-- @ _IPDiscovery :: Traversal' VoiceUDPPacket (Integer, T.Text, Integer) _IPDiscovery f (IPDiscovery ssrc ip port) = (\(a, b, c) -> IPDiscovery a b c) <$> f (ssrc, ip, port)-_IPDiscovery f packet = pure packet+_IPDiscovery _ packet = pure packet +-- | @VoiceUDPPacketHeader@ represents the RTP header for an uplink UDP audio+-- packet. It is to be constructed manually. data VoiceUDPPacketHeader-    = Header Word8 Word8 Word16 Word32 Word32 +    = Header Word8 Word8 Word16 Word32 Word32+    -- ^ The fields in order are: version + flags (0x80), payload type (0x78),+    -- sequence, timestamp, and SSRC. +-- | The binary instance for 'VoiceUDPPacketHeader' is a simple big-endian+-- binary encoder and decoder. Discord requires numbers to be big-endian. instance Binary VoiceUDPPacketHeader where     get = do         ver <- getWord8@@ -69,6 +109,15 @@         putWord32be timestamp         putWord32be ssrc +-- | The binary instance for 'VoiceUDPPacket'encodes and decodes all documented+-- UDP packet types. Numbers are encoded as big-endian per Discord's docs.+-- Decryption does not take place for audio packets, so the output will be+-- either 'SpeakingDataEncrypted' or 'SpeakingDataEncryptedExtra', where the+-- difference is whether the speaker was using a Chromium web browser or Discord+-- Desktop. Decryption not taking place also means that the 'get' definition+-- for this instance will never output a 'MalformedPacket' (for decryption+-- failures), although it may output 'UnknownPacket' (on seeing undocumented+-- packet types). instance Binary VoiceUDPPacket where     get = do         flags <- lookAhead getWord8@@ -97,10 +146,10 @@                 header <- getByteString 12                 a <- getRemainingLazyByteString                 pure $ SpeakingDataEncryptedExtra header a-            other -> do+            _other -> do                 a <- getRemainingLazyByteString                 pure $ UnknownPacket a-    put (IPDiscovery ssrc ip port) = do+    put (IPDiscovery ssrc _ip port) = do         putWord16be 1 -- 1 is request, 2 is response         putWord16be 70 -- specified in docs         putWord32be $ fromIntegral ssrc@@ -111,4 +160,5 @@         putLazyByteString a     put (MalformedPacket a) = putLazyByteString a --- $(makePrisms ''VoiceUDPPacket)+    -- Other datatypes should logically never be used with put.+    put _ = undefined

@@ -1,11 +1,12 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE DerivingStrategies #-} {-| Module      : Discord.Internal.Types.VoiceWebsocket Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -14,28 +15,30 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description  This module defines basic types for the communication packets in the Discord-Voice Gateway. Some ToJSON and FromJSON instances are defined, as according to-the official Discord documentation for v4 of the gateway.--Prisms are defined using TemplateHaskell for VoiceWebsocketReceivable.+Voice control plane gateway. Some ToJSON and FromJSON instances are defined,+according to the official Discord documentation for v4 of the gateway. -}-module Discord.Internal.Types.VoiceWebsocket where+module Discord.Internal.Types.VoiceWebsocket+    ( module Discord.Internal.Types.VoiceWebsocket+    ) where  import Control.Applicative ( (<|>) ) import Lens.Micro import Data.Aeson import Data.Aeson.Types import Data.Text qualified as T-import Data.ByteString qualified as B import Data.Word ( Word8 )  import Discord.Internal.Types.Prelude +-- | @VoiceWebsocketReceivable@ represents a JSON websocket packet that could be+-- received from Discord's voice control plane gateway. data VoiceWebsocketReceivable     = Ready ReadyPayload                            -- Opcode 2     | SessionDescription T.Text [Word8]             -- Opcode 4@@ -48,21 +51,53 @@     | UnknownOPCode Integer Object                  -- Opcode unknown     | ParseError T.Text                             -- Internal use     | Reconnect                                     -- Internal use-    deriving (Show, Eq)+    deriving stock (Show, Eq) +-- | @_Ready@ is a 'Traversal'' for manipulating the payload of the+-- 'Ready' voice gateway receivable packet. It is a no-op for other packet types.+--+-- The following code returns @Just Ready(..)@ for Ready packets and Nothing for+-- all other packet types.+--+-- @+-- payload :: Maybe VoiceWebsocketReceivable+-- payload = packet ^? _Ready+-- @ _Ready :: Traversal' VoiceWebsocketReceivable ReadyPayload _Ready f (Ready rp) = Ready <$> f rp-_Ready f rp = pure rp+_Ready _ rp = pure rp +-- | @_SessionDescription@ is a 'Traversal'' for manipulating the payload of the+-- 'SessionDescription' voice gateway receivable packet. It is a no-op for other+-- packet types.+--+-- The following code returns @Just SessionDescription(..)@ for+-- SessionDescription packets and Nothing for all other packet types.+--+-- @+-- payload :: Maybe VoiceWebsocketReceivable+-- payload = packet ^? _SessionDescription+-- @ _SessionDescription :: Traversal' VoiceWebsocketReceivable (T.Text, [Word8]) _SessionDescription f (SessionDescription t bytes) = uncurry SessionDescription <$> f (t, bytes)-_SessionDescription f sd = pure sd+_SessionDescription _ sd = pure sd +-- | @_Hello@ is a 'Traversal'' for manipulating the payload of the 'Hello'+-- voice gateway receivable packet. It is a no-op for other packet types.+--+-- The following code returns @Just Hello(..)@ for Hello packets and Nothing for+-- all other packet types.+--+-- @+-- payload :: Maybe VoiceWebsocketReceivable+-- payload = packet ^? _Hello+-- @ _Hello :: Traversal' VoiceWebsocketReceivable Int _Hello f (Hello a) = Hello <$> f a-_Hello f a = pure a-+_Hello _ a = pure a +-- | @VoiceWebsocketSendable@ represents a JSON websocket packet that could be+-- sent to Discord's voice control plane gateway. data VoiceWebsocketSendable     = Identify IdentifyPayload                      -- Opcode 0     | SelectProtocol SelectProtocolPayload          -- Opcode 1@@ -70,41 +105,77 @@       -- ^ Int because threadDelay uses it     | Speaking SpeakingPayload                      -- Opcode 5     | Resume GuildId T.Text T.Text                  -- Opcode 7-    deriving (Show, Eq)+    deriving stock (Show, Eq) +-- | The payload of the voice control plane gateway downlink packet Opcode 2+-- Ready. data ReadyPayload = ReadyPayload-    { readyPayloadSSRC  :: Integer -- contains the 32-bit SSRC identifier+    { readyPayloadSSRC  :: Integer+    -- ^ The 32-bit SSRC identifier for our bot client. SSRC is an identifier+    -- used by other voice clients to distinguish which packets are from which+    -- speaker.     , readyPayloadIP    :: T.Text+    -- ^ The UDP IP to connect to for the data plane.     , readyPayloadPort  :: Integer+    -- ^ The UDP port to connect to for the data plane.     , readyPayloadModes :: [T.Text]-    -- , readyPayloadHeartbeatInterval <- This should not be used, as per Discord documentation+    -- ^ Supported encryption modes. Per Discord's documentation, we should+    -- support at least @aead_xchacha20_poly1305_rtpsize@, or+    -- @aead_aes256_gcm_rtpsize@ if available.+    -- , readyPayloadHeartbeatInterval+    -- ^ The Ready payload also contains heartbeat_interval, but this should not+    -- be used per Discord's docs. Instead, the Hello payload contains the+    -- correct heartbeat interval.     }-    deriving (Show, Eq)+    deriving stock (Show, Eq) +-- | The payload of the voice control plane gateway uplink packet Opcode 5+-- Speaking. data SpeakingPayload = SpeakingPayload     { speakingPayloadMicrophone :: Bool+    -- ^ Whether this is a normal microphone transmission of audio.     , speakingPayloadSoundshare :: Bool+    -- ^ Whether this is a companion context audio for video, and the speaking+    -- indicator shouldn't light up.     , speakingPayloadPriority   :: Bool+    -- ^ Whether the audio should be lower other speakers as a priority speaker.     , speakingPayloadDelay      :: Integer+    -- ^ The delay field is not documented except that it should be set to 0 for+    -- all bots that use the voice gateway.     , speakingPayloadSSRC       :: Integer+    -- ^ The SSRC for the bot client.     }-    deriving (Show, Eq)+    deriving stock (Show, Eq) +-- | The payload of the voice control plane gateway uplink packet Opcode 0+-- Identify. data IdentifyPayload = IdentifyPayload     { identifyPayloadServerId  :: GuildId+    -- ^ Server where bot wants to join the voice call     , identifyPayloadUserId    :: UserId+    -- ^ User ID for the bot     , identifyPayloadSessionId :: T.Text+    -- ^ Session ID obtained from the normal gateway.     , identifyPayloadToken     :: T.Text+    -- ^ Token obtained from the normal gateway.     }-    deriving (Show, Eq)+    deriving stock (Show, Eq) +-- | The payload for the voice control plane gateway uplink packet Opcode 1+-- Select Protocol. data SelectProtocolPayload = SelectProtocolPayload     { selectProtocolPayloadProtocol :: T.Text+    -- ^ Can only be "udp" as far as we understand -- Discord hasn't explained     , selectProtocolPayloadIP       :: T.Text+    -- ^ Our client's external IP for the UDP thread, which we discover through+    -- IP Discovery.     , selectProtocolPayloadPort     :: Integer+    -- ^ Our client's external port for the UDP thread, which we discover through+    -- IP Discovery.     , selectProtocolPayloadMode     :: T.Text+    -- ^ Our selected encryption mode, e.g. "aead_aes256_gcm_rtpsize"     }-    deriving (Show, Eq)+    deriving stock (Show, Eq)  instance FromJSON VoiceWebsocketReceivable where     parseJSON = withObject "payload" $ \o -> do@@ -130,9 +201,7 @@                     (od .: "speaking" :: Parser Int) <|>                         (do                             s <- od .: "speaking" :: Parser Bool-                            case s of-                                True  -> pure 1-                                False -> pure 0+                            pure $ if s then 1 else 0                         )                  let (priority, rest1) = speaking `divMod` 4@@ -208,5 +277,3 @@             , "token"      .= token             ]         ]---- $(makePrisms ''VoiceWebsocketReceivable)

@@ -3,9 +3,10 @@ {-| Module      : Discord.Internal.Voice Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -14,7 +15,8 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description @@ -22,17 +24,14 @@ this module (or other Internal modules) is discouraged. Please see "Discord.Voice" for the public interface. -}-module Discord.Internal.Voice where+module Discord.Internal.Voice+    ( 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+    ( forkIO     , mkWeakThreadId     , Chan     , dupChan@@ -47,27 +46,29 @@     , modifyMVar_     , readMVar     )+import Control.Concurrent.STM ( atomically, newEmptyTMVarIO, putTMVar, tryReadTMVar ) 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 Control.Exception.Safe ( catch, throwIO )+import Control.Monad.Reader ( ask, asks, runReaderT )+import Control.Monad.Except ( runExceptT )+import Control.Monad ( when, void, forM_ )+import Control.Exception ( BlockedIndefinitelyOnMVar(..) ) import Data.Aeson import Data.Aeson.Types ( parseMaybe ) import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.Conduit.Process.Typed import Data.Foldable ( traverse_ )-import Data.List ( partition )-import Data.Maybe ( fromJust )+import Data.Function ( on )+import Data.List ( intercalate, groupBy )+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe ( isNothing ) import Data.Text qualified as T-import GHC.Weak ( deRefWeak, Weak )-import System.Exit ( ExitCode(..) )-import System.IO ( hClose, hGetContents, hWaitForInput, hIsOpen )+import Lens.Micro+import Lens.Micro.Extras (view)+import System.IO ( hGetContents, hWaitForInput ) import System.IO.Error ( isEOFError )-import System.Process-import UnliftIO qualified as UnliftIO+import UnliftIO qualified  import Discord ( DiscordHandler, sendCommand, readCache ) import Discord.Handle ( discordHandleGateway, discordHandleLog )@@ -79,7 +80,6 @@ import Discord.Internal.Types     ( GuildId     , ChannelId-    , UserId     , User(..)     , GatewaySendable(..)     , UpdateStatusVoiceOpts(..)@@ -91,31 +91,108 @@     , SpeakingPayload(..)     ) import Discord.Internal.Voice.CommonUtils+import Discord.Internal.Voice.OggParser import Discord.Internal.Voice.WebsocketLoop --- | @liftDiscord@ lifts a computation in DiscordHandler into a computation in--- Voice. This is useful for performing DiscordHandler actions inside the--- Voice monad.+-- | @liftDiscord@ lifts a computation in 'DiscordHandler' into a computation in+-- 'Voice'. This is useful for performing DiscordHandler actions inside the+-- Voice monad. To perform IO actions inside the Voice monad, use 'liftIO'. ----- Usage:--- +-- == Examples+-- -- @--- runVoice $ do---     join (read "123456789012345") (read "67890123456789012")---     liftDiscord $ void $ restCall $ R.CreateMessage (read "2938481828383") "Joined!"---     liftIO $ threadDelay 5e6---     playYouTube "Rate of Reaction of Sodium Hydroxide and Hydrochloric Acid"---     liftDiscord $ void $ restCall $ R.CreateMessage (read "2938481828383") "Finished!"--- void $ restCall $ R.CreateMessage (read "2938481828383") "Finished all voice actions!"+-- func :: DiscordHandler ()+-- func = do+--     let textChannel = read "2938481828383"+--     void $ restCall $ R.CreateMessage textChannel "Joining!"+--     runVoice $ do+--         join (read "123456789012345") (read "67890123456789012")+--+--         liftDiscord $ void $ restCall $ R.CreateMessage textChannel "Joined!"+--         liftIO $ threadDelay 5e6+--+--         res <- createYoutubeResource "Sodium Hydroxide" Nothing+--         play res UnknownCodec+--+--         liftDiscord $ void $ restCall $ R.CreateMessage textChannel "Finished!" -- @ -- liftDiscord :: DiscordHandler a -> Voice a-liftDiscord = Voice . lift . lift+liftDiscord = Voice . lift --- | Execute the voice actions stored in the Voice monad.+-- | Executes the voice actions stored in the form of the Voice monad. ----- A single mutex and sending packet channel is used throughout all voice--- connections within the actions, which enables multi-channel broadcasting.+-- == Basic Usage+--+-- The following demonstrates joining a voice call and instantly leaving it.+--+-- @+-- runVoice $ join (read "\<guildID\>") (read "\<vcID\>")+-- @+--+-- == Control Flow+--+-- The voice monad cleans up after execution and thus you cannot linger in the+-- voice chat unless you explicitly prevent exiting from the computation. The+-- following demonstrates joining a voice call and never leaving it.+--+-- @+-- runVoice $ do+--     join (read "\<guildID\>") (read "\<vcID\>")+--     forever $ pure ()+-- @+--+-- This might seem unintuitive at first. You might ask, "How would I return+-- control flow to my program!? I want to control audio or do something else, not+-- be stuck in the 'runVoice' function!". Our approach makes it impossible for+-- your bot to be in a state that you forgot about, and makes it easy to reason+-- about your voice call. So in fact, the solution to do other things during+-- voice calls is not to return control flow, but to use multiple threads and+-- communicate. Threads are cheap in Haskell, and Discord-Haskell already spawns+-- a new thread for each event. You can let one thread forever stay in+-- 'runVoice', while other threads communicate with it using+-- 'Control.Concurrent.MVar', for example. To leave a voice call from another+-- thread, use the return value of 'join', which you might choose to communicate+-- using 'Control.Concurrent.MVar' too.+--+-- The following demonstrates joining a voice call and never leaving it, but+-- making the leave action available in an STM Map container, which can be+-- accessed and invoked from another event handler thread.+--+-- @+-- mapping <- StmContainers.Map.newIO+-- let guildId = (read "123456789012345")+-- runVoice $ do+--     leave <- join guildId (read "67890123456789012")+--     liftDiscord $ atomically $ M.insert leave (show guildId) mapping+--     forever $ pure ()+-- @+--+-- See the BasicMusicBot example program provided together with this library+-- (or on the GitHub repository for this library) for a music bot that does+-- exactly the approach described above.+--+-- == Forking+--+-- You can also fork and run 'runVoice' in a separate thread, although we don't+-- provide any helpers or wrappers. An example is given below. The example uses+-- UnliftIO for convenience of forking from within DiscordHandler, but you could+-- also manually 'ask' the state from DiscordHandler, lift to IO, use regular+-- 'Control.Concurrent.forkIO', and run ReaderT again to achieve the same.+--+-- @+-- import qualified UnliftIO.Concurrent as Unlift (forkIO)+-- func :: DiscordHandler ()+-- func = do+--     tid <- Unlift.forkIO $ runVoice $ do+--         join guildid chanid+--         forever $ play (createFileResource "music.mp3" Nothing) UnknownCodec+-- @+--+-- == Broadcasting+--+-- Within a single use of 'runVoice', the same packets are sent to all+-- connections that have been joined. This enables multi-channel broadcasting. -- The following demonstrates how a single playback is streamed to multiple -- connections. --@@ -123,24 +200,23 @@ -- runVoice $ do --     join (read "123456789012345") (read "67890123456789012") --     join (read "098765432123456") (read "12345698765456709")---     playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"+--     res <- createYoutubeResource "https://www.youtube.com/watch?v=dQw4w9WgXcQ" Nothing+--     play res UnknownCodec -- @ ----- The return type of @runVoice@ represents result status of the voice computation.--- It is isomorphic to @Maybe@, but the use of Either explicitly denotes that--- the correct\/successful\/'Right' behaviour is (), and that the potentially---- existing value is of failure.+-- == Possible Exceptions ----- This function may propagate and throw an 'IOException' if 'createProcess' --- fails for e.g. ffmpeg or youtube-dl.-runVoice :: Voice () -> DiscordHandler (Either VoiceError ())+-- This function may propagate and throw an 'Control.Exception.IOException' if+-- 'System.Process.Typed.proc' fails for any subprocesses, or if any file- or+-- network-related errors occur.+runVoice :: Voice () -> DiscordHandler () runVoice action = do     voiceHandles <- UnliftIO.newMVar []     mutEx <- UnliftIO.newMVar ()      let initialState = DiscordBroadcastHandle voiceHandles mutEx -    result <- runExceptT $ flip runReaderT initialState $ unVoice $ action+    result <- flip runReaderT initialState $ unVoice action      -- Wrap cleanup action in @finally@ to ensure we always close the     -- threads even if an exception occurred.@@ -160,27 +236,44 @@  -- | Join a specific voice channel, given the Guild and Channel ID of the voice -- channel. Since the Channel ID is globally unique, there is theoretically no--- need to specify the Guild ID, but it is provided until discord-haskell fully--- caches the mappings internally.+-- need to specify the Guild ID, but it needs to be provided manually until+-- discord-haskell fully caches the mappings internally and is able to look up+-- the Guild for any Channel ID. --+-- == Basic Usage+--+-- @+-- runVoice $ do+--    join (read "123456789012345") (read "67890123456789012")+-- @+--+-- Note that the above on its own is not useful in practice, since the runVoice+-- cleanup will make the bot leave the voice call immediately after joining.+--+-- == Leaving the channel+-- -- This function returns a Voice action that, when executed, will leave the -- joined voice channel. For example: -- -- @ -- runVoice $ do---   leave <- join (read "123456789012345") (read "67890123456789012")---   playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"---   leave+--     leave <- join (read "123456789012345") (read "67890123456789012")+--     let res = createFileResource "myfile.mp3" Nothing+--     play res UnknownCodec+--     leave -- @ ----- The above use is not meaningful in practice, since @runVoice@ will perform--- the appropriate cleanup and leaving as necessary at the end of all actions.--- However, it may be useful to interleave @leave@ with other Voice actions.+-- Calling leave at the end of runVoice is not needed in practice, since+-- @runVoice@ will perform the appropriate cleanup and leaving as necessary at+-- the end of all actions. However, it may be useful to interleave @leave@ with+-- other Voice actions, or escape it from the monad using MVars or STMs to be+-- called from other threads. ----- Since the @leave@ function will gracefully do nothing if the voice connection--- is already severed, it is safe to escape this function from the Voice monad--- and use it in a different context. That is, the following is allowed and--- is encouraged if you are building a @\/leave@ command of any sort:+-- The @leave@ function is idempotent and will do nothing if the voice+-- connection is already severed, meaning it is safe to call this from other+-- contexts. The following demonstrates joining a voice channel and playing a+-- file on repeat forever, until a @\/leave@ command is received at which point+-- the connection is severed and the playback thread is killed gracefully. -- -- @ -- -- On \/play@@ -188,16 +281,17 @@ --   leave <- join (read "123456789012345") (read "67890123456789012") --   liftIO $ putMVar futureLeaveFunc leave --   forever $---     playYouTube "https://www.youtube.com/watch?v=dQw4w9WgXcQ"+--     play (createFileResource "myfile.ogg" Nothing) OpusCodec -- -- -- On \/leave, from a different thread -- leave <- liftIO $ takeMVar futureLeaveFunc -- runVoice leave -- @ ----- The above will join a voice channel, play a YouTube video, but immediately--- quit and leave the channel when the @\/leave@ command is received, regardless--- of the playback status.+-- == Possible Exceptions+--+-- This function may throw a 'VoiceError' synchronous exception if we were+-- unable to retrieve connection information about the voice gateway. join :: GuildId -> ChannelId -> Voice (Voice ()) join guildId channelId = do     h <- liftDiscord ask@@ -212,10 +306,10 @@     (liftIO . timeoutMs 5000) (waitForVoiceStatusServerUpdate events) >>= \case         Nothing -> do             -- did not respond in time: no permission? or discord offline?-            throwError VoiceNotAvailable+            liftIO $ throwIO VoiceNotAvailable         Just (_, _, _, Nothing) -> do             -- If endpoint is null, according to Docs, no servers are available.-            throwError NoServerAvailable+            liftIO $ throwIO NoServerAvailable         Just (sessionId, token, guildId, Just endpoint) -> do             -- create the sending and receiving channels for Websocket             wsChans <- liftIO $ (,) <$> newChan <*> newChan@@ -230,7 +324,7 @@             -- ssrc to be filled in during initial handshake             ssrcM <- liftIO newEmptyMVar -            uid <- userId . cacheCurrentUser <$> (liftDiscord readCache)+            uid <- userId . cacheCurrentUser <$> liftDiscord readCache             let wsOpts = WebsocketLaunchOpts uid sessionId token guildId endpoint                     wsChans udpTidM udpChans ssrcM @@ -238,7 +332,7 @@             -- monad using the current Reader state. Not much of a problem             -- since many of the fields are mutable references.             wsTid <- liftIO $ forkIO $ launchWebsocket wsOpts $ discordHandleLog h-            +             wsTidWeak <- liftIO $ mkWeakThreadId wsTid              -- TODO: check if readMVar ever blocks if the UDP thread fails to@@ -271,13 +365,13 @@         :: Chan (Either GatewayException EventInternalParse)         -> IO (T.Text, T.Text, GuildId, Maybe T.Text)     waitForVoiceStatusServerUpdate = loopForBothEvents Nothing 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 (Just a) (Just (b, c, d)) events = pure (a, b, c, d)+    loopForBothEvents (Just a) (Just (b, c, d)) _ = pure (a, b, c, d)     loopForBothEvents mb1 mb2 events = readChan events >>= \case         -- Parse UnknownEvent, which are events not handled by discord-haskell.         Right (InternalUnknownEvent "VOICE_STATE_UPDATE" obj) -> do@@ -295,17 +389,19 @@             loopForBothEvents mb1 result events         _ -> loopForBothEvents mb1 mb2 events --- | Helper function to update the speaking indicator for the bot. Setting the--- microphone status to True is required for Discord to transmit the bot's--- voice to other clients. It is done automatically in all of the @play*@--- functions, so there should be no use for this function in practice.+-- | @updateSpeakingStatus@ updates the speaking indicator for the bot. Setting+-- the indicator to True is required for Discord to transmit the bot's voice to+-- other clients. However, we call this automatically as part of the 'play'+-- function, so there should be no use for this function in practice. --+-- === __Dev Note:__+-- -- Note: Soundshare and priority are const as False in the payload because I--- don't see bots needing them. If and when required, add Bool signatures to--- this function.+-- don't see bots needing them. If there are users who require this, this+-- function will gain additional arguments to control those fields. updateSpeakingStatus :: Bool -> Voice () updateSpeakingStatus micStatus = do-    h <- (^. voiceHandles) <$> ask+    h <- asks (^. voiceHandles)     handles <- UnliftIO.readMVar h     flip (traverseOf_ traverse) handles $ \handle ->         liftIO $ writeChan (handle ^. websocket . _2 . _2) $ Speaking $ SpeakingPayload@@ -316,67 +412,261 @@             , speakingPayloadSSRC       = handle ^. ssrc             } --- | Send a Gateway Websocket Update Voice State command (Opcode 4). Used to--- indicate that the client voice status (deaf/mute) as well as the channel--- they are active on.--- This is not in the Voice monad because it has to be used after all voice--- actions end, to quit the voice channels. It also has no benefit, since it--- would cause extra transformer wrapping/unwrapping.+-- | @updateStatusVoice@ sends a Gateway uplink Opcode 4 Update Voice State.+-- This is used to indicate the client voice status (deaf/mute) as well as the+-- channel they are active on (or Nothing if they are leaving).+--+-- This function is not in the Voice monad because it's purely an operation on+-- the regular websocket. It even has to be used after all voice actions end to+-- move the bot out of voice channels, so there's no benefit to the extra+-- transformer wrapping. updateStatusVoice     :: GuildId-    -- ^ Id of Guild+    -- ^ Guild ID     -> Maybe ChannelId-    -- ^ Id of the voice channel client wants to join (Nothing if disconnecting)+    -- ^ Voice channel ID that we want to join (Nothing if disconnecting)     -> Bool-    -- ^ Whether the client muted+    -- ^ Whether we want to be muted     -> Bool-    -- ^ Whether the client deafened+    -- ^ Whether we want to be deafened     -> DiscordHandler () updateStatusVoice a b c d = sendCommand $ UpdateStatusVoice $ UpdateStatusVoiceOpts a b c d --- | @play source@ plays some sound from the conduit @source@, provided in the--- form of 16-bit Little Endian PCM. The use of Conduit allows you to perform--- arbitrary lazy transformations of audio data, using all the advantages that--- Conduit brings. As the base monad for the Conduit is @ResourceT DiscordHandler@,--- you can access any DiscordHandler effects (through @lift@) or IO effects--- (through @liftIO@) in the conduit as well.+-- | @probeCodec resource@ tries to use @ffprobe@ to probe the codec of the+-- audio resource for files/URLs. If the probed format was Opus or 16-bit PCM,+-- then the function will return the appropriate 'AudioCodec', so that it can be+-- used to tell we won't need FFmpeg is needed as a transcoder. For any other+-- codec or if the resource is raw bytes, the function will return 'UnknownCodec'.+probeCodec :: String -> AudioResource -> IO AudioCodec+probeCodec ffprobeBinary resource = do+    case resource ^. stream of+        Right lbs -> pure UnknownCodec+        Left source -> do+            let processConfig = proc ffprobeBinary+                    [ source+                    , "-print_format", "json"+                    , "-v", "quiet"+                    , "-show_entries", "stream=codec_name"+                    , "-select_streams", "0"+                    ]+            (_exitCode, stdout, _stderr) <- liftIO $ readProcess processConfig++            let codec = do+                    -- Chain the Maybe monad+                    result <- decode stdout+                    flip parseMaybe result $ \obj -> do+                        streams <- obj .: "streams"+                        head streams .: "codec_name"++            case codec :: Maybe String of+                Just "opus" -> pure OPUSCodec+                Just "pcm_s16le" -> pure PCMCodec+                _ -> pure UnknownCodec+++-- | @getPipeline resource codec@ returns some information about the pipeline+-- required for the audio before it is sent to Discord. See the 'AudioPipeline'+-- datatype for the flags set. ----- For a more specific interface that is easier to use, see the 'playPCMFile',--- 'playFile', and 'playYouTube' functions.+-- The audio resource pipeline can be complex. Even if the source is already+-- Opus encoded (and Discord wants Opus), if there is an FFmpeg filter desired+-- then discord-haskell-voice will need to launch a FFmpeg subprocess. If there+-- is also a ByteString conduit filter also desired, then the FFmpeg subprocess+-- will need to output PCM ByteString, which is then transcoded to Opus within+-- Haskell. This complex behaviour is hard to keep track of, so this function+-- acts as an abstraction layer that basically returns what things are necessary+-- for a given audio resource.+getPipeline :: AudioResource -> AudioCodec -> AudioPipeline+getPipeline (AudioResource (Left _path) _ Nothing) OPUSCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = OPUSFinalOutput+    }+getPipeline (AudioResource (Right _bs) _ Nothing) OPUSCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = False+    , audioPipelineOutputCodec = OPUSFinalOutput+    }+getPipeline (AudioResource (Left _path) _ Nothing) PCMCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline (AudioResource (Right _bs) _ Nothing) PCMCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = False+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline (AudioResource _ _ Nothing) UnknownCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = OPUSFinalOutput+    }+getPipeline (AudioResource _ _ (Just (FFmpegTransformation _))) _ = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = OPUSFinalOutput+    }+getPipeline (AudioResource (Left _path) _ (Just (HaskellTransformation _))) PCMCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline (AudioResource (Right _bs) _ (Just (HaskellTransformation _))) PCMCodec = AudioPipeline+    { audioPipelineNeedsFFmpeg = False+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline (AudioResource _ _ (Just (HaskellTransformation _))) _ = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline (AudioResource _ _ (Just (_ :.->: _))) _ = AudioPipeline+    { audioPipelineNeedsFFmpeg = True+    , audioPipelineOutputCodec = PCMFinalOutput+    }+getPipeline _ (ProbeCodec _) = error+    "Impossible! getPipeline should only be called after codec is probed." -- TODO: encode in type++-- | @play resource codec@ plays the specified @resource@. The codec argument+-- should be 'OPUSCodec' or 'PCMCodec' if you know that the resource is already+-- in this format (it can save computational power to transcode). If you do not+-- know and want to unconditionally use ffmpeg to transcode, then specify the+-- codec as 'UnknownCodec'. If you do not know but can afford to wait a few+-- seconds at first to probe the codec (using @ffprobe@) so that we may be able+-- to skip transcoding if it's either PCM or Opus, then use 'ProbeCodec' and+-- specify the name/location of the @ffprobe@ binary. --+-- == Basic Usage+--+-- The following unconditionally calls out to ffmpeg to transcode to Opus:+-- -- @--- import Conduit ( sourceFile )+-- res <- createYoutubeResource "i love trains" Nothing+-- play res UnknownCodec+-- @ ----- runVoice $ do---   join gid cid---   play $ sourceFile ".\/audio\/example.pcm"+-- The following checks if the resource is actually Opus (which actually a lot+-- of YouTube audio streams are), otherwise calls out to ffmpeg to transcode:+-- -- @-play :: ConduitT () B.ByteString (ResourceT DiscordHandler) () -> Voice ()-play source = do+-- res <- createYoutubeResource "i love trains" Nothing+-- play res (ProbeCodec "ffprobe")+-- @+--+-- The following calls out to ffmpeg to transcode to 16-bit PCM (despite being+-- Opus already), because it needs to use the provided conduit to process each+-- PCM sample. Afterwards, the bytestream is encoded to Opus from within Haskell+-- using @libopus@ bindings+--+-- @+-- let res = createFileResource "myfile.ogg" $ HaskellTransformation myConduit+-- play res OpusCodec+-- @+play :: AudioResource -> AudioCodec -> Voice ()+play resource (ProbeCodec ffprobeExe) = do+    -- If we are told the audio should be probed for info, do so and rerun play.+    -- The return value of probeCodec will never be ProbeCodec again, so this+    -- will safely recurse only once.+    liftIO (probeCodec ffprobeExe resource) >>= play resource+play resource codec = do+    -- If we are given a codec of some sort, check if we need transcoding. Also+    -- check if we have any transformations that will need FFmpeg.     h <- ask-    dh <- liftDiscord ask     handles <- UnliftIO.readMVar $ h ^. voiceHandles      updateSpeakingStatus True-    liftDiscord $ UnliftIO.withMVar (h ^. mutEx) $ \_ -> do-        runConduitRes $ source .| encodeOpusC .| sinkHandles handles-    updateSpeakingStatus False-  where-    sinkHandles-        :: [DiscordVoiceHandle]-        -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()-    sinkHandles handles = getZipSink $-        traverse_ (ZipSink . sinkChan . view (udp . _2 . _2)) handles+    let pipeline = getPipeline resource codec -    sinkChan-        :: Bounded.BoundedChan B.ByteString-        -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()-    sinkChan chan = await >>= \case-        Nothing -> pure ()-        Just bs -> do-            liftIO $ Bounded.writeChan chan bs-            sinkChan chan+    -- If the pipeline before it gets to Haskell outputs in OPUS, we can send+    -- those directly to Discord. For PCM, there is likely a transformation we+    -- have to apply (or perhaps none, if it was a PCM bytestring with no FFmpeg).+    -- We then use the Haskell opus library to transcode and send natively.+    let finalProcessing = case pipeline ^. outputCodec of+            OPUSFinalOutput -> transPipe liftIO unwrapOggPacketsC .| sinkHandles handles+            PCMFinalOutput -> case resource ^. transform of+                Just (HaskellTransformation tsC) -> tsC .| encodeOpusC .| sinkHandles handles+                Just (_ :.->: tsC) -> tsC .| encodeOpusC .| sinkHandles handles+                _ -> encodeOpusC .| sinkHandles handles +    if not (pipeline ^. needsFFmpeg) then do+        -- The resource doesn't need to go through ffmpeg at all. It can be an+        -- OPUS or PCM filepath that can be read directly as a Conduit source,+        -- or some lazy bytestring containing either OPUS or PCM.+        liftDiscord $ runConduitRes $ case resource ^. stream of+            Left filepath -> sourceFile filepath .| finalProcessing+            Right lbs -> sourceLazy lbs .| finalProcessing++    else do+        -- We need the FFmpeg subprocess. Sources may be file input, stream URL,+        -- or bytestring stdin.+        let (iFlag, inputStream) = case resource ^. stream of+                Left filepath -> (filepath, nullStream)+                Right lbs     -> ("pipe:0", byteStringInput lbs)+        -- Get all the arguments for FFmpeg using the generator function, either+        -- provided or a default one that only consists of -i.+        let inputArgs = case resource ^. transform of+                Just (FFmpegTransformation argsFunc) -> argsFunc iFlag+                Just (argsFunc :.->: _) -> argsFunc iFlag+                _ -> defaultFfmpegArgs iFlag+        let outputFlags = case pipeline ^. outputCodec of+                -- OPUS output from FFmpeg will be in an OGG container.+                OPUSFinalOutput -> ["-f", "opus", "-c:a", "libopus", "-b:a", "128K", "-ar", "48000", "-ac", "2"]+                PCMFinalOutput -> ["-f", "s16le", "-c:a", "pcm_s16le", "-ar", "48000", "-ac", "2"]+        let args = inputArgs <> outputFlags <>+                    [ "pipe:1"+                    , "-loglevel", "warning"+                    , "-xerror"+                    ]++        let processConfig = proc "ffmpeg" args+                & setStdin inputStream+                & setStdout createSource+                & setStderr createPipe+        -- run the process, but send SIGTERM and terminate it when our inner+        -- function exits. Since we use the stdout conduit source, the inner+        -- func shouldn't exit prematurely. The only possible way we may exit+        -- prematurely is when we get a signal from stderr, in which case it's+        -- desired to stop the process rather than wait until safe termination+        -- (which may never happen).+        liftDiscord $ withProcessTerm processConfig $ \process -> do+            errorSignal <- liftIO newEmptyTMVarIO+            void $ liftIO $ forkIO $+                -- wait indefinitely until end of handle to see if we catch any+                -- output in stderr.+                void $ hWaitForInput (getStderr process) (-1) `catch` \e -> do+                    when (not $ isEOFError e) $ do+                        -- when there is output in stderr, signal its contents+                        -- back to main thread+                        err <- hGetContents (getStderr process)+                        atomically $ putTMVar errorSignal err+                    return True+            runConduitRes+                $ ( do+                    -- check if we have received an error signal, if so terminate+                    errorsExist <- liftIO $ atomically $ tryReadTMVar errorSignal+                    when (isNothing errorsExist) $ getStdout process+                ) .| finalProcessing++        updateSpeakingStatus False+    where+        -- | @sinkHandles handles@ is a conduit that sinks the source to the+        -- individual channels within DiscordVoiceHandle.+        sinkHandles+            :: [DiscordVoiceHandle]+            -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()+        sinkHandles handles = getZipSink $+            traverse_ (ZipSink . sinkChan . view (udp . _2 . _2)) handles++        -- | @sinkChan chan@ is a conduit that sinks the source to a single+        -- bounded channel.+        sinkChan+            :: Bounded.BoundedChan B.ByteString+            -> ConduitT B.ByteString Void (ResourceT DiscordHandler) ()+        sinkChan chan = await >>= \case+            Nothing -> pure ()+            Just bs -> do+                -- Try to write to the channel. It can fail if it's full, in+                -- which case we just want to wait and keep writing. But if the+                -- consuming thread has been killed (by e.g. leaving VC), then+                -- writeChan'll throw an async MVar deadlock exception, which+                -- we'll check for to avoid looping any more.+                tryC (liftIO $ Bounded.writeChan chan bs) >>= \case+                    Left BlockedIndefinitelyOnMVar -> pure ()+                    _ -> sinkChan chan+ -- | @encodeOpusC@ is a conduit that splits the ByteString into chunks of -- (frame size * no of channels * 16/8) bytes, and encodes each chunk into -- OPUS format. ByteStrings are made of CChars (Int8)s, but the data is 16-bit@@ -388,18 +678,28 @@     loop encoder   where     enCfg = mkEncoderConfig opusSR48k True app_audio-    -- 1275 is the max bytes an opus 20ms frame can have-    streamCfg = mkStreamConfig enCfg (48*20) 1276++    -- 48kHz means that 1s has 48,000 samples (or 96,000 for stereo). Therefore,+    -- 1ms has 48 samples. An opus frame is 20ms (by default), so it has+    -- 48 * 20 samples (or 48 * 20 * 2 for stereo).+    -- Each sample has 2 bytes of precision (16 bits), so the size of a frame+    -- is 48 * 20 * 2 (or double for stereo). libopus, per its docs, wants a+    -- per-channel frame size in the unit of "number of samples", so we use+    -- 48 * 20 as the input.+    --+    -- For the output buffer size, 1275 is the max bytes an opus 20ms frame can+    -- have, + the largest possible Opus packet header size is 7 bytes.+    streamCfg = mkStreamConfig enCfg (48 * 20) (1275 + 7)     loop encoder = await >>= \case         Nothing -> do-            -- Send at least 5 blank frames (20ms * 5 = 100 ms)-            let frame = B.pack $ concat $ replicate 1280 [0xF8, 0xFF, 0xFE]-            encoded <- liftIO $ opusEncode encoder streamCfg frame-            yield encoded-            yield encoded-            yield encoded-            yield encoded-            yield encoded+            -- Send at least 5 blank frames before stopping.+            -- Per Discord docs: "When there's a break in the sent data, the+            -- packet transmission shouldn't simply stop. Instead, send five+            -- frames of silence (0xF8, 0xFF, 0xFE) before stopping to avoid+            -- unintended Opus interpolation with subsequent transmissions."+            let encoded = B.pack [0xF8, 0xFF, 0xFE]+            forM_ [0..4] $ \_ -> do+                yield encoded         Just frame -> do             -- encode the audio             encoded <- liftIO $ opusEncode encoder streamCfg frame@@ -407,322 +707,79 @@             yield encoded             loop encoder --- | @playPCMFile file@ plays the sound stored in the file located at @file@,--- provided it is in the form of 16-bit Little Endian PCM. @playPCMFile@ is--- defined as a handy alias for the following:------ > playPCMFile ≡ play . sourceFile------ For a variant of this function that allows arbitrary transformations of the--- audio data through a conduit component, see 'playPCMFile''.------ To play any other format, it will need to be transcoded using FFmpeg. See--- 'playFile' for such usage.-playPCMFile-    :: FilePath-    -- ^ The path to the PCM file to play-    -> Voice ()-playPCMFile = play . sourceFile---- | @playPCMFile' file processor@ plays the sound stored in the file located at--- @file@, provided it is in the form of 16-bit Little Endian PCM. Audio data--- will be passed through the @processor@ conduit component, allowing arbitrary--- transformations to audio data before playback. @playPCMFile'@ is defined as--- the following:------ > playPCMFile' file processor ≡ play $ sourceFile file .| processor------ For a variant of this function with no processing, see 'playPCMFile'.------ To play any other format, it will need to be transcoded using FFmpeg. See--- 'playFile' for such usage.-playPCMFile'-    :: FilePath-    -- ^ The path to the PCM file to play-    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()-    -- ^ Any processing that needs to be done on the audio data-    -> Voice ()-playPCMFile' fp processor = play $ sourceFile fp .| processor---- | @playFile file@ plays the sound stored in the file located at @file@. It--- supports any format supported by FFmpeg by transcoding it, which means it can--- play a wide range of file types. This function expects "@ffmpeg@" to be--- available in the system PATH.------ For a variant that allows you to specify the executable and/or any arguments,--- see 'playFileWith'.------ For a variant of this function that allows arbitrary transformations of the--- audio data through a conduit component, see 'playFile''.------ If the file is already known to be in 16-bit little endian PCM, using--- 'playPCMFile' is much more efficient as it does not go through FFmpeg.-playFile-    :: FilePath-    -- ^ The path to the audio file to play-    -> Voice ()-playFile fp = playFile' fp (awaitForever yield)---- | @playFile' file processor@ plays the sound stored in the file located at--- @file@. It supports any format supported by FFmpeg by transcoding it, which--- means it can play a wide range of file types. This function expects--- "@ffmpeg@" to be available in the system PATH. Audio data will be passed--- through the @processor@ conduit component, allowing arbitrary transformations--- to audio data before playback.------ For a variant that allows you to specify the executable and/or any arguments,--- see 'playFileWith''.------ For a variant of this function with no processing, see 'playFile'.------ If the file is already known to be in 16-bit little endian PCM, using--- 'playPCMFile'' is much more efficient as it does not go through FFmpeg.-playFile'-    :: FilePath-    -- ^ The path to the audio file to play-    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()-    -- ^ Any processing that needs to be done on the audio data-    -> Voice ()-playFile' fp = playFileWith' "ffmpeg" defaultFFmpegArgs fp---- | @defaultFFmpegArgs@ is a generator function for the default FFmpeg--- arguments used when streaming audio into 16-bit little endian PCM on stdout.------ This function takes in the input file path as an argument, because FFmpeg--- arguments are position sensitive in relation to the placement of @-i@.------ It is defined semantically as:------ > defaultFFmpegArgs FILE ≡ "-i FILE -f s16le -ar 48000 -ac 2 -loglevel warning pipe:1"-defaultFFmpegArgs :: FilePath -> [String]-defaultFFmpegArgs fp =-    [ "-i", fp-    , "-f", "s16le"-    , "-ar", "48000"-    , "-ac", "2"-    , "-loglevel", "warning"-    , "pipe:1"-    ]+-- | @createYoutubeResource query mbTransform@ creates an audio resource from a+-- YouTube query. The query is passed to @yt-dlp@, which returns the best audio+-- stream available. If you specify a URL as the query, naturally it will+-- choose the search result for that, which is (likely) guaranteed to be the+-- video itself. The optional 'AudioTransformation' is applied to the audio+-- stream before it is sent to Discord.+createYoutubeResource :: String -> Maybe AudioTransformation -> Voice (Maybe AudioResource)+createYoutubeResource query mbTransform = do+    let processConfig = proc "yt-dlp"+            [ "-j"+            , "--default-search", "ytsearch"+            , "--format", "bestaudio/best"+            , query+            ]+    (_exitCode, stdout, _stderr) <- liftIO $ readProcess processConfig --- | @playFileWith exe args file@ plays the sound stored in the file located at--- @file@, using the specified FFmpeg executable @exe@ and an argument generator--- function @args@ (see @defaultFFmpegArgs@ for the default). It supports any--- format supported by FFmpeg by transcoding it, which means it can play a wide--- range of file types.--- --- For a variant of this function that uses the "@ffmpeg@" executable in your--- PATH automatically, see 'playFile'.------ For a variant of this function that allows arbitrary transformations of the--- audio data through a conduit component, see 'playFileWith''.------ If the file is known to be in 16-bit little endian PCM, using 'playPCMFile'--- is more efficient as it does not go through FFmpeg.-playFileWith-    :: String-    -- ^ The name of the FFmpeg executable-    -> (String -> [String])-    -- ^ FFmpeg argument generator function, given the filepath-    -> FilePath-    -- ^ The path to the audio file to play-    -> Voice ()-playFileWith exe args fp = playFileWith' exe args fp (awaitForever yield)+    pure $ do+        -- Chain the Maybe monad+        result <- decode stdout+        url <- flip parseMaybe result $ \obj -> obj .: "url"+        pure $ AudioResource+            { audioResourceStream = Left url+            , audioResourceYouTubeDLInfo = Just result+            , audioResourceTransform = mbTransform+            } --- | @playFileWith' exe args file processor@ plays the sound stored in the file--- located at @file@, using the specified FFmpeg executable @exe@ and an--- argument generator function @args@ (see @defaultFFmpegArgs@ for the default).--- It supports any format supported by FFmpeg by transcoding it, which means it--- can play a wide range of file types. Audio data will be passed through the--- @processor@ conduit component, allowing arbitrary transformations to audio--- data before playback.--- --- For a variant of this function that uses the "@ffmpeg@" executable in your--- PATH automatically, see 'playFile''.------ For a variant of this function with no processing, see 'playFileWith'.+-- | @createFileResource path mbTransform@ creates an audio resource from a file+-- path. The optional 'AudioTransformation' is applied to the audio stream before+-- it is sent to Discord. ----- If the file is known to be in 16-bit little endian PCM, using 'playPCMFile''--- is more efficient as it does not go through FFmpeg.-playFileWith'-    :: String-    -- ^ The name of the FFmpeg executable-    -> (String -> [String])-    -- ^ FFmpeg argument generator function, given the filepath-    -> String-    -- ^ The path to the audio file to play-    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()-    -- ^ Any processing that needs to be done on the audio data-    -> Voice ()-playFileWith' exe argsGen path processor = do-    let args = argsGen path-    -- NOTE: We use CreatePipe for the stdout handle of ffmpeg, but a preexisting-    -- handle for stderr. This is because we want to retain the stderr output-    -- when ffmpeg has exited with an error code, and capture it before manually-    -- closing the handle. Otherwise, the stderr of ffmpeg may be lost. Using-    -- a preexisting handle for stdout is however, avoided, because createProcess_-    -- does not automatically close UseHandles when done, while conduit's-    -- sourceHandle will patiently wait and block forever for the handle to close.-    -- We may use createProcess (notice the lack of underscore) to automatically-    -- close the UseHandles passed into it, but then we 1. lose the error output-    -- for stderr, and 2. there have been frequent occasions of ffmpeg trying to-    -- write to the closed pipe, causing a "broken pipe" fatal error. We want to-    -- therefore make sure that even if that happens, the error is captured and-    -- stored. Perhaps this explanation makes no sense, but I have suffered too-    -- long on this problem (of calling a subprocess, streaming its output,-    -- storing its errors, and making sure they gracefully kill themselves upon-    -- the parent thread being killed) and I am hoping that this is something-    -- I don't have to touch again.-    (errorReadEnd, errorWriteEnd) <- liftIO $ createPipe-    (a, Just stdout, c, ph) <- liftIO $ createProcess_ "the ffmpeg process" (proc exe args)-        { std_out = CreatePipe-        , std_err = UseHandle errorWriteEnd-        }-    -- We maintain a forked thread that constantly monitors the stderr output,-    -- and if it sees an error, it kills the ffmpeg process so it doesn't block-    -- (sometimes ffmpeg outputs a fatal error but still tries to continue,-    -- especially during streams), and then rethrows the error as a-    -- SubprocessException to the parent (this) thread. The idea is for the-    -- @bracket@ to handle it, properly clean up any remnants, then rethrow it-    -- further up so that user code can handle it, or let it propagate to-    -- the "discord-haskell encountered an exception" handler. However in-    -- practice, I have not seen this exception appear in the logs even once,-    -- even when the preceding putStrLn executes.-    myTid <- liftIO myThreadId-    bracket (liftIO $ forkIO $ do-        thereIsAnError <- hWaitForInput errorReadEnd (-1) `catch` \e ->-            if isEOFError e then return False else throwIO e-        when thereIsAnError $ do-            exitCode <- terminateProcess ph >> waitForProcess ph-            case exitCode of-                ExitSuccess -> do-                    putStrLn "ffmpeg exited successfully"-                    pure ()-                ExitFailure i -> do-                    err <- hGetContents errorReadEnd-                    exitCode <- terminateProcess ph >> waitForProcess ph-                    putStrLn $ "ffmpeg exited with code " ++ show exitCode ++ ": " ++ err-                    throwTo myTid $ SubprocessException err-        ) (\tid -> do-            liftIO $ cleanupProcess (a, Just stdout, c, ph)-            liftIO $ killThread tid-        ) $ const $ play $ sourceHandle stdout .| processor-    liftIO $ hClose errorReadEnd >> hClose errorWriteEnd+-- Note: Currently, file resources are unconditionally read using FFmpeg even+-- when you specify an Opus or PCM codec (which don't need transcoding). This is+-- currently because the library can't distinguish a URL path and a file path+-- given they're both valid inputs to FFmpeg -- however, in the future, this may+-- change. If you have any ideas on how to implement a more intelligent way to+-- avoid transcoding for local files if they're already in the appropriate+-- format, then please suggest an issue or pull request! (It will likely need+-- changes in 'getPipeline')+createFileResource :: String -> Maybe AudioTransformation -> AudioResource+createFileResource path mbTransform = AudioResource+    { audioResourceStream = Left path+    , audioResourceYouTubeDLInfo = Nothing+    , audioResourceTransform = mbTransform+    } --- | @playYouTube query@ plays the first result of searching @query@ on YouTube.--- If a direct video URL is given, YouTube will always return that as the first--- result, which means @playYouTube@ also supports playing links. It supports--- all videos, by automatically transcoding to PCM using FFmpeg. Since it--- streams the data instead of downloading it first, it can play live videos as--- well. This function expects "@ffmpeg@" and "@youtube-dl@" to be available in--- the system PATH.------ For a variant that allows you to specify the executable and/or any arguments,--- see 'playYouTubeWith'.------ For a variant of this function that allows arbitrary transformations of the--- audio data through a conduit component, see 'playYouTube''.-playYouTube-    :: String-    -- ^ Search query (or video URL)-    -> Voice ()-playYouTube query = playYouTube' query (awaitForever yield)+-- | @createPCMResource bs mbTransform@ creates an audio resource from a+-- lazy ByteString. The optional 'AudioTransformation' is applied to the audio+-- stream before it is sent to Discord.+createPCMResource :: BL.ByteString -> Maybe AudioTransformation -> AudioResource+createPCMResource bs mbTransform = AudioResource+    { audioResourceStream = Right bs+    , audioResourceYouTubeDLInfo = Nothing+    , audioResourceTransform = mbTransform+    } --- | @playYouTube' query processor@ plays the first result of searching @query@--- on YouTube. If a direct video URL is given, YouTube will always return that--- as the first result, which means @playYouTube@ also supports playing links.--- It supports all videos, by automatically transcoding to PCM using FFmpeg.--- Since it streams the data instead of downloading it first, it can play live--- videos as well. This function expects "@ffmpeg@" and "@youtube-dl@" to be--- available in the system PATH. Audio data will be passed through the--- @processor@ conduit component, allowing arbitrary transformations to audio--- data before playback.------ For a variant that allows you to specify the executable and/or any arguments,--- see 'playYouTubeWith''.+-- | @defaultFfmpegArgs file@ is a generator function that returns the default+-- arguments for FFmpeg (excluding error handling and output file specification).+-- Specifically, it is defined as: ----- For a variant of this function with no processing, see 'playYouTube'.-playYouTube'-    :: String-    -- ^ Search query (or video URL)-    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()-    -- ^ Any processing that needs to be done on the audio data-    -> Voice ()-playYouTube' query processor =-  let-    customArgGen url = -        [ "-reconnect", "1"-        , "-reconnect_streamed", "1"-        , "-reconnect_delay_max", "2"-        ] <> defaultFFmpegArgs url-  in-    playYouTubeWith' "ffmpeg" customArgGen "youtube-dl" query processor---- | @playYouTubeWith fexe fargs yexe query@ plays the first result of searching--- @query@ on YouTube, using the specified @youtube-dl@ executable @yexe@,--- FFmpeg executable @fexe@ and an argument generator function @fargs@ (see--- @defaultFFmpegArgs@ for the default). If a direct video URL is given, YouTube--- will always return that as the first result, which means @playYouTube@ also--- supports playing links. It supports all videos, by automatically transcoding--- to PCM using FFmpeg. Since it streams the data instead of downloading it--- first, it can play live videos as well.+-- @+-- defaultFfmpegArgs file = [ "-i", file ]+-- @ ----- For a variant of this function that uses the "@ffmpeg@" executable and --- "@youtube-dl@" executable in your PATH automatically, see 'playYouTube'.+-- You may write a replacement argument generator function if you need to+-- specify custom ffmpeg arguments, that migth use complex_filters etc. ----- For a variant of this function that allows arbitrary transformations of the--- audio data through a conduit component, see 'playYouTubeWith''.-playYouTubeWith-    :: String-    -- ^ The name of the FFmpeg executable-    -> (String -> [String])-    -- ^ FFmpeg argument generator function, given the URL-    -> String-    -- ^ The name of the youtube-dl executable-    -> String-    -- ^ The search query (or video URL)-    -> Voice ()-playYouTubeWith fexe fargsGen yexe query = playYouTubeWith' fexe fargsGen yexe query (awaitForever yield)---- | @playYouTubeWith' fexe fargs yexe query processor@ plays the first result--- of searching @query@ on YouTube, using the specified @youtube-dl@ executable--- @yexe@, FFmpeg executable @fexe@ and an argument generator function @fargs@--- (see @defaultFFmpegArgs@ for the default). If a direct video URL is given,--- YouTube will always return that as the first result, which means--- @playYouTube@ also supports playing links. It supports all videos, by--- automatically transcoding to PCM using FFmpeg. Since it streams the data--- instead of downloading it first, it can play live videos as well. Audio data--- will be passed through the @processor@ conduit component, allowing arbitrary--- transformations to audio data before playback.+-- == Basic Usage ----- For a variant of this function that uses the "@ffmpeg@" executable and --- "@youtube-dl@" executable in your PATH automatically, see 'playYouTube''.+-- The following is the same as not passing in a transformation. ----- For a variant of this function with no processing, see 'playYouTubeWith'.-playYouTubeWith'-    :: String-    -- ^ The name of the FFmpeg executable-    -> (String -> [String])-    -- ^ The arguments to pass to FFmpeg-    -> String-    -- ^ The name of the youtube-dl executable-    -> String-    -- ^ The search query (or video URL)-    -> ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) ()-    -- ^ Any processing that needs to be done on the audio data-    -> Voice ()-playYouTubeWith' fexe fargsGen yexe query processor = do-    extractedInfo <- liftIO $ withCreateProcess (proc yexe-        [ "-j"-        , "--default-search", "ytsearch"-        , "--format", "bestaudio/best"-        , query-        ]) { std_out = CreatePipe } $ \stdin (Just stdout) stderr ph ->-            B.hGetContents stdout--    let perhapsUrl = do-            result <- decodeStrict extractedInfo-            flip parseMaybe result $ \obj -> obj .: "url"-    case perhapsUrl of-        -- no matching url found-        Nothing  -> pure ()-        Just url -> playFileWith' fexe fargsGen url processor+-- @+-- res \<- createYoutubeResource "cars" $ FFmpegTransformation $ \\f -> ["-i", f]+-- play res UnknownCodec+-- @+defaultFfmpegArgs :: FilePath -> [String]+defaultFfmpegArgs file = [ "-i", file ]

@@ -3,9 +3,10 @@ {-| Module      : Discord.Internal.Voice.CommonUtils Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -14,20 +15,19 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description  This module provides useful utility functions used in discord-haskell-voice. -}-module Discord.Internal.Voice.CommonUtils where+module Discord.Internal.Voice.CommonUtils+    ( module Discord.Internal.Voice.CommonUtils+    ) where  import Control.Concurrent-import Control.Concurrent.Async ( race )-import Lens.Micro import Data.Text qualified as T-import Data.Time.Clock.POSIX-import Data.Time import GHC.Weak import System.Timeout ( timeout ) 

@@ -0,0 +1,87 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-|+Module      : Discord.Internal.Voice.Encryption+Description : Strictly for internal use only. See Discord.Voice for the public interface.+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors+License     : MIT+Maintainer  : Yuto Takano <moa17stock@gmail.com>++= WARNING++This module is considered __internal__.++The Package Versioning Policy __does not apply__.++The contents of this module may change __in any way whatsoever__ and __without__+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.++= Description++This module provides encryption and decryption of secretbox schemes, abstracting+over either Saltine/Libsodium (standard) or Crypton.+-}+module Discord.Internal.Voice.Encryption+    ( module Discord.Internal.Voice.Encryption+    ) where++#ifdef USE_CRYPTON+import Crypto.PubKey.Curve25519 qualified as X25519+import Crypto.SecretBox qualified as SecretBox+import Crypto.Error ( maybeCryptoError )+#else+import Crypto.Saltine.Core.SecretBox+    ( secretboxOpen+    , secretbox+    )+import Crypto.Saltine.Class qualified as SC+#endif++import Data.ByteString qualified as B+import Data.Maybe ( fromJust )+import Data.Word ( Word8 )+++-- | @decrypt byteKey nonce ciphertext@ decrypts a packet using the provided+-- Discord key (32-bytes) and header nonce (24-bytes). The argument uses strict+-- bytestrings because it has to be strict when passed to FFI/Saltine anyway.+--+-- This does no error handling on misformatted key/nonce since this function is+-- only used in contexts where we are guaranteed they are valid.+--+-- When USE_CRYPTON is defined (using the use-crypton flag), the function+-- is implemented as a wrapper for the 'SecretBox.open' function.+decrypt :: [Word8] -> B.ByteString -> B.ByteString -> Maybe B.ByteString+#ifdef USE_CRYPTON+decrypt byteKey nonce ciphertext = SecretBox.open ciphertext nonce key+  where+    key = fromJust $ maybeCryptoError $ X25519.dhSecret $ B.pack byteKey+#else+decrypt byteKey byteNonce og = secretboxOpen key nonce og+  where+    key = fromJust $ SC.decode $ B.pack byteKey+    nonce = fromJust $ SC.decode byteNonce+#endif++-- | @encrypt byteKey nonce message@ encrypts an audio packet using the provided+-- Discord key and (32-bytes) header nonce (24-bytes). The argument uses strict+-- bytestrings because it has to be strict when passed to FFI/Saltine anyway.+--+-- As with decryption, this function does no error handling on the format of the+-- key and nonce (key = 32 bytes, nonce = 24 bytes).+--+-- When USE_CRYPTON is defined (using the use-crypton flag), the function+-- is implemented as a warpper for the 'SecretBox.create' function.+encrypt :: [Word8] -> B.ByteString -> B.ByteString -> B.ByteString+#ifdef USE_CRYPTON+encrypt byteKey nonce message = SecretBox.create message nonce key+  where+    key = fromJust $ maybeCryptoError $ X25519.dhSecret $ B.pack byteKey+#else+encrypt byteKey byteNonce og = secretbox key nonce og+  where+    key = fromJust $ SC.decode $ B.pack byteKey+    nonce = fromJust $ SC.decode byteNonce+#endif

@@ -0,0 +1,323 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-|+Module      : Discord.Internal.Voice.OggParser+Description : Strictly for internal use only. See Discord.Voice for the public interface.+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors+License     : MIT+Maintainer  : Yuto Takano <moa17stock@gmail.com>++= WARNING++This module is considered __internal__.++The Package Versioning Policy __does not apply__.++The contents of this module may change __in any way whatsoever__ and __without__+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.++= Description++This module provides 'unwrapOggPacketsC', a conduit that unwraps Ogg packets+from a stream of bytes, and extracts the Opus packets from them. This is used+to parse FFmpeg's Ogg output into Opus packets that can be sent to Discord.+-}+module Discord.Internal.Voice.OggParser+    ( unwrapOggPacketsC+    ) where++import Codec.Audio.Opus.Encoder+import Conduit+import Control.Monad ( forM_, replicateM, void, unless )+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Maybe ( isNothing )+import Lens.Micro++-- | The Ogg Page Header, after the initial 4 byte pattern of "OggS".+--+-- As described here: https://xiph.org/ogg/doc/framing.html+-- and here: http://www33146ue.sakura.ne.jp/staff/iz/formats/ogg.html+data OggPageHeader = OggPageHeader+    { oggPageVersion :: Word8+    -- ^ The index 4 byte is "stream_structure_version", which should be set to+    -- 0x00.+    , oggPageFlags :: Word8+    -- ^ The index 5 byte is "header_type_flag", which can be a combination of+    -- 0x01 continued packet (if unset then fresh packet)+    -- 0x02 first page of bitstream (if unset then not first page)+    -- 0x04 last page of bitsream (if unset then not last page)+    , oggPageGranularPosition :: Word64+    -- ^ The index 6 to 13 bytes are the "absolute granule position", which is+    -- the "sample" number. "-1" in two's complement indicate that no packets+    -- finish on this page.+    , oggPageStreamSerial :: Word32+    -- ^ The index 14 to 17 bytes are the "stream serial number". Each logical+    -- stream has a unique serial number.+    , oggPageSeqNumber :: Word32+    -- ^ The index 18 to 21 bytes are the "page counter".+    , oggPageCRCChecksum :: Word32+    -- ^ The index 22 to 25 is the CRC checksum of the entire page, with the+    -- checksum field set to 0.+    , oggPageSegmentAmt :: Int+    -- ^ The index 26 is "page_segments", which is the number of entries+    -- appearing in the segment table below.+    , oggPageSegmentLengths :: [Int]+    -- ^ Index 27 onwards in the header contains the length of each segment that+    -- follows this header in the body, up to the number of segments specified+    -- in segmentAmt. These are also called the lacing values.+    }+    deriving stock (Eq, Show)++instance Binary OggPageHeader where+    put OggPageHeader{..} = do+        putByteString "OggS"+        -- Ogg is a little-endian format+        putWord8 oggPageVersion+        putWord8 oggPageFlags+        putWord64le oggPageGranularPosition+        putWord32le oggPageStreamSerial+        putWord32le oggPageSeqNumber+        putWord32le oggPageCRCChecksum+        putWord8 $ fromIntegral oggPageSegmentAmt+        forM_ oggPageSegmentLengths $ \len ->+            putWord8 $ fromIntegral len+    get = do+        -- Ignore the OggS pattern+        void $ getByteString 4+        ver <- getWord8+        flags <- getWord8+        granularPosition <- getWord64le+        streamSerial <- getWord32le+        seqNumber <- getWord32le+        crcChecksum <- getWord32le+        segmentAmt <- fromIntegral <$> getWord8+        segmentLengths <- replicateM segmentAmt $ fromIntegral <$> getWord8+        pure $ OggPageHeader ver flags granularPosition streamSerial seqNumber crcChecksum segmentAmt segmentLengths++-- | An @OggPage@ consists of an 'OggPageHeader' followed by a segment of+-- variable length with maximum 255 bytes. An Opus packet may span multiple+-- page boundaries.+data OggPage = OggPage+    { oggPageHdr :: OggPageHeader+    , oggPageSegs :: BS.ByteString+    }+    deriving stock (Eq, Show)++-- | @unwrapOggPacketsC@ is a conduit that extracts Opus audio frames from+-- a stream of Ogg page packets. It works by parsing the stream into a series+-- of 'OggPage's, then constructing Opus frames by concatinating multiple Ogg+-- pages using a buffer, and finally filtering out any non-audio packets.+--+-- The function is meant to be used as a replacement for Opus encoding when the+-- audio source is already in Ogg format. Thus, the function will also insert+-- five frames of silence to avoid audio interpolation, just like in+-- 'Discord.Internal.Voice.encodeOpusC'.+unwrapOggPacketsC :: ConduitT BS.ByteString BS.ByteString IO ()+unwrapOggPacketsC = oggPageExtractC .| opusPacketExtractC .| filterOpusNonMetaC++-- | Parses a byte stream as a stream of 'OggPage's, using a buffer to consume+-- bytes as needed and yielding the parsed data.+oggPageExtractC :: (Monad m) => ConduitT BS.ByteString OggPage m ()+oggPageExtractC = loop BL.empty+  where+    -- | Keep awaiting for new chunks of bytestrings, concat that with any+    -- previous leftover chunks, and try to parse it as an Ogg, yielding any+    -- parsed pages.+    -- Since we perform concatenation between large bytestrings repeatedly,+    -- we use lazy bytestrings for the intermediate unconsumedBytes variable.+    loop :: (Monad m) => BL.ByteString -> ConduitT BS.ByteString OggPage m ()+    loop unconsumedBytes = do+        -- Get the bytestring chunks that sourceHandle reads, which is+        -- defaultChunkSize, roughly 32k bytes.+        -- Prepend any previous bytes we didn't consume since it wasn't part of+        -- the page.+        -- We cannot use 'leftover' to put back the unconsumed bytes at the end+        -- of each iteration, since conduit does not concatenate those bytes with+        -- the next item, and it'll just loop forever on the same failing input.+        -- See: https://stackoverflow.com/a/26872574+        mbChunk <- await+        -- Return early and prevent the bytestring append operation if neither+        -- the unconsumed bytes nor the conduit data exist. Both BL.null and+        -- equality check are O(1).+        if BL.null unconsumedBytes && isNothing mbChunk then+            pure ()+        else do+            -- Since these are lazy bytestrings, appending is only dependent+            -- on the length of the spine in @unconsumedBytes@. Furthermore,+            -- conversion of strict to lazy with BL.fromStrict is O(1).+            -- This is better than using strict bytestrings, where appending+            -- incurs two memory copies.+            -- https://hackage.haskell.org/package/bytestring-0.11.3.1/docs/src/Data.ByteString.Internal.html#append+            let chunk = unconsumedBytes <> maybe BL.empty BL.fromStrict mbChunk+            let page = dropUntilPageStart chunk+            case decodeOrFail page of+                Left (_unconsumed, _consumedAmt, _err) -> do+                    -- TOOD: log warning+                    void $ error "warning"+                    loop page+                Right (unconsumed, _consumedAmt, hdr) -> do+                    let (page, rest) = BL.splitAt (fromIntegral $ sum $ oggPageSegmentLengths hdr) unconsumed+                    yield $ OggPage hdr (BL.toStrict page)+                    loop rest++-- | Conduit to extract the Opus bytes from an Ogg Page. This also handles the+-- addition of empty frames when there is no audio, like in+-- 'Discord.Internal.Voice.encodeOpusC'. The output of this conduit is a strict+-- bytestring since there is no longer any need for laziness, and it's better to+-- make it strict when we can guarantee properties of it (like that each packet+-- will only be made strict once) than later down. We need a strict bytestring+-- at the end anyway to send to Discord.+opusPacketExtractC :: ConduitT OggPage BS.ByteString IO ()+opusPacketExtractC = loop BL.empty+  where+    loop :: BL.ByteString -> ConduitT OggPage BS.ByteString IO ()+    loop opusSegment = do+        mbPage <- await+        case mbPage of+            Nothing -> do+                -- Send any incomplete leftovers. The toStrict here is+                -- run on the remaining unterminated Opus packet, which was never+                -- called toStrict upon previously. This is in sync with the+                -- runtime explanation given in splitOggPackets (that toStrict+                -- is only called maximally once for each segment).+                if BL.null opusSegment then pure () else yield (BL.toStrict opusSegment)++                -- Send at least 5 blank frames before stopping.+                -- Per Discord docs: "When there's a break in the sent data, the+                -- packet transmission shouldn't simply stop. Instead, send five+                -- frames of silence (0xF8, 0xFF, 0xFE) before stopping to avoid+                -- unintended Opus interpolation with subsequent transmissions."+                let encoded = BS.pack [0xF8, 0xFF, 0xFE]+                forM_ [0..4] $ \_ -> do+                    yield encoded+            Just (OggPage hdr segsBytes) -> do+                let (pkts, untermSeg, _) = splitOggPackets (oggPageSegmentLengths hdr) segsBytes opusSegment+                forM_ pkts $ yield . BL.toStrict+                loop untermSeg++-- | Conduit to filter out any Opus packets beginning with the first 8 bytes+-- being @OpusHead@ or @OpusTag@.+filterOpusNonMetaC :: (Monad m) => ConduitT BS.ByteString BS.ByteString m ()+filterOpusNonMetaC = do+    mbPkt <- await+    case mbPkt of+        Nothing -> pure ()+        Just pkt -> do+            unless (BS.take 8 pkt `elem` ["OpusHead", "OpusTags"]) $+                yield pkt+            filterOpusNonMetaC++-- | @dropUntilPageStart@ drops one byte at a time until the first four bytes+-- say @OggS@.+dropUntilPageStart :: BL.ByteString -> BL.ByteString+dropUntilPageStart bsChunk+    | BL.length bsChunk < 4+    = BL.empty+    | BL.take 4 bsChunk == "OggS"+    = bsChunk+    | otherwise+    = dropUntilPageStart $ BL.tail bsChunk++-- | @splitOggPackets@ splits a series of bytes according to a list of segment+-- lengths, returning any leftover bytes or unterminated segments. Leftover+-- bytes can be present when there are more bytes provided than the segments,+-- while unterminated segments can be present if e.g. the last item in the+-- provided lengths was 255. (This is because the Ogg frame segmentation+-- defines the segments to be 255 long except for the last one, which is <255).+--+-- Callers of this function can also specify leftover bytes from a previous call+-- to the function, to essentially prepend to the parsing bytes.+splitOggPackets+    :: [Int]+    -- ^ Length of each segment in bytes (0 - 255). This list can be up to 255+    -- items long (255 bytes each), and is taken from the segmentAmt header.+    -- By definition of the Ogg frame format, each segment should be exactly+    -- 255 bytes long, except for the last segment which is <255.+    -> BS.ByteString+    -- ^ The bytes to split and parse from. Unless the network packet itself was+    -- corrupt or lost halfway, this should have at least the total length of+    -- all segments.+    -> BL.ByteString+    -- ^ Any previous segment data that was not terminated in the previous page.+    -> ([BL.ByteString], BL.ByteString, BS.ByteString)+    -- ^ A tuple containing: (the list of parsed and concatted packets, any+    -- unterminated segments, any leftover bytes that were after the segments).+splitOggPackets sl bytes ps = loop sl bytes ps+  where+    loop+        :: [Int]+        -- ^ Length of remaining segments in bytes (0-255).+        -> BS.ByteString+        -- ^ The remaining bytes.+        -> BL.ByteString+        -- ^ Any previous unterminated segments that need to be prepended with+        -- this one to construct a complete Opus packet. This argument is lazy+        -- since it can undergo an append operation on each loop.+        --+        -- To explain:+        --+        -- 1. Both Lazy and Strict bytestring variants would need to be made+        --    strict in its entirety once: O(n). The lazy variant will be made+        --    strict at the very end, while the strict one will be made strict+        --    before calling splitOggPackets.+        -- 2. Both Lazy and Strict bytestring variants have O(1) operation on+        --    self-contained segments (i.e. Opus packets that don't span multiple+        --    segments). For Lazy, we use constant-time strict splitAt: O(1);+        --    then convert the strict bytestring to lazy: O(1); and prepend that+        --    to the result list: O(1). For Strict, we use the same splitAt+        --    operation: O(1); And just prepend it to the result list: O(1).+        -- 3. Both Lazy and Strict bytestring variants have+        --    O(255 * (n * (n + 1) / 2)) for n segments that continue onto the+        --    next. In the case of Lazy, the discovery of a new nth continuation+        --    segment n will perform an append operation walking through the+        --    spine of previous (n - 1) * 255 bytes. The discovery of a+        --    termination segment at n+1 will walk through n * 255 bytes. This+        --    totals to (n * (n + 1) / 2) times walkthrough of 255 bytes.+        --    In the case of Strict, the discovery of a new nth continuation+        --    segment n will perform an append operation walking through both+        --    the previous (n - 1) * 255 bytes and the new 255 bytes, so n * 255.+        --    This totals to (n * (n + 1) / 2) times walkthrough of 255 bytes,+        --    although we have yet to consider the termination segment.+        -- 4. The discovery of a termination segment at n+1 in the Strict variant+        --    incurs a further walkthrough of the previous 255 * n bytes, plus+        --    however many bytes are in the last segment (<255).+        --+        -- Because 4 introduces an additional factor of 255 * n + lastBytes, the+        -- Lazy variant is preferred.+        -> ([BL.ByteString], BL.ByteString, BS.ByteString)+    loop [] bytes previousSegment = ([], previousSegment, bytes) -- O(255i)+    loop (segLen : segLengths) bytes previousSegment+        -- Handle the case when this is the first segment in a series of more+        -- than one segments.+        | (seg, rest) <- BS.splitAt segLen bytes -- O(1)+        , BS.length seg == segLen -- O(1)+        , segLen == 255 -- O(1)+        , BL.null previousSegment -- O(1)+        = loop segLengths rest $ BL.fromStrict seg -- O(1)+        | (seg, rest) <- BS.splitAt segLen bytes -- O(1)+        , BS.length seg == segLen -- O(1)+        , segLen == 255 -- O(1)+        = loop segLengths rest (previousSegment <> BL.fromStrict seg) -- O(255 * m), where m is number of previous segments+        -- Handle the case when this segment is self-conclusive+        | (seg, rest) <- BS.splitAt segLen bytes -- O(1)+        , BS.length seg == segLen -- O(1)+        , segLen < 255 -- O(1)+        , BL.null previousSegment -- O(1)+        = _1 %~ (BL.fromStrict seg :) $ loop segLengths rest BL.empty -- O(1)+        -- Handle the case when this segment terminates a packet+        | (seg, rest) <- BS.splitAt segLen bytes -- O(1)+        , BS.length seg == segLen -- O(1)+        , segLen < 255 -- O(1)+        = _1 %~ (previousSegment <> BL.fromStrict seg :) $ loop segLengths rest BL.empty -- O(255 * m) + recursion, where m is number of previous segments+        -- Handle the case when the segment length doesn't match!! This only+        -- happens if the network packet was lost somewhere, or if the Ogg packet+        -- is simply corrupt.+        | otherwise+        = error "Ogg packet is corrupt and couldn't be parsed."

@@ -2,9 +2,10 @@ {-| Module      : Discord.Internal.Voice.UDPLoop Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -13,32 +14,26 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description -This module provides @launchUdp@, a function used to start a UDP socket and+This module provides 'launchUdp', a function used to start a UDP socket and perform initial handshaking with the Discord Voice UDP Endpoint. It will-continuously encrypt and send the OPUS voice packets as received through the-specified Chan. This function is called automatically by @launchWebsocket@.+continuously encrypt and send the Opus voice packets as received through the+specified Chan. The UDP (data-plane) thread is launched by the websocket+(control-plane) thread, however references to both are held by the main thread+which may terminate the threads using asynchronous exceptions (e.g. on leave). -} 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@@ -46,19 +41,15 @@     , myThreadId     ) import Control.Concurrent.BoundedChan qualified as Bounded-import Control.Exception.Safe ( handle, SomeException, finally, try, bracket )+import Control.Exception.Safe ( SomeException, finally, try, bracket )+import Control.Monad ( replicateM_ ) import Lens.Micro-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 )@@ -66,7 +57,9 @@ import Discord.Internal.Types.VoiceCommon import Discord.Internal.Types.VoiceUDP import Discord.Internal.Voice.CommonUtils+import Discord.Internal.Voice.Encryption +-- | States of the UDP thread state machine. data UDPState     = UDPClosed     | UDPStart@@ -77,13 +70,18 @@ logChan ✍ log = do     t <- formatTime defaultTimeLocale "%F %T %q" <$> getCurrentTime     tid <- myThreadId-    writeChan logChan $ (T.pack t) <> " " <> (tshow tid) <> " " <> log+    writeChan logChan $ T.pack t <> " " <> tshow tid <> " " <> log  -- | A variant of (✍) that prepends the udpError text. (✍!) :: Chan T.Text -> T.Text -> IO () logChan ✍! log = logChan ✍ ("!!! Voice UDP Error - " <> log) --- Alias for opening a UDP socket connection using the Discord endpoint.+-- | @runUDPClient@ is a helper for opening a UDP socket connection using the+-- Discord endpoint and performing an action using that connection. The socket+-- is closed afterwards.+--+-- The connection is wrapped in 'bracket', which allows cleanup after+-- synchronous exceptions. runUDPClient :: AddrInfo -> (Socket -> IO a) -> IO a runUDPClient addr things = bracket     (S.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))@@ -91,15 +89,15 @@         Network.Socket.connect sock $ addrAddress addr         things sock --- | Starts the UDP connection, performs IP discovery, writes the result to the--- receivables channel, and then starts an eternal loop of sending and receiving--- packets.+-- | @launchUdp@ starts the UDP connection, performs IP discovery, writes the+-- result to the receivables channel, and then starts an eternal loop of sending+-- and receiving packets. launchUdp :: UDPLaunchOpts -> Chan T.Text -> IO () launchUdp opts log = loop UDPStart 0   where     loop :: UDPState -> Int -> IO ()-    loop UDPClosed retries = pure ()-    loop UDPStart retries = do+    loop UDPClosed _retries = pure ()+    loop UDPStart _retries = do         next <- try $ do             let hints = defaultHints                     { addrSocketType = Datagram@@ -126,7 +124,7 @@         case next :: Either SomeException UDPState of             Left e -> do                 (✍!) log $ "could not start UDP conn due to an exception: " <>-                    (T.pack $ show e)+                    tshow e                 loop UDPClosed 0             Right n -> loop n 0 @@ -148,15 +146,15 @@                 startForks (UDPConn opts sock) log          case next :: Either SomeException UDPState of-            Left e -> do+            Left _e -> do                 log ✍! "could not reconnect to UDP, will restart in 10 secs."                 threadDelay $ 10 * (10^(6 :: Int))                 loop UDPReconnect (retries + 1)             Right n -> loop n 1 --- | Starts the sendable loop in another thread, and starts the receivable--- loop in the current thread. Once receivable is closed, closes sendable and--- exits. Reconnects if a temporary IO exception occured.+-- | @startForks@ starts the sendable loop in another thread, and starts the+-- receivable loop in the current thread. Once receivable is closed, closes+-- sendable and exits. startForks     :: UDPConn     -> Chan T.Text@@ -168,14 +166,14 @@     -- write five frames of silence initially     -- TODO: check if this is needed (is the 5 frames only for between voice,     -- or also at the beginning like it is now?)-    sequence_ $ replicate 5 $ Bounded.writeChan (conn ^. launchOpts . udpHandle . _2) "\248\255\254"+    replicateM_ 5 $ Bounded.writeChan (conn ^. launchOpts . udpHandle . _2) "\248\255\254"      finally (receivableLoop conn log >> pure UDPClosed)         (killThread sendLoopId) --- | Eternally receive a packet from the socket (max length 999, so practically--- never fails). Decrypts audio data as necessary, and writes it to the--- receivables channel.+-- | @receivableLoop@ eternally receives a packet from the socket (with a buffer+-- size of 999, so that it practically never fails). The function decrypts audio+-- data if it is encrypted, and relays it to the receivables channel. receivableLoop     :: UDPConn     -> Chan T.Text@@ -215,14 +213,17 @@     writeChan (conn ^. launchOpts . udpHandle . _1) msg     receivableLoop conn log --- | Appends 12 empty bytes to form the 24-byte nonce for the secret box.+-- | Appends 12 empty bytes to a 12-byte nonce to form the 24-byte nonce for the+-- secret box. createNonceFromHeader :: B.ByteString -> B.ByteString createNonceFromHeader h = B.append h $ B.concat $ replicate 12 $ B.singleton 0 --- | Eternally send the top packet in the sendable packet Chan. It assumes that--- it is already OPUS-encoded. The function will encrypt it using the syncKey.+-- | @sendableLoop@ eternally sends the top packet in the sendable packet Chan.+-- It assumes that any audio is already Opus-encoded. The function will encrypt+-- it using the provided syncKey. sendableLoop     :: UDPConn+    -- ^ Connection details     -> Chan T.Text     -- ^ Logs     -> Integer@@ -230,6 +231,10 @@     -> Integer     -- ^ Timestamp number, modulo 4294967295     -> POSIXTime+    -- ^ The current time, which is used to dynamically calculate the delay so+    -- that audio packets are sent at just a little faster than 20ms intervals+    -- regardless of the speed at which they arrive in the sendables channel.+    -- This maximises the seamlessness of audio for other clients.     -> IO () sendableLoop conn log sequence timestamp startTime = do     -- Immediately send the first packet available@@ -257,39 +262,15 @@             -- logic taken from discord.py discord/player.py L595             let theoreticalNextTime = startTime + (20 / 1000)             currentTime <- getPOSIXTime-            threadDelay $ round $ (max 0 $ theoreticalNextTime - currentTime) * 10^(6 :: Int)+            threadDelay $ round $ max 0 (theoreticalNextTime - currentTime) * 10^(6 :: Int)             sendableLoop conn log                 (sequence + 1 `mod` 0xFFFF) (timestamp + 48*20 `mod` 0xFFFFFFFF) theoreticalNextTime --- | Decrypt a sound packet using the provided Discord key and header nonce. The--- argument is strict because it has to be strict when passed to Saltine anyway,--- and having the same type signature leaves room for the caller to choose.------ This does no error handling on misformatted key/nonce since this function is--- only used in contexts where we are guaranteed they are valid.-decrypt :: [Word8] -> B.ByteString -> B.ByteString -> Maybe B.ByteString-decrypt byteKey byteNonce og = secretboxOpen key nonce og-  where-    key = fromJust $ SC.decode $ B.pack byteKey-    nonce = fromJust $ SC.decode byteNonce---- | Encrypt a strict sound packet using the provided Discord key and header--- nonce. The argument is strict because it has to be converted to strict--- before passing onto Saltine anyway, and it leaves room for the caller of the--- function to choose which laziness to use.------ As with decryption, this function does no error handling on the format of the--- key and nonce (key = 32 bytes, nonce = 24 bytes).-encrypt :: [Word8] -> B.ByteString -> B.ByteString -> B.ByteString-encrypt byteKey byteNonce og = secretbox key nonce og-  where-    key = fromJust $ SC.decode $ B.pack byteKey-    nonce = fromJust $ SC.decode byteNonce-+-- | @decodeOpusData@ decodes Opus data into dual-channel 16-bit little-endian+-- PCM bytes. decodeOpusData :: B.ByteString -> IO B.ByteString decodeOpusData bytes = do     let deCfg = mkDecoderConfig opusSR48k True-    let deStreamCfg = mkDecoderStreamConfig deCfg (48*20) 0+    let deStreamCfg = mkDecoderStreamConfig deCfg (48*20*2) 0     decoder <- opusDecoderCreate deCfg-    decoded <- opusDecode decoder deStreamCfg bytes-    pure decoded+    opusDecode decoder deStreamCfg bytes

@@ -1,11 +1,12 @@ {-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DerivingStrategies #-} {-| Module      : Discord.Internal.Voice.WebsocketLoop Description : Strictly for internal use only. See Discord.Voice for the public interface.-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  = WARNING @@ -14,15 +15,17 @@ The Package Versioning Policy __does not apply__.  The contents of this module may change __in any way whatsoever__ and __without__-__any warning__ between minor versions of this package.+__any warning__ between minor versions of this package, unless the identifier is+re-exported from a non-internal module.  = Description -This module provides @launchWebsocket@, a function used to launch a websocket to-the Discord Voice Gateway, and perform necessary handshakes including-heartbeat setup, mode selection, and IP Discovery. The function will also set up-the UDP socket for voice data transmission by calling @launchUDP@ from the-"Discord.Internal.Voice.UDPLoop" module.+This module provides 'launchWebsocket', a function used to start a websocket+connection to the Discord voice gateway (i.e. the voice control-plane), and+perform necessary setup including launching a heartbeat thread, selecting+encryption modes, and initiating IP Discovery. The function will also set up+the UDP socket (i.e. the voice data-plane) for voice data transmission by+calling 'launchUdp'. -} module Discord.Internal.Voice.WebsocketLoop     ( launchWebsocket@@ -47,10 +50,10 @@     , newMVar     , readMVar     )-import Control.Exception.Safe ( try, tryAsync, SomeException, finally, handle )+import Control.Exception.Safe ( try, SomeException, finally ) import Lens.Micro import Control.Monad ( forever, guard )-import Control.Monad.Except ( runExceptT, ExceptT (ExceptT), lift )+import Control.Monad.Except ( runExceptT, ExceptT (ExceptT) ) import Control.Monad.IO.Class ( liftIO ) import Data.Aeson ( encode, eitherDecode ) import Data.ByteString.Lazy qualified as BL@@ -62,33 +65,30 @@ import Network.WebSockets     ( ConnectionException(..)     , Connection-    , sendClose     , receiveData     , sendTextData     ) import Wuss ( runSecureClient ) -import Discord-import Discord.Internal.Gateway ( GatewayException )-import Discord.Internal.Types ( GuildId, UserId, User(..), Event(..) ) import Discord.Internal.Types.VoiceCommon import Discord.Internal.Types.VoiceWebsocket import Discord.Internal.Types.VoiceUDP import Discord.Internal.Voice.CommonUtils import Discord.Internal.Voice.UDPLoop +-- | States of the Websocket thread state machine. data WSState     = WSStart     | WSClosed     | WSResume-    deriving Show+    deriving stock Show  -- | A custom logging function that writes the date/time and the thread ID. (✍) :: Chan T.Text -> T.Text -> IO () logChan ✍ log = do     t <- formatTime defaultTimeLocale "%F %T %q" <$> getCurrentTime     tid <- myThreadId-    writeChan logChan $ (T.pack t) <> " " <> (tshow tid) <> " " <> log+    writeChan logChan $ T.pack t <> " " <> tshow tid <> " " <> log  -- | A variant of (✍) that prepends the wsError text. (✍!) :: Chan T.Text -> T.Text -> IO ()@@ -96,8 +96,8 @@  -- | @connect@ is an alias for running a websocket connection using the Discord -- endpoint URL (which contains the port as well). It makes sure to connect to--- the correct voice gateway version as well, as the default version of 1 is--- severely out of date (the opcode behaviours are not according to docs).+-- the correct voice gateway version (v4) as well, as the default version of 1+-- is severely out of date (the opcode behaviours are not according to docs). connect :: T.Text -> (Connection -> IO a) -> IO a connect endpoint = runSecureClient url port "/?v=4"   where@@ -115,16 +115,15 @@   where     websocketFsm :: WSState -> Int -> MVar UDPLaunchOpts -> IO ()     -- Websocket closed legitimately. The UDP thread and this thread-    -- will be closed by the cleanup in runVoice.-    websocketFsm WSClosed retries udpInfo = pure ()+    -- will be closed by the cleanup in 'runVoice'.+    websocketFsm WSClosed _retries _udpInfo = pure () -    -- First time. Let's open a Websocket connection to the Voice-    -- Gateway, do the initial Websocket handshake routine, then-    -- ask to open the UDP connection.-    -- When creating the UDP thread, we will fill in the MVars in-    -- @opts@ to report back to runVoice, so it can be killed in the-    -- future.-    websocketFsm WSStart retries udpInfo = do+    -- First time. Let's open a Websocket connection to the Voice gateway, do+    -- the initial Websocket handshake routine, then ask to open the UDP data+    -- plane connection. When creating the UDP thread, we will fill in the MVars+    -- in @opts@ to report back to 'runVoice', so it can be killed from the main+    -- thread if necessary (e.g. on leaving the call).+    websocketFsm WSStart _retries udpInfo = do         next <- try $ connect (opts ^. endpoint) $ \conn -> do             (libSends, sendTid) <- flip (setupSendLoop conn) log $ opts ^. wsHandle . _2 @@ -139,9 +138,9 @@                  -- Create a thread to add heartbeating packets to the                 -- libSends Chan.-                heartGenTid <- lift $ forkIO $ heartbeatLoop libSends interval log+                heartGenTid <- liftIO $ forkIO $ heartbeatLoop libSends interval log -                flip finally (lift $ killThread heartGenTid) $ do+                flip finally (liftIO $ killThread heartGenTid) $ do                     -- Perform the Identify/Ready handshake                     readyPacket <- ExceptT $                         over _Left ((<> "Failed to get Opcode 2 Ready: ") . tshow) <$>@@ -151,7 +150,7 @@                         maybeToRight ("First packet after Identify not " <> "Opcode 2 Ready " <> tshow readyPacket) $                             readyPacket ^? _Ready -                    secretKey <- lift $ newEmptyMVar+                    secretKey <- liftIO newEmptyMVar                     let udpLaunchOpts = UDPLaunchOpts                             { uDPLaunchOptsSsrc      = readyPayloadSSRC p                             , uDPLaunchOptsIp        = readyPayloadIP p@@ -164,25 +163,25 @@                     -- We should be putting SSRC into the MVar to report back to                     -- the websocket (TODO: why was this again), but we hold it off                     -- until the ssrcCheck guard a few lines below.-                    lift $ modifyMVar_ udpInfo (pure . const udpLaunchOpts)+                    liftIO $ modifyMVar_ udpInfo (pure . const udpLaunchOpts)                      -- Launch the UDP thread, automatically perform                      -- IP discovery, which will write the result                     -- to the receiving Chan. We will pass not the MVar but                     -- the raw options, since there's no writing to be done. -                    forkedId <- lift $ forkIO $ launchUdp udpLaunchOpts log-                    flip finally (lift $ killThread forkedId) $ do+                    forkedId <- liftIO $ forkIO $ launchUdp udpLaunchOpts log+                    flip finally (liftIO $ killThread forkedId) $ do                         udpTidWeak <- liftIO $ mkWeakThreadId forkedId-                        lift $ putMVar (opts ^. udpTid) udpTidWeak+                        liftIO $ putMVar (opts ^. udpTid) udpTidWeak -                        ipDiscovery <- lift $ readChan $ opts ^. udpHandle . _1+                        ipDiscovery <- liftIO $ readChan $ opts ^. udpHandle . _1                         (ssrcCheck, ip, port) <- ExceptT $ pure $                             maybeToRight ("First UDP Packet not IP Discovery " <> tshow ipDiscovery) $                                 ipDiscovery ^? _IPDiscovery                          guard (ssrcCheck == udpLaunchOpts ^. ssrc)-                        lift $ putMVar (opts ^. ssrc) ssrcCheck+                        liftIO $ putMVar (opts ^. ssrc) ssrcCheck                          -- TODO: currently, we await the Opcode 4 SD right after                         -- Select Protocol, blocking the start of heartbeats until@@ -201,11 +200,11 @@                          guard (modeCheck == udpLaunchOpts ^. mode) -                        lift $ putMVar secretKey key+                        liftIO $ putMVar secretKey key                          -- Move to eternal websocket event loop, mainly for the                         -- heartbeats, but also for any user-generated packets.-                        lift $ eventStream conn opts interval udpLaunchOpts libSends log+                        liftIO $ eventStream conn opts interval udpLaunchOpts libSends log              case result of                 Left reason -> log ✍! reason >> pure WSClosed@@ -214,8 +213,9 @@         -- Connection is now closed.         case next :: Either SomeException WSState of             Left e -> do-                (✍!) log $ "connection terminated due to a synchronous exception: " <>-                    (tshow e)+                (✍!) log $+                    "connection terminated due to a synchronous exception: " <>+                    tshow e                 writeChan (opts ^. wsHandle . _1) $ Left $                     VoiceWebsocketCouldNotConnect                         "connection terminated due to a synchronous exception"@@ -228,7 +228,7 @@             helloPacket <- getPayload conn             case helloPacket of                 Left e -> do-                    (✍!) log $ "Failed to get Opcode 8 Hello: " <> (tshow e)+                    (✍!) log $ "Failed to get Opcode 8 Hello: " <> tshow e                     pure WSClosed                 Right (Hello interval) -> do                     -- Create a thread to add heartbeating packets to the@@ -238,46 +238,44 @@                     resumedPacket <- performResumption conn opts                     case resumedPacket of                         Left e -> do-                            (✍!) log $ "Failed to get Opcode 9 Resumed: " <> (tshow e)+                            (✍!) log $ "Failed to get Opcode 9 Resumed: " <> tshow e                             pure WSClosed-                        Right (Discord.Internal.Types.VoiceWebsocket.Resumed) -> do+                        Right Discord.Internal.Types.VoiceWebsocket.Resumed -> do                             -- use the previous UDP launch options since it's not resent                             udpLaunchOpts <- readMVar udpInfo                              -- Pass not the MVar but the raw options, since                             -- there's no writing to be done.-                            finally (eventStream conn opts interval udpLaunchOpts libSends log) $+                            finally (eventStream conn opts interval udpLaunchOpts libSends log)                                 (killThread heartGenTid >> killThread sendTid)                         Right p -> do                             (✍!) log $ "First packet after Resume not " <>-                                "Opcode 9 Resumed: " <> (tshow p)+                                "Opcode 9 Resumed: " <> tshow p                             pure WSClosed                 Right p -> do-                    (✍!) log $ "First packet not Opcode 8 Hello: " <> (tshow p)+                    (✍!) log $ "First packet not Opcode 8 Hello: " <> tshow p                     pure WSClosed          case next :: Either SomeException WSState of             Left e -> do                 (✍!) log $ "could not resume due to a synchronous exception: " <>-                    (tshow e) <> ", retrying after 5 seconds"+                    tshow e <> ", retrying after 5 seconds"                 threadDelay $ 5 * (10^(6 :: Int))                 websocketFsm WSResume (retries + 1) udpInfo             Right n -> websocketFsm n retries udpInfo --- | Create the library-specific sending packets Chan, and then create the--- thread for eternally sending contents in the said Chan, as well as the--- user-generated packet Chan.--- loop for--- the websocket.+-- | @setupSendLoop@ takes a 'Chan' of user-generated packets to send in the+-- websocket. It forks a thread that runs 'sendableLoop' using the provided+-- Chan, together with a new internal-use-only Chan for e.g. heartbeat packets. setupSendLoop     :: Connection-    -- ^ Connection to use+    -- ^ The websocket connection     -> VoiceWebsocketSendChan     -- ^ User generated packets to send in the Websocket     -> Chan T.Text     -- ^ Logging channel     -> IO (VoiceWebsocketSendChan, ThreadId)-    -- ^ Chan to send library-specific packets in the Websocket, and the thread+    -- ^ Chan to send internal-only packets in the Websocket, and the thread     -- ID of the eternal sending thread (useful for killing it). setupSendLoop conn userSends log = do     -- The following Chan will be used for accumulating library-generated@@ -289,57 +287,75 @@      pure (libSends, sendLoopId) --- | Send the Opcode 0 Identify packet to Discord, and await the Opcode 2 Ready--- payload, which contains the UDP connection info.+-- | @performIdentification@ sends the voice gateway uplink Opcode 0 Identify+-- packet to Discord, and awaits the voice gateway downlink Opcode 2 Ready,+-- which has the UDP connection info in its payload. performIdentification     :: Connection+    -- ^ The websocket connection     -> WebsocketLaunchOpts+    -- ^ The options used to launch the websocket     -> IO (Either ConnectionException VoiceWebsocketReceivable) performIdentification conn opts = do     -- Send opcode 0 Identify     sendTextData conn $ encode $ Identify $ IdentifyPayload-        { identifyPayloadServerId = (opts ^. guildId)-        , identifyPayloadUserId = (opts ^. botUserId)-        , identifyPayloadSessionId = (opts ^. sessionId)-        , identifyPayloadToken = (opts ^. token)+        { identifyPayloadServerId = opts ^. guildId+        , identifyPayloadUserId = opts ^. botUserId+        , identifyPayloadSessionId = opts ^. sessionId+        , identifyPayloadToken = opts ^. token         }-        +     getPayload conn --- | Send the Opcode 7 Resume packet to Discord, and await the Opcode 9 Resumed--- payload.+-- | @performResumption@ sends the voice gateway uplink Opcode 7 Resume packet+-- to Discord, and awaits the voice gateway downlink Opcode 9 Resumed payload. performResumption     :: Connection+    -- ^ The websocket connection     -> WebsocketLaunchOpts+    -- ^ The options used to launch the websocket     -> IO (Either ConnectionException VoiceWebsocketReceivable) performResumption conn opts = do     -- Send opcode 7 Resume     sendTextData conn $ encode $         Resume (opts ^. guildId) (opts ^. sessionId) (opts ^. token)-    +     getPayload conn --- | Send the Opcode 1 Select Protocol to Discord. Does not wait for a payload.+-- | @sendSelectProtocol@ sends the voice gateway uplink Opcode 1 Select+-- Protocol to Discord., and waits until we get voice gatway downlink Opcode 4+-- Session Description. We ignore any irrelevant packets during this wait,+-- including downlink Opcode 11 Client Connect, downlink Opcode 18 Client Flags,+-- downlink 20 Client Platform, all of which are sent to us if there is already+-- another user in the voice chat. sendSelectProtocol     :: Connection+    -- ^ The websocket connection     -> T.Text+    -- ^ Our local UDP thread IP as found by IP Discovery     -> Integer+    -- ^ Our local UDP thread port as found by IP Discovery     -> T.Text+    -- ^ Selected encryption mode     -> IO (Either ConnectionException VoiceWebsocketReceivable) sendSelectProtocol conn ip port mode = do     sendTextData conn $ encode $ SelectProtocol $          SelectProtocolPayload "udp" ip port mode-    -    getPayload conn -    -- We do not do getPayload here, since there's no guarantee the next-    -- received packet is an Opcode 4 Session Description, when heartbeats-    -- has began already.-    -- TODO: remove if the above is not a problem+    -- Skip payloads until we get the Opcode 4 Session Description.+    waitUntilSessionDescription+  where+    waitUntilSessionDescription :: IO (Either ConnectionException VoiceWebsocketReceivable)+    waitUntilSessionDescription = do+        payload <- getPayload conn+        case payload of+            Left e -> pure $ Left e+            Right s@(SessionDescription _ _) -> pure $ Right s+            Right _ -> waitUntilSessionDescription --- | Get one packet from the Websocket Connection, parsing it into a--- VoiceWebsocketReceivable using Aeson. If the packet is not validly--- parsed, it will be a @Right (ParseError info)@.+-- | @getPayload@ gets one packet from the Websocket 'Connection' using+-- 'receiveData', parsing it into a 'VoiceWebsocketReceivable' using Aeson. If+-- the packet could not be parsed, it will return @Right (ParseError info)@. getPayload     :: Connection     -> IO (Either ConnectionException VoiceWebsocketReceivable)@@ -350,12 +366,17 @@         Left err  -> pure $ ParseError $ T.pack err             <> " while decoding " <> TE.decodeUtf8 (BL.toStrict msg') --- | Eternally send data from libSends and usrSends channels+-- | @sendableLoop@ eternally send data from @libSends@ and @usrSends@ channels,+-- whenever either of them have data to send. sendableLoop     :: Connection+    -- ^ The websocket connection     -> VoiceWebsocketSendChan+    -- ^ Internal-use sendable channel, e.g. for heartbeat packets     -> VoiceWebsocketSendChan+    -- ^ User-generated sendable packets channel     -> Chan T.Text+    -- ^ Logs     -> IO () sendableLoop conn libSends usrSends log = do     -- Wait-time taken from discord-haskell/Internal.Gateway.EventLoop@@ -366,32 +387,42 @@     sendTextData conn $ encode payload     sendableLoop conn libSends usrSends log --- | Eternally send heartbeats through the libSends channel+-- | @heartbeatLoop@ eternally generates Heartbeat packets every interval, and+-- puts it into the sendable channel to be sent by 'sendableLoop'. heartbeatLoop     :: VoiceWebsocketSendChan+    -- ^ The internal-use sendable channel for websocket packets     -> Int     -- ^ milliseconds     -> Chan T.Text+    -- ^ Logs     -> IO ()-heartbeatLoop libSends interval log = do+heartbeatLoop libSends interval _log = do     threadDelay $ 1 * 10^(6 :: Int)     forever $ do         time <- round <$> getPOSIXTime-        writeChan libSends $ Heartbeat $ time+        writeChan libSends $ Heartbeat time         threadDelay $ interval * 1000 --- | This function is the main event loop for the Websocket, after all initial+-- | @eventStream@ is the main event loop for the Websocket, after all initial -- handshake stages (Hello and identification/resumption). It will continuously -- read the top packet in the Websocket receives, and handle closures, and -- packet responses (like heartbeat responses).--- TODO: a separate ADT for this? what to call it eventStream     :: Connection+    -- ^ The websocket connection     -> WebsocketLaunchOpts+    -- ^ Options used to launch the websokcet connection     -> Int+    -- ^ Interval at which we expect to receive a heartbeat response. We tolerate+    -- up to double of the interval, but if no heartbeat response is received in+    -- this time, we consider the connection to be lost.     -> UDPLaunchOpts+    -- ^ Options used to launch the UDP data plane     -> VoiceWebsocketSendChan+    -- ^ The internal-use sendable channel for websocket packets     -> Chan T.Text+    -- ^ Logs     -> IO WSState eventStream conn opts interval udpLaunchOpts libSends log = do     -- there has to be at least one packet every @interval@ milliseconds (which@@ -422,15 +453,15 @@     -- | Handle Websocket Close codes by logging appropriate messages and     -- closing the connection.     handleClose :: Word16 -> BL.ByteString -> IO WSState-    handleClose 1000 str = log ✍! "websocket closed normally."+    handleClose 1000 _str = log ✍! "websocket closed normally."         >> pure WSClosed-    handleClose 4001 str = log ✍! "websocket closed due to unknown opcode"+    handleClose 4001 _str = log ✍! "websocket closed due to unknown opcode"         >> pure WSClosed-    handleClose 4014 str = log ✍! ("vc deleted, main gateway closed, or bot " <>+    handleClose 4014 _str = log ✍! ("vc deleted, main gateway closed, or bot " <>         "forcefully disconnected... Restarting voice.")         >> pure WSStart-    handleClose 4015 str = log ✍! "server crashed on Discord side, resuming"+    handleClose 4015 _str = log ✍! "server crashed on Discord side, resuming"         >> pure WSResume     handleClose code str = (✍!) log ("connection closed with code: [" <>-        tshow code <> "] " <> (TE.decodeUtf8 $ BL.toStrict str))+        tshow code <> "] " <> TE.decodeUtf8 (BL.toStrict str))         >> pure WSClosed

@@ -1,9 +1,10 @@ {-| Module      : Discord.Voice Description : Voice support for discord-haskell!-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  Welcome to @discord-haskell-voice@! This library provides you with a high-level interface for interacting with Discord's Voice API, building on top of the@@ -14,20 +15,19 @@ the following snippet of code:  @-rickroll :: 'Channel' -> 'DiscordHandler' ()-rickroll c@(ChannelVoice {}) = do-    result <- runVoice $ do-        join (channelGuild c) (channelId c)-        playYouTube \"https:\/\/www.youtube.com\/watch?v=dQw4w9WgXcQ\"--    case result of-        Left err -> liftIO $ print err-        Right _  -> pure ()+rickroll :: 'Discord.Types.Channel' -> 'Discord.DiscordHandler' ()+rickroll c@(ChannelVoice {}) = runVoice $ do+    join (channelGuild c) (channelId c)+    res <- createYoutubeResource \"https:\/\/www.youtube.com\/watch?v=dQw4w9WgXcQ\" Nothing+    play res UnknownCodec @  We can see that this library introduces a dedicated monad for voice operations, which opaquely guarantees that you won't accidentally keep hold of a closed-voice connection, or try to use it after a network error had occurred.+voice connection, or try to use it after a network error had occurred. We also+see intuitive functions for creating and playing audio resources. If you were+worried about how we leave the voice call, it's done automatically as part of+the cleanup action in 'runVoice'.  You'll also see further down the docs, that you can use @[conduit](https://hackage.haskell.org/package/conduit)@ to stream arbitrary@@ -35,59 +35,137 @@ interface. This is quite a powerful feature!  Let's dive in :)++== Dependencies / Requirements++Our README contains the requirements for this library to operate as expected,+but we repeat it here as well for readers who are too lazy.++  [@libsodium@]: We depend on [saltine](https://github.com/tel/saltine) for+  encryption and decryption of audio packets. This binds to libsodium, a system+  package.+  An alternative to saltine is provided via a compile flag. That is to use+  @crypton@ as the encryption backend instead, which needs no system+  dependencies. The security of this library has not been vetted so be cautious.++  [@libopus@]: We require Opus libraries to be installed on your system. Please+  follow the README of the [Haskell Opus package](https://github.com/yutotakano/opus).++  [@ffmpeg@]: It is heavily recommended to have FFmpeg installed and available in+  PATH. Without FFmpeg, you will not be able to transcode any non-PCM non-Opus+  files, bytestrings, or YouTube media.++  [@yt-dlp@]: It is equally heavily recommended to have yt-dlp installed and+  available in PATH. Without yt-dlp, you will not be able to use+  'createYoutubeResource'.++  [@ffprobe@]: It is optional to have FFprobe installed and available in PATH.+  Without FFprobe, you will not be able to use 'ProbeCodec' to check if a given+  file, bytestream, or YouTube video can avoid transcoding via FFmpeg if it's+  already PCM or Opus-encoded.++In general, all three largest OSes (Windows, macOS, Ubuntu) are supported, but+each one has a different way of installing system dependencies for encryption+and encoding, so please be careful.++=== I want to hurry up and just test around++The following commands install all system dependencies for the three most major+OSes.++==== __Windows__++For ffmpeg, ffprobe, and yt-dlp:++> winget install --id=Gyan.FFmpeg -e+> winget install --id=yt-dlp.yt-dlp -e++For libopus and libsodium, if you know where the MSYS2 environment uesd by+your Haskell toolchain is and you are comfortable modifying it, run:++> pacman -S mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-opus mingw64/mingw-w64-x86_64-libsodium++Otherwise, assuming you installed your Haskell toolchain using GHCup, run:++> ghcup run -m -- pacman -S mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-opus mingw64/mingw-w64-x86_64-libsodium++All other scenarios are unsupported but there should be equivalences.++==== __macOS__+> brew install ffmpeg yt-dlp opus libsodium++==== __Ubuntu__++> sudo add-apt-repository ppa:tomtomtom/yt-dlp+> sudo apt update+> sudo apt-get install ffmpeg yt-dlp pkg-config libopus-dev++== Getting Started++We assume you've added this library to your Cabal file dependencies list, and+already have a basic skeleton of a Discord bot. Specifically, our 'Voice' monad+can only be run from within code in the 'Discord.DiscordHandler' monad. Whether+it be within an event handler or on join or some scheduled action, make sure you+find where you want the bot to join a voice call.++The first two functions to learn are 'runVoice' and 'join'. Scroll down! -} module Discord.Voice-    ( +    (       -- * Monad for Voice Operations       Voice     , runVoice     , liftDiscord       -- * Joining a Voice Channel     , join-      -- * Play Some Audio+      -- * Play an Audio Resource     , play-      -- ** More Accessible Variants-      -- $moreAccessibleVariants-    , playPCMFile-    , playPCMFile'-    , playFile-    , playFile'-    , playFileWith-    , playFileWith'-    , playYouTube-    , playYouTube'-    , playYouTubeWith-    , playYouTubeWith'-    , defaultFFmpegArgs+      -- * Create an Audio Resource+    , createYoutubeResource+    , createFileResource+    , createPCMResource+      -- * Transformations+      --+      -- | You can apply transformations to your audio stream, in the form of+      -- extra @ffmpeg@ arguments, or in the form of a Haskell conduit that+      -- operates on PCM bytestreams.+      --+      -- == Examples+      --+      -- The following transforms the audio to mono by averaging the left and+      -- right channels:+      --+      -- @+      -- res \<- createFileResource "space.m4a" $ HaskellTransformation $ packTo16CT .| toMono .| packFrom16CT+      -- @+      --+      -- The following transforms the audio's volume by multiplying every value:+      --+      -- @+      -- let adjust = awaitForever $ \current -> yield (urrent * 2)+      -- res \<- createFileResource "space.m4a" $ HaskellTransformation $ packTo16C .| adjust .| packFrom16C+      -- @+      --+      -- The following selects the second audio track from a video file with multiple audio tracks:+      --+      -- @+      -- res \<- createFileResource "movie.mkv" $ FFmpegTransformation $ \\file -> ["-i", file, "-map", "0:a:1"]+      -- @+      --+      -- == Cost of Transformations+      --+      -- Unfortunately, for most cases, transformations are not zero-cost. If+      -- the source audio is not PCM already, it will need to be transcoded via+      -- FFmpeg to PCM in order to apply 'HaskellTransformation's. If the source+      -- audio was Opus already and ready-to-send to Discord, but you request+      -- any sort of transformation, it will have to go through FFmpeg, and+      -- potentially also be transcoded to PCM.+    , AudioTransformation(..)+    , AudioCodec(..)+    , AudioResource(..)+    , defaultFfmpegArgs     ) where  import Discord.Internal.Types.VoiceCommon import Discord.Internal.Voice -{- $moreAccessibleVariants--While 'play' is the most fundamental way to play audio, it is often inconvenient-to write a Conduit, especially if you want to perform common actions like-streaming YouTube audio, or playing arbitrary audio files in arbitrary formats.-This is why we provide a number of more accessible variants of 'play', which-provide a more convenient interface to playing your favourite media.--Some of the functions in this section are marked with an apostrophe, which-indicate that they accept a Conduit processor as an argument to manipulate the-audio stream on the fly (such as changing volume).--The following table gives a comparative overview of all the functions provided-in this module for playing audio:--+-------------------------+--------------------+------------------+-------------------------------+-------------------------------------+-| Variant \\ Audio Source | ByteString Conduit | PCM Encoded File | Arbitrary Audio File          | YouTube Search/Video                |-+=========================+====================+==================+=============+=================+================+====================+-| Basic                   | 'play'             | 'playPCMFile'    | 'playFile'  | 'playFileWith'  | 'playYouTube'  | 'playYouTubeWith'  |-+-------------------------+--------------------+------------------+-------------+-----------------+----------------+--------------------+-| Post-process audio      | -                  | 'playPCMFile''   | 'playFile'' | 'playFileWith'' | 'playYouTube'' | 'playYouTubeWith'' |-+-------------------------+--------------------+------------------+-------------+-----------------+----------------+--------------------+--The functions that end with @-With@ accept arguments to specify executable names,-and in the case of FFmpeg, any arguments to FFmpeg.---}

@@ -1,28 +1,34 @@ {-# LANGUAGE ImportQualifiedPost #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-| Module      : Discord.Voice.Conduit Description : Convenient Conduits for transforming voice data-Copyright   : (c) Yuto Takano (2021)+Copyright   : (c) 2021-2022 Yuto Takano+              (c) 2025-PRESENT discord-haskell-voice Contributors License     : MIT-Maintainer  : moa17stock@gmail.com+Maintainer  : Yuto Takano <moa17stock@gmail.com>  This module provides convenient Conduits (see the @conduit@ package for an introduction to conduits, but essentially streaming pipes) for transforming-audio data, to be used with the apostrophe-marked functions in "Discord.Voice".+audio data, to be used 'Discord.Voice.HaskellTransformation's when constructing+audio resources using functions like 'Discord.Voice.createYoutubeResource'. -The apostrophe-marked functions, such as 'playFile'', take as argument a-Conduit of the following type:+Functions that create an audio resource can optionally take as argument a+'Discord.Voice.HaskellTransformation', which is a Conduit transformation to+apply to the 16 bit little endian representation of the audio stream. It takes a+Conduit of the following type.  @ ConduitT B.ByteString B.ByteString (ResourceT DiscordHandler) () @  That is, the Conduit's needs to take @ByteString@ values from the upstream and-give to the downstream, @ByteString@s. This ByteString is formatted according to-a 16-bit signed little-endian representation of PCM data, with a sample rate of-48kHz. Since ByteStrings are stored as 'Word8' (8-bits) internally, this module-provides conduits to pack every two bytes into a single signed 16-bit 'Int16',-and vice versa. See 'packInt16C' and 'unpackInt16C'.+give to the downstream @ByteString@s. This ByteString stream is rather useless+as-is because it interweaves both stereo channels and has bytes as elements+(when 16-bit signed little-endian PCM means each sample spans across two bytes).+To make this stream useful, this module provides conduits to pack every two+bytes into a single signed 16-bit 'Int16', and vice versa. See 'packInt16C' and+'unpackInt16C'.  Since the audio data is stereo, there are also conduits provided that pack to and unpack from tuples of @(left, right) :: (Int16, Int16)@ values.@@ -33,22 +39,20 @@ @ yourConduit :: ConduitT Int16 Int16 (ResourceT DiscordHandler) () -playYouTube' "never gonna give you up" $ packInt16C .| yourConduit .| unpackInt16C+play (createFileResource "myfile.mp3" $ HaskellTransformation $ packInt16C .| yourConduit .| unpackInt16C) UnknownCodec @ -Despite the pack/unpack being a common pattern, unfortunately due to library-design, it is not the default behaviour for apostrophe-marked functions (the-reason being that the non-apostrophe-marked-functions are simply aliases for-the apostrophe ones but with a @awaitForever yield@ conduit; this means adding-pack/unpack to the apostrophe versions would slow down the streaming of-untransformed data).+Despite the pack/unpack being a common pattern, we have not chosen it to be the+default behaviour, since you may want to use your own algorithms for+transforming audio.  An example usage of these conduits is:  @ runVoice $ do     join (read "123456789012345") (read "67890123456789012")-    playFile' "Lost in the Woods.mp3" $ packTo16CT .| toMono .| packFrom16CT+    res <- createYoutubeResource "Lost in the Woods" $ HaskellTransformation $ packTo16CT .| toMono .| packFrom16CT+    play res (ProbeCodec "ffprobe") @ -} module Discord.Voice.Conduit