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