1 files changed, 69 insertions, 0 deletions
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