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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Hsm.Web
( Web
, runServer
, runWeb
)
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
( SideEffects (WithSideEffects)
, StaticRep
, evalStaticRep
, getStaticRep
, unEff
, unsafeEff
)
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 Text.Read (readMaybe)
import Web.Scotty
( Options (settings, verbose)
, defaultOptions
, file
, get
, middleware
, queryParamMaybe
, raw
, scottyOpts
, setHeader
, status
)
data Web (a :: * -> *) (b :: *)
type instance DispatchOf Web = Static WithSideEffects
newtype instance StaticRep Web
= Web Options
server
:: ( Concurrent :> es
, Drive :> es
, Fail :> es
, GPIO :> es
, I2CINA226 :> es
, INA226 :> es
, Logs '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream"] es
, PWM :> 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"
-- Battery status
get "/ina226" $ do
setHeader "Content-Type" "application/json"
res <- liftIO $ unEff readINA226State env
raw $ encode res
-- Camera stream control endpoints
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 '["drive", "gpio", "gst", "i2c", "ina226", "pwm", "stream", "web"] es
, PWM :> 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 code fileSize = loggerIO Trace $ unwords [show request, show code, show fileSize]
options logger = defaultOptions{verbose = 0, settings = setLogger logger defaultSettings}
|
