aboutsummaryrefslogtreecommitdiff
path: root/hsm-web/Hsm
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-web/Hsm')
-rw-r--r--hsm-web/Hsm/Web.hs28
1 files changed, 7 insertions, 21 deletions
diff --git a/hsm-web/Hsm/Web.hs b/hsm-web/Hsm/Web.hs
index 8c0284c..aaf67d2 100644
--- a/hsm-web/Hsm/Web.hs
+++ b/hsm-web/Hsm/Web.hs
@@ -9,21 +9,13 @@ module Hsm.Web
where
import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, (:>))
-import Effectful.Dispatch.Static
- ( SideEffects (WithSideEffects)
- , StaticRep
- , evalStaticRep
- , getStaticRep
- , unEff
- , unsafeEff
- )
+import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep, evalStaticRep, getStaticRep, 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)
+import Web.Scotty (Options (settings, verbose), defaultOptions, file, get, scottyOpts)
data Web (a :: * -> *) (b :: *)
@@ -32,23 +24,17 @@ 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
+server :: Options -> Env es -> IO ()
+server options _ = getDataFileName "Html/index.html" >>= scottyOpts options . get "/" . file
-runServer :: (Cam :> es, Logs '["cam", "web"] es, Web :> es) => Eff es ()
+runServer :: (Log "web" :> es, Web :> es) => Eff es ()
runServer = finally startServer stopServer
where
startServer = do
Web options <- getStaticRep
- logMsg @"web" Info "Starting scotty web server"
+ logMsg Info "Starting scotty web server"
unsafeEff $ server options
- stopServer = logMsg @"web" Info "Stopping scotty web server"
+ stopServer = logMsg Info "Stopping scotty web server"
runWeb :: (IOE :> es, Logs '["scotty", "web"] es) => Eff (Web : es) a -> Eff es a
runWeb action = do