From ab707af87083a2ee0519b74a569118aecb9de26f Mon Sep 17 00:00:00 2001
From: Stuce <lefabricesaucy@outlook.com>
Date: Mon, 23 Jun 2025 11:25:55 +0100
Subject: [PATCH] implemented yesodauth, now need use it in handler

---
 src/Application.hs       | 26 ++++++++++++++++++++++++++
 src/Handler/TodoEntry.hs |  2 +-
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/src/Application.hs b/src/Application.hs
index cb03f37..314b501 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE InstanceSigs #-}
 module Application
     ( getApplicationDev
     , appMain
@@ -43,6 +46,9 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 import Handler.Common
 import Handler.Home
 import Handler.TodoEntry
+import Yesod.Auth
+import Database.Persist.Class.PersistUnique (getByValueUniques)
+import Database.Persist.SqlBackend.SqlPoolHooks (getAlterBackend)
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -187,3 +193,23 @@ handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
 -- | Run DB queries
 db :: ReaderT SqlBackend Handler a -> IO a
 db = handler . runDB
+instance YesodAuthPersist App
+instance YesodAuth App where
+    type AuthId App = Key User
+    loginDest _ = HomeR
+    logoutDest _ = HomeR
+
+    authPlugins _ = [ ]
+
+    authenticate :: (MonadHandler m, HandlerSite m ~ App) => Creds App -> m (AuthenticationResult App)
+    authenticate _ = liftHandler $ do
+        mUserName <- lookupHeader "remoteUser"
+        case mUserName of
+            Just userNameBS -> do
+                        let userName = decodeUtf8 userNameBS
+                        x <- runDB $ insertBy $ User userName
+                        return $ Authenticated $
+                            case x of
+                                Left (Entity user _) -> user -- existing user
+                                Right user -> user -- newly added user
+            Nothing -> notAuthenticated
\ No newline at end of file
diff --git a/src/Handler/TodoEntry.hs b/src/Handler/TodoEntry.hs
index 4ce96d6..b49ac60 100644
--- a/src/Handler/TodoEntry.hs
+++ b/src/Handler/TodoEntry.hs
@@ -241,7 +241,7 @@ getItems text todolistId = map read (lines text)
 --             Nothing -> runDB $ insert $ User "Stuce"
 --             Just u -> return $ entityKey u
 
--- TODO: this is kinda ugly, i need to try to find better solution, maybe do a custom auth instance, but i guess it goes for the moment
+-- TODO: use yesodAuth and clean this mess
 getUserId :: Handler (Key User)
 getUserId = do
     mName <- lookupHeader "Remote-User"