Adds camera streaming to frontend

1 files changed, 40 insertions, 3 deletions

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