Adds libcamera to WebRTC streaming service

7 files changed, 215 insertions, 15 deletions

diff --git a/README.md b/README.md
index 9072edd..8c29c5f 100644
--- a/README.md
+++ b/README.md
@@ -52,7 +52,7 @@ follow these steps:
 This configuration ensures that GPIO and PWM operations can be performed
 without needing root access.
 
-## Libcamera Setup
+## Libcamera Setup:
 The upstream libcamera package in Arch Linux ARM (as of August 2025) has
 compatibility issues with the Raspberry Pi kernel, preventing detection of
 official camera modules. Until this is resolved upstream, you'll need to build
@@ -71,6 +71,22 @@ References:
 - [RPi Kernel Issue #6983](https://github.com/raspberrypi/linux/issues/6983)
 - [Libcamera Installation Guide](https://blog.jirkabalhar.cz/2024/02/raspberry-camera-on-archlinux-arm-in-2024/)
 
+## GStreamer Streaming Setup:
+The repository includes a low-latency video streaming pipeline from libcamera to WebRTC,
+enabling browser-based video streaming directly from the Raspberry Pi camera.
+
+### Installation
+Install required GStreamer packages:
+```console
+user@alarm$ sudo pacman -S glib2 gstreamer gst-plugin-rswebrtc gst-plugins-bad gst-plugins-base gst-plugins-good gst-plugins-ugly
+```
+
+### Testing
+Verify the pipeline works:
+```console
+user@alarm$ gst-launch-1.0 libcamerasrc ! videoconvert ! vp8enc deadline=1 ! webrtcsink run-signalling-server=true
+```
+
 ## I2C Setup:
 The provided `config.txt` exposes `/dev/i2c-0` on GPIO pins 0 (SDA) and 1 (SCL).
 Ensure your user has I2C permissions:
@@ -92,7 +108,7 @@ user@alarm$ sudo i2cdetect -y 0
 70: -- -- -- -- -- -- -- --
 ```
 
-## Battery Monitoring with INA226
+## Battery Monitoring with INA226:
 This repository includes INA226 voltage/current sensing via I2C.
 For battery-powered operation:
 
@@ -122,5 +138,5 @@ user@alarm$ sudo i2cdetect -y 0
    installation.
 2. Run `make` to compile the libraries and executables
 
-> Note: You may need to install system dependencies on your host first (e.g.,
-> `libgpiod`, `libcamera`, etc.)
+> Note: You may need to install system dependencies on your host first
+> (e.g., `glib2`, `gstreamer`, `libcamera`, `libgpiod`, etc.)
diff --git a/hsm-log/Hsm/Log.hs b/hsm-log/Hsm/Log.hs
index bd8c73f..09d4c2d 100644
--- a/hsm-log/Hsm/Log.hs
+++ b/hsm-log/Hsm/Log.hs
@@ -105,6 +105,18 @@ runLog
   -> Eff es a
 runLog = evalStaticRep . Log
 
+class LogsClass (ds :: [Symbol]) (es :: [Effect]) where
+  type Insert ds es :: [Effect]
+  runLogs :: Severity -> Eff (Insert ds es) a -> Eff es a
+
+instance LogsClass ('[] :: [Symbol]) (es :: [Effect]) where
+  type Insert '[] es = es
+  runLogs = const id
+
+instance (IOE :> Insert ds es, KnownSymbol d, LogsClass ds es) => LogsClass (d : ds :: [Symbol]) (es :: [Effect]) where
+  type Insert (d : ds) es = Log d : Insert ds es
+  runLogs level = runLogs @ds level . runLog @d level
+
 runLogOpt
   :: forall d f o es a
    . (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> es)
@@ -113,20 +125,17 @@ runLogOpt
   -> Eff es a
 runLogOpt = runLog . getField @f
 
-class LogsClass (o :: *) (ds :: [Symbol]) (es :: [Effect]) where
-  type Insert ds es :: [Effect]
-  runLogs :: Severity -> Eff (Insert ds es) a -> Eff es a
-  runLogsOpt :: o -> Eff (Insert ds es) a -> Eff es a
+class LogsOptClass (o :: *) (ds :: [Symbol]) (es :: [Effect]) where
+  type InsertOpt ds es :: [Effect]
+  runLogsOpt :: o -> Eff (InsertOpt ds es) a -> Eff es a
 
-instance LogsClass (o :: *) ('[] :: [Symbol]) (es :: [Effect]) where
-  type Insert '[] es = es
-  runLogs = const id
+instance LogsOptClass (o :: *) ('[] :: [Symbol]) (es :: [Effect]) where
+  type InsertOpt '[] es = es
   runLogsOpt = const id
 
 instance
-  (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> Insert ds es, KnownSymbol d, LogsClass o ds es)
-  => LogsClass (o :: *) (d : ds :: [Symbol]) (es :: [Effect])
+  (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> InsertOpt ds es, KnownSymbol d, LogsOptClass o ds es)
+  => LogsOptClass (o :: *) (d : ds :: [Symbol]) (es :: [Effect])
   where
-  type Insert (d : ds) es = Log d : Insert ds es
-  runLogs level = runLogs @o @ds level . runLog @d level
+  type InsertOpt (d : ds) es = Log d : InsertOpt ds es
   runLogsOpt opts = runLogsOpt @o @ds opts . runLogOpt @d @f @o opts
diff --git a/hsm-stream/Hsm/Stream.hs b/hsm-stream/Hsm/Stream.hs
new file mode 100644
index 0000000..e0b2b5b
--- /dev/null
+++ b/hsm-stream/Hsm/Stream.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Stream
+  ( Stream
+  , startStream
+  , stopStream
+  , runStream
+  )
+where
+
+import Control.Monad (void, when)
+import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
+import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_)
+import Effectful.Exception (finally)
+import Foreign.C.String (withCString)
+import Foreign.Ptr (Ptr, nullPtr)
+import Hsm.Log (Log, Severity (Info), logMsg)
+import Hsm.Stream.FFI
+  ( GstElement
+  , gstDeinit
+  , gstElementSetState
+  , gstInit
+  , gstObjectUnref
+  , gstParseLaunch
+  , gstStateNull
+  , gstStatePlaying
+  )
+import System.Environment (setEnv)
+
+data Stream (a :: * -> *) (b :: *)
+
+type instance DispatchOf Stream = Static WithSideEffects
+
+newtype instance StaticRep Stream
+  = Stream (Ptr GstElement)
+
+startStream :: (Log "stream" :> es, Stream :> es) => Eff es ()
+startStream = do
+  Stream pipeline <- getStaticRep
+  logMsg Info "Starting stream"
+  unsafeEff_ . void $ gstElementSetState pipeline gstStatePlaying
+
+stopStream :: (Log "stream" :> es, Stream :> es) => Eff es ()
+stopStream = do
+  Stream pipeline <- getStaticRep
+  logMsg Info "Stopping stream"
+  unsafeEff_ . void $ gstElementSetState pipeline gstStateNull
+
+runStream :: (IOE :> es, Log "stream" :> es) => Bool -> Eff (Stream : es) a -> Eff es a
+runStream suppressXLogs action = do
+  when suppressXLogs $ do
+    logMsg Info "Suppressing external loggers"
+    liftIO $ setEnv "GST_DEBUG" "none"
+    liftIO $ setEnv "LIBCAMERA_LOG_LEVELS" "FATAL"
+    liftIO $ setEnv "WEBRTCSINK_SIGNALLING_SERVER_LOG" "none"
+  logMsg Info "Initializing gstreamer library"
+  liftIO $ gstInit nullPtr nullPtr
+  logMsg Info $ "Parsing gstreamer pipeline: " <> pipelineStr
+  pipeline <- liftIO . withCString pipelineStr $ \cStr -> gstParseLaunch cStr nullPtr
+  evalStaticRep (Stream pipeline) . finally action $ stopStream >> endStream
+  where
+    pipelineStr = "libcamerasrc ! videoconvert ! vp8enc deadline=1 ! webrtcsink run-signalling-server=true"
+    endStream = do
+      Stream pipeline <- getStaticRep
+      logMsg Info "Unrefing gstreamer pipeline"
+      liftIO $ gstObjectUnref pipeline
+      logMsg Info "De-initializing gstreamer library"
+      liftIO gstDeinit
diff --git a/hsm-stream/Hsm/Stream/FFI.hsc b/hsm-stream/Hsm/Stream/FFI.hsc
new file mode 100644
index 0000000..3ef4f98
--- /dev/null
+++ b/hsm-stream/Hsm/Stream/FFI.hsc
@@ -0,0 +1,48 @@
+{-# LANGUAGE CApiFFI #-}
+
+module Hsm.Stream.FFI
+  ( GstElement
+  , gstInit
+  , gstDeinit
+  , gstParseLaunch
+  , gstStatePlaying
+  , gstStateNull
+  , gstElementSetState
+  , gstObjectUnref
+  )
+where
+
+import Foreign.C.String (CString)
+import Foreign.C.Types (CChar, CInt)
+import Foreign.Ptr (Ptr)
+
+data GstElement
+
+data GError
+
+newtype GStateChangeReturn
+  = GStateChangeReturn Int
+
+newtype GState
+  = GState Int
+
+foreign import capi safe "gst/gst.h gst_init"
+  gstInit :: Ptr CInt -> Ptr (Ptr (Ptr CChar)) -> IO ()
+
+foreign import capi safe "gst/gst.h gst_deinit"
+  gstDeinit :: IO ()
+
+foreign import capi safe "gst/gst.h gst_parse_launch"
+  gstParseLaunch :: CString -> Ptr GError -> IO (Ptr GstElement)
+
+foreign import capi safe "gst/gst.h value GST_STATE_PLAYING"
+  gstStatePlaying :: GState
+
+foreign import capi safe "gst/gst.h value GST_STATE_NULL"
+  gstStateNull :: GState
+
+foreign import capi safe "gst/gst.h gst_element_set_state"
+  gstElementSetState :: Ptr GstElement -> GState -> IO GStateChangeReturn
+
+foreign import capi safe "gst/gst.h gst_object_unref"
+  gstObjectUnref :: Ptr GstElement -> IO ()
diff --git a/hsm-stream/Test/Stream.hs b/hsm-stream/Test/Stream.hs
new file mode 100644
index 0000000..010ebcc
--- /dev/null
+++ b/hsm-stream/Test/Stream.hs
@@ -0,0 +1,8 @@
+import Control.Concurrent (threadDelay)
+import Data.Function ((&))
+import Effectful (liftIO, runEff)
+import Hsm.Log (Severity (Info), runLog)
+import Hsm.Stream (runStream, startStream)
+
+main :: IO ()
+main = (startStream >> liftIO (threadDelay $ maxBound @Int)) & runStream True & runLog @"stream" Info & runEff
diff --git a/hsm-stream/hsm-stream.cabal b/hsm-stream/hsm-stream.cabal
new file mode 100644
index 0000000..96bca1d
--- /dev/null
+++ b/hsm-stream/hsm-stream.cabal
@@ -0,0 +1,49 @@
+cabal-version: 3.8
+author:        Paul Oliver <contact@pauloliver.dev>
+name:          hsm-stream
+version:       0.1.0.0
+
+library
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , hsm-log
+
+  default-language: GHC2024
+  exposed-modules:  Hsm.Stream
+  extra-libraries:  gstreamer-1.0
+  ghc-options:
+    -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
+    -fplugin=Effectful.Plugin
+
+  include-dirs:
+    /usr/include/gstreamer-1.0 /usr/include/glib-2.0
+    /usr/lib/glib-2.0/include
+
+  other-modules:    Hsm.Stream.FFI
+
+executable test-stream
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , hsm-log
+
+  default-language: GHC2024
+  extra-libraries:  gstreamer-1.0
+  ghc-options:
+    -O2 -threaded -Wall -Werror -Wno-star-is-type -Wunused-packages
+    -fplugin=Effectful.Plugin
+
+  if !arch(x86_64)
+    ghc-options: -optl=-mno-fix-cortex-a53-835769
+
+  include-dirs:
+    /usr/include/gstreamer-1.0 /usr/include/glib-2.0
+    /usr/lib/glib-2.0/include
+
+  main-is:          Test/Stream.hs
+  other-modules:
+    Hsm.Stream
+    Hsm.Stream.FFI
diff --git a/stack.yaml b/stack.yaml
index fb04d85..815ea3d 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -12,5 +12,6 @@ packages:
   - hsm-log
   - hsm-pwm
   - hsm-repl
+  - hsm-stream
   - hsm-web
 resolver: lts-24.26