From 511c3c60db8744bc7b45fd2e30d1d9059561493b Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Mon, 6 Jul 2020 08:01:02 +0000
Subject: [PATCH] C2S: In yesod authorization check, support OAuth2 as login
 method

---
 src/Vervis/Foundation.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

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