1 files changed, 36 insertions, 12 deletions
diff --git a/hsm-web/Hsm/Web.hs b/hsm-web/Hsm/Web.hs
index f7fddad..a99ba5b 100644
--- a/hsm-web/Hsm/Web.hs
+++ b/hsm-web/Hsm/Web.hs
@@ -9,6 +9,7 @@ module Hsm.Web
 where
 
 import Data.Aeson (encode)
+import Data.Maybe (fromJust, isJust)
 import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
 import Effectful.Concurrent (Concurrent)
 import Effectful.Dispatch.Static
@@ -22,13 +23,29 @@ import Effectful.Dispatch.Static
 import Effectful.Dispatch.Static.Primitive (Env)
 import Effectful.Exception (finally)
 import Effectful.Fail (Fail)
+import Hsm.Drive (Action, Drive, drive)
+import Hsm.GPIO (GPIO)
 import Hsm.INA226 (I2CINA226, INA226, readINA226State)
 import Hsm.Log (Logs, Severity (Info, Trace), logMsg, makeLoggerIO)
+import Hsm.PWM (PWM)
 import Hsm.Stream (Stream, isStreaming, startStream, stopStream)
+import Network.HTTP.Types.Status (status400)
 import Network.Wai.Handler.Warp (defaultSettings, setLogger)
 import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->))
 import Paths_hsm_web (getDataFileName)
-import Web.Scotty (Options (settings, verbose), defaultOptions, file, get, middleware, raw, scottyOpts, setHeader)
+import Text.Read (readMaybe)
+import Web.Scotty
+  ( Options (settings, verbose)
+  , defaultOptions
+  , file
+  , get
+  , middleware
+  , queryParamMaybe
+  , raw
+  , scottyOpts
+  , setHeader
+  , status
+  )
 
 data Web (a :: * -> *) (b :: *)
 
@@ -39,10 +56,13 @@ newtype instance StaticRep Web
 
 server
   :: ( Concurrent :> es
+     , Drive :> es
      , Fail :> es
+     , GPIO :> es
      , I2CINA226 :> es
      , INA226 :> es
-     , Logs '["gst", "i2c", "ina226", "stream"] es
+     , Logs '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream"] es
+     , PWM :> es
      , Stream :> es
      )
   => Options
@@ -54,30 +74,34 @@ server options env = do
     -- Index and static files
     middleware . staticPolicy $ noDots >-> addBase dist
     get "/" . file $ dist <> "index.html"
+    -- Battery status
     get "/ina226" $ do
       setHeader "Content-Type" "application/json"
       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 "/startStream" . liftIO $ unEff startStream env
+    get "/stopStream" $ liftIO $ unEff stopStream env
     get "/isStreaming" $ do
       setHeader "Content-Type" "text/plain"
       res <- liftIO $ unEff isStreaming env
       raw $ encode res
+    -- Motion control
+    get "/command" $ do
+      cmd <- (>>= readMaybe @Action) <$> queryParamMaybe "cmd"
+      if isJust cmd
+        then liftIO $ unEff (drive [fromJust cmd]) env
+        else status status400
 
 runServer
   :: ( Concurrent :> es
+     , Drive :> es
      , Fail :> es
+     , GPIO :> es
      , I2CINA226 :> es
      , INA226 :> es
-     , Logs '["gst", "i2c", "ina226", "stream", "web"] es
+     , Logs '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream", "web"] es
+     , PWM :> es
      , Stream :> es
      , Web :> es
      )
@@ -96,5 +120,5 @@ runWeb action = do
   scottyLogger <- logRequest <$> makeLoggerIO @"scotty"
   evalStaticRep (Web $ options scottyLogger) action
   where
-    logRequest loggerIO request status fileSize = loggerIO Trace $ unwords [show request, show status, show fileSize]
+    logRequest loggerIO request code fileSize = loggerIO Trace $ unwords [show request, show code, show fileSize]
     options logger = defaultOptions{verbose = 0, settings = setLogger logger defaultSettings}