From 8f83462134d260b59a156ab8fc43ab26f0b906b5 Mon Sep 17 00:00:00 2001
From: Arthur Sakhievich Fayzrakhmanov <heraldhoi@gmail.com>
Date: Fri, 10 Sep 2021 11:29:24 +0500
Subject: [PATCH] Fix GHC 9.0.1 build

---
 yesod-auth/Yesod/Auth/Dummy.hs        |  2 ++
 yesod-auth/Yesod/Auth/Email.hs        | 26 ++++++++++++++------------
 yesod-auth/Yesod/Auth/GoogleEmail2.hs |  4 +++-
 yesod-auth/Yesod/Auth/Hardcoded.hs    |  1 +
 4 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs
index b768b3ae..5b1b703c 100644
--- a/yesod-auth/Yesod/Auth/Dummy.hs
+++ b/yesod-auth/Yesod/Auth/Dummy.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | Provides a dummy authentication module that simply lets a user specify
 -- their identifier. This is not intended for real world use, just for
@@ -49,6 +50,7 @@ authDummy :: YesodAuth m => AuthPlugin m
 authDummy =
     AuthPlugin "dummy" dispatch login
   where
+    dispatch :: Text -> [Text] -> AuthHandler m TypedContent
     dispatch "POST" [] = do
         (jsonResult :: Result Value) <- parseCheckJsonBody
         eIdent <- case jsonResult of
diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs
index 7a09d8c6..2395ed67 100644
--- a/yesod-auth/Yesod/Auth/Email.hs
+++ b/yesod-auth/Yesod/Auth/Email.hs
@@ -31,16 +31,16 @@
 -- = Using JSON Endpoints
 --
 -- We are assuming that you have declared auth route as follows
--- 
+--
 -- @
 --    /auth AuthR Auth getAuth
 -- @
--- 
+--
 -- If you are using a different route, then you have to adjust the
 -- endpoints accordingly.
 --
 --     * Registration
--- 
+--
 -- @
 --       Endpoint: \/auth\/page\/email\/register
 --       Method: POST
@@ -49,9 +49,9 @@
 --                      "password": "myStrongPassword" (optional)
 --                  }
 -- @
--- 
+--
 --     * Forgot password
---  
+--
 -- @
 --       Endpoint: \/auth\/page\/email\/forgot-password
 --       Method: POST
@@ -59,16 +59,16 @@
 -- @
 --
 --     * Login
---  
+--
 -- @
 --       Endpoint: \/auth\/page\/email\/login
 --       Method: POST
---       JSON Data: { 
+--       JSON Data: {
 --                      "email": "myemail@domain.com",
 --                      "password": "myStrongPassword"
 --                  }
 -- @
--- 
+--
 --     * Set new password
 --
 -- @
@@ -139,6 +139,7 @@ import qualified Text.Email.Validate
 import           Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?))
 import           Data.Maybe (isJust)
 import Data.ByteArray (convert)
+import Yesod.Core.Types (TypedContent(TypedContent))
 
 loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
 loginR = PluginR "email" ["login"]
@@ -240,7 +241,7 @@ class ( YesodAuth site
     --
     -- @since 1.4.20
     hashAndSaltPassword :: Text -> AuthHandler site SaltedPass
-    hashAndSaltPassword = liftIO . saltPass
+    hashAndSaltPassword password = liftIO $ saltPass password
 
     -- | Verify a password matches the stored password for the given account.
     --
@@ -432,6 +433,7 @@ authEmail :: (YesodAuthEmail m) => AuthPlugin m
 authEmail =
     AuthPlugin "email" dispatch emailLoginHandler
   where
+    dispatch :: YesodAuthEmail m => Text -> [Text] -> AuthHandler m TypedContent
     dispatch "GET" ["register"] = getRegisterR >>= sendResponse
     dispatch "POST" ["register"] = postRegisterR >>= sendResponse
     dispatch "GET" ["forgot-password"] = getForgotPasswordR >>= sendResponse
@@ -779,8 +781,8 @@ getPasswordR = do
     maid <- maybeAuthId
     case maid of
         Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
-        Just _ -> do
-            needOld <- maybe (return True) needOldPassword maid
+        Just aid -> do
+            needOld <- needOldPassword aid
             setPasswordHandler needOld
 
 -- | Default implementation of 'setPasswordHandler'.
@@ -932,7 +934,7 @@ postPasswordR = do
 
                      mr <- getMessageRender
                      selectRep $ do
-                         provideRep $ 
+                         provideRep $
                             fmap asHtml $ redirect $ afterPasswordRoute y
                          provideJsonMessage (mr msgOk)
 
diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
index ce734a40..5dbbd6d1 100644
--- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs
+++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs
@@ -247,7 +247,9 @@ authPlugin storeToken clientID clientSecret =
         -- User's access token is saved for further access to API
         when storeToken $ setSession accessTokenKey accessToken'
 
-        personValue <- makeHttpRequest =<< personValueRequest token
+        personValReq <- personValueRequest token
+        personValue <- makeHttpRequest personValReq
+
         person <- case parseEither parseJSON personValue of
                 Left e -> error e
                 Right x -> return x
diff --git a/yesod-auth/Yesod/Auth/Hardcoded.hs b/yesod-auth/Yesod/Auth/Hardcoded.hs
index 4acfac06..e8bdccdb 100644
--- a/yesod-auth/Yesod/Auth/Hardcoded.hs
+++ b/yesod-auth/Yesod/Auth/Hardcoded.hs
@@ -159,6 +159,7 @@ authHardcoded :: YesodAuthHardcoded m => AuthPlugin m
 authHardcoded =
   AuthPlugin "hardcoded" dispatch loginWidget
   where
+    dispatch :: YesodAuthHardcoded m => Text -> [Text] -> AuthHandler m TypedContent
     dispatch "POST" ["login"] = postLoginR >>= sendResponse
     dispatch _ _ = notFound
     loginWidget toMaster = do