forge/Vervis
1
0
Fork 0
Code Pull requests Activity

C2S: In yesod authorization check, support OAuth2 as login method

Browse source
This commit is contained in:
fr33domlover 2020-07-06 08:01:02 +00:00
parent d392a37707
commit 511c3c60db
1 changed files with 10 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/Vervis/Foundation.hs
View file

@ -15,10 +15,12 @@
module Vervis.Foundation where module Vervis.Foundation where
import Control.Applicative
import Control.Concurrent.Chan import Control.Concurrent.Chan
import Control.Concurrent.STM.TVar import Control.Concurrent.STM.TVar
import Control.Monad import Control.Monad
import Control.Monad.Logger.CallStack (logWarn) import Control.Monad.Logger.CallStack (logWarn)
import Control.Monad.Trans.Maybe
import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding import Data.Text.Encoding
@ -35,7 +37,7 @@ import Network.HTTP.Types.Header
import Text.Shakespeare.Text (textFile) import Text.Shakespeare.Text (textFile)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
--import Text.Jasmine (minifym) --import Text.Jasmine (minifym)
import Text.Read import Text.Read hiding (lift)
import Web.Hashids import Web.Hashids
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.Account import Yesod.Auth.Account
@ -202,6 +204,7 @@ instance Yesod App where
(getCurrentRoute >>= \ mr -> case mr of (getCurrentRoute >>= \ mr -> case mr of
Nothing -> return False Nothing -> return False
Just PostReceiveR -> return False Just PostReceiveR -> return False
Just (SharerOutboxR _) -> return False
Just (SharerInboxR _) -> return False Just (SharerInboxR _) -> return False
Just (ProjectInboxR _ _) -> return False Just (ProjectInboxR _ _) -> return False
Just (RepoInboxR _ _) -> return False Just (RepoInboxR _ _) -> return False
@ -386,10 +389,15 @@ instance Yesod App where
personAnd personAnd
:: (Entity Person -> Handler AuthResult) -> Handler AuthResult :: (Entity Person -> Handler AuthResult) -> Handler AuthResult
personAnd f = do personAnd f = do
mp <- maybeAuth mp <- runMaybeT $ MaybeT maybeAuth <|> maybeAuthDvara
case mp of case mp of
Nothing -> return AuthenticationRequired Nothing -> return AuthenticationRequired
Just p -> f p Just p -> f p
where
maybeAuthDvara = do
(_app, mpid, _scopes) <- MaybeT getDvaraAuth
pid <- MaybeT $ pure mpid
lift $ runDB $ getJustEntity pid
personUnverifiedAnd personUnverifiedAnd
:: (Entity Person -> Handler AuthResult) -> Handler AuthResult :: (Entity Person -> Handler AuthResult) -> Handler AuthResult