1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Hsm.Web
( Web
, runServer
, runWeb
)
where
import Data.Aeson (encode)
import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
import Effectful.Concurrent (Concurrent)
import Effectful.Dispatch.Static
( SideEffects (WithSideEffects)
, StaticRep
, evalStaticRep
, getStaticRep
, unEff
, unsafeEff
)
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)
import Web.Scotty (Options (settings, verbose), defaultOptions, file, get, middleware, raw, scottyOpts, setHeader)
data Web (a :: * -> *) (b :: *)
type instance DispatchOf Web = Static WithSideEffects
newtype instance StaticRep Web
= Web Options
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"
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
:: ( 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
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 <- logRequest <$> makeLoggerIO @"scotty"
evalStaticRep (Web $ options scottyLogger) action
where
logRequest loggerIO request status fileSize = loggerIO Trace $ unwords [show request, show status, show fileSize]
options logger = defaultOptions{verbose = 0, settings = setLogger logger defaultSettings}
|
