Merge pull request #1737 from geraldus/ghc-9.0.1

Make yesod-auth buildable with GHC 9.0.1
This commit is contained in:
Michael Snoyman 2021-09-10 14:56:36 +03:00 committed by GitHub
commit dfc270b0b2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 125 additions and 114 deletions

View File

@ -1,5 +1,9 @@
# ChangeLog for yesod-auth
## 1.6.10.4
* Add support for GHC 9 [#1737](https://github.com/yesodweb/yesod/pull/1737)
## 1.6.10.3
* Relax bounds for yesod-form 1.7

View File

@ -1,8 +1,9 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- | Provides a dummy authentication module that simply lets a user specify
-- their identifier. This is not intended for real world use, just for
-- testing. This plugin supports form submissions via JSON (since 1.6.8).
@ -35,12 +36,12 @@ module Yesod.Auth.Dummy
( authDummy
) where
import Yesod.Auth
import Yesod.Form (runInputPost, textField, ireq)
import Yesod.Core
import Data.Text (Text)
import Data.Aeson.Types (Result(..), Parser)
import Data.Aeson.Types (Parser, Result (..))
import qualified Data.Aeson.Types as A (parseEither, withObject)
import Data.Text (Text)
import Yesod.Auth
import Yesod.Core
import Yesod.Form (ireq, runInputPost, textField)
identParser :: Value -> Parser Text
identParser = A.withObject "Ident" (.: "ident")
@ -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

View File

@ -117,18 +117,17 @@ module Yesod.Auth.Email
, defaultRegisterHelper
) where
import Yesod.Auth
import qualified Yesod.Auth.Message as Msg
import Yesod.Core
import Yesod.Form
import qualified Yesod.Auth.Util.PasswordStore as PS
import Control.Applicative ((<$>), (<*>))
import qualified Crypto.Hash as H
import qualified Crypto.Nonce as Nonce
import Data.Aeson.Types (Parser, Result (..), parseMaybe,
withObject, (.:?))
import Data.ByteArray (convert)
import Data.ByteString.Base16 as B16
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as TS
import qualified Data.Text as T
import qualified Data.Text as TS
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import qualified Data.Text.Encoding as TE
import Data.Text.Encoding.Error (lenientDecode)
@ -136,9 +135,12 @@ import Data.Time (addUTCTime, getCurrentTime)
import Safe (readMay)
import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Email.Validate
import Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?))
import Data.Maybe (isJust)
import Data.ByteArray (convert)
import Yesod.Auth
import qualified Yesod.Auth.Message as Msg
import qualified Yesod.Auth.Util.PasswordStore as PS
import Yesod.Core
import Yesod.Core.Types (TypedContent (TypedContent))
import Yesod.Form
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"]
@ -240,7 +242,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 +434,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 +782,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'.

View File

@ -53,20 +53,20 @@ module Yesod.Auth.GoogleEmail2
, pid
) where
import Yesod.Auth (Auth, AuthPlugin (AuthPlugin),
import Yesod.Auth (Auth, AuthHandler,
AuthPlugin (AuthPlugin),
AuthRoute, Creds (Creds),
Route (PluginR), YesodAuth,
runHttpRequest, setCredsRedirect,
logoutDest, AuthHandler)
logoutDest, runHttpRequest,
setCredsRedirect)
import qualified Yesod.Auth.Message as Msg
import Yesod.Core (HandlerSite, MonadHandler,
TypedContent, getRouteToParent,
getUrlRender, invalidArgs,
liftIO, lookupGetParam,
TypedContent, addMessage,
getRouteToParent, getUrlRender,
getYesod, invalidArgs, liftIO,
liftSubHandler, lookupGetParam,
lookupSession, notFound, redirect,
setSession, whamlet, (.:),
addMessage, getYesod,
toHtml, liftSubHandler)
setSession, toHtml, whamlet, (.:))
import Blaze.ByteString.Builder (fromByteString, toByteString)
@ -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

View File

@ -131,10 +131,9 @@ module Yesod.Auth.Hardcoded
, loginR )
where
import Yesod.Auth (AuthPlugin (..), AuthRoute,
import Yesod.Auth (AuthHandler, AuthPlugin (..), AuthRoute,
Creds (..), Route (..), YesodAuth,
loginErrorMessageI, setCredsRedirect,
AuthHandler)
loginErrorMessageI, setCredsRedirect)
import qualified Yesod.Auth.Message as Msg
import Yesod.Core
import Yesod.Form (ireq, runInputPost, textField)
@ -159,6 +158,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

View File

@ -1,6 +1,6 @@
cabal-version: >=1.10
name: yesod-auth
version: 1.6.10.3
version: 1.6.10.4
license: MIT
license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin