4 files changed, 160 insertions, 0 deletions
diff --git a/hsm-web/Hsm/Web.hs b/hsm-web/Hsm/Web.hs
new file mode 100644
index 0000000..8c0284c
--- /dev/null
+++ b/hsm-web/Hsm/Web.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Web
+  ( Web
+  , runServer
+  , runWeb
+  )
+where
+
+import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, (:>))
+import Effectful.Dispatch.Static
+  ( SideEffects (WithSideEffects)
+  , StaticRep
+  , evalStaticRep
+  , getStaticRep
+  , unEff
+  , unsafeEff
+  )
+import Effectful.Dispatch.Static.Primitive (Env)
+import Effectful.Exception (finally)
+import Hsm.Cam (Cam, capturePng)
+import Hsm.Log (Log, Logs, Severity (Info, Trace), logMsg, makeLoggerIO)
+import Network.Wai.Handler.Warp (defaultSettings, setLogger)
+import Paths_hsm_web (getDataFileName)
+import Web.Scotty (Options (settings, verbose), defaultOptions, file, get, liftIO, raw, scottyOpts, setHeader)
+
+data Web (a :: * -> *) (b :: *)
+
+type instance DispatchOf Web = Static WithSideEffects
+
+newtype instance StaticRep Web
+  = Web Options
+
+server :: (Cam :> es, Log "cam" :> es) => Options -> Env es -> IO ()
+server options env = do
+  index <- getDataFileName "Html/index.html"
+  scottyOpts options $ do
+    get "/" $ file index
+    get "/cam.png" $ do
+      setHeader "Content-Type" "image/png"
+      liftIO (unEff capturePng env) >>= raw
+
+runServer :: (Cam :> es, Logs '["cam", "web"] es, Web :> es) => Eff es ()
+runServer = finally startServer stopServer
+  where
+    startServer = do
+      Web options <- getStaticRep
+      logMsg @"web" Info "Starting scotty web server"
+      unsafeEff $ server options
+    stopServer = logMsg @"web" Info "Stopping scotty web server"
+
+runWeb :: (IOE :> es, Logs '["scotty", "web"] es) => Eff (Web : es) a -> Eff es a
+runWeb action = do
+  logMsg @"web" Info "Registering logger for scotty web server"
+  scottyLogger <- makeLoggerIO @"scotty" >>= return . logRequest
+  evalStaticRep (Web $ defaultOptions{verbose = 0, settings = setLogger scottyLogger defaultSettings}) action
+  where
+    logRequest loggerIO request status fileSize = loggerIO Trace $ unwords [show request, show status, show fileSize]
diff --git a/hsm-web/Html/index.html b/hsm-web/Html/index.html
new file mode 100644
index 0000000..030e8e5
--- /dev/null
+++ b/hsm-web/Html/index.html
@@ -0,0 +1,34 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <title>HsMouse Monitor</title>
+    <meta charset="utf-8"/>
+  </head>
+  <body>
+    <h2>HsMouse Monitor</h2>
+    <img id="my_img"></img>
+  </body>
+  <script>
+    function updateImg() {
+      fetch("cam.png")
+        .then(response => response.blob())
+        .then(function(myBlob){
+          URL.revokeObjectURL(my_img.src)
+          my_img.src = URL.createObjectURL(myBlob)
+          updateImg()
+        })
+    }
+    updateImg()
+  </script>
+  <style>
+    body, html {
+      background-color: #002b36;
+      color: #586e75;
+      font-family: monospace;
+    }
+    img {
+      outline: 2px solid #586e75;
+      width: 100%;
+    }
+  </style>
+</html>
diff --git a/hsm-web/Main.hs b/hsm-web/Main.hs
new file mode 100644
index 0000000..82e07c9
--- /dev/null
+++ b/hsm-web/Main.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.Function ((&))
+import Effectful (runEff)
+import Hsm.Cam (runCam)
+import Hsm.Core.App (bootstrapAppNoEcho)
+import Hsm.Log (Severity (Info), runLogsOpt)
+import Hsm.Log.Options (makeLoggerOptionParser)
+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 = '["cam", "libcamera", "scotty", "web"]
+
+$(makeLoggerOptionParser @Logs "Options" "parser" 'Info)
+
+main :: IO ()
+main = bootstrapAppNoEcho parser "Launch HsMouse Web Server" $ \opts -> runServer & runWeb & runCam & runLogsOpt @Options @Logs opts & runEff
diff --git a/hsm-web/hsm-web.cabal b/hsm-web/hsm-web.cabal
new file mode 100644
index 0000000..ca631b4
--- /dev/null
+++ b/hsm-web/hsm-web.cabal
@@ -0,0 +1,48 @@
+cabal-version: 3.8
+author:        Paul Oliver <contact@pauloliver.dev>
+name:          hsm-web
+version:       0.1.0.0
+data-files:    Html/index.html
+
+library
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , hsm-cam
+    , hsm-log
+    , scotty
+    , warp
+
+  default-language: GHC2024
+  exposed-modules:  Hsm.Web
+  ghc-options:
+    -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
+    -fplugin=Effectful.Plugin
+
+  other-modules:    Paths_hsm_web
+
+executable hsm-web
+  build-depends:
+    , base
+    , effectful-core
+    , effectful-plugin
+    , hsm-cam
+    , hsm-core
+    , hsm-log
+    , optparse-applicative
+    , scotty
+    , warp
+
+  default-language: GHC2024
+  ghc-options:
+    -O2 -threaded -Wall -Werror -Wno-star-is-type -Wunused-packages -Wno-unused-imports
+    -ddump-splices -fplugin=Effectful.Plugin
+
+  if !arch(x86_64)
+    ghc-options: -optl=-mno-fix-cortex-a53-835769
+
+  main-is:          Main.hs
+  other-modules:
+    Hsm.Web
+    Paths_hsm_web