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
|
{-# 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]
|
