opus (empty) → 0.3.0.0
raw patch · 15 files changed
+1491/−0 lines, 15 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, directory, exceptions, hspec, microlens, microlens-th, opus, resourcet
Files
- ChangeLog.md +33/−0
- LICENSE +32/−0
- README.md +70/−0
- Setup.hs +2/−0
- opus.cabal +81/−0
- src/Codec/Audio/Opus/Decoder.hs +124/−0
- src/Codec/Audio/Opus/Decoder/Conduit.hs +37/−0
- src/Codec/Audio/Opus/Encoder.hs +119/−0
- src/Codec/Audio/Opus/Encoder/Conduit.hs +37/−0
- src/Codec/Audio/Opus/Internal/Opus.hsc +198/−0
- src/Codec/Audio/Opus/Types.hs +208/−0
- test/OpusCompare.hs +46/−0
- test/Spec.hs +105/−0
- test/opus_compare.c +382/−0
- test/opus_compare_wrapper.c +17/−0
+ ChangeLog.md view
@@ -0,0 +1,33 @@+# ChangeLog for `opus` + +### Unreleased Changes + +- nothing yet! + +### 0.3.0.0 — 2025 February + +- **[breaking]** Update Cabal package description file schema to 3.0 (can no longer run with low Cabal versions) +- **[breaking]** Use opus.h for includes instead of opus/opus.h for better Windows/Mingw compatibility +- **[breaking]** Use pkg-config on all platforms including Windows +- Add CI to run tests on every pull request on GitHub +- Modify test suite to remove dependency on `opus-tools` package (instead we now FFI into a local opus_compare.c) +- Add Haddock documentation to all modules, values, and functions. + +### 0.2.1.0 — 2025 February + +- Remove stack from project as Cabal is enough and reduces complexity +- Received permission from alios (the original author) to release this package under the original name +- Update project synopsis, description, links, maintainer info etc in .cabal file +- Remove `hspec` from library dependency +- Fix wrong include path for opus.h in hsc file (on Windows) + +### 0.2.0.0 — 2022 May + +- Decoder and decoder conduit implemented +- `opus` is forked from alios (the original author) due to inactivity +- Add a test suite for decoding mono and stereo audio +- Migrate from `lens` to `microlens` for lighter dependency + +### 0.1.0.0 — 2018 July + +- Encoder and encoder conduit implemented
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2018 Markus Barenhoff +Copyright (c) 2021-2022 Yuto Takano +Copyright (c) 2025-PRESENT Haskell Opus Library Contributors + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Markus Barenhoff nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,70 @@+# opus: Haskell Bindings to libopus + +> This is an active fork of previous work at +> [alios/opus](https://github.com/alios/opus) +> with permission granted from the original author to publish the package/code +> under the same name. + +Xiph.Org Foundation's Opus Audio codec is a widely used audio codec for VoIP and +streaming. `libopus` is the reference implementation of an encoder and decoder +for this codec, and is available to be used via various package managers +[under the BSD-3 license](https://opus-codec.org/license/). + +This Haskell package provides bindings to `libopus`'s encoding and decoding +functionality. It is continuously tested against the official audio vectors in +the project CI (on GitHub). + +The package also provides Conduit functions for encoding and decoding, for easy +use in streaming scenarios. + +## Usage + +1. Add `opus` to your cabal/stack project dependencies +2. Install `libopus` and `pkg-config` (used for finding where libopus is): + 1. **On Windows**: Run the following commands in your MSYS2 environment: + ``` + pacman -S mingw64/mingw-w64-x86_64-pkg-config + pacman -S mingw64/mingw-w64-x86_64-opus + ``` + If you do not know where your MSYS2 environment is, but you installed + the Haskell toolchain using GHCup, try: + ``` + ghcup run -m -- pacman -S mingw64/mingw-w64-x86_64-pkg-config + ghcup run -m -- pacman -S mingw64/mingw-w64-x86_64-opus + ``` + 2. **On MacOS**: Run the following commands: + ``` + brew install opus + ``` + 3. **On Ubuntu/Debian**: Run the following commands: + ``` + apt-get install pkg-config + apt-get install libopus-dev + ``` +3. Import and get going! For example, import `Codec.Audio.Opus.Encoder` to use + the `opusEncoderCreate` and `opusEncode` functions. + +## Development + +To develop locally, you will need the `pkg-config` (pre-installed on Mac) and +`libopus` system packages, as described above. + +To run tests locally, you will also need the Opus test vectors available within +a directory called `opus_newvectors`. The following command will do just that: + +``` +curl -L https://opus-codec.org/static/testvectors/opus_testvectors-rfc8251.tar.gz | tar -xz +``` + +## License + +`test/opus_compare.c` was taken as-is from Xiph.Org Foundation under the BSD-3 +license. + +This project as a whole is licensed under the BSD-3 license. Please see the +LICENSE file for more information. + +Copyright (c) 2018 Markus Barenhoff +Copyright (c) 2021-2022 Yuto Takano +Copyright (c) 2025-PRESENT Haskell Opus Library Contributors +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ opus.cabal view
@@ -0,0 +1,81 @@+cabal-version: 3.0 +name: opus +version: 0.3.0.0 +synopsis: Bindings to libopus for the Opus audio codec +description: + Provides Haskell FFI bindings to libopus, the reference implementation of + the Opus Codec (RFC 6716 and RFC 8251). The Opus codec is designed for + interactive speech and audio transmission over the Internet, but is also + intended for storage and streaming. + + The library provides an interface to the encoder and decoder, as well as a + Conduit wrapper for operating with stream data. + + To use this library, you need to have the libopus library installed on your + system. Please see the README for more info. + + The compiled Haskell code will link dynamically by default, so if + you are distributing a precompiled binary, you may want to look into + static linking. + + This package is a fork of the original opus package by Markus Barenhoff, + which is no longer maintained (and was never published to Hackage). + Permission has been granted by the original author to publish this fork + with the same name under the BSD3 license. +homepage: https://github.com/yutotakano/opus +license: BSD-3-Clause +license-file: LICENSE +author: Markus Barenhoff <mbarenh@alios.org> +maintainer: Yuto Takano <moa17stock@gmail.com> +copyright: Markus Barenhoff <mbarenh@alios.org>, Yuto Takano <moa17stock@gmail.com>, Haskell Opus Library Contributors +category: Codec +build-type: Simple +tested-with: GHC ==9.4.8 +extra-doc-files: + README.md + ChangeLog.md + LICENSE +extra-source-files: + test/opus_compare_wrapper.c + test/opus_compare.c + +source-repository head + type: git + location: https://github.com/yutotakano/opus + +library + hs-source-dirs: src + exposed-modules: Codec.Audio.Opus.Encoder, + Codec.Audio.Opus.Encoder.Conduit, + Codec.Audio.Opus.Decoder, + Codec.Audio.Opus.Decoder.Conduit, + Codec.Audio.Opus.Types, + Codec.Audio.Opus.Internal.Opus + default-language: Haskell2010 + build-tool-depends: hsc2hs:hsc2hs + pkgconfig-depends: opus + ghc-options: -Wall + build-depends: base >= 4.7 && < 5, + exceptions >= 0.10.0 && < 0.11, + resourcet >= 1.2.1 && < 1.4, + bytestring >= 0.11.0.0 && < 0.13, + conduit >= 1.3 && < 1.4, + microlens >= 0.4.11.2 && < 0.5, + microlens-th >= 0.4.3.11 && < 0.5, + +test-suite opus-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + default-language: Haskell2010 + hs-source-dirs: + test + other-modules: OpusCompare + c-sources: test/opus_compare_wrapper.c + include-dirs: test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base, + opus, + bytestring, + hspec, + microlens, + directory
+ src/Codec/Audio/Opus/Decoder.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleContexts #-} +-- | This module contains the high-level API for decoding Opus audio. +module Codec.Audio.Opus.Decoder + ( -- * Decoder + Decoder, OpusException(..) + -- ** create + , withOpusDecoder, opusDecoderCreate, opusDecoderDestroy + -- ** run + , opusDecode, opusDecodeLazy + -- * re-exports + , module Codec.Audio.Opus.Types + ) where + +import Codec.Audio.Opus.Internal.Opus +import Codec.Audio.Opus.Types +import Lens.Micro +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Foreign + +-- | Decoder. Internally, it holds a pointer to the libopus decoder state and +-- a pointer to the (potential) last Opus error code. +newtype Decoder = Decoder (ForeignPtr DecoderT, ForeignPtr ErrorCode) + deriving (Eq, Ord, Show) + +-- | Allocates and initializes a decoder. +opusDecoderCreate :: (HasDecoderConfig cfg, MonadIO m) => cfg -> m Decoder +opusDecoderCreate cfg = liftIO $ do + let cs = if isStereo then 2 else 1 + sr = cfg ^. (decoderConfig . samplingRate) + isStereo = cfg ^. decoderIsStereo + err <- mallocForeignPtr + d <- withForeignPtr err (c_opus_decoder_create sr cs) + d' <- newForeignPtr cp_opus_decoder_destroy d + let enc = Decoder (d', err) + opusLastError enc >>= maybe (pure enc) throwM + +-- | Decode an Opus frame. +opusDecode + :: (HasDecoderStreamConfig cfg, MonadIO m) + => Decoder + -- ^ 'Decoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, whether FEC is + -- enabled, and the decoder configuration (sampling rate, channels). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) + -> m ByteString +opusDecode d cfg i = + let fs = cfg ^. deStreamFrameSize + fec = cfg ^. deStreamDecodeFec + conf = cfg ^. deStreamDecoderConfig + chans = if conf ^. decoderIsStereo then 2 else 1 + pcm_length = fs * chans + in liftIO $ + BS.useAsCStringLen i $ \(i', ilen) -> + allocaArray pcm_length $ \os -> + runDecoderAction d $ \d' -> do + r <- c_opus_decode d' i' (fromIntegral ilen) os + (fromIntegral fs) (fromIntegral fec) + let l = fromIntegral r + if l < 0 then do + let mbException = ErrorCode l ^? _ErrorCodeException + case mbException of + Nothing -> throwM OpusInvalidPacket + Just x -> throwM x + else do + -- multiply by 2 because "os" is CShort i.e. Int16 + -- but CStringLen expects a CChar which is Int8 + BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2 * chans) + +-- | Decode an Opus frame, returning a lazy 'BL.ByteString'. +opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) + => Decoder + -- ^ 'Decoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, whether FEC is + -- enabled, and the decoder configuration (sampling rate, channels). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) + -> m BL.ByteString +opusDecodeLazy d cfg = fmap BL.fromStrict . opusDecode d cfg + +-- | For use with 'ResourceT' or any other monad that implements 'MonadResource'. +-- Safely allocate a 'Decoder' that will be freed upon exiting the monad, an +-- exception, or an explicit call to 'Control.Monad.Trans.Resource.release'. +withOpusDecoder :: (HasDecoderConfig cfg) => MonadResource m + => cfg + -> (Decoder -> IO ()) + -> m Decoder +withOpusDecoder cfg a = + snd <$> allocate (opusDecoderCreate cfg) a + +-- | Frees an 'Decoder'. +opusDecoderDestroy :: MonadIO m => Decoder -> m () +opusDecoderDestroy (Decoder (d, err)) = liftIO $ + finalizeForeignPtr d >> finalizeForeignPtr err + +-- | Get the last error from decoder. +opusLastError :: MonadIO m => Decoder -> m (Maybe OpusException) +opusLastError (Decoder (_, fp)) = + liftIO $ (^? _ErrorCodeException) <$> withForeignPtr fp peek + +-- | An 'DecoderAction' is an IO action that uses a 'DecoderT' for its operation. +type DecoderAction a = Ptr DecoderT -> IO a + +-- | Run a 'DecoderAction' using a 'Decoder', returning either 'OpusException' +-- for errors or the result of the action. +withDecoder' :: MonadIO m => + Decoder -> DecoderAction a -> m (Either OpusException a) +withDecoder' e@(Decoder (fp_a, _)) m = liftIO $ + withForeignPtr fp_a $ \a -> do + r <- m a + le <- opusLastError e + pure $ maybe (Right r) Left le + +-- | Run a 'DecoderAction'. Might throw an 'OpusException' if the action fails. +runDecoderAction :: (MonadIO m, MonadThrow m) => + Decoder -> DecoderAction a -> m a +runDecoderAction d m = withDecoder' d m >>= either throwM pure
+ src/Codec/Audio/Opus/Decoder/Conduit.hs view
@@ -0,0 +1,37 @@+-- | Conduit interface for decoding audio data with Opus. +module Codec.Audio.Opus.Decoder.Conduit + ( decoderC, decoderLazyC + , decoderSink + ) where + +import Codec.Audio.Opus.Decoder +import Conduit +import Lens.Micro +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Conduit.Combinators +import Prelude (($)) + +-- | Decode audio data with Opus. +decoderC :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString ByteString m () +decoderC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> mapM (opusDecode d cfg) + +-- | Decode lazy bytestring audio data with Opus. +decoderLazyC :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString BL.ByteString m () +decoderLazyC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> mapM (opusDecodeLazy d cfg) + +-- | A sink to decode audio data with Opus and return a lazy bytestring of the +-- whole stream. +decoderSink :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString o m BL.ByteString +decoderSink cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> foldMapM (opusDecodeLazy d cfg) + +-- | Run a conduit that uses a decoder with the given configuration. +withDecoder :: (HasDecoderConfig cfg, MonadResource m) => + cfg -> (Decoder -> ConduitT i o m r) -> ConduitT i o m r +withDecoder cfg = bracketP (opusDecoderCreate cfg) opusDecoderDestroy
+ src/Codec/Audio/Opus/Encoder.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleContexts #-} +-- | This module contains the high-level API for encoding Opus audio. +module Codec.Audio.Opus.Encoder + ( -- * Encoder + Encoder, OpusException(..) + -- ** create + , withOpusEncoder, opusEncoderCreate, opusEncoderDestroy + -- ** run + , opusEncode, opusEncodeLazy + -- * re-exports + , module Codec.Audio.Opus.Types + ) where + +import Codec.Audio.Opus.Internal.Opus +import Codec.Audio.Opus.Types +import Lens.Micro +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Foreign + +-- | Encoder. Internally, it holds a pointer to the libopus encoder state and +-- a pointer to the (potential) last Opus error code. +newtype Encoder = Encoder (ForeignPtr EncoderT, ForeignPtr ErrorCode) + deriving (Eq, Ord, Show) + +-- | Allocates and initializes an encoder. +opusEncoderCreate :: (HasEncoderConfig cfg, MonadIO m) => cfg -> m Encoder +opusEncoderCreate cfg = liftIO $ do + let cs = if isStereo then 2 else 1 + sr = cfg ^. (encoderConfig . samplingRate) + isStereo = cfg ^. encoderIsStereo + cm = cfg ^. (encoderConfig . codingMode) + err <- mallocForeignPtr + e <- withForeignPtr err (c_opus_encoder_create sr cs cm) + e' <- newForeignPtr cp_opus_encoder_destroy e + let enc = Encoder (e', err) + opusLastError enc >>= maybe (pure enc) throwM + +-- | Encode an Opus frame. +opusEncode + :: (HasStreamConfig cfg, MonadIO m) + => Encoder + -- ^ 'Encoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, the output size, + -- and the encoder configuration (sampling rate, channels, coding mode). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) + -> m ByteString +opusEncode e cfg i = + let fs = cfg ^. streamFrameSize + n = cfg ^. streamOutSize + in liftIO $ + BS.useAsCString i $ \i' -> + allocaArray n $ \os -> + runEncoderAction e $ \e' -> do + r <- c_opus_encode e' (castPtr i') (fromInteger . toInteger $ fs) os + (fromInteger . toInteger $ n) + let l = fromInteger . toInteger $ r + ol = (os, l) + if l < 0 then throwM OpusInvalidPacket else + BS.packCStringLen ol + +-- | Encode an Opus frame. Returns a lazy 'BL.ByteString'. +opusEncodeLazy :: (HasStreamConfig cfg, MonadIO m) + => Encoder + -- ^ 'Encoder' state + -> cfg + -- ^ The stream configuration that specifies the frame size, the output size, + -- and the encoder configuration (sampling rate, channels, coding mode). + -> ByteString + -- ^ Input signal (interleaved if 2 channels) + -> m BL.ByteString +opusEncodeLazy e cfg = fmap BL.fromStrict . opusEncode e cfg + + +-- | For use with 'ResourceT' or any other monad that implements 'MonadResource'. +-- Safely allocate an 'Encoder' that will be freed upon exiting the monad, an +-- exception, or an explicit call to 'Control.Monad.Trans.Resource.release'. +withOpusEncoder :: (HasEncoderConfig cfg) => MonadResource m + => cfg + -> (Encoder -> IO ()) + -> m Encoder +withOpusEncoder cfg a = + snd <$> allocate (opusEncoderCreate cfg) a + + +-- | Frees an 'Encoder'. +opusEncoderDestroy :: MonadIO m => Encoder -> m () +opusEncoderDestroy (Encoder (e, err)) = liftIO $ + finalizeForeignPtr e >> finalizeForeignPtr err + + +-- | Get the last error from the encoder. +opusLastError :: MonadIO m => Encoder -> m (Maybe OpusException) +opusLastError (Encoder (_, fp)) = + liftIO $ (^? _ErrorCodeException) <$> withForeignPtr fp peek + +-- | An 'EncoderAction' is an IO action that uses a 'EncoderT' for its operation. +type EncoderAction a = Ptr EncoderT -> IO a + +-- | Run an 'EncoderAction' using an 'Encoder', returning either 'OpusException' +-- for errors or the result of the action. +withEncoder' :: MonadIO m => + Encoder -> EncoderAction a -> m (Either OpusException a) +withEncoder' e@(Encoder (fp_a, _)) m = liftIO $ + withForeignPtr fp_a $ \a -> do + r <- m a + le <- opusLastError e + pure $ maybe (Right r) Left le + +-- | Run an 'EncoderAction'. Might throw an 'OpusException' if the action fails. +runEncoderAction :: (MonadIO m, MonadThrow m) => + Encoder -> EncoderAction a -> m a +runEncoderAction e m = withEncoder' e m >>= either throwM pure
+ src/Codec/Audio/Opus/Encoder/Conduit.hs view
@@ -0,0 +1,37 @@+-- | Conduit interface for encoding audio data with Opus. +module Codec.Audio.Opus.Encoder.Conduit + ( encoderC, encoderLazyC + , encoderSink + ) where + +import Codec.Audio.Opus.Encoder +import Conduit +import Lens.Micro +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Conduit.Combinators +import Prelude (($)) + +-- | Encode audio data with Opus. +encoderC :: (HasStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString ByteString m () +encoderC cfg = withEncoder (cfg ^. streamConfig) $ + \e -> mapM (opusEncode e cfg) + +-- | Encode lazy bytestring audio data with Opus. +encoderLazyC :: (HasStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString BL.ByteString m () +encoderLazyC cfg = withEncoder (cfg ^. streamConfig) $ + \e -> mapM (opusEncodeLazy e cfg) + +-- | A sink to encode audio data with Opus and return a lazy bytestring of the +-- whole stream. +encoderSink :: (HasStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString o m BL.ByteString +encoderSink cfg = withEncoder (cfg ^. streamConfig) $ + \e -> foldMapM (opusEncodeLazy e cfg) + +-- | Run a conduit that uses an encoder with the given configuration. +withEncoder :: (HasEncoderConfig cfg, MonadResource m) => + cfg -> (Encoder -> ConduitT i o m r) -> ConduitT i o m r +withEncoder cfg = bracketP (opusEncoderCreate cfg) opusEncoderDestroy
+ src/Codec/Audio/Opus/Internal/Opus.hsc view
@@ -0,0 +1,198 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +-- | This module contains the raw FFI bindings to the Opus library. It is not +-- meant to be consumed directly by users of this library, but rather to be +-- used by the higher-level API in "Codec.Audio.Opus". +module Codec.Audio.Opus.Internal.Opus where + +import Foreign +import Foreign.C.Types +import Foreign.C.String + +#include <opus.h> + +-- | Raw error codes returned by the Opus library, represented as an int. +newtype ErrorCode = ErrorCode { unErrorCode :: CInt } + deriving (Eq, Show) + +-- | Storable instance for 'ErrorCode' which is necessary for using it an +-- argument in FFI calls. +instance Storable ErrorCode where + sizeOf (ErrorCode e) = sizeOf e + alignment (ErrorCode e) = alignment e + peek p = ErrorCode <$> peek (castPtr p) + poke p = poke (castPtr p) . unErrorCode + +-- | libopus error: No error. +opus_ok :: ErrorCode +opus_ok = ErrorCode (#const OPUS_OK) + +-- | libopus error: One or more invalid/out of range arguments. +opus_bad_arg :: ErrorCode +opus_bad_arg = ErrorCode (#const OPUS_BAD_ARG) + +-- | libopus error: Not enough bytes allocated in the buffer. +opus_buffer_too_small :: ErrorCode +opus_buffer_too_small = ErrorCode (#const OPUS_BUFFER_TOO_SMALL) + +-- | libopus error: An internal error was detected. +opus_internal_error :: ErrorCode +opus_internal_error = ErrorCode (#const OPUS_INTERNAL_ERROR) + +-- | libopus error: The compressed data passed is corrupted. +opus_invalid_packet :: ErrorCode +opus_invalid_packet = ErrorCode (#const OPUS_INVALID_PACKET) + +-- | libopus error: Invalid/unsupported request number. +opus_unimplemented :: ErrorCode +opus_unimplemented = ErrorCode (#const OPUS_UNIMPLEMENTED) + +-- | libopus error: An encoder or decoder structure is invalid or already freed. +opus_invalid_state :: ErrorCode +opus_invalid_state = ErrorCode (#const OPUS_INVALID_STATE) + +-- | libopus error: Memory allocation has failed. +opus_alloc_fail :: ErrorCode +opus_alloc_fail = ErrorCode (#const OPUS_ALLOC_FAIL) + +-- | Coding mode for the Opus encoder, represented as an int. +newtype CodingMode = CodingMode { unCodingMode :: CInt } + deriving (Eq) + +-- | Show instance for 'CodingMode'. +instance Show CodingMode where + show a + | app_voip == a = "voip coding" + | app_audio == a = "audio coding" + | app_lowdelay == a = "lowdelay coding" + | otherwise = "unknown coding" + +-- | Best for most VoIP/videoconference applications where listening quality and +-- intelligibility matter most. +app_voip :: CodingMode +app_voip = CodingMode (#const OPUS_APPLICATION_VOIP) + +-- | Best for broadcast/high-fidelity application where the decoded audio should +-- be as close as possible to the input. +app_audio :: CodingMode +app_audio = CodingMode (#const OPUS_APPLICATION_AUDIO) + +-- | Only use when lowest-achievable latency is what matters most. +app_lowdelay :: CodingMode +app_lowdelay = CodingMode (#const OPUS_APPLICATION_RESTRICTED_LOWDELAY) + +-- | Sampling rate for the Opus encoder, represented as an int. +newtype SamplingRate = SamplingRate { unSamplingRate :: Int } + deriving (Eq) + +-- | Show instance for 'SamplingRate' makes it human-readable. +instance Show SamplingRate where + show (SamplingRate r) = mconcat [show $ r `div` 1000, "kHz"] + +-- | Sampling rate 8kHz +opusSR8k :: SamplingRate +opusSR8k = SamplingRate 8000 + +-- | Sampling rate 12kHz +opusSR12k :: SamplingRate +opusSR12k = SamplingRate 12000 + +-- | Sampling rate 16kHz +opusSR16k :: SamplingRate +opusSR16k = SamplingRate 16000 + +-- | Sampling rate 24kHz +opusSR24k :: SamplingRate +opusSR24k = SamplingRate 24000 + +-- | Sampling rate 48kHz +opusSR48k :: SamplingRate +opusSR48k = SamplingRate 48000 + +-- Declare empty (i.e. opaque) data types for the encoder and decoder states. +-- This is not meant to be consumed by Haskell code, but is rather meant to +-- encapsulate the C types that FFI calls return and expect to be passed +-- modified in a subsequent FFI call. +-- +-- For example, the encoder state can be created only by 'c_opus_encoder_create', +-- and destroyed by 'cp_opus_encoder_destroy'. + +-- | Encoder state. Can be created only by 'c_opus_encoder_create', +-- and destroyed by 'cp_opus_encoder_destroy'. +data EncoderT + +-- | Decoder state. Can be created only by 'c_opus_decoder_create', +-- and destroyed by 'cp_opus_decoder_destroy'. +data DecoderT + + +-- | Allocates and initializes an encoder state. +foreign import ccall unsafe "opus.h opus_encoder_create" + c_opus_encoder_create + :: SamplingRate + -- ^ Sampling rate of input signal (Hz). + -> Int32 + -- ^ Number of channels (1 or 2) in input signal + -> CodingMode + -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') + -> Ptr ErrorCode + -- ^ 'ErrorCode' pointer + -> IO (Ptr EncoderT) + +-- | Frees an 'EncoderT' that has been created using 'c_opus_encoder_create'. +foreign import ccall unsafe "opus.h &opus_encoder_destroy" + cp_opus_encoder_destroy + :: FunPtr (Ptr EncoderT -> IO ()) + +-- | Encode an Opus frame. +foreign import ccall unsafe "opus.h opus_encode" + c_opus_encode + :: Ptr EncoderT + -- ^ Encoder state + -> Ptr CShort + -- ^ Input signal + -> Int32 + -- ^ Frame size + -> CString + -- ^ Output payload + -> Int32 + -- ^ Max data bytes + -> IO Int32 + -- ^ Number of bytes written or negative in case of error + +-- | Allocates and initializes a decoder state. +foreign import ccall unsafe "opus.h opus_decoder_create" + c_opus_decoder_create + :: SamplingRate + -- ^ Sampling rate, same as encoder_create + -> Int32 + -- ^ Number of channels in input signal + -> Ptr ErrorCode + -- ^ 'ErrorCode' pointer + -> IO (Ptr DecoderT) + +-- | Frees a 'DecoderT' that has been created using 'c_opus_decoder_create'. +foreign import ccall unsafe "opus.h &opus_decoder_destroy" + cp_opus_decoder_destroy + :: FunPtr (Ptr DecoderT -> IO ()) + +-- | Decodes an Opus frame. +foreign import ccall unsafe "opus.h opus_decode" + c_opus_decode + :: Ptr DecoderT + -- ^ Decoder state + -> Ptr CChar + -- ^ Byte array of compressed data + -> Int32 + -- ^ Exact number of bytes in the payload + -> Ptr CShort + -- ^ Decoded audio data + -> Int32 + -- ^ Max duration of the frame in samples that can fit + -> CInt + -- ^ Flag to request that any in-band forward error correction data be + -- decoded. If no such data is available, the frame is decoded as if it + -- were lost. + -> IO Int32 + -- ^ Number of decoded samples, or negative in case of error +
+ src/Codec/Audio/Opus/Types.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE TemplateHaskell #-} +-- | This module contains the types used in the higher-level API of this library. +module Codec.Audio.Opus.Types + ( -- * Sampling Rate + SamplingRate, HasSamplingRate(..) + , opusSR8k, opusSR12k, opusSR16k, opusSR24k, opusSR48k + -- * Coding Mode + , CodingMode, HasCodingMode(..), app_voip, app_audio, app_lowdelay + -- * Exception + , OpusException(..), ErrorCode, _ErrorCodeException + -- * EncoderConfig + , FrameSize + , EncoderConfig, HasEncoderConfig(..), mkEncoderConfig + -- * DecoderConfig + , DecoderConfig, HasDecoderConfig(..), mkDecoderConfig + -- * StreamConfig + , StreamConfig, HasStreamConfig(..), mkStreamConfig + -- * DecoderStreamConfig + , DecoderStreamConfig, HasDecoderStreamConfig(..), mkDecoderStreamConfig + ) where + +import Codec.Audio.Opus.Internal.Opus + +import Lens.Micro +import Lens.Micro.TH +import Control.Monad.Catch +import Data.Typeable (Typeable) + + +-- | A potential error that can happen during encoding or decoding, as reported +-- by the Opus library. The descriptions of each error have been taken from the +-- [Opus documentation](https://opus-codec.org/docs/opus_api-1.5/group__opus__errorcodes.html). +data OpusException + = OpusBadArg + -- ^ One or more invalid/out of range arguments. + | OpusBufferToSmall + -- ^ Not enough bytes allocated in the buffer. + | OpusInternalError + -- ^ An internal error was detected. + | OpusInvalidPacket + -- ^ The compressed data passed is corrupted. + | OpusUnimplemented + -- ^ Invalid/unsupported request number. + | OpusInvalidState + -- ^ An encoder or decoder structure is invalid or already freed. + | OpusAllocFail + -- ^ Memory allocation has failed. + deriving (Eq, Show, Typeable) + +instance Exception OpusException + +-- | A 'Traversal' that maps a function @f@ onto the contained 'OpusException' +-- if the input 'ErrorCode' can be converted into it. +_ErrorCodeException :: Traversal' ErrorCode OpusException +_ErrorCodeException f e + | Just exc <- errorCodeException e = errorCodeException' <$> f exc + | otherwise = pure e + +-- | Convert an 'OpusException' into an 'ErrorCode'. +errorCodeException' :: OpusException -> ErrorCode +errorCodeException' OpusBadArg = opus_bad_arg +errorCodeException' OpusBufferToSmall = opus_buffer_too_small +errorCodeException' OpusInternalError = opus_internal_error +errorCodeException' OpusInvalidPacket = opus_invalid_packet +errorCodeException' OpusUnimplemented = opus_unimplemented +errorCodeException' OpusInvalidState = opus_invalid_state +errorCodeException' OpusAllocFail = opus_alloc_fail + +-- | Convert an 'ErrorCode' into an 'OpusException'. Returns Nothing if it is +-- not a known error code. +errorCodeException :: ErrorCode -> Maybe OpusException +errorCodeException a + | a == opus_bad_arg = Just OpusBadArg + | a == opus_buffer_too_small = Just OpusBufferToSmall + | a == opus_internal_error = Just OpusInternalError + | a == opus_invalid_packet = Just OpusInvalidPacket + | a == opus_unimplemented = Just OpusUnimplemented + | a == opus_invalid_state = Just OpusInvalidState + | a == opus_alloc_fail = Just OpusAllocFail + | otherwise = Nothing + + +-- | A 'HasSamplingRate' typeclass, generated from the definition of +-- 'SamplingRate' using Template Haskell. This allows us to use 'samplingRate' +-- to access the 'SamplingRate' field of a data type such as 'EncoderConfig'. +makeClassy ''SamplingRate + +-- | A 'HasCodingMode' typeclass, generated from the definition of 'CodingMode' +-- using Template Haskell. This allows us to use 'codingMode' to access the +-- 'CodingMode' field of a data type such as 'EncoderConfig'. +makeClassy ''CodingMode + +-- | The configuration of an Opus encoder. Use 'mkEncoderConfig' to create a new +-- 'EncoderConfig'. +data EncoderConfig = EncoderConfig + { _encoderSamplingRate :: SamplingRate + -- ^ sampling rate of input signal + , _encoderIsStereo :: Bool + -- ^ stereo mode? ('True' => 2 channels, 'False' => 1 channel) + , _encoderCodingMode :: CodingMode + -- ^ Coding mode. (See 'app_voip', 'app_audio', 'app_lowdelay') + } deriving (Eq, Show) + +-- | A 'HasEncoderConfig' typeclass, generated from the definition of +-- 'EncoderConfig' using Template Haskell. This allows us to use 'encoderConfig' +-- to access the 'EncoderConfig' field of e.g. 'StreamConfig'. +makeClassy 'EncoderConfig + +-- | Create a new 'EncoderConfig' with the given sampling rate, stereo mode, and +-- coding mode. Set the second argument to True for stereo mode, and False for +-- mono mode. +mkEncoderConfig :: SamplingRate -> Bool -> CodingMode -> EncoderConfig +mkEncoderConfig = EncoderConfig + +-- | An 'EncoderConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. +instance HasSamplingRate EncoderConfig where + samplingRate = encoderSamplingRate + +-- | An 'EncoderConfig' has a reference to the 'CodingMode' it is meant to be +-- used with. +instance HasCodingMode EncoderConfig where + codingMode = encoderCodingMode + +-- | The configuration of an Opus decoder. Use 'mkDecoderConfig' to create a new +-- 'DecoderConfig'. +data DecoderConfig = DecoderConfig + { _decoderSamplingRate :: SamplingRate + , _decoderIsStereo :: Bool + } deriving (Eq, Show) + +-- | A 'HasDecoderConfig' typeclass, generated from the definition of +-- 'DecoderConfig' using Template Haskell. This allows us to use 'decoderConfig' +-- to access the 'DecoderConfig' field of e.g. 'DecoderStreamConfig'. +makeClassy 'DecoderConfig + +-- | Create a new 'DecoderConfig' with the given sampling rate and stereo mode. +-- Set the second argument to True for stereo mode, and False for mono mode. +mkDecoderConfig :: SamplingRate -> Bool -> DecoderConfig +mkDecoderConfig = DecoderConfig + +-- | A 'DecoderConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. +instance HasSamplingRate DecoderConfig where + samplingRate = decoderSamplingRate + +-- | A type alias for the size of an Opus frame in integers. +type FrameSize = Int + +-- | The configuration of an Opus encoder stream. Use 'mkStreamConfig' to +-- create a new 'StreamConfig'. +data StreamConfig = StreamConfig + { _streamEncoderConfig :: EncoderConfig + , _streamFrameSize :: FrameSize + , _streamOutSize :: Int + } deriving (Eq, Show) + +-- | A 'HasStreamConfig' typeclass, generated from the definition of +-- 'StreamConfig' using Template Haskell. +makeClassy ''StreamConfig + +-- | Create a new 'StreamConfig' with the given 'EncoderConfig', frame size, and +-- output size. +mkStreamConfig :: EncoderConfig -> FrameSize -> Int -> StreamConfig +mkStreamConfig = StreamConfig + +-- | An 'StreamConfig' has a reference to the 'EncoderConfig' it was created +-- with. +instance HasEncoderConfig StreamConfig where + encoderConfig = streamEncoderConfig + +-- | An 'StreamConfig' has a reference to the 'SamplingRate' it is meant to be +-- used with. +instance HasSamplingRate StreamConfig where + samplingRate = encoderConfig . samplingRate + +-- | An 'StreamConfig' has a reference to the 'CodingMode' it is meant to be +-- used with. +instance HasCodingMode StreamConfig where + codingMode = encoderConfig . codingMode + +-- | The configuration of an Opus decoder stream. Use 'mkDecoderStreamConfig' to +-- create a new 'DecoderStreamConfig'. +data DecoderStreamConfig = DecoderStreamConfig + { _deStreamDecoderConfig :: DecoderConfig + , _deStreamFrameSize :: FrameSize + , _deStreamDecodeFec :: Int + } deriving (Eq, Show) + +-- | A 'HasDecoderStreamConfig' typeclass, generated from the definition of +-- 'DecoderStreamConfig' using Template Haskell. +makeClassy ''DecoderStreamConfig + +-- | Create a new 'DecoderStreamConfig' with the given 'DecoderConfig', frame +-- size, and FEC decode flag. +mkDecoderStreamConfig :: DecoderConfig -> FrameSize -> Int -> DecoderStreamConfig +mkDecoderStreamConfig = DecoderStreamConfig + +-- | A 'DecoderStreamConfig' has a reference to the 'DecoderConfig' it was +-- created with. +instance HasDecoderConfig DecoderStreamConfig where + decoderConfig = deStreamDecoderConfig + +-- | A 'DecoderStreamConfig' has a reference to the 'SamplingRate' it is meant +-- to be used with. +instance HasSamplingRate DecoderStreamConfig where + samplingRate = decoderConfig . samplingRate +
+ test/OpusCompare.hs view
@@ -0,0 +1,46 @@+-- | This module is a wrapper around opus_compare.c. +-- Calling 'compareFiles' is equivalent to running the opus_compare executable. +-- Due to conflicting definitions of "main" (one in opus_compare and one in our +-- Haskell program), we assume that opus_compare has been compiled with a define +-- that renames its main function to "opus_compare_main". +module OpusCompare where + +import Codec.Audio.Opus.Internal.Opus +import Foreign +import Foreign.C.Types +import Foreign.C.String + +-- | Channel type +data Channel = Mono | Stereo + deriving (Eq, Show) + +-- | Compares two Opus files using the opus_compare executable code. The result +-- is True if the files are quality-wise identical (which doesn't necessarily +-- mean that they are byte-wise identical due to entropy in the Opus encoding). +-- The result is False if the files are measurably different. +compareFiles :: Channel -> SamplingRate -> FilePath -> FilePath -> IO Bool +compareFiles channel samplingRate filePath1 filePath2 = + withCString "opus_compare" $ \cProgramName -> + withCString "-r" $ \cSROpt -> -- sampling rate option + withCString (show $ unSamplingRate samplingRate) $ \cSRVal -> -- sampling rate value + withCString filePath1 $ \cFile1 -> -- first file + withCString filePath2 $ \cFile2 -> -- second file + if channel == Mono + then allocaArray 5 $ \p -> do + pokeArray p [cProgramName, cSROpt, cSRVal, cFile1, cFile2] + c_opus_compare_main 5 p >>= \r -> return (r == 0) + else withCString "-s" $ \cSOpt -> -- stereo option + allocaArray 6 $ \p -> do + pokeArray p [cProgramName, cSOpt, cSROpt, cSRVal, cFile1, cFile2] + c_opus_compare_main 6 p >>= \r -> return (r == 0) + +-- | Call the opus_compare_main function, which should be the main function +-- within opus_compare.c. We assume that when compiling opus_compare.c, a +-- define was used to rename the main function to "opus_compare_main". +foreign import ccall unsafe "opus_compare_wrapper.c opus_compare_main" + c_opus_compare_main + :: Int + -- ^ number of arguments + -> Ptr (Ptr CChar) + -- ^ arguments + -> IO Int
+ test/Spec.hs view
@@ -0,0 +1,105 @@+module Main(main) where + +import Codec.Audio.Opus.Encoder +import Codec.Audio.Opus.Decoder +import Lens.Micro +import Control.Exception +import Control.Monad (guard, forM_) +import qualified Data.ByteString as B +import Data.Bits +import Data.List +import Data.Word (Word8) +import System.Directory (doesDirectoryExist) +import Test.Hspec +import qualified OpusCompare as Opus + +cfgs :: [EncoderConfig] +cfgs = [mkEncoderConfig sr s c | sr <- srs, s <- ss, c <- cs] + where + srs = [opusSR48k, opusSR24k, opusSR16k, opusSR12k, opusSR8k ] + ss = [True, False] + cs = [app_voip, app_audio, app_lowdelay] + +seqWithCfgs :: Monad m => (EncoderConfig -> m a) -> m () +seqWithCfgs a = sequence_ (a <$> cfgs) + +testEncoderCreate :: HasEncoderConfig cfg => cfg -> SpecWith () +testEncoderCreate cfg = + let n = mconcat [ "create valid ", show $ cfg ^. encoderConfig, " encoder"] + in it n $ + opusEncoderCreate cfg >>= (`shouldSatisfy` const True) + + +onlyIfTestVectorsExist :: IO () -> IO () +onlyIfTestVectorsExist action = do + exists <- doesDirectoryExist "opus_newvectors" + if exists then action else fail "opus_newvectors directory not found" + +decodeFile :: DecoderConfig -> B.ByteString -> IO B.ByteString +decodeFile decoderCfg bytes = do + decoder <- opusDecoderCreate decoderCfg + loop decoder bytes + where + + -- | Convert four unsigned bytes to a 32-bit integer. fromIntegral is + -- applied to each byte before shifting to not lose any bits. + charToInt :: [Word8] -> Int + charToInt (b1:b2:b3:b4:[]) = (fromIntegral b1) `shiftL` 24 .|. (fromIntegral b2) `shiftL` 16 .|. (fromIntegral b3) `shiftL` 8 .|. (fromIntegral b4) + charToInt _ = error "wrong length to convert to int" + + maxPacket, maxFrameSize :: Int + maxPacket = 1500 + maxFrameSize = 48000 * 2 + + -- | A simplified port of the official opus_demo.c file's decoding loop + loop decoder bytes + | B.length bytes < 8 = pure mempty + | otherwise = do + -- lines 649 to 672 in opus_demo.c + let inputLen = charToInt $ B.unpack $ B.take 4 bytes + guard $ inputLen <= maxPacket && inputLen >= 0 -- invalid payload length + + let inputEncFinalRange = charToInt $ B.unpack $ B.take 4 $ B.drop 4 bytes + let (inputData, remaining) = B.splitAt inputLen $ B.drop 8 bytes + guard $ inputLen == B.length inputData -- ran out of input, expecting inputLen but got B.length bytes + + guard $ inputLen /= 0 -- lost packets are not supported for now in this test + + -- line 783 + let outputSamples = maxFrameSize + decoded <- opusDecode decoder (mkDecoderStreamConfig decoderCfg outputSamples 0) inputData + -- recursively continue with the rest + (decoded <>) <$> loop decoder remaining + +main :: IO () +main = hspec $ do + describe "opusEncoderCreate" $ + seqWithCfgs testEncoderCreate + around_ onlyIfTestVectorsExist $ do + -- These tests require the opus test vectors, downloaded from the official + -- opus website. + describe "opus mono test vectors" $ + forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do + it ("mono testvector " <> file) $ do + let decoderCfg = mkDecoderConfig opusSR48k False + B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" + Opus.compareFiles Opus.Mono opusSR48k ("opus_newvectors/testvector" <> file <> "m.dec") "tmp.out" >>= shouldBe True + + describe "opus stereo test vectors" $ + forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do + it ("stereo testvector " <> file) $ do + let decoderCfg = mkDecoderConfig opusSR48k True + B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" + Opus.compareFiles Opus.Stereo opusSR48k ("opus_newvectors/testvector" <> file <> ".dec") "tmp.out" >>= shouldBe True + + +{- + +-} +{- + let testEncoderEncodeWith = testEncoderEncode <$> srs <*> ss <*> cs + describe "opusEncode" $ do +r <- + sequence_ $ testEncoderEncodeWith <*> pure "empty input" <*> pure mempty >>= (`shouldSatisfy` const True) + return () +-}
+ test/opus_compare.c view
@@ -0,0 +1,382 @@+/* Copyright (c) 2011-2012 Xiph.Org Foundation, Mozilla Corporation + Written by Jean-Marc Valin and Timothy B. Terriberry */ +/* + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + - Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + - Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER + OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, + EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR + PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*/ + +#include <stdio.h> +#include <stdlib.h> +#include <math.h> +#include <string.h> + +#define OPUS_PI (3.14159265F) + +#define OPUS_COSF(_x) ((float)cos(_x)) +#define OPUS_SINF(_x) ((float)sin(_x)) + +static void *check_alloc(void *_ptr){ + if(_ptr==NULL){ + fprintf(stderr,"Out of memory.\n"); + exit(EXIT_FAILURE); + } + return _ptr; +} + +static void *opus_malloc(size_t _size){ + return check_alloc(malloc(_size)); +} + +static void *opus_realloc(void *_ptr,size_t _size){ + return check_alloc(realloc(_ptr,_size)); +} + +static size_t read_pcm16(float **_samples,FILE *_fin,int _nchannels){ + unsigned char buf[1024]; + float *samples; + size_t nsamples; + size_t csamples; + size_t xi; + size_t nread; + samples=NULL; + nsamples=csamples=0; + for(;;){ + nread=fread(buf,2*_nchannels,1024/(2*_nchannels),_fin); + if(nread<=0)break; + if(nsamples+nread>csamples){ + do csamples=csamples<<1|1; + while(nsamples+nread>csamples); + samples=(float *)opus_realloc(samples, + _nchannels*csamples*sizeof(*samples)); + } + for(xi=0;xi<nread;xi++){ + int ci; + for(ci=0;ci<_nchannels;ci++){ + int s; + s=buf[2*(xi*_nchannels+ci)+1]<<8|buf[2*(xi*_nchannels+ci)]; + s=((s&0xFFFF)^0x8000)-0x8000; + samples[(nsamples+xi)*_nchannels+ci]=s; + } + } + nsamples+=nread; + } + *_samples=(float *)opus_realloc(samples, + _nchannels*nsamples*sizeof(*samples)); + return nsamples; +} + +static void band_energy(float *_out,float *_ps,const int *_bands,int _nbands, + const float *_in,int _nchannels,size_t _nframes,int _window_sz, + int _step,int _downsample){ + float *window; + float *x; + float *c; + float *s; + size_t xi; + int xj; + int ps_sz; + window=(float *)opus_malloc((3+_nchannels)*_window_sz*sizeof(*window)); + c=window+_window_sz; + s=c+_window_sz; + x=s+_window_sz; + ps_sz=_window_sz/2; + for(xj=0;xj<_window_sz;xj++){ + window[xj]=0.5F-0.5F*OPUS_COSF((2*OPUS_PI/(_window_sz-1))*xj); + } + for(xj=0;xj<_window_sz;xj++){ + c[xj]=OPUS_COSF((2*OPUS_PI/_window_sz)*xj); + } + for(xj=0;xj<_window_sz;xj++){ + s[xj]=OPUS_SINF((2*OPUS_PI/_window_sz)*xj); + } + for(xi=0;xi<_nframes;xi++){ + int ci; + int xk; + int bi; + for(ci=0;ci<_nchannels;ci++){ + for(xk=0;xk<_window_sz;xk++){ + x[ci*_window_sz+xk]=window[xk]*_in[(xi*_step+xk)*_nchannels+ci]; + } + } + for(bi=xj=0;bi<_nbands;bi++){ + float p[2]={0}; + for(;xj<_bands[bi+1];xj++){ + for(ci=0;ci<_nchannels;ci++){ + float re; + float im; + int ti; + ti=0; + re=im=0; + for(xk=0;xk<_window_sz;xk++){ + re+=c[ti]*x[ci*_window_sz+xk]; + im-=s[ti]*x[ci*_window_sz+xk]; + ti+=xj; + if(ti>=_window_sz)ti-=_window_sz; + } + re*=_downsample; + im*=_downsample; + _ps[(xi*ps_sz+xj)*_nchannels+ci]=re*re+im*im+100000; + p[ci]+=_ps[(xi*ps_sz+xj)*_nchannels+ci]; + } + } + if(_out){ + _out[(xi*_nbands+bi)*_nchannels]=p[0]/(_bands[bi+1]-_bands[bi]); + if(_nchannels==2){ + _out[(xi*_nbands+bi)*_nchannels+1]=p[1]/(_bands[bi+1]-_bands[bi]); + } + } + } + } + free(window); +} + +#define NBANDS (21) +#define NFREQS (240) + +/*Bands on which we compute the pseudo-NMR (Bark-derived + CELT bands).*/ +static const int BANDS[NBANDS+1]={ + 0,2,4,6,8,10,12,14,16,20,24,28,32,40,48,56,68,80,96,120,156,200 +}; + +#define TEST_WIN_SIZE (480) +#define TEST_WIN_STEP (120) + +int main(int _argc,const char **_argv){ + FILE *fin1; + FILE *fin2; + float *x; + float *y; + float *xb; + float *X; + float *Y; + double err; + float Q; + size_t xlength; + size_t ylength; + size_t nframes; + size_t xi; + int ci; + int xj; + int bi; + int nchannels; + unsigned rate; + int downsample; + int ybands; + int yfreqs; + int max_compare; + if(_argc<3||_argc>6){ + fprintf(stderr,"Usage: %s [-s] [-r rate2] <file1.sw> <file2.sw>\n", + _argv[0]); + return EXIT_FAILURE; + } + nchannels=1; + if(strcmp(_argv[1],"-s")==0){ + nchannels=2; + _argv++; + } + rate=48000; + ybands=NBANDS; + yfreqs=NFREQS; + downsample=1; + if(strcmp(_argv[1],"-r")==0){ + rate=atoi(_argv[2]); + if(rate!=8000&&rate!=12000&&rate!=16000&&rate!=24000&&rate!=48000){ + fprintf(stderr, + "Sampling rate must be 8000, 12000, 16000, 24000, or 48000\n"); + return EXIT_FAILURE; + } + downsample=48000/rate; + switch(rate){ + case 8000:ybands=13;break; + case 12000:ybands=15;break; + case 16000:ybands=17;break; + case 24000:ybands=19;break; + } + yfreqs=NFREQS/downsample; + _argv+=2; + } + fin1=fopen(_argv[1],"rb"); + if(fin1==NULL){ + fprintf(stderr,"Error opening '%s'.\n",_argv[1]); + return EXIT_FAILURE; + } + fin2=fopen(_argv[2],"rb"); + if(fin2==NULL){ + fprintf(stderr,"Error opening '%s'.\n",_argv[2]); + fclose(fin1); + return EXIT_FAILURE; + } + /*Read in the data and allocate scratch space.*/ + xlength=read_pcm16(&x,fin1,2); + if(nchannels==1){ + for(xi=0;xi<xlength;xi++)x[xi]=.5*(x[2*xi]+x[2*xi+1]); + } + fclose(fin1); + ylength=read_pcm16(&y,fin2,nchannels); + fclose(fin2); + if(xlength!=ylength*downsample){ + fprintf(stderr,"Sample counts do not match (%lu!=%lu).\n", + (unsigned long)xlength,(unsigned long)ylength*downsample); + return EXIT_FAILURE; + } + if(xlength<TEST_WIN_SIZE){ + fprintf(stderr,"Insufficient sample data (%lu<%i).\n", + (unsigned long)xlength,TEST_WIN_SIZE); + return EXIT_FAILURE; + } + nframes=(xlength-TEST_WIN_SIZE+TEST_WIN_STEP)/TEST_WIN_STEP; + xb=(float *)opus_malloc(nframes*NBANDS*nchannels*sizeof(*xb)); + X=(float *)opus_malloc(nframes*NFREQS*nchannels*sizeof(*X)); + Y=(float *)opus_malloc(nframes*yfreqs*nchannels*sizeof(*Y)); + /*Compute the per-band spectral energy of the original signal + and the error.*/ + band_energy(xb,X,BANDS,NBANDS,x,nchannels,nframes, + TEST_WIN_SIZE,TEST_WIN_STEP,1); + free(x); + band_energy(NULL,Y,BANDS,ybands,y,nchannels,nframes, + TEST_WIN_SIZE/downsample,TEST_WIN_STEP/downsample,downsample); + free(y); + for(xi=0;xi<nframes;xi++){ + /*Frequency masking (low to high): 10 dB/Bark slope.*/ + for(bi=1;bi<NBANDS;bi++){ + for(ci=0;ci<nchannels;ci++){ + xb[(xi*NBANDS+bi)*nchannels+ci]+= + 0.1F*xb[(xi*NBANDS+bi-1)*nchannels+ci]; + } + } + /*Frequency masking (high to low): 15 dB/Bark slope.*/ + for(bi=NBANDS-1;bi-->0;){ + for(ci=0;ci<nchannels;ci++){ + xb[(xi*NBANDS+bi)*nchannels+ci]+= + 0.03F*xb[(xi*NBANDS+bi+1)*nchannels+ci]; + } + } + if(xi>0){ + /*Temporal masking: -3 dB/2.5ms slope.*/ + for(bi=0;bi<NBANDS;bi++){ + for(ci=0;ci<nchannels;ci++){ + xb[(xi*NBANDS+bi)*nchannels+ci]+= + 0.5F*xb[((xi-1)*NBANDS+bi)*nchannels+ci]; + } + } + } + /* Allowing some cross-talk */ + if(nchannels==2){ + for(bi=0;bi<NBANDS;bi++){ + float l,r; + l=xb[(xi*NBANDS+bi)*nchannels+0]; + r=xb[(xi*NBANDS+bi)*nchannels+1]; + xb[(xi*NBANDS+bi)*nchannels+0]+=0.01F*r; + xb[(xi*NBANDS+bi)*nchannels+1]+=0.01F*l; + } + } + + /* Apply masking */ + for(bi=0;bi<ybands;bi++){ + for(xj=BANDS[bi];xj<BANDS[bi+1];xj++){ + for(ci=0;ci<nchannels;ci++){ + X[(xi*NFREQS+xj)*nchannels+ci]+= + 0.1F*xb[(xi*NBANDS+bi)*nchannels+ci]; + Y[(xi*yfreqs+xj)*nchannels+ci]+= + 0.1F*xb[(xi*NBANDS+bi)*nchannels+ci]; + } + } + } + } + + /* Average of consecutive frames to make comparison slightly less sensitive */ + for(bi=0;bi<ybands;bi++){ + for(xj=BANDS[bi];xj<BANDS[bi+1];xj++){ + for(ci=0;ci<nchannels;ci++){ + float xtmp; + float ytmp; + xtmp = X[xj*nchannels+ci]; + ytmp = Y[xj*nchannels+ci]; + for(xi=1;xi<nframes;xi++){ + float xtmp2; + float ytmp2; + xtmp2 = X[(xi*NFREQS+xj)*nchannels+ci]; + ytmp2 = Y[(xi*yfreqs+xj)*nchannels+ci]; + X[(xi*NFREQS+xj)*nchannels+ci] += xtmp; + Y[(xi*yfreqs+xj)*nchannels+ci] += ytmp; + xtmp = xtmp2; + ytmp = ytmp2; + } + } + } + } + + /*If working at a lower sampling rate, don't take into account the last + 300 Hz to allow for different transition bands. + For 12 kHz, we don't skip anything, because the last band already skips + 400 Hz.*/ + if(rate==48000)max_compare=BANDS[NBANDS]; + else if(rate==12000)max_compare=BANDS[ybands]; + else max_compare=BANDS[ybands]-3; + err=0; + for(xi=0;xi<nframes;xi++){ + double Ef; + Ef=0; + for(bi=0;bi<ybands;bi++){ + double Eb; + Eb=0; + for(xj=BANDS[bi];xj<BANDS[bi+1]&&xj<max_compare;xj++){ + for(ci=0;ci<nchannels;ci++){ + float re; + float im; + re=Y[(xi*yfreqs+xj)*nchannels+ci]/X[(xi*NFREQS+xj)*nchannels+ci]; + im=re-log(re)-1; + /*Make comparison less sensitive around the SILK/CELT cross-over to + allow for mode freedom in the filters.*/ + if(xj>=79&&xj<=81)im*=0.1F; + if(xj==80)im*=0.1F; + Eb+=im; + } + } + Eb /= (BANDS[bi+1]-BANDS[bi])*nchannels; + Ef += Eb*Eb; + } + /*Using a fixed normalization value means we're willing to accept slightly + lower quality for lower sampling rates.*/ + Ef/=NBANDS; + Ef*=Ef; + err+=Ef*Ef; + } + free(xb); + free(X); + free(Y); + err=pow(err/nframes,1.0/16); + Q=100*(1-0.5*log(1+err)/log(1.13)); + if(Q<0){ + fprintf(stderr,"Test vector FAILS\n"); + fprintf(stderr,"Internal weighted error is %f\n",err); + return EXIT_FAILURE; + } + else{ + fprintf(stderr,"Test vector PASSES\n"); + fprintf(stderr, + "Opus quality metric: %.1f %% (internal weighted error is %f)\n",Q,err); + return EXIT_SUCCESS; + } +}
+ test/opus_compare_wrapper.c view
@@ -0,0 +1,17 @@+// A wrapper for opus_compare.c which renames the main symbol to avoid conflits +// with Haskell, and which disables the use of fprintf. + +// First, include stdio to prevent the fprintf definition later from breaking +// the definition of fprintf +#include <stdio.h> + +// Rewrite main to opus_compare_main to prevent conflits when FFI-ed +#define main opus_compare_main + +// Rewrite all fprintf to a no-op +#define fprintf(out,fmt,...) +#include "opus_compare.c" + +// Undefine main and fprintf for safety +#undef main +#undef fprintf