From 5ef386041c4f001826d57dff4b406535010924a5 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sat, 8 May 2021 15:23:32 +0100 Subject: [PATCH 01/15] Begin attempting to create a decoder --- opus.cabal | 1 + src/Codec/Audio/Opus/Decoder.hs | 115 +++++++++++++++++++++++++ src/Codec/Audio/Opus/Encoder.hs | 1 - src/Codec/Audio/Opus/Internal/Opus.hsc | 25 ++++++ src/Codec/Audio/Opus/Types.hs | 31 +++++++ 5 files changed, 172 insertions(+), 1 deletion(-) create mode 100644 src/Codec/Audio/Opus/Decoder.hs diff --git a/opus.cabal b/opus.cabal index 05be07b..3357326 100644 --- a/opus.cabal +++ b/opus.cabal @@ -20,6 +20,7 @@ library hs-source-dirs: src exposed-modules: Codec.Audio.Opus.Encoder, Codec.Audio.Opus.Encoder.Conduit, + Codec.Audio.Opus.Decoder, Codec.Audio.Opus.Types, Codec.Audio.Opus.Internal.Opus default-language: Haskell2010 diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs new file mode 100644 index 0000000..042164f --- /dev/null +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE FlexibleContexts #-} + +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 Control.Lens.Fold +import Control.Lens.Operators +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 +import Foreign.C.Types (CShort) + +-- | Decoder State +newtype Decoder = Decoder (ForeignPtr DecoderT, ForeignPtr ErrorCode) + deriving (Eq, Ord, Show) + +-- | allocates and initializes a decoder state. +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 -- ^ max data bytes + -> 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-- * sizeOf(undefined :: CShort) + in liftIO $ + BS.useAsCStringLen i $ \(i', ilen) -> + allocaArray pcm_length $ \os -> + runDecoderAction d $ \d' -> do + r <- c_opus_decode d' (castPtr i') (fromIntegral ilen) os + (fromIntegral fs) (fromIntegral fec) + let l = fromIntegral r + if l < 0 then do + let mbException = preview _ErrorCodeException $ ErrorCode l + case mbException of + Nothing -> throwM OpusInvalidPacket + Just x -> throwM x + else do + BS.packCStringLen $ (castPtr os, fromIntegral l) + + +opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) + => Decoder -- ^ 'Decoder' state + -> cfg + -> ByteString -- ^ input signal (interleaved if 2 channels) + -> m BL.ByteString +opusDecodeLazy d cfg = fmap BL.fromStrict . opusDecode d cfg + +withOpusDecoder :: (HasDecoderConfig cfg) => MonadResource m + => cfg + -> (Decoder -> IO ()) + -> m Decoder +withOpusDecoder cfg a = + snd <$> allocate (opusDecoderCreate cfg) a + + +-- | Frees an 'Decoder'. Is normaly called automaticly +-- when 'Decoder' gets out of scope +opusDecoderDestroy :: MonadIO m => Decoder -> m () +opusDecoderDestroy (Decoder (d, err)) = liftIO $ + finalizeForeignPtr d >> finalizeForeignPtr err + + +-- | get last error from decoder +opusLastError :: MonadIO m => Decoder -> m (Maybe OpusException) +opusLastError (Decoder (_, fp)) = + liftIO $ preview _ErrorCodeException <$> withForeignPtr fp peek + +type DecoderAction a = Ptr DecoderT -> IO a + +-- | Run an 'DecoderAction'. +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 an 'DecoderAction'. Might throw an 'OpusException' +runDecoderAction :: (MonadIO m, MonadThrow m) => + Decoder -> DecoderAction a -> m a +runDecoderAction d m = withDecoder' d m >>= either throwM pure diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index 324427b..adee4ec 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -63,7 +63,6 @@ opusEncode e cfg i = if l < 0 then throwM OpusInvalidPacket else BS.packCStringLen ol - opusEncodeLazy :: (HasStreamConfig cfg, MonadIO m) => Encoder -- ^ 'Encoder' state -> cfg diff --git a/src/Codec/Audio/Opus/Internal/Opus.hsc b/src/Codec/Audio/Opus/Internal/Opus.hsc index a741e29..ee6c582 100644 --- a/src/Codec/Audio/Opus/Internal/Opus.hsc +++ b/src/Codec/Audio/Opus/Internal/Opus.hsc @@ -77,6 +77,7 @@ instance Show SamplingRate where show (SamplingRate r) = mconcat [show $ r `div` 1000, "kHz"] data EncoderT +data DecoderT -- | allocates and initializes an encoder state. @@ -102,3 +103,27 @@ foreign import ccall unsafe "opus.h opus_encode" -> 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' +foreign import ccall unsafe "opus.h &opus_decoder_destroy" + cp_opus_decoder_destroy + :: FunPtr (Ptr DecoderT -> IO ()) + +foreign import ccall unsafe "opus.h opus_decode" + c_opus_decode + :: Ptr DecoderT -- ^ Decoder state + -> CString -- ^ 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 + diff --git a/src/Codec/Audio/Opus/Types.hs b/src/Codec/Audio/Opus/Types.hs index 518c216..f866ac5 100644 --- a/src/Codec/Audio/Opus/Types.hs +++ b/src/Codec/Audio/Opus/Types.hs @@ -11,8 +11,12 @@ module Codec.Audio.Opus.Types -- * EncoderConfig , FrameSize , EncoderConfig, HasEncoderConfig(..), _EncoderConfig + -- * DecoderConfig + , DecoderConfig, HasDecoderConfig(..), _DecoderConfig -- * StreamConfig , StreamConfig, HasStreamConfig(..), _StreamConfig + -- * DecoderStreamConfig + , DecoderStreamConfig, HasDecoderStreamConfig(..), _DecoderStreamConfig ) where import Codec.Audio.Opus.Internal.Opus @@ -79,6 +83,17 @@ instance HasSamplingRate EncoderConfig where instance HasCodingMode EncoderConfig where codingMode = encoderCodingMode +data DecoderConfig = DecoderConfig + { _decoderSamplingRate :: SamplingRate + , _decoderIsStereo :: Bool + } deriving (Eq, Show) + +makeClassy 'DecoderConfig +makePrisms 'DecoderConfig + +instance HasSamplingRate DecoderConfig where + samplingRate = decoderSamplingRate + type FrameSize = Int @@ -99,3 +114,19 @@ instance HasSamplingRate StreamConfig where instance HasCodingMode StreamConfig where codingMode = encoderConfig . codingMode + +data DecoderStreamConfig = DecoderStreamConfig + { _deStreamDecoderConfig :: DecoderConfig + , _deStreamFrameSize :: FrameSize + , _deStreamDecodeFec :: Int + } deriving (Eq, Show) + +makeClassy ''DecoderStreamConfig +makePrisms ''DecoderStreamConfig + +instance HasDecoderConfig DecoderStreamConfig where + decoderConfig = deStreamDecoderConfig + +instance HasSamplingRate DecoderStreamConfig where + samplingRate = decoderConfig . samplingRate + From 2821ebd1574fe115caedede5ff72a7926d2ba4fc Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 May 2021 16:03:52 +0100 Subject: [PATCH 02/15] Remove unnecessary casting, fix length being halved --- src/Codec/Audio/Opus/Decoder.hs | 11 ++++++----- src/Codec/Audio/Opus/Internal/Opus.hsc | 2 +- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index 042164f..cfb85fa 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -59,17 +59,18 @@ opusDecode d cfg i = BS.useAsCStringLen i $ \(i', ilen) -> allocaArray pcm_length $ \os -> runDecoderAction d $ \d' -> do - r <- c_opus_decode d' (castPtr i') (fromIntegral ilen) os + r <- c_opus_decode d' i' (fromIntegral ilen) os (fromIntegral fs) (fromIntegral fec) let l = fromIntegral r if l < 0 then do - let mbException = preview _ErrorCodeException $ ErrorCode l + let mbException = ErrorCode l ^? _ErrorCodeException case mbException of Nothing -> throwM OpusInvalidPacket Just x -> throwM x - else do - BS.packCStringLen $ (castPtr os, fromIntegral l) - + else + -- multiply length by two because "os" is CShort i.e. Int16 + -- but CStringLen expects a CChar which is Int8 + BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2) opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) => Decoder -- ^ 'Decoder' state diff --git a/src/Codec/Audio/Opus/Internal/Opus.hsc b/src/Codec/Audio/Opus/Internal/Opus.hsc index ee6c582..29722ea 100644 --- a/src/Codec/Audio/Opus/Internal/Opus.hsc +++ b/src/Codec/Audio/Opus/Internal/Opus.hsc @@ -120,7 +120,7 @@ foreign import ccall unsafe "opus.h &opus_decoder_destroy" foreign import ccall unsafe "opus.h opus_decode" c_opus_decode :: Ptr DecoderT -- ^ Decoder state - -> CString -- ^ Byte array of compressed data + -> 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 From 0e894e3733bb426ab438101b2480ee9ff952da69 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 May 2021 16:13:57 +0100 Subject: [PATCH 03/15] Add back sizeOf --- src/Codec/Audio/Opus/Decoder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index cfb85fa..672b67b 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -54,7 +54,7 @@ opusDecode d cfg i = fec = cfg ^. deStreamDecodeFec conf = cfg ^. deStreamDecoderConfig chans = if conf ^. decoderIsStereo then 2 else 1 - pcm_length = fs * chans-- * sizeOf(undefined :: CShort) + pcm_length = fs * chans * sizeOf(undefined :: CShort) in liftIO $ BS.useAsCStringLen i $ \(i', ilen) -> allocaArray pcm_length $ \os -> From 742a6dc94300d6d8998926e2225dcb455c75cc10 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 May 2021 16:35:01 +0100 Subject: [PATCH 04/15] Dynamically calculate the multiple of CShort and CChar --- src/Codec/Audio/Opus/Decoder.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index 672b67b..cb0e9bb 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -22,7 +22,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Foreign -import Foreign.C.Types (CShort) +import Foreign.C.Types (CShort + ,CChar + ) -- | Decoder State newtype Decoder = Decoder (ForeignPtr DecoderT, ForeignPtr ErrorCode) @@ -54,7 +56,7 @@ opusDecode d cfg i = fec = cfg ^. deStreamDecodeFec conf = cfg ^. deStreamDecoderConfig chans = if conf ^. decoderIsStereo then 2 else 1 - pcm_length = fs * chans * sizeOf(undefined :: CShort) + pcm_length = fs * chans in liftIO $ BS.useAsCStringLen i $ \(i', ilen) -> allocaArray pcm_length $ \os -> @@ -67,10 +69,11 @@ opusDecode d cfg i = case mbException of Nothing -> throwM OpusInvalidPacket Just x -> throwM x - else + else do -- multiply length by two because "os" is CShort i.e. Int16 -- but CStringLen expects a CChar which is Int8 - BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2) + let multiple = sizeOf (undefined :: CShort) `div` sizeOf (undefined :: CChar) + BS.packCStringLen $ (castPtr os, (fromIntegral l) * multiple) opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) => Decoder -- ^ 'Decoder' state From ed9de2c3546e2c78f045ca9784ceec35e427134d Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sun, 6 Jun 2021 18:53:25 +0100 Subject: [PATCH 05/15] Add a bunch of print statements... --- src/Codec/Audio/Opus/Encoder.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index adee4ec..165250c 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -53,11 +53,15 @@ opusEncode e cfg i = let fs = cfg ^. streamFrameSize n = cfg ^. streamOutSize in liftIO $ - BS.useAsCString i $ \i' -> - allocaArray n $ \os -> + BS.useAsCString i $ \i' -> do + print "cstring made" + allocaArray n $ \os -> do + print $ "allocated array of size " <> (show n) runEncoderAction e $ \e' -> do + print "encoder is in hand" r <- c_opus_encode e' (castPtr i') (fromInteger . toInteger $ fs) os (fromInteger . toInteger $ n) + print "encoded" let l = fromInteger . toInteger $ r ol = (os, l) if l < 0 then throwM OpusInvalidPacket else From ce7262bb476a108e77273ae17c983b3edc020b26 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sun, 6 Jun 2021 18:53:36 +0100 Subject: [PATCH 06/15] Format long line --- src/Codec/Audio/Opus/Decoder.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index cb0e9bb..036a9cc 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -70,9 +70,10 @@ opusDecode d cfg i = Nothing -> throwM OpusInvalidPacket Just x -> throwM x else do - -- multiply length by two because "os" is CShort i.e. Int16 + -- multiply length because "os" is CShort i.e. Int16 -- but CStringLen expects a CChar which is Int8 - let multiple = sizeOf (undefined :: CShort) `div` sizeOf (undefined :: CChar) + let multiple = sizeOf (undefined :: CShort) `div` + sizeOf (undefined :: CChar) BS.packCStringLen $ (castPtr os, (fromIntegral l) * multiple) opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) From cf53b7d1c931c4f1d4587f7dcf84b95639b9fea5 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sun, 6 Jun 2021 19:24:58 +0100 Subject: [PATCH 07/15] More debug prints, as there is a segfault that can't be identified --- src/Codec/Audio/Opus/Encoder.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index 165250c..f302fbb 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -21,6 +21,7 @@ import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL +import Foreign.C.Types (CShort) import Foreign -- | Encoder State @@ -54,7 +55,7 @@ opusEncode e cfg i = n = cfg ^. streamOutSize in liftIO $ BS.useAsCString i $ \i' -> do - print "cstring made" + print $ "cstring made from bs of length" <> (show $ BS.length i) <> " this should be equal to " <> (show $ fs * 2 * sizeOf (undefined :: CShort)) allocaArray n $ \os -> do print $ "allocated array of size " <> (show n) runEncoderAction e $ \e' -> do From 4f540b726763edef82a5b3776c57b8ff99846199 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sun, 6 Jun 2021 19:33:12 +0100 Subject: [PATCH 08/15] Change useAsCString to useAsCStringLen --- src/Codec/Audio/Opus/Encoder.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index f302fbb..86932f8 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -21,7 +21,6 @@ import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL -import Foreign.C.Types (CShort) import Foreign -- | Encoder State @@ -54,8 +53,8 @@ opusEncode e cfg i = let fs = cfg ^. streamFrameSize n = cfg ^. streamOutSize in liftIO $ - BS.useAsCString i $ \i' -> do - print $ "cstring made from bs of length" <> (show $ BS.length i) <> " this should be equal to " <> (show $ fs * 2 * sizeOf (undefined :: CShort)) + BS.useAsCStringLen i $ \(i',_) -> do + print $ "cstring made from bs" allocaArray n $ \os -> do print $ "allocated array of size " <> (show n) runEncoderAction e $ \e' -> do From 6ebb1d5e7d1583bb4dd881ae0edc1415a6bfefdf Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Sun, 6 Jun 2021 21:05:15 +0100 Subject: [PATCH 09/15] Revert all debug commits --- src/Codec/Audio/Opus/Decoder.hs | 9 ++------- src/Codec/Audio/Opus/Encoder.hs | 8 ++------ 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index 036a9cc..31ba016 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -22,9 +22,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Foreign -import Foreign.C.Types (CShort - ,CChar - ) -- | Decoder State newtype Decoder = Decoder (ForeignPtr DecoderT, ForeignPtr ErrorCode) @@ -70,11 +67,9 @@ opusDecode d cfg i = Nothing -> throwM OpusInvalidPacket Just x -> throwM x else do - -- multiply length because "os" is CShort i.e. Int16 + -- multiply by 2 because "os" is CShort i.e. Int16 -- but CStringLen expects a CChar which is Int8 - let multiple = sizeOf (undefined :: CShort) `div` - sizeOf (undefined :: CChar) - BS.packCStringLen $ (castPtr os, (fromIntegral l) * multiple) + BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2) opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) => Decoder -- ^ 'Decoder' state diff --git a/src/Codec/Audio/Opus/Encoder.hs b/src/Codec/Audio/Opus/Encoder.hs index 86932f8..adee4ec 100644 --- a/src/Codec/Audio/Opus/Encoder.hs +++ b/src/Codec/Audio/Opus/Encoder.hs @@ -53,15 +53,11 @@ opusEncode e cfg i = let fs = cfg ^. streamFrameSize n = cfg ^. streamOutSize in liftIO $ - BS.useAsCStringLen i $ \(i',_) -> do - print $ "cstring made from bs" - allocaArray n $ \os -> do - print $ "allocated array of size " <> (show n) + BS.useAsCString i $ \i' -> + allocaArray n $ \os -> runEncoderAction e $ \e' -> do - print "encoder is in hand" r <- c_opus_encode e' (castPtr i') (fromInteger . toInteger $ fs) os (fromInteger . toInteger $ n) - print "encoded" let l = fromInteger . toInteger $ r ol = (os, l) if l < 0 then throwM OpusInvalidPacket else From 707ff27025be74b76575968106e45a74fe01cfda Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 19:46:33 +0000 Subject: [PATCH 10/15] Add process dependency in cabal test suite --- opus.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/opus.cabal b/opus.cabal index 3357326..b7b9052 100644 --- a/opus.cabal +++ b/opus.cabal @@ -55,4 +55,5 @@ test-suite hs-mumble-test http-client-tls, zlib, lens, - tar + tar, + process From 6f05586fd7a2654369761f3dbb7b45f41bd16f78 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 19:59:07 +0000 Subject: [PATCH 11/15] Add opus mono test vector tests --- test/Spec.hs | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 07016eb..f448ae9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,8 +1,16 @@ module Main(main) where import Codec.Audio.Opus.Encoder +import Codec.Audio.Opus.Decoder import Control.Lens.Operators --- import qualified Data.ByteString as BS +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.Exit +import System.Process import Test.Hspec @@ -23,11 +31,72 @@ testEncoderCreate cfg = opusEncoderCreate cfg >>= (`shouldSatisfy` const True) +onlyIfOpusCompareExists :: IO () -> IO () +onlyIfOpusCompareExists action = do + result <- try $ readProcessWithExitCode "./opus_compare" [] "" + case (result :: Either IOException (ExitCode, String, String)) of + Right (ExitFailure 1, _, _) -> action + _ -> fail "opus_compare executable not found" + +decodeFile :: Decoder -> B.ByteString -> IO B.ByteString +decodeFile decoder bytes = do + decoder <- opusDecoderCreate decoderCfg + loop 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" + + decoderCfg :: DecoderConfig + decoderCfg = _DecoderConfig # (opusSR48k, False) + + maxPacket, maxFrameSize :: Int + maxPacket = 1500 + maxFrameSize = 48000 * 2 + + loop bytes + | B.length bytes < 8 = pure mempty + | otherwise = do + 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 + + -- assumptions: no lost packets. no inband fec. + let outputSamples = maxFrameSize + decoded <- opusDecode decoder (_DecoderStreamConfig # (decoderCfg, outputSamples, 0)) inputData + (decoded <>) <$> loop remaining main :: IO () main = hspec $ do describe "opusEncoderCreate" $ seqWithCfgs testEncoderCreate + around_ onlyIfOpusCompareExists $ do + describe "opus mono test vectors" $ do + forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do + it ("Testing testvector " <> file) $ do + decoder <- opusDecoderCreate (_DecoderConfig # (opusSR48k, False)) + B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoder >>= B.writeFile "tmp.out" + -- Use readProcessWithExitCode to account for the fact that opus_compare + -- returns a non-zero exit code if the comparing fails. + (exitcode1, stdout1, error1) <- readProcessWithExitCode "./opus_compare" + ["-r", "48000" + , "opus_newvectors/testvector" <> file <> ".dec" + , "tmp.out" + ] "" + (exitcode2, stdout2, error2) <- readProcessWithExitCode "./opus_compare" + ["-r", "48000" + , "opus_newvectors/testvector" <> file <> "m.dec" + , "tmp.out" + ] "" + shouldSatisfy (error1, error2) $ \(a, b) -> "PASSES" `isInfixOf` a || "PASSES" `isInfixOf` b {- From c059121ae61237ea2b1ff6e09bd2068dcbad79b2 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 20:02:16 +0000 Subject: [PATCH 12/15] Add comments in Spec.hs --- test/Spec.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index f448ae9..7974ed4 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -57,9 +57,11 @@ decodeFile decoder bytes = do maxPacket = 1500 maxFrameSize = 48000 * 2 + -- | A simplified port of the official opus_demo.c file's decoding loop loop 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 @@ -69,9 +71,10 @@ decodeFile decoder bytes = do guard $ inputLen /= 0 -- lost packets are not supported for now in this test - -- assumptions: no lost packets. no inband fec. + -- line 783 let outputSamples = maxFrameSize decoded <- opusDecode decoder (_DecoderStreamConfig # (decoderCfg, outputSamples, 0)) inputData + -- recursively continue with the rest (decoded <>) <$> loop remaining main :: IO () @@ -79,6 +82,9 @@ main = hspec $ do describe "opusEncoderCreate" $ seqWithCfgs testEncoderCreate around_ onlyIfOpusCompareExists $ do + -- These tests require the opus_compare executable to be present in the + -- project root, and the opus test vectors, downloaded from the official + -- opus website. describe "opus mono test vectors" $ do forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do it ("Testing testvector " <> file) $ do From fd03a3543247796fd2c9d740c535a6f29aeb741c Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 21:10:09 +0000 Subject: [PATCH 13/15] Add a Decoder Conduit --- opus.cabal | 1 + src/Codec/Audio/Opus/Decoder/Conduit.hs | 31 +++++++++++++++++++++++++ 2 files changed, 32 insertions(+) create mode 100644 src/Codec/Audio/Opus/Decoder/Conduit.hs diff --git a/opus.cabal b/opus.cabal index b7b9052..e5e60e9 100644 --- a/opus.cabal +++ b/opus.cabal @@ -21,6 +21,7 @@ library 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 diff --git a/src/Codec/Audio/Opus/Decoder/Conduit.hs b/src/Codec/Audio/Opus/Decoder/Conduit.hs new file mode 100644 index 0000000..bf3c46e --- /dev/null +++ b/src/Codec/Audio/Opus/Decoder/Conduit.hs @@ -0,0 +1,31 @@ +module Codec.Audio.Opus.Decoder.Conduit + ( decoderC, decoderLazyC + , decoderSink + ) where + +import Codec.Audio.Opus.Decoder +import Conduit +import Control.Lens.Operators +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Conduit.Combinators +import Prelude (($)) + +decoderC :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString ByteString m () +decoderC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> mapM (opusDecode d cfg) + +decoderLazyC :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString BL.ByteString m () +decoderLazyC cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> mapM (opusDecodeLazy d cfg) + +decoderSink :: (HasDecoderStreamConfig cfg, MonadResource m) => + cfg -> ConduitT ByteString o m BL.ByteString +decoderSink cfg = withDecoder (cfg ^. deStreamDecoderConfig) $ + \d -> foldMapM (opusDecodeLazy d cfg) + +withDecoder :: (HasDecoderConfig cfg, MonadResource m) => + cfg -> (Decoder -> ConduitT i o m r) -> ConduitT i o m r +withDecoder cfg = bracketP (opusDecoderCreate cfg) opusDecoderDestroy From fa11458977e638bf38cf654739b1e03681e005f9 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 21:36:28 +0000 Subject: [PATCH 14/15] Add stereo test vector tests --- test/Spec.hs | 42 ++++++++++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 7974ed4..fd6a26a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -38,10 +38,10 @@ onlyIfOpusCompareExists action = do Right (ExitFailure 1, _, _) -> action _ -> fail "opus_compare executable not found" -decodeFile :: Decoder -> B.ByteString -> IO B.ByteString -decodeFile decoder bytes = do +decodeFile :: DecoderConfig -> B.ByteString -> IO B.ByteString +decodeFile decoderCfg bytes = do decoder <- opusDecoderCreate decoderCfg - loop bytes + loop decoder bytes where -- | Convert four unsigned bytes to a 32-bit integer. fromIntegral is @@ -50,15 +50,12 @@ decodeFile decoder bytes = do 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" - decoderCfg :: DecoderConfig - decoderCfg = _DecoderConfig # (opusSR48k, False) - maxPacket, maxFrameSize :: Int maxPacket = 1500 maxFrameSize = 48000 * 2 -- | A simplified port of the official opus_demo.c file's decoding loop - loop bytes + loop decoder bytes | B.length bytes < 8 = pure mempty | otherwise = do -- lines 649 to 672 in opus_demo.c @@ -75,7 +72,7 @@ decodeFile decoder bytes = do let outputSamples = maxFrameSize decoded <- opusDecode decoder (_DecoderStreamConfig # (decoderCfg, outputSamples, 0)) inputData -- recursively continue with the rest - (decoded <>) <$> loop remaining + (decoded <>) <$> loop decoder remaining main :: IO () main = hspec $ do @@ -85,11 +82,11 @@ main = hspec $ do -- These tests require the opus_compare executable to be present in the -- project root, and the opus test vectors, downloaded from the official -- opus website. - describe "opus mono test vectors" $ do + describe "opus mono test vectors" $ forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do - it ("Testing testvector " <> file) $ do - decoder <- opusDecoderCreate (_DecoderConfig # (opusSR48k, False)) - B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoder >>= B.writeFile "tmp.out" + it ("mono testvector " <> file) $ do + let decoderCfg = _DecoderConfig # (opusSR48k, False) + B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" -- Use readProcessWithExitCode to account for the fact that opus_compare -- returns a non-zero exit code if the comparing fails. (exitcode1, stdout1, error1) <- readProcessWithExitCode "./opus_compare" @@ -104,6 +101,27 @@ main = hspec $ do ] "" shouldSatisfy (error1, error2) $ \(a, b) -> "PASSES" `isInfixOf` a || "PASSES" `isInfixOf` b + 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 = _DecoderConfig # (opusSR48k, True) + B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" + -- Use readProcessWithExitCode to account for the fact that opus_compare + -- returns a non-zero exit code if the comparing fails. + (exitcode1, stdout1, error1) <- readProcessWithExitCode "./opus_compare" + [ "-s" + , "-r", "48000" + , "opus_newvectors/testvector" <> file <> ".dec" + , "tmp.out" + ] "" + (exitcode2, stdout2, error2) <- readProcessWithExitCode "./opus_compare" + [ "-s" + , "-r", "48000" + , "opus_newvectors/testvector" <> file <> "m.dec" + , "tmp.out" + ] "" + shouldSatisfy (error1, error2) $ \(a, b) -> "PASSES" `isInfixOf` a || "PASSES" `isInfixOf` b + {- From ace2ef14109b4cdbec74cfd5606f27261854b210 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Tue, 11 Jan 2022 21:36:40 +0000 Subject: [PATCH 15/15] Fix bug with stereo output size being half of expected --- src/Codec/Audio/Opus/Decoder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Codec/Audio/Opus/Decoder.hs b/src/Codec/Audio/Opus/Decoder.hs index 31ba016..eddec1f 100644 --- a/src/Codec/Audio/Opus/Decoder.hs +++ b/src/Codec/Audio/Opus/Decoder.hs @@ -69,7 +69,7 @@ opusDecode d cfg i = 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) + BS.packCStringLen $ (castPtr os, (fromIntegral l) * 2 * chans) opusDecodeLazy :: (HasDecoderStreamConfig cfg, MonadIO m) => Decoder -- ^ 'Decoder' state