diff options
| -rw-r--r-- | hsm-web/Hsm/Web.hs | 51 | ||||
| -rw-r--r-- | hsm-web/Html/index.html | 34 | ||||
| -rw-r--r-- | hsm-web/Main.hs | 7 | ||||
| -rw-r--r-- | hsm-web/hsm-web.cabal | 46 | ||||
| -rw-r--r-- | stack.yaml | 3 | ||||
| -rw-r--r-- | stack.yaml.lock | 8 |
6 files changed, 144 insertions, 5 deletions
diff --git a/hsm-web/Hsm/Web.hs b/hsm-web/Hsm/Web.hs new file mode 100644 index 0000000..975f556 --- /dev/null +++ b/hsm-web/Hsm/Web.hs @@ -0,0 +1,51 @@ +{-# 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, 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, Log "cam" :> es, Log "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, Log "scotty" :> es, Log "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..9eef1e7 --- /dev/null +++ b/hsm-web/Main.hs @@ -0,0 +1,7 @@ +import Effectful (runEff) +import Hsm.Cam (runCam) +import Hsm.Log (Severity(Info), runLogs) +import Hsm.Web (runServer, runWeb) + +main :: IO () +main = runEff . runLogs @'[ "cam", "libcamera", "scotty", "web"] Info . runCam . runWeb $ runServer diff --git a/hsm-web/hsm-web.cabal b/hsm-web/hsm-web.cabal new file mode 100644 index 0000000..89d97e9 --- /dev/null +++ b/hsm-web/hsm-web.cabal @@ -0,0 +1,46 @@ +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-log + , scotty + , warp + + default-language: GHC2024 + ghc-options: + -O2 -threaded -Wall -Werror -Wno-star-is-type -Wunused-packages + -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 @@ -8,4 +8,5 @@ packages: - hsm-log - hsm-pwm - hsm-repl -resolver: lts-24.7 + - hsm-web +resolver: lts-24.8 diff --git a/stack.yaml.lock b/stack.yaml.lock index de48d6f..550b233 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -20,7 +20,7 @@ packages: hackage: typelits-printf-0.3.0.0 snapshots: - completed: - sha256: b63fde5242c7a5d20e9c8070190038c5589424dabb8f8c7f02ec4b2be743ad23 - size: 726276 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/7.yaml - original: lts-24.7 + sha256: d347039f81388e16ea93ddaf9ff1850abfba8f8680ff75fbdd177692542ceb26 + size: 726286 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/8.yaml + original: lts-24.8 |