{-# 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, unsafeEff) import Effectful.Dispatch.Static.Primitive (Env) import Effectful.Exception (finally) 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, scottyOpts) data Web (a :: * -> *) (b :: *) type instance DispatchOf Web = Static WithSideEffects newtype instance StaticRep Web = Web Options server :: Options -> Env es -> IO () server options _ = getDataFileName "Html/index.html" >>= scottyOpts options . get "/" . file runServer :: (Log "web" :> es, Web :> es) => Eff es () runServer = finally startServer stopServer where startServer = do Web options <- getStaticRep logMsg Info "Starting scotty web server" unsafeEff $ server options stopServer = logMsg 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 <- 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]