Update to the latest FFMpeg (5.1) on Debian

.gitignore

@@ -7,3 +7,6 @@ dist
 /.cabbages
 /TAGS
 .stack-work
+dist-newstyle
+cabal.project.local
+

Containerfile-alpine

@@ -0,0 +1,26 @@
+# To build this container run
+# docker build --build-arg STRIPE_SECRET=<from Stripe dashboard> --build-arg RECAPTCHA_SECRET=<from Google console> \
+# --build-arg PG_DATABASE_URL="host=host.docker.internal user=docker password=docker dbname=test" \ 
+# --add-host=host.docker.internal:host-gateway -f/home/sumit/dev/matrixid/matrixid-api-server-bin/deploy/Containerised/Containerfile .
+# Make sure the database on the host has a docker user with password docker and a database test
+# To run the container a docker volume is required for video storage
+# docker volume create image-store
+# and run the image with --mount source=image-store,target=/tmp
+
+FROM docker.io/alpine:3.19 as builder
+
+RUN apk update && apk add binutils-gold curl gcc g++ gmp-dev libc-dev zlib-dev libffi-dev make musl-dev ncurses-dev perl tar xz git pkgconf mercurial sudo openssl libpq-dev ffmpeg-dev gettext
+
+RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=9.4.8 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
+
+COPY . /build/ffmpeg-light
+
+WORKDIR /build/ffmpeg-light
+
+RUN --mount=type=cache,target=/root/.cabal/ . /root/.ghcup/env && ghcup install cabal latest
+RUN --mount=type=cache,target=/root/.cabal/ . /root/.ghcup/env && ghcup set cabal latest
+RUN --mount=type=cache,target=/root/.cabal/ . /root/.ghcup/env && cabal update
+RUN --mount=type=cache,target=/root/.cabal/ . /root/.ghcup/env && cabal build --dependencies-only all
+RUN --mount=type=cache,target=/root/.cabal/ . /root/.ghcup/env && cabal build -fBuildAudioExtractDemo -fBuildAudioSinDemo -fBuildDemo -fBuildRasterDemo -fBuildTranscodeDemo
+
+CMD /bin/sh

demo/AudioExtract.hs

@@ -18,12 +18,14 @@ main = do initFFmpeg
               eRes <- runExceptT $ frameAudioReader (File fname)
               case eRes of
                 Left er -> error er
-                Right (as, getFrame, cleanup) -> do
+                Right (as, getFrame, cleanup, _) -> do
                   putStrLn $ "bitrate : " ++ show (asBitRate as)
                   putStrLn $ "sample rate : " ++ show (asSampleRate as)
                   putStrLn $ "sample format : " ++
                       show (getSampleFormatInt (asSampleFormat as))
-                  putStrLn $ "channel layout : " ++ show (asChannelLayout as)
+                  let chLayout = asChannelLayout as
+                  putStrLn $ "channel layout order: " ++ show (order chLayout)
+                  putStrLn $ "channel layout channels: " ++ show (numChannels chLayout)
                   putStrLn $ "channel count : " ++ show (asChannelCount as)
                   let inParams = AudioParams
                                   { apChannelLayout = asChannelLayout as

demo/AudioSin.hs

@@ -13,9 +13,11 @@ import           Control.Monad.Except
 import           Data.IORef
 import           Foreign.C.Types
 import           Foreign.Marshal.Array
+import           Foreign.Marshal.Alloc
 import           Foreign.Ptr
 import           Foreign.Storable
 import           System.Environment
+import           Control.Monad (forM_, when)
 
 -- Simple Music DSL
 type Sound = Float -> Float
@@ -79,66 +81,67 @@ mkImage w h color =
 main :: IO ()
 main = do
   initFFmpeg
-
-  let w = 1080
-      h = 720
-      encParams = AVEncodingParams
-                    { avepWidth = w
-                    , avepHeight = h
-                    , avepFps = 30
-                    , avepCodec = Nothing
-                    , avepPixelFormat = Nothing
-                    , avepChannelLayout = avChLayoutMono
-                    , avepSampleRate = 44100
-                    , avepSampleFormat = avSampleFmtFltp
-                    , avepPreset = ""
-                    , avepFormatName = Nothing
-                    }
-  writerContext <- audioVideoWriter encParams "sinusoidal.mp4"
-  let mCtx = avwAudioCodecContext writerContext
-      videoWriter = avwVideoWriter writerContext
-      audioWriter = avwAudioWriter writerContext
-  case mCtx of
-    Nothing -> error "Could not get audio ctx"
-    Just ctx -> do
-      frame <- frame_alloc_check
-      setNumSamples frame =<< getFrameSize ctx
-      setFormat frame . getSampleFormatInt =<< getSampleFormat ctx
-      setChannelLayout frame =<< getChannelLayout ctx
-      setSampleRate frame =<< getSampleRate ctx
-
-      ch <- getChannelLayout ctx
-      numChannels <- getChannels ctx
-
-      print ("Channel Layout", ch)
-      print ("Channels", numChannels)
-
-      runWithError "Alloc buffers" (av_frame_get_buffer frame 0)
-
-      let sampleRate = avepSampleRate encParams
-      print ("sample rate", sampleRate)
-
-      vidFrameRef <- newIORef 0 :: IO (IORef Int)
-      forM_ [0..120] $ \i -> do
-        av_frame_make_writable frame
-        dataPtr <- castPtr <$> getData frame :: IO (Ptr CFloat)
-        nbSamples <- getNumSamples frame
-        forM_ [0..nbSamples-1] $ \j -> do
-          let idx = fromIntegral i * fromIntegral nbSamples + fromIntegral j :: Integer
-              t = fromIntegral idx / fromIntegral sampleRate
-              v = twoFiveOne t
-          poke (advancePtr dataPtr (fromIntegral j)) (realToFrac v)
-          vidFrame <- readIORef vidFrameRef
-          when (t * 30 >= fromIntegral vidFrame) $ do
-            -- TODO: I'm not sure why t seems to be half the actual value but I need to do
-            -- 0.5 and 1 to make the chord changes match up with the color changes
-            modifyIORef vidFrameRef (+1)
-            let color = if | t <= 1    -> PixelRGB8 255 0 0
-                           | t <= 2    -> PixelRGB8 0 255 0
-                           | otherwise -> PixelRGB8 0 0 255
-                img = mkImage (fromIntegral w) (fromIntegral h) color
-            videoWriter (Just (fromJuciy img))
-        audioWriter (Just frame)
-
-      videoWriter Nothing
-      audioWriter Nothing
+  setLogLevel avLogTrace
+
+  allocaBytes sizeOfAVChannelLayout $ \chanLayout -> do
+    let w = 1080
+        h = 720
+        encParams = AVEncodingParams
+                      { avepWidth = w
+                      , avepHeight = h
+                      , avepFps = 30
+                      , avepCodec = Nothing
+                      , avepPixelFormat = Nothing
+                      , avepChannelLayout = cAV_CHANNEL_LAYOUT_MONO
+                      , avepSampleRate = 44100
+                      , avepSampleFormat = avSampleFmtFltp
+                      , avepPreset = ""
+                      , avepFormatName = Nothing
+                      , avepDisplayRotation = Nothing
+                      }
+    writerContext <- audioVideoWriter encParams "sinusoidal.mp4"
+    let mCtx = avwAudioCodecContext writerContext
+        videoWriter = avwVideoWriter writerContext
+        audioWriter = avwAudioWriter writerContext
+    case mCtx of
+      Nothing -> error "Could not get audio ctx"
+      Just ctx -> do
+        frame <- frame_alloc_check
+        setNumSamples frame =<< getFrameSize ctx
+        setFormat frame . getSampleFormatInt =<< getSampleFormat ctx
+        setChannelLayout frame =<< getChannelLayout ctx
+        setSampleRate frame =<< getSampleRate ctx
+
+        ch <- getChannelLayout ctx
+        putStrLn $ "channel layout order: " ++ show (order ch)
+        putStrLn $ "channel layout channels: " ++ show (numChannels ch)
+
+        runWithError "Alloc buffers" (av_frame_get_buffer frame 0)
+
+        let sampleRate = avepSampleRate encParams
+        print ("sample rate", sampleRate)
+
+        vidFrameRef <- newIORef 0 :: IO (IORef Int)
+        forM_ [0..120] $ \i -> do
+          av_frame_make_writable frame
+          dataPtr <- castPtr <$> getData frame :: IO (Ptr CFloat)
+          nbSamples <- getNumSamples frame
+          forM_ [0..nbSamples-1] $ \j -> do
+            let idx = fromIntegral i * fromIntegral nbSamples + fromIntegral j :: Integer
+                t = fromIntegral idx / fromIntegral sampleRate
+                v = twoFiveOne t
+            poke (advancePtr dataPtr (fromIntegral j)) (realToFrac v)
+            vidFrame <- readIORef vidFrameRef
+            when (t * 30 >= fromIntegral vidFrame) $ do
+              -- TODO: I'm not sure why t seems to be half the actual value but I need to do
+              -- 0.5 and 1 to make the chord changes match up with the color changes
+              modifyIORef vidFrameRef (+1)
+              let color = if | t <= 1    -> PixelRGB8 255 0 0
+                             | t <= 2    -> PixelRGB8 0 255 0
+                             | otherwise -> PixelRGB8 0 0 255
+                  img = mkImage (fromIntegral w) (fromIntegral h) color
+              videoWriter (Just (fromJuciy img))
+          audioWriter (Just frame)
+
+        videoWriter Nothing
+        audioWriter Nothing

demo/Main.hs

@@ -11,7 +11,7 @@ import Control.Monad (unless)
 -- The example used in the README
 firstFrame :: IO (Maybe DynamicImage)
 firstFrame = do initFFmpeg
-                (getFrame, cleanup) <- imageReader (File "myVideo.mov")
+                (getFrame, cleanup, _) <- imageReader False (File "myVideo.mov")
                 (fmap ImageRGB8 <$> getFrame) <* cleanup
 
 -- | Generate a video that pulses from light to dark.
@@ -34,27 +34,29 @@ pulseVid =
 
 -- | Generate a video that fades from white to gray to white.
 testEncode :: IO ()
-testEncode = initFFmpeg >> pulseVid >> putStrLn "All done!"
+testEncode = initFFmpeg >> setLogLevel avLogTrace >> pulseVid >> putStrLn "All done!"
 
 -- | Decoding example. Try changing 'ImageRGB8' to 'ImageY8' in the
 -- 'savePngImage' lines to automatically decode to grayscale images!
 testDecode :: FilePath -> IO ()
 testDecode vidFile =
-  do initFFmpeg
-     (getFrame, cleanup) <- imageReaderTime (File vidFile)
-     frame1 <- getFrame
-     case frame1 of
-       Just (avf,ts) -> do putStrLn $ "Frame at "++show ts
-                           savePngImage "frame1.png" (ImageRGB8 avf)
-       Nothing -> putStrLn "No frame for me :("
-     replicateM_ 299 getFrame
-     frame2 <- getFrame
-     case frame2 of
-       Just (avf,ts) -> do putStrLn $ "Frame at "++show ts
-                           savePngImage "frame2.png" (ImageRGB8 avf)
-       Nothing -> putStrLn "No frame for me :("
-     cleanup
-     putStrLn "All done!"
+  do 
+    initFFmpeg 
+    -- setLogLevel avLogTrace
+    (getFrame, cleanup, maybeMetadata) <- imageReaderTime True (File vidFile)
+    frame1 <- getFrame
+    case frame1 of
+      Just (avf,ts) -> do putStrLn $ "Frame at "++show ts
+                          savePngImage "frame1.png" (ImageRGB8 avf)
+      Nothing -> putStrLn "No frame for me :("
+    replicateM_ 299 getFrame
+    frame2 <- getFrame
+    case frame2 of
+      Just (avf,ts) -> do putStrLn $ "Frame at "++show ts
+                          savePngImage "frame2.png" (ImageRGB8 avf)
+      Nothing -> putStrLn "No frame for me :("
+    cleanup
+    putStrLn "All done!"
 
 -- | @loopFor timeSpan action@ repeats @action@ until at least @timeSpan@
 -- seconds have elapsed.
@@ -71,7 +73,7 @@ testCamera =
   do initFFmpeg -- Defaults to quiet (minimal) logging
      -- setLogLevel avLogInfo -- Restore standard ffmpeg logging
 
-     (getFrame, cleanup) <- imageReader $
+     (getFrame, cleanup, maybeMetadata) <- imageReader False $
        case Info.os of
          "linux" ->
            let cfg = CameraConfig (Just 30) Nothing (Just "mjpeg")
@@ -104,8 +106,9 @@ main = do args <- getArgs
   where usage =
           unlines [ "Usage: demo [videoFile]"
                   , "  If no argument is given, a test video named "
-                  , "  pulse.mov is generated."
+                  , "  pulse.mov is generated with side data of 90 degree rotation."
                   , ""
                   , "  If a file name is given, then two frames are "
                   , "  extracted: the first frame, and the 301st."
-                  , "  These are saved to frame1.png and frame2.png" ]
+                  , "  These are saved to frame1.png and frame2.png."
+                  , "  If the video has rotation then these frame are corrected" ]

demo/Transcode.hs

@@ -34,7 +34,7 @@ copy from to format w h = do
   let ep = (FF.defaultH264 (fromIntegral w) (fromIntegral h))
             -- { FF.epFormatName = Just format }
             -- TODO: get this working again
-  (getFrame, cleanup) <- FF.imageReader (FF.File from)
+  (getFrame, cleanup, _) <- FF.imageReader False (FF.File from)
   putFrame <- FF.imageWriter ep to
   loop getFrame cleanup putFrame (\x -> return x)
 

demo/VPlay.hs

@@ -7,10 +7,11 @@ import Codec.FFmpeg.Common
 import Codec.FFmpeg.Decode hiding (av_malloc)
 
 import Control.Concurrent.MVar (newMVar, takeMVar, putMVar)
-import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.IO.Class (MonadIO (liftIO))
 import Control.Monad.Except
 import Control.Monad.Loops
 import Control.Monad.Trans.Maybe
+import Control.Monad (when)
 
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe (unsafePackCStringFinalizer)
@@ -83,7 +84,7 @@ readTSDiff readerTS = do
   return reader
 
 -- Transformer version of updateTextureByFrame.
-updateTextureByFrameT :: SDL.Texture -> AVFrame -> MaybeT IO SDL.Texture
+updateTextureByFrameT :: SDL.Texture -> AVFrame -> MaybeT IO ()
 updateTextureByFrameT texture frame =
   copyImageDataT frame >>= updateTexture texture
   where
@@ -92,7 +93,7 @@ updateTextureByFrameT texture frame =
         SDL.updateTexture t Nothing img
 
 -- Update texture by image data from frame.
-updateTextureByFrame :: SDL.Texture -> AVFrame -> IO (Maybe SDL.Texture)
+updateTextureByFrame :: SDL.Texture -> AVFrame -> IO (Maybe ())
 updateTextureByFrame t = runMaybeT . updateTextureByFrameT t
 
 -- Return Nothing when condition holds.
@@ -300,7 +301,7 @@ videoPlayer cfg src = do
       let reader' = runMaybeT $ do
                           (f, t) <- MaybeT tsDiffReader
                           updateTextureByFrameT texture f
-                            >>= return . flip (,) t
+                          return (texture, t)
 
           -- Texture renderer.
           render t = do

ffmpeg-light.cabal

@@ -1,5 +1,5 @@
 name:                ffmpeg-light
-version:             0.14.1
+version:             0.15.0
 synopsis:            Minimal bindings to the FFmpeg library.
 
 description:         Stream frames from an encoded video, or stream frames to
@@ -28,7 +28,7 @@ category:            Codec
 build-type:          Simple
 extra-source-files:  src/hscMacros.h, src/nameCompat.h, CHANGELOG.md
 cabal-version:       >=1.10
-tested-with:         GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.1 || == 9.6.11
+tested-with:         GHC == 8.8.4 || == 8.10.7 || == 9.2.8 || == 9.4.8 || == 9.6.4
 
 source-repository head
   type:     git
@@ -74,6 +74,7 @@ library
                        Codec.FFmpeg.Juicy,
                        Codec.FFmpeg.Probe,
                        Codec.FFmpeg.Resampler,
+                       Codec.FFmpeg.Display,
                        Codec.FFmpeg.Scaler,
                        Codec.FFmpeg.Types,
                        Codec.FFmpeg.Internal.Debug,
@@ -87,7 +88,9 @@ library
                        transformers >= 0.4.1 && < 0.7,
                        mtl >= 2.2.1 && < 2.4,
                        JuicyPixels >= 3.1 && < 3.4,
-                       bytestring
+                       JuicyPixels-extra >= 0.5.2,
+                       bytestring,
+                       containers
 
   pkgconfig-depends:   libavutil, libavformat, libavcodec, libswscale, libavdevice,
                        libswresample
@@ -160,4 +163,4 @@ executable audio-sin
   hs-source-dirs:   demo
   main-is:          AudioSin.hs
   default-language: Haskell2010
-  ghc-options:      -Wall
+  ghc-options:      -Wall

src/Codec/FFmpeg.hs

@@ -19,13 +19,9 @@ import Codec.FFmpeg.Enums
 import Codec.FFmpeg.Juicy
 import Codec.FFmpeg.Resampler
 import Codec.FFmpeg.Types
+import Codec.FFmpeg.Common (avdevice_register_all)
 import Foreign.C.Types (CInt(..))
 
-foreign import ccall "av_register_all" av_register_all :: IO ()
-foreign import ccall "avdevice_register_all" avdevice_register_all :: IO ()
-
--- foreign import ccall "avcodec_register_all" avcodec_register_all :: IO (
-
 foreign import ccall "av_log_set_level" av_log_set_level :: CInt -> IO ()
 
 -- | Log output is sent to stderr.
@@ -37,4 +33,4 @@ setLogLevel (LogLevel l) = av_log_set_level l
 -- initially set to @quiet@. If you would like the standard ffmpeg
 -- debug level, call @setLogLevel avLogInfo@ after @initFFmpeg@.
 initFFmpeg :: IO ()
-initFFmpeg = av_register_all >> avdevice_register_all >> setLogLevel avLogQuiet
+initFFmpeg = avdevice_register_all >> setLogLevel avLogQuiet

src/Codec/FFmpeg/AudioStream.hs

@@ -2,14 +2,14 @@ module Codec.FFmpeg.AudioStream where
 
 import           Codec.FFmpeg.Enums
 import           Data.Bits
-import qualified Data.Vector.Storable as V
 import           Foreign.C.Types
+import Codec.FFmpeg.Types (AVChannelLayout)
 
 data AudioStream = AudioStream
   { asBitRate       :: CInt
   , asSampleFormat  :: AVSampleFormat
   , asSampleRate    :: CInt
-  , asChannelLayout :: CULong
+  , asChannelLayout :: AVChannelLayout
   , asChannelCount  :: CInt
   , asCodec         :: AVCodecID
   }