LoginRoutes.hs

{-# LANGUAGE OverloadedLabels #-}

module WikiMusic.SSR.Servant.LoginRoutes (submitLoginRoute, loginFormRoute) where

import Control.Monad.Error.Class
import Data.ByteString.Lazy qualified as BL
import Data.Map qualified as Map
import Data.Text qualified as T
import Free.AlaCarte
import Optics
import Relude
import Servant
import Servant.Multipart
import Text.Blaze.Html as Html
import WikiMusic.Model.Auth
import WikiMusic.SSR.Backend.Rest ()
import WikiMusic.SSR.Free.Backend
import WikiMusic.SSR.Free.View
import WikiMusic.SSR.Model.Api
import WikiMusic.SSR.Model.Env
import WikiMusic.SSR.Servant.Utilities
import WikiMusic.SSR.View.Html ()

submitLoginRoute :: (MonadIO m, MonadError ServerError m) => Env -> MultipartData tag -> m a
submitLoginRoute env multipartData = do
  maybeAuthToken <- liftIO $ exec @Backend (login env (LoginRequest {wikimusicEmail = email, wikimusicPassword = password}))
  case maybeAuthToken of
    Left e -> do
      _ <- liftIO $ BL.putStr . fromString . T.unpack $ e
      setCookieRoute (env ^. #cfg % #cookie) "/login" Map.empty
    Right authToken -> setCookieRoute (env ^. #cfg % #cookie) "/songs" (Map.fromList [(authCookieName, encodeToken authToken)])
  where
    email = T.unpack $ fromForm multipartData "" "email"
    password = T.unpack $ fromForm multipartData "" "password"

loginFormRoute :: (MonadIO m) => Env -> Maybe Text -> m Html
loginFormRoute env cookie = liftIO $ exec @View (loginPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))
  where
    viewVars = viewVarsFromCookies cookie