implemented yesodauth, now need use it in handler
This commit is contained in:
parent
4b9d2e8733
commit
ab707af870
2 changed files with 27 additions and 1 deletions
|
|
@ -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
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue