{-# 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 Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->)) import Paths_hsm_web (getDataFileName) import Web.Scotty (Options (settings, verbose), defaultOptions, file, get, middleware, scottyOpts) data Web (a :: * -> *) (b :: *) type instance DispatchOf Web = Static WithSideEffects newtype instance StaticRep Web = Web Options server :: Options -> Env es -> IO () server options _ = do dist <- getDataFileName "Client/dist/" scottyOpts options $ do get "/" . file $ dist <> "index.html" middleware . staticPolicy $ noDots >-> addBase dist 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 <- 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}