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