diff options
| -rw-r--r-- | hsm-ina226/Test/INA226.hs | 5 | ||||
| -rw-r--r-- | hsm-ina226/hsm-ina226.cabal | 1 | ||||
| -rw-r--r-- | hsm-stream/Hsm/Stream.hs | 116 | ||||
| -rw-r--r-- | hsm-stream/Hsm/Stream/FFI.hsc | 48 | ||||
| -rw-r--r-- | hsm-stream/Test/Stream.hs | 15 | ||||
| -rw-r--r-- | hsm-stream/hsm-stream.cabal | 22 | ||||
| -rw-r--r-- | hsm-web/Client/package-lock.json | 216 | ||||
| -rw-r--r-- | hsm-web/Client/package.json | 1 | ||||
| -rw-r--r-- | hsm-web/Client/src/App.vue | 5 | ||||
| -rw-r--r-- | hsm-web/Client/src/CameraStream.vue | 103 | ||||
| -rw-r--r-- | hsm-web/Client/src/INA226.vue | 31 | ||||
| -rw-r--r-- | hsm-web/Client/src/config.js | 2 | ||||
| -rw-r--r-- | hsm-web/Hsm/Web.hs | 43 | ||||
| -rw-r--r-- | hsm-web/Main.hs | 17 | ||||
| -rw-r--r-- | hsm-web/hsm-web.cabal | 4 |
15 files changed, 488 insertions, 141 deletions
diff --git a/hsm-ina226/Test/INA226.hs b/hsm-ina226/Test/INA226.hs index 71f8f45..a92fec7 100644 --- a/hsm-ina226/Test/INA226.hs +++ b/hsm-ina226/Test/INA226.hs @@ -1,9 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} -import Control.Concurrent (threadDelay) import Control.Monad (forever) import Data.Function ((&)) import Effectful (liftIO, runEff) +import Effectful.Concurrent (runConcurrent, threadDelay) import Hsm.Core.App (bootstrapApp) import Hsm.I2C (runI2C) import Hsm.INA226 (readINA226State, runINA226) @@ -20,8 +20,9 @@ $(makeLoggerOptionParser @Logs "Options" "parser" 'Info) main :: IO () main = bootstrapApp parser "Launch INA226 Monitoring Test Application" $ \opts -> - forever (liftIO (threadDelay 1000000) >> readINA226State >>= logMsg @"ina226" Info . show) + forever (threadDelay 1000000 >> readINA226State >>= logMsg @"ina226" Info . show) & runINA226 & runI2C & runLogsOpt @Options @Logs opts + & runConcurrent & runEff diff --git a/hsm-ina226/hsm-ina226.cabal b/hsm-ina226/hsm-ina226.cabal index 6ac642a..ce831d1 100644 --- a/hsm-ina226/hsm-ina226.cabal +++ b/hsm-ina226/hsm-ina226.cabal @@ -23,6 +23,7 @@ executable test-ina226 build-depends: , aeson , base + , effectful , effectful-core , effectful-plugin , hsm-core diff --git a/hsm-stream/Hsm/Stream.hs b/hsm-stream/Hsm/Stream.hs index e0b2b5b..a01eb4b 100644 --- a/hsm-stream/Hsm/Stream.hs +++ b/hsm-stream/Hsm/Stream.hs @@ -1,69 +1,87 @@ -{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Hsm.Stream ( Stream , startStream , stopStream + , isStreaming , 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 Control.Monad (forever) +import Control.Monad.Extra (unlessM, whenM) +import Data.Maybe (fromJust, isJust) +import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, (:>)) +import Effectful.Concurrent (Concurrent, ThreadId, forkIO, killThread) +import Effectful.Dispatch.Static + ( SideEffects (WithSideEffects) + , StaticRep + , evalStaticRep + , getStaticRep + , putStaticRep + , unsafeEff_ ) -import System.Environment (setEnv) +import Effectful.Exception (IOException, catch, finally) +import Effectful.Fail (Fail) +import GHC.IO.Handle (Handle, hGetLine) +import Hsm.Log (Log, Logs, Severity (Info, Trace), logMsg) +import System.Process (ProcessHandle, StdStream (CreatePipe), cleanupProcess, createProcess, proc, std_err, std_out) data Stream (a :: * -> *) (b :: *) type instance DispatchOf Stream = Static WithSideEffects -newtype instance StaticRep Stream - = Stream (Ptr GstElement) +data StreamRep = StreamRep + { phdl :: ProcessHandle + , hout :: Handle + , herr :: Handle + , tout :: ThreadId + , terr :: ThreadId + } -startStream :: (Log "stream" :> es, Stream :> es) => Eff es () -startStream = do - Stream pipeline <- getStaticRep - logMsg Info "Starting stream" - unsafeEff_ . void $ gstElementSetState pipeline gstStatePlaying +newtype instance StaticRep Stream + = Stream (Maybe StreamRep) -stopStream :: (Log "stream" :> es, Stream :> es) => Eff es () -stopStream = do - Stream pipeline <- getStaticRep - logMsg Info "Stopping stream" - unsafeEff_ . void $ gstElementSetState pipeline gstStateNull +-- The following functions manage the GStreamer pipeline as a subprocess. +-- This ensures: +-- - Clean resource cleanup on stream restart +-- - Proper WebSocket connection teardown (prevents browser-side lingering) +-- - Reliable browser disconnect/reconnect cycles +-- +-- Direct library integration proved problematic due to resource lifecycle +-- issues, particularly with `webrtcsink` WebSocket persistence. +isStreaming :: (Log "stream" :> es, Stream :> es) => Eff es Bool +isStreaming = do + Stream rep <- getStaticRep + return $ isJust rep -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 +startStream :: (Concurrent :> es, Fail :> es, Logs '["gst", "stream"] es, Stream :> es) => Eff es () +startStream = + unlessM isStreaming $ do + logMsg @"stream" Info "Initializing gstreamer pipeline" + (_, Just hout, Just herr, phdl) <- unsafeEff_ $ createProcess spDecl + tout <- spEcho hout + terr <- spEcho herr + putStaticRep . Stream $ Just StreamRep{..} 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 + spFlags = words "--quiet --no-position" + pipeline = words "libcamerasrc ! videoconvert ! vp8enc deadline=1 ! queue ! webrtcsink run-signalling-server=true" + spArgs = spFlags <> pipeline + spDecl = (proc "gst-launch-1.0" spArgs){std_out = CreatePipe, std_err = CreatePipe} + spEcho hdl = forkIO . catch @IOException (forever $ unsafeEff_ (hGetLine hdl) >>= logMsg @"gst" Trace) . const $ return () + +stopStream :: (Concurrent :> es, Log "stream" :> es, Stream :> es) => Eff es () +stopStream = + whenM isStreaming $ do + Stream rep <- getStaticRep + logMsg Info "Stopping stream" + let StreamRep{..} = fromJust rep + unsafeEff_ $ cleanupProcess (Nothing, Just hout, Just herr, phdl) + killThread tout + killThread terr + putStaticRep $ Stream Nothing + +runStream :: (Concurrent :> es, IOE :> es, Log "stream" :> es) => Eff (Stream : es) a -> Eff es a +runStream action = evalStaticRep (Stream Nothing) $ finally action stopStream diff --git a/hsm-stream/Hsm/Stream/FFI.hsc b/hsm-stream/Hsm/Stream/FFI.hsc deleted file mode 100644 index 3ef4f98..0000000 --- a/hsm-stream/Hsm/Stream/FFI.hsc +++ /dev/null @@ -1,48 +0,0 @@ -{-# 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 index 010ebcc..327d2e4 100644 --- a/hsm-stream/Test/Stream.hs +++ b/hsm-stream/Test/Stream.hs @@ -1,8 +1,15 @@ -import Control.Concurrent (threadDelay) import Data.Function ((&)) -import Effectful (liftIO, runEff) -import Hsm.Log (Severity (Info), runLog) +import Effectful (runEff) +import Effectful.Concurrent (runConcurrent, threadDelay) +import Effectful.Fail (runFailIO) +import Hsm.Log (Severity (Trace), runLogs) import Hsm.Stream (runStream, startStream) main :: IO () -main = (startStream >> liftIO (threadDelay $ maxBound @Int)) & runStream True & runLog @"stream" Info & runEff +main = + (startStream >> threadDelay (maxBound @Int)) + & runStream + & runLogs @'["gst", "stream"] Trace + & runConcurrent + & runFailIO + & runEff diff --git a/hsm-stream/hsm-stream.cabal b/hsm-stream/hsm-stream.cabal index 96bca1d..1774ae7 100644 --- a/hsm-stream/hsm-stream.cabal +++ b/hsm-stream/hsm-stream.cabal @@ -6,32 +6,30 @@ version: 0.1.0.0 library build-depends: , base + , effectful , effectful-core , effectful-plugin + , extra , hsm-log + , process 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 , effectful-core , effectful-plugin + , extra , hsm-log + , process default-language: GHC2024 - extra-libraries: gstreamer-1.0 ghc-options: -O2 -threaded -Wall -Werror -Wno-star-is-type -Wunused-packages -fplugin=Effectful.Plugin @@ -39,11 +37,5 @@ executable test-stream 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 + other-modules: Hsm.Stream diff --git a/hsm-web/Client/package-lock.json b/hsm-web/Client/package-lock.json index 14e6a57..ea30111 100644 --- a/hsm-web/Client/package-lock.json +++ b/hsm-web/Client/package-lock.json @@ -5,6 +5,7 @@ "packages": { "": { "dependencies": { + "@tomoxv/gstwebrtc-api": "^2.0.0", "@vue/cli": "^5.0.9", "axios": "^1.13.2", "core-js": "^3.8.3", @@ -2653,6 +2654,17 @@ "dev": true, "license": "MIT" }, + "node_modules/@tomoxv/gstwebrtc-api": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/@tomoxv/gstwebrtc-api/-/gstwebrtc-api-2.0.0.tgz", + "integrity": "sha512-JWjKrwVyGWc1HpXGAOo6Nz7HpQOMSRragn2dJeq8oQKOJcZ6Vaq8KPmZTC9aFoouzVpFvlAdzrAhpAif7IGSug==", + "hasInstallScript": true, + "license": "MPL-2.0", + "dependencies": { + "patch-package": "8.0.0", + "webrtc-adapter": "8.2.3" + } + }, "node_modules/@trysound/sax": { "version": "0.2.0", "resolved": "https://registry.npmjs.org/@trysound/sax/-/sax-0.2.0.tgz", @@ -4003,6 +4015,12 @@ "dev": true, "license": "Apache-2.0" }, + "node_modules/@yarnpkg/lockfile": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/@yarnpkg/lockfile/-/lockfile-1.1.0.tgz", + "integrity": "sha512-GpSwvyXOcOOlV70vbnzjj4fW5xW/FdUF6nQEt1ENy7m4ZCczi1+/buVUPAqmGfqznsORNFzUMjctTIp8a9tuCQ==", + "license": "BSD-2-Clause" + }, "node_modules/accepts": { "version": "1.3.8", "resolved": "https://registry.npmjs.org/accepts/-/accepts-1.3.8.tgz", @@ -8385,6 +8403,15 @@ "url": "https://github.com/sponsors/sindresorhus" } }, + "node_modules/find-yarn-workspace-root": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/find-yarn-workspace-root/-/find-yarn-workspace-root-2.0.0.tgz", + "integrity": "sha512-1IMnbjt4KzsQfnhnzNd8wUEgXZ44IzZaZmnLYx7D5FZlaHt2gW20Cri8Q+E/t5tIj4+epTBub+2Zxu/vNILzqQ==", + "license": "Apache-2.0", + "dependencies": { + "micromatch": "^4.0.2" + } + }, "node_modules/fkill": { "version": "7.2.1", "resolved": "https://registry.npmjs.org/fkill/-/fkill-7.2.1.tgz", @@ -10294,6 +10321,25 @@ "dev": true, "license": "MIT" }, + "node_modules/json-stable-stringify": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/json-stable-stringify/-/json-stable-stringify-1.3.0.tgz", + "integrity": "sha512-qtYiSSFlwot9XHtF9bD9c7rwKjr+RecWT//ZnPvSmEjpV5mmPOCN4j8UjY5hbjNkOwZ/jQv3J6R1/pL7RwgMsg==", + "license": "MIT", + "dependencies": { + "call-bind": "^1.0.8", + "call-bound": "^1.0.4", + "isarray": "^2.0.5", + "jsonify": "^0.0.1", + "object-keys": "^1.1.1" + }, + "engines": { + "node": ">= 0.4" + }, + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, "node_modules/json-stable-stringify-without-jsonify": { "version": "1.0.1", "resolved": "https://registry.npmjs.org/json-stable-stringify-without-jsonify/-/json-stable-stringify-without-jsonify-1.0.1.tgz", @@ -10301,6 +10347,12 @@ "dev": true, "license": "MIT" }, + "node_modules/json-stable-stringify/node_modules/isarray": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-2.0.5.tgz", + "integrity": "sha512-xHjhDr3cNBK0BzdUJSPXZntQUx/mwMS5Rw4A7lPJ90XGAO6ISP/ePDNuo0vhqOZU+UD5JoodwCAAoZQd3FeAKw==", + "license": "MIT" + }, "node_modules/json5": { "version": "2.2.3", "resolved": "https://registry.npmjs.org/json5/-/json5-2.2.3.tgz", @@ -10325,6 +10377,15 @@ "graceful-fs": "^4.1.6" } }, + "node_modules/jsonify": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/jsonify/-/jsonify-0.0.1.tgz", + "integrity": "sha512-2/Ki0GcmuqSrgFyelQq9M05y7PS0mEwuIzrf3f1fPqkVDVRvZrPZtVSMHxdgo8Aq0sxAOb/cr2aqqA3LeWHVPg==", + "license": "Public Domain", + "funding": { + "url": "https://github.com/sponsors/ljharb" + } + }, "node_modules/keyv": { "version": "4.5.4", "resolved": "https://registry.npmjs.org/keyv/-/keyv-4.5.4.tgz", @@ -10344,6 +10405,15 @@ "node": ">=0.10.0" } }, + "node_modules/klaw-sync": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/klaw-sync/-/klaw-sync-6.0.0.tgz", + "integrity": "sha512-nIeuVSzdCCs6TDPTqI8w1Yre34sSq7AkZ4B3sfOBbI2CgVSB4Du4aLQijFU2+lhAFCwt9+42Hel6lQNIv6AntQ==", + "license": "MIT", + "dependencies": { + "graceful-fs": "^4.1.11" + } + }, "node_modules/klona": { "version": "2.0.6", "resolved": "https://registry.npmjs.org/klona/-/klona-2.0.6.tgz", @@ -11503,7 +11573,6 @@ "version": "1.1.1", "resolved": "https://registry.npmjs.org/object-keys/-/object-keys-1.1.1.tgz", "integrity": "sha512-NuAESUOUMrlIXOfHKzD6bpPu3tYt3xvjNdRIQ+FeT0lNb4K8WR70CaDxhuNguS2XG+GjkyMwOzsN5ZktImfhLA==", - "dev": true, "license": "MIT", "engines": { "node": ">= 0.4" @@ -11918,6 +11987,132 @@ "node": ">=0.10.0" } }, + "node_modules/patch-package": { + "version": "8.0.0", + "resolved": "https://registry.npmjs.org/patch-package/-/patch-package-8.0.0.tgz", + "integrity": "sha512-da8BVIhzjtgScwDJ2TtKsfT5JFWz1hYoBl9rUQ1f38MC2HwnEIkK8VN3dKMKcP7P7bvvgzNDbfNHtx3MsQb5vA==", + "license": "MIT", + "dependencies": { + "@yarnpkg/lockfile": "^1.1.0", + "chalk": "^4.1.2", + "ci-info": "^3.7.0", + "cross-spawn": "^7.0.3", + "find-yarn-workspace-root": "^2.0.0", + "fs-extra": "^9.0.0", + "json-stable-stringify": "^1.0.2", + "klaw-sync": "^6.0.0", + "minimist": "^1.2.6", + "open": "^7.4.2", + "rimraf": "^2.6.3", + "semver": "^7.5.3", + "slash": "^2.0.0", + "tmp": "^0.0.33", + "yaml": "^2.2.2" + }, + "bin": { + "patch-package": "index.js" + }, + "engines": { + "node": ">=14", + "npm": ">5" + } + }, + "node_modules/patch-package/node_modules/chalk": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-4.1.2.tgz", + "integrity": "sha512-oKnbhFyRIXpUuez8iBMmyEa4nbj4IOQyuhc/wy9kY7/WVPcwIO9VA668Pu8RkO7+0G76SLROeyw9CpQ061i4mA==", + "license": "MIT", + "dependencies": { + "ansi-styles": "^4.1.0", + "supports-color": "^7.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/chalk/chalk?sponsor=1" + } + }, + "node_modules/patch-package/node_modules/ci-info": { + "version": "3.9.0", + "resolved": "https://registry.npmjs.org/ci-info/-/ci-info-3.9.0.tgz", + "integrity": "sha512-NIxF55hv4nSqQswkAeiOi1r83xy8JldOFDTWiug55KBu9Jnblncd2U6ViHmYgHf01TPZS77NJBhBMKdWj9HQMQ==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/sibiraj-s" + } + ], + "license": "MIT", + "engines": { + "node": ">=8" + } + }, + "node_modules/patch-package/node_modules/open": { + "version": "7.4.2", + "resolved": "https://registry.npmjs.org/open/-/open-7.4.2.tgz", + "integrity": "sha512-MVHddDVweXZF3awtlAS+6pgKLlm/JgxZ90+/NBurBoQctVOOB/zDdVjcyPzQ+0laDGbsWgrRkflI65sQeOgT9Q==", + "license": "MIT", + "dependencies": { + "is-docker": "^2.0.0", + "is-wsl": "^2.1.1" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/patch-package/node_modules/rimraf": { + "version": "2.7.1", + "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-2.7.1.tgz", + "integrity": "sha512-uWjbaKIK3T1OSVptzX7Nl6PvQ3qAGtKEtVRjRuazjfL3Bx5eI409VZSqgND+4UNnmzLVdPj9FqFJNPqBZFve4w==", + "deprecated": "Rimraf versions prior to v4 are no longer supported", + "license": "ISC", + "dependencies": { + "glob": "^7.1.3" + }, + "bin": { + "rimraf": "bin.js" + } + }, + "node_modules/patch-package/node_modules/semver": { + "version": "7.7.3", + "resolved": "https://registry.npmjs.org/semver/-/semver-7.7.3.tgz", + "integrity": "sha512-SdsKMrI9TdgjdweUSR9MweHA4EJ8YxHn8DFaDisvhVlUOe4BF1tLD7GAj0lIqWVl+dPb/rExr0Btby5loQm20Q==", + "license": "ISC", + "bin": { + "semver": "bin/semver.js" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/patch-package/node_modules/slash": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/slash/-/slash-2.0.0.tgz", + "integrity": "sha512-ZYKh3Wh2z1PpEXWr0MpSBZ0V6mZHAQfYevttO11c51CaWjGTaadiKZ+wVt1PbMlDV5qhMFslpZCemhwOK7C89A==", + "license": "MIT", + "engines": { + "node": ">=6" + } + }, + "node_modules/patch-package/node_modules/yaml": { + "version": "2.8.2", + "resolved": "https://registry.npmjs.org/yaml/-/yaml-2.8.2.tgz", + "integrity": "sha512-mplynKqc1C2hTVYxd0PU2xQAc22TI1vShAYGksCCfxbn/dFwnHTNi1bvYsBTkhdUNtGIf5xNOg938rrSSYvS9A==", + "license": "ISC", + "bin": { + "yaml": "bin.mjs" + }, + "engines": { + "node": ">= 14.6" + }, + "funding": { + "url": "https://github.com/sponsors/eemeli" + } + }, "node_modules/path-exists": { "version": "4.0.0", "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", @@ -13654,6 +13849,12 @@ "url": "https://opencollective.com/webpack" } }, + "node_modules/sdp": { + "version": "3.2.1", + "resolved": "https://registry.npmjs.org/sdp/-/sdp-3.2.1.tgz", + "integrity": "sha512-lwsAIzOPlH8/7IIjjz3K0zYBk7aBVVcvjMwt3M4fLxpjMYyy7i3I97SLHebgn4YBjirkzfp3RvRDWSKsh/+WFw==", + "license": "MIT" + }, "node_modules/seek-bzip": { "version": "1.0.6", "resolved": "https://registry.npmjs.org/seek-bzip/-/seek-bzip-1.0.6.tgz", @@ -16459,6 +16660,19 @@ "url": "https://opencollective.com/webpack" } }, + "node_modules/webrtc-adapter": { + "version": "8.2.3", + "resolved": "https://registry.npmjs.org/webrtc-adapter/-/webrtc-adapter-8.2.3.tgz", + "integrity": "sha512-gnmRz++suzmvxtp3ehQts6s2JtAGPuDPjA1F3a9ckNpG1kYdYuHWYpazoAnL9FS5/B21tKlhkorbdCXat0+4xQ==", + "license": "BSD-3-Clause", + "dependencies": { + "sdp": "^3.2.0" + }, + "engines": { + "node": ">=6.0.0", + "npm": ">=3.10.0" + } + }, "node_modules/websocket-driver": { "version": "0.7.4", "resolved": "https://registry.npmjs.org/websocket-driver/-/websocket-driver-0.7.4.tgz", diff --git a/hsm-web/Client/package.json b/hsm-web/Client/package.json index 21f7248..d9aa322 100644 --- a/hsm-web/Client/package.json +++ b/hsm-web/Client/package.json @@ -8,6 +8,7 @@ "lint": "vue-cli-service lint" }, "dependencies": { + "@tomoxv/gstwebrtc-api": "^2.0.0", "@vue/cli": "^5.0.9", "axios": "^1.13.2", "core-js": "^3.8.3", diff --git a/hsm-web/Client/src/App.vue b/hsm-web/Client/src/App.vue index 84fefcf..af4ca3e 100644 --- a/hsm-web/Client/src/App.vue +++ b/hsm-web/Client/src/App.vue @@ -1,14 +1,17 @@ <template> <h1>HsMouse</h1> <INA226 /> + <CameraStream /> </template> <script> import INA226 from './INA226.vue' +import CameraStream from './CameraStream.vue' export default { components: { - INA226 + INA226, + CameraStream } } </script> diff --git a/hsm-web/Client/src/CameraStream.vue b/hsm-web/Client/src/CameraStream.vue new file mode 100644 index 0000000..1defed2 --- /dev/null +++ b/hsm-web/Client/src/CameraStream.vue @@ -0,0 +1,103 @@ +<template> + <h2>Camera Stream</h2> + <button @click='toggleStream()' :disabled='disabled'>{{ command }}</button> + <video ref='player' muted></video> +</template> + +<script> +import axios from 'axios' +import config from './config' +import GstWebRTCAPI from '@tomoxv/gstwebrtc-api/src/gstwebrtc-api.js' +import { useTemplateRef } from 'vue' + +export default { + data() { + return { + api: null, + listener: null, + player: null, + session: null, + + command: 'Loading', + disabled: true, + streaming: false + } + }, + mounted() { + this.player = useTemplateRef('player') + this.monitor() + this.bindStream() + }, + methods: { + // Continuously checks if WebRTC stream is running on server + async monitor() { + const res = await axios.get(config.api + '/isStreaming') + + switch (res.status) { + case 200: + this.command = res.data ? 'Stop' : 'Play' + this.disabled = false + this.streaming = res.data + break + default: + this.command = 'Error' + this.disabled = true + this.streaming = false + } + + setTimeout(this.monitor, 1000) + }, + + // Toggles WebRTC stream + async toggleStream() { + const ep = this.streaming ? '/stopStream' : '/startStream' + const res = await axios.get(config.api + ep) + + if (res.status != 200) { + console.error(res) + } + }, + + // Binds WebRTC stream to video element + bindStream() { + this.api = new GstWebRTCAPI({ + meta: { name: 'WebClient-' + Date.now() }, + signalingServerUrl: 'ws://' + window.location.hostname + ':8443' + }) + + this.listener = { + producerAdded: (producer) => { + console.log("Producer added", producer) + + this.session = this.api.createConsumerSession(producer.id) + this.session.addEventListener('streamsChanged', () => { + if (this.session.streams.length > 0) { + this.player.srcObject = this.session.streams[0] + this.player.play() + } + }) + + this.session.connect() + }, + + producerRemoved: (producer) => { + console.log("Producer removed", producer) + + this.player.pause() + this.player.srcObject = null + this.session = null + } + } + + this.api.registerProducersListener(this.listener) + } + } +} +</script> + +<style> +video { + height: 360px; + width: 480px; +} +</style> diff --git a/hsm-web/Client/src/INA226.vue b/hsm-web/Client/src/INA226.vue index bf0141f..a827b0b 100644 --- a/hsm-web/Client/src/INA226.vue +++ b/hsm-web/Client/src/INA226.vue @@ -1,41 +1,42 @@ <template> - <h3>Battery Status</h3> + <h2>Battery Status</h2> <table> <tbody> <tr> - <td>{{ ina226Reading.voltage.toFixed(2) }}V</td> - <td>{{ ina226Reading.current.toFixed(2) }}A</td> - <td>{{ ina226Reading.power.toFixed(2) }}W</td> + <td>{{ fmt(reading.voltage, 'V') }}</td> + <td>{{ fmt(reading.current, 'A') }}</td> + <td>{{ fmt(reading.power, 'W') }}</td> </tr> </tbody> </table> </template> <script> -import axios from 'axios' +import axios from 'axios' import config from './config' export default { data() { return { - ina226Reading: { + reading: { voltage: 0, current: 0, - power: 0 + power: 0 } } }, mounted() { - this.getINA226Reading() + this.getReading() }, methods: { - getINA226Reading() { - axios - .get(`${config.api}/ina226`) - .then(res => { - this.ina226Reading = res.data - setTimeout(this.getINA226Reading, 1000) - }) + async getReading() { + const res = await axios.get(config.api + '/ina226') + this.reading = res.data + + setTimeout(this.getReading, 1000) + }, + fmt(val, sfx) { + return val.toFixed(2) + sfx } } } diff --git a/hsm-web/Client/src/config.js b/hsm-web/Client/src/config.js index b8e9a98..b2217b7 100644 --- a/hsm-web/Client/src/config.js +++ b/hsm-web/Client/src/config.js @@ -1,3 +1,3 @@ module.exports = { - api: 'http://192.168.8.170:3000' + api: `http://${window.location.hostname}:3000` } diff --git a/hsm-web/Hsm/Web.hs b/hsm-web/Hsm/Web.hs index 4f6fb6e..f7fddad 100644 --- a/hsm-web/Hsm/Web.hs +++ b/hsm-web/Hsm/Web.hs @@ -10,6 +10,7 @@ where import Data.Aeson (encode) import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>)) +import Effectful.Concurrent (Concurrent) import Effectful.Dispatch.Static ( SideEffects (WithSideEffects) , StaticRep @@ -20,8 +21,10 @@ import Effectful.Dispatch.Static ) import Effectful.Dispatch.Static.Primitive (Env) import Effectful.Exception (finally) +import Effectful.Fail (Fail) import Hsm.INA226 (I2CINA226, INA226, readINA226State) import Hsm.Log (Logs, Severity (Info, Trace), logMsg, makeLoggerIO) +import Hsm.Stream (Stream, isStreaming, startStream, stopStream) import Network.Wai.Handler.Warp (defaultSettings, setLogger) import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->)) import Paths_hsm_web (getDataFileName) @@ -34,17 +37,51 @@ type instance DispatchOf Web = Static WithSideEffects newtype instance StaticRep Web = Web Options -server :: (I2CINA226 :> es, INA226 :> es, Logs '["i2c", "ina226"] es) => Options -> Env es -> IO () +server + :: ( Concurrent :> es + , Fail :> es + , I2CINA226 :> es + , INA226 :> es + , Logs '["gst", "i2c", "ina226", "stream"] es + , Stream :> es + ) + => Options + -> Env es + -> IO () server options env = do dist <- getDataFileName "Client/dist/" scottyOpts options $ do + -- Index and static files middleware . staticPolicy $ noDots >-> addBase dist get "/" . file $ dist <> "index.html" get "/ina226" $ do setHeader "Content-Type" "application/json" - liftIO (unEff readINA226State env) >>= raw . encode + res <- liftIO $ unEff readINA226State env + raw $ encode res + -- Camera stream control endpoints + get "/startStream" $ do + setHeader "Content-Type" "text/plain" + liftIO $ unEff startStream env + raw "Started stream" + get "/stopStream" $ do + setHeader "Content-Type" "text/plain" + liftIO $ unEff stopStream env + raw "Stopped stream" + get "/isStreaming" $ do + setHeader "Content-Type" "text/plain" + res <- liftIO $ unEff isStreaming env + raw $ encode res -runServer :: (I2CINA226 :> es, INA226 :> es, Logs '["i2c", "ina226", "web"] es, Web :> es) => Eff es () +runServer + :: ( Concurrent :> es + , Fail :> es + , I2CINA226 :> es + , INA226 :> es + , Logs '["gst", "i2c", "ina226", "stream", "web"] es + , Stream :> es + , Web :> es + ) + => Eff es () runServer = finally startServer stopServer where startServer = do diff --git a/hsm-web/Main.hs b/hsm-web/Main.hs index 0ec780e..0eb5237 100644 --- a/hsm-web/Main.hs +++ b/hsm-web/Main.hs @@ -1,20 +1,33 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE TemplateHaskell #-} import Data.Function ((&)) import Effectful (runEff) +import Effectful.Concurrent (runConcurrent) +import Effectful.Fail (runFailIO) import Hsm.Core.App (bootstrapAppNoEcho) import Hsm.I2C (runI2C) import Hsm.INA226 (runINA226) import Hsm.Log (Severity (Info), runLogsOpt) import Hsm.Log.Options (makeLoggerOptionParser) +import Hsm.Stream (runStream) import Hsm.Web (runServer, runWeb) -- Import full module for cleaner `-ddump-splices` output -- Avoids package/module qualifiers in generated code import Options.Applicative -type Logs = '["i2c", "ina226", "scotty", "web"] +type Logs = '["gst", "i2c", "ina226", "scotty", "stream", "web"] $(makeLoggerOptionParser @Logs "Options" "parser" 'Info) main :: IO () -main = bootstrapAppNoEcho parser "Launch HsMouse Web Server" $ \opts -> runServer & runWeb & runINA226 & runI2C & runLogsOpt @Options @Logs opts & runEff +main = bootstrapAppNoEcho parser "Launch HsMouse Web Server" $ \opts -> + runServer + & runWeb + & runStream + & runINA226 + & runI2C + & runLogsOpt @Options @Logs opts + & runConcurrent + & runFailIO + & runEff diff --git a/hsm-web/hsm-web.cabal b/hsm-web/hsm-web.cabal index 20b7db0..4c2a9b8 100644 --- a/hsm-web/hsm-web.cabal +++ b/hsm-web/hsm-web.cabal @@ -12,10 +12,12 @@ library build-depends: , aeson , base + , effectful , effectful-core , effectful-plugin , hsm-ina226 , hsm-log + , hsm-stream , scotty , wai-middleware-static , warp @@ -32,12 +34,14 @@ executable hsm-web build-depends: , aeson , base + , effectful , effectful-core , effectful-plugin , hsm-core , hsm-i2c , hsm-ina226 , hsm-log + , hsm-stream , optparse-applicative , scotty , wai-middleware-static |