diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index 2a5c4b4d..59003582 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -27,9 +27,10 @@ module Yesod.Auth , AuthException (..) ) where -import Control.Monad (when) +import Control.Monad (when) import Control.Monad.Trans.Maybe +import Yesod.Auth.Routes import Data.Aeson import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) @@ -51,17 +52,17 @@ import Yesod.Form (FormMessage) import Data.Typeable (Typeable) import Control.Exception (Exception) -data Auth = Auth - type AuthRoute = Route Auth +type AuthHandler master a = YesodAuth master => HandlerT Auth (GHandler master) a + type Method = Text type Piece = Text data AuthPlugin master = AuthPlugin { apName :: Text - , apDispatch :: Method -> [Piece] -> GHandler Auth master () - , apLogin :: forall sub. (Route Auth -> Route master) -> GWidget sub master () + , apDispatch :: Method -> [Piece] -> AuthHandler master () + , apLogin :: (Route Auth -> Text) -> GWidget master () } getAuth :: a -> Auth @@ -86,18 +87,19 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage logoutDest :: master -> Route master -- | Determine the ID associated with the set of credentials. - getAuthId :: Creds master -> GHandler sub master (Maybe (AuthId master)) + getAuthId :: Creds master -> GHandler master (Maybe (AuthId master)) -- | Which authentication backends to use. authPlugins :: master -> [AuthPlugin master] -- | What to show on the login page. - loginHandler :: GHandler Auth master RepHtml - loginHandler = defaultLayout $ do - setTitleI Msg.LoginTitle - tm <- lift getRouteToMaster - master <- lift getYesod - mapM_ (flip apLogin tm) (authPlugins master) + loginHandler :: AuthHandler master RepHtml + loginHandler = do + render <- getUrlRender + lift $ defaultLayout $ do + setTitleI Msg.LoginTitle + master <- lift getYesod + mapM_ (flip apLogin render) (authPlugins master) -- | Used for i18n of messages provided by this package. renderAuthMessage :: master @@ -118,11 +120,11 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- | Called on a successful login. By default, calls -- @setMessageI NowLoggedIn@. - onLogin :: GHandler sub master () + onLogin :: GHandler master () onLogin = setMessageI Msg.NowLoggedIn -- | Called on logout. By default, does nothing - onLogout :: GHandler sub master () + onLogout :: GHandler master () onLogout = return () -- | Retrieves user credentials, if user is authenticated. @@ -134,7 +136,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- other than a browser. -- -- Since 1.1.2 - maybeAuthId :: GHandler sub master (Maybe (AuthId master)) + maybeAuthId :: GHandler master (Maybe (AuthId master)) maybeAuthId = defaultMaybeAuthId credsKey :: Text @@ -144,29 +146,15 @@ credsKey = "_ID" -- -- Since 1.1.2 defaultMaybeAuthId :: YesodAuth master - => GHandler sub master (Maybe (AuthId master)) + => GHandler master (Maybe (AuthId master)) defaultMaybeAuthId = do ms <- lookupSession credsKey case ms of Nothing -> return Nothing Just s -> return $ fromPathPiece s -mkYesodSub "Auth" - [ ClassP ''YesodAuth [VarT $ mkName "master"] - ] -#define STRINGS *Texts - [parseRoutes| -/check CheckR GET -/login LoginR GET -/logout LogoutR GET POST -/page/#Text/STRINGS PluginR -|] - -setCreds :: YesodAuth master - => Bool - -> Creds master - -> GHandler sub master () -setCreds doRedirects creds = do +setCreds :: Bool -> Creds master -> AuthHandler master () +setCreds doRedirects creds = lift $ do y <- getYesod maid <- getAuthId creds case maid of @@ -196,8 +184,8 @@ setCreds doRedirects creds = do provideRep $ return $ object ["message" .= ("Login Successful" :: Text)] sendResponse res -getCheckR :: YesodAuth master => GHandler Auth master TypedContent -getCheckR = do +getCheckR :: AuthHandler master TypedContent +getCheckR = lift $ do creds <- maybeAuthId defaultLayoutJson (do setTitle "Authentication Status" @@ -217,29 +205,27 @@ $nothing [ (T.pack "logged_in", Bool $ maybe False (const True) creds) ] -setUltDestReferer' :: YesodAuth master => GHandler sub master () -setUltDestReferer' = do +setUltDestReferer' :: AuthHandler master () +setUltDestReferer' = lift $ do master <- getYesod when (redirectToReferer master) setUltDestReferer -getLoginR :: YesodAuth master => GHandler Auth master RepHtml +getLoginR :: AuthHandler master RepHtml getLoginR = setUltDestReferer' >> loginHandler -getLogoutR :: YesodAuth master => GHandler Auth master () -getLogoutR = do - tm <- getRouteToMaster - setUltDestReferer' >> redirectToPost (tm LogoutR) +getLogoutR :: AuthHandler master () +getLogoutR = setUltDestReferer' >> redirectToPost LogoutR -postLogoutR :: YesodAuth master => GHandler Auth master () -postLogoutR = do +postLogoutR :: AuthHandler master () +postLogoutR = lift $ do y <- getYesod deleteSession credsKey onLogout redirectUltDest $ logoutDest y -handlePluginR :: YesodAuth master => Text -> [Text] -> GHandler Auth master () +handlePluginR :: Text -> [Text] -> AuthHandler master () handlePluginR plugin pieces = do - master <- getYesod + master <- lift getYesod env <- waiRequest let method = decodeUtf8With lenientDecode $ W.requestMethod env case filter (\x -> apName x == plugin) (authPlugins master) of @@ -247,14 +233,14 @@ handlePluginR plugin pieces = do ap:_ -> apDispatch ap method pieces maybeAuth :: ( YesodAuth master - , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val + , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend val , b ~ YesodPersistBackend master , Key val ~ AuthId master - , PersistStore (b (GHandler sub master)) + , PersistStore (b (GHandler master)) , PersistEntity val , YesodPersist master , Typeable val - ) => GHandler sub master (Maybe (Entity val)) + ) => GHandler master (Maybe (Entity val)) maybeAuth = runMaybeT $ do aid <- MaybeT $ maybeAuthId a <- MaybeT @@ -268,21 +254,21 @@ maybeAuth = runMaybeT $ do newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val } deriving Typeable -requireAuthId :: YesodAuth master => GHandler sub master (AuthId master) +requireAuthId :: YesodAuth master => GHandler master (AuthId master) requireAuthId = maybeAuthId >>= maybe redirectLogin return requireAuth :: ( YesodAuth master , b ~ YesodPersistBackend master - , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val + , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend val , Key val ~ AuthId master - , PersistStore (b (GHandler sub master)) + , PersistStore (b (GHandler master)) , PersistEntity val , YesodPersist master , Typeable val - ) => GHandler sub master (Entity val) + ) => GHandler master (Entity val) requireAuth = maybeAuth >>= maybe redirectLogin return -redirectLogin :: Yesod master => GHandler sub master a +redirectLogin :: Yesod master => GHandler master a redirectLogin = do y <- getYesod setUltDestCurrent @@ -297,3 +283,6 @@ data AuthException = InvalidBrowserIDAssertion | InvalidFacebookResponse deriving (Show, Typeable) instance Exception AuthException + +instance YesodAuth master => YesodSubDispatch Auth (GHandler master) where + yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth) diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs index 9aab88ac..95e12467 100644 --- a/yesod-auth/Yesod/Auth/BrowserId.hs +++ b/yesod-auth/Yesod/Auth/BrowserId.hs @@ -49,14 +49,13 @@ helper maudience = AuthPlugin , apDispatch = \m ps -> case (m, ps) of ("GET", [assertion]) -> do - master <- getYesod + master <- lift getYesod audience <- case maudience of Just a -> return a Nothing -> do - tm <- getRouteToMaster r <- getUrlRender - return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR + return $ T.takeWhile (/= '/') $ stripScheme $ r LoginR memail <- lift $ checkAssertion audience assertion (authHttpManager master) case memail of Nothing -> liftIO $ throwIO InvalidBrowserIDAssertion @@ -83,7 +82,7 @@ helper maudience = AuthPlugin $newline never

- + |] } where @@ -92,18 +91,18 @@ $newline never -- | Generates a function to handle on-click events, and returns that function -- name. -createOnClick :: (Route Auth -> Route master) -> GWidget sub master Text +createOnClick :: (Route Auth -> Text) -> GWidget master Text createOnClick toMaster = do addScriptRemote browserIdJs - onclick <- lift newIdent - render <- lift getUrlRender - let login = toJSON $ getPath $ render (toMaster LoginR) + onclick <- newIdent + render <- getUrlRender + let login = toJSON $ getPath $ toMaster LoginR toWidget [julius| function #{rawJS onclick}() { navigator.id.watch({ onlogin: function (assertion) { if (assertion) { - document.location = "@{toMaster complete}/" + assertion; + document.location = #{toJSON $ toMaster complete} + "/" + assertion; } }, onlogout: function () {} diff --git a/yesod-auth/Yesod/Auth/Dummy.hs b/yesod-auth/Yesod/Auth/Dummy.hs index 7ba931e5..26000be2 100644 --- a/yesod-auth/Yesod/Auth/Dummy.hs +++ b/yesod-auth/Yesod/Auth/Dummy.hs @@ -9,23 +9,22 @@ module Yesod.Auth.Dummy import Yesod.Auth import Yesod.Form (runInputPost, textField, ireq) -import Yesod.Handler (notFound) import Text.Hamlet (hamlet) -import Yesod.Widget (toWidget) +import Yesod.Core authDummy :: YesodAuth m => AuthPlugin m authDummy = AuthPlugin "dummy" dispatch login where dispatch "POST" [] = do - ident <- runInputPost $ ireq textField "ident" + ident <- lift $ runInputPost $ ireq textField "ident" setCreds True $ Creds "dummy" ident [] dispatch _ _ = notFound url = PluginR "dummy" [] login authToMaster = toWidget [hamlet| $newline never -

+ Your new identifier is: # diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index 2fe5d7e7..caa8ebd6 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -17,6 +17,7 @@ module Yesod.Auth.Email import Network.Mail.Mime (randomString) import Yesod.Auth import System.Random +import Text.Blaze.Html (toHtml) import Control.Monad (when) import Control.Applicative ((<$>), (<*>)) import Data.Digest.Pure.MD5 @@ -28,9 +29,7 @@ import qualified Crypto.PasswordStore as PS import qualified Data.Text.Encoding as DTE import Yesod.Form -import Yesod.Handler -import Yesod.Content -import Yesod.Core (PathPiece, fromPathPiece, whamlet, defaultLayout, setTitleI, toPathPiece) +import Yesod.Core import Control.Monad.IO.Class (liftIO) import qualified Yesod.Auth.Message as Msg @@ -59,15 +58,15 @@ data EmailCreds m = EmailCreds class (YesodAuth m, PathPiece (AuthEmailId m)) => YesodAuthEmail m where type AuthEmailId m - addUnverified :: Email -> VerKey -> GHandler Auth m (AuthEmailId m) - sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler Auth m () - getVerifyKey :: AuthEmailId m -> GHandler Auth m (Maybe VerKey) - setVerifyKey :: AuthEmailId m -> VerKey -> GHandler Auth m () - verifyAccount :: AuthEmailId m -> GHandler Auth m (Maybe (AuthId m)) - getPassword :: AuthId m -> GHandler Auth m (Maybe SaltedPass) - setPassword :: AuthId m -> SaltedPass -> GHandler Auth m () - getEmailCreds :: Email -> GHandler Auth m (Maybe (EmailCreds m)) - getEmail :: AuthEmailId m -> GHandler Auth m (Maybe Email) + addUnverified :: Email -> VerKey -> GHandler m (AuthEmailId m) + sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler m () + getVerifyKey :: AuthEmailId m -> GHandler m (Maybe VerKey) + setVerifyKey :: AuthEmailId m -> VerKey -> GHandler m () + verifyAccount :: AuthEmailId m -> GHandler m (Maybe (AuthId m)) + getPassword :: AuthId m -> GHandler m (Maybe SaltedPass) + setPassword :: AuthId m -> SaltedPass -> GHandler m () + getEmailCreds :: Email -> GHandler m (Maybe (EmailCreds m)) + getEmail :: AuthEmailId m -> GHandler m (Maybe Email) -- | Generate a random alphanumeric string. randomKey :: m -> IO Text @@ -80,7 +79,7 @@ authEmail = AuthPlugin "email" dispatch $ \tm -> [whamlet| $newline never - +
_{Msg.Email} @@ -93,7 +92,7 @@ $newline never
- I don't have an account + I don't have an account |] where dispatch "GET" ["register"] = getRegisterR >>= sendResponse @@ -107,81 +106,75 @@ $newline never dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse dispatch _ _ = notFound -getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml +getRegisterR :: YesodAuthEmail master => HandlerT Auth (GHandler master) RepHtml getRegisterR = do - toMaster <- getRouteToMaster email <- newIdent - defaultLayout $ do - setTitleI Msg.RegisterLong + mrender <- getMessageRender + defaultLayoutT $ do + setTitle $ toHtml $ mrender Msg.RegisterLong [whamlet| -$newline never -

_{Msg.EnterEmail} - -

#{mrender Msg.EnterEmail} + +

_{Msg.ConfirmationEmailSent email} -|] + [whamlet|

_{Msg.ConfirmationEmailSent email}|] getVerifyR :: YesodAuthEmail m - => AuthEmailId m -> Text -> GHandler Auth m RepHtml + => AuthEmailId m + -> Text + -> HandlerT Auth (GHandler m) RepHtml getVerifyR lid key = do - realKey <- getVerifyKey lid - memail <- getEmail lid + realKey <- lift $ getVerifyKey lid + memail <- lift $ getEmail lid case (realKey == Just key, memail) of (True, Just email) -> do - muid <- verifyAccount lid + muid <- lift $ verifyAccount lid case muid of Nothing -> return () Just _uid -> do setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid? - toMaster <- getRouteToMaster - setMessageI Msg.AddressVerified - redirect $ toMaster setpassR + mrender <- lift getMessageRender + setMessage $ toHtml $ mrender Msg.AddressVerified + redirect setpassR _ -> return () - defaultLayout $ do + lift $ defaultLayout $ do setTitleI Msg.InvalidKey - [whamlet| -$newline never -

_{Msg.InvalidKey} -|] + [whamlet|

_{Msg.InvalidKey}|] -postLoginR :: YesodAuthEmail master => GHandler Auth master () +postLoginR :: YesodAuthEmail master => HandlerT Auth (GHandler master) () postLoginR = do - (email, pass) <- runInputPost $ (,) + (email, pass) <- lift $ runInputPost $ (,) <$> ireq emailField "email" <*> ireq textField "password" - mecreds <- getEmailCreds email + mecreds <- lift $ getEmailCreds email maid <- case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of (Just aid, Just True) -> do - mrealpass <- getPassword aid + mrealpass <- lift $ getPassword aid case mrealpass of Nothing -> return Nothing Just realpass -> return $ @@ -193,63 +186,63 @@ postLoginR = do Just _aid -> setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid? Nothing -> do - setMessageI Msg.InvalidEmailPass - toMaster <- getRouteToMaster - redirect $ toMaster LoginR + mrender <- lift getMessageRender + setMessage $ toHtml $ mrender Msg.InvalidEmailPass + redirect LoginR -getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml +getPasswordR :: YesodAuthEmail master => HandlerT Auth (GHandler master) RepHtml getPasswordR = do - toMaster <- getRouteToMaster - maid <- maybeAuthId + maid <- lift maybeAuthId pass1 <- newIdent pass2 <- newIdent + mrender <- lift getMessageRender case maid of Just _ -> return () Nothing -> do - setMessageI Msg.BadSetPass - redirect $ toMaster LoginR - defaultLayout $ do - setTitleI Msg.SetPassTitle + setMessage $ toHtml $ mrender Msg.BadSetPass + redirect LoginR + defaultLayoutT $ do + setTitle $ toHtml $ mrender Msg.SetPassTitle -- FIXME make setTitleI more intelligent [whamlet| $newline never -

_{Msg.SetPass} - +

#{mrender Msg.SetPass} +
-
-
- + |] -postPasswordR :: YesodAuthEmail master => GHandler Auth master () +postPasswordR :: YesodAuthEmail master => HandlerT Auth (GHandler master) () postPasswordR = do - (new, confirm) <- runInputPost $ (,) + (new, confirm) <- lift $ runInputPost $ (,) <$> ireq textField "new" <*> ireq textField "confirm" - toMaster <- getRouteToMaster - y <- getYesod when (new /= confirm) $ do - setMessageI Msg.PassMismatch - redirect $ toMaster setpassR - maid <- maybeAuthId + lift $ setMessageI Msg.PassMismatch + redirect setpassR + maid <- lift maybeAuthId aid <- case maid of Nothing -> do - setMessageI Msg.BadSetPass - redirect $ toMaster LoginR + lift $ setMessageI Msg.BadSetPass + redirect LoginR Just aid -> return aid salted <- liftIO $ saltPass new - setPassword aid salted - setMessageI Msg.PassUpdated - redirect $ loginDest y + lift $ do + y <- getYesod + setPassword aid salted + setMessageI Msg.PassUpdated + redirect $ loginDest y saltLength :: Int saltLength = 5 diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs index ab315295..5ed1003a 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs @@ -40,15 +40,11 @@ authGoogleEmail = where complete = PluginR pid ["complete"] login tm = - [whamlet| -$newline never -_{Msg.LoginGoogle} -|] + [whamlet|_{Msg.LoginGoogle}|] dispatch "GET" ["forward"] = do render <- getUrlRender - toMaster <- getRouteToMaster - let complete' = render $ toMaster complete - master <- getYesod + let complete' = render complete + master <- lift getYesod eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing [ ("openid.ax.type.email", "http://schema.openid.net/contact/email") , ("openid.ns.ax", "http://openid.net/srv/ax/1.0") @@ -60,7 +56,7 @@ $newline never either (\err -> do setMessage $ toHtml $ show (err :: SomeException) - redirect $ toMaster LoginR + redirect LoginR ) redirect eres @@ -74,14 +70,13 @@ $newline never completeHelper posts dispatch _ _ = notFound -completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m () +completeHelper :: YesodAuth m => [(Text, Text)] -> HandlerT Auth (GHandler m) () completeHelper gets' = do - master <- getYesod + master <- lift getYesod eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master) - toMaster <- getRouteToMaster let onFailure err = do setMessage $ toHtml $ show (err :: SomeException) - redirect $ toMaster LoginR + redirect LoginR let onSuccess oir = do let OpenId.Identifier ident = OpenId.oirOpLocal oir memail <- lookupGetParam "openid.ext1.value.email" @@ -89,8 +84,8 @@ completeHelper gets' = do (Just email, True) -> setCreds True $ Creds pid email [] (_, False) -> do setMessage "Only Google login is supported" - redirect $ toMaster LoginR + redirect LoginR (Nothing, _) -> do setMessage "No email address provided" - redirect $ toMaster LoginR + redirect LoginR either onFailure onSuccess eres diff --git a/yesod-auth/Yesod/Auth/HashDB.hs b/yesod-auth/Yesod/Auth/HashDB.hs index 5bf9abac..66f9746b 100644 --- a/yesod-auth/Yesod/Auth/HashDB.hs +++ b/yesod-auth/Yesod/Auth/HashDB.hs @@ -73,10 +73,9 @@ module Yesod.Auth.HashDB ) where import Yesod.Persist -import Yesod.Handler import Yesod.Form import Yesod.Auth -import Yesod.Widget (toWidget) +import Yesod.Core import Text.Hamlet (hamlet) import Control.Applicative ((<$>), (<*>)) @@ -135,14 +134,14 @@ setPassword pwd u = do salt <- randomSalt -- the database values. validateUser :: ( YesodPersist yesod , b ~ YesodPersistBackend yesod - , PersistMonadBackend (b (GHandler sub yesod)) ~ PersistEntityBackend user - , PersistUnique (b (GHandler sub yesod)) + , PersistMonadBackend (b (GHandler yesod)) ~ PersistEntityBackend user + , PersistUnique (b (GHandler yesod)) , PersistEntity user , HashDBUser user ) => Unique user -- ^ User unique identifier -> Text -- ^ Password in plaint-text - -> GHandler sub yesod Bool + -> GHandler yesod Bool validateUser userID passwd = do -- Checks that hash and password match let validate u = do hash <- userPasswordHash u @@ -162,23 +161,22 @@ login = PluginR "hashdb" ["login"] postLoginR :: ( YesodAuth y, YesodPersist y , HashDBUser user, PersistEntity user , b ~ YesodPersistBackend y - , PersistMonadBackend (b (GHandler Auth y)) ~ PersistEntityBackend user - , PersistUnique (b (GHandler Auth y)) + , PersistMonadBackend (b (GHandler y)) ~ PersistEntityBackend user + , PersistUnique (b (GHandler y)) ) => (Text -> Maybe (Unique user)) - -> GHandler Auth y () + -> HandlerT Auth (GHandler y) () postLoginR uniq = do - (mu,mp) <- runInputPost $ (,) + (mu,mp) <- lift $ runInputPost $ (,) <$> iopt textField "username" <*> iopt textField "password" - isValid <- fromMaybe (return False) + isValid <- lift $ fromMaybe (return False) (validateUser <$> (uniq =<< mu) <*> mp) if isValid then setCreds True $ Creds "hashdb" (fromMaybe "" mu) [] else do setMessage "Invalid username/password" - toMaster <- getRouteToMaster - redirect $ toMaster LoginR + redirect LoginR -- | A drop in for the getAuthId method of your YesodAuth instance which @@ -187,13 +185,13 @@ getAuthIdHashDB :: ( YesodAuth master, YesodPersist master , HashDBUser user, PersistEntity user , Key user ~ AuthId master , b ~ YesodPersistBackend master - , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend user - , PersistUnique (b (GHandler sub master)) + , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend user + , PersistUnique (b (GHandler master)) ) => (AuthRoute -> Route master) -- ^ your site's Auth Route -> (Text -> Maybe (Unique user)) -- ^ gets user ID -> Creds master -- ^ the creds argument - -> GHandler sub master (Maybe (AuthId master)) + -> GHandler master (Maybe (AuthId master)) getAuthIdHashDB authR uniq creds = do muid <- maybeAuthId case muid of @@ -216,8 +214,8 @@ authHashDB :: ( YesodAuth m, YesodPersist m , HashDBUser user , PersistEntity user , b ~ YesodPersistBackend m - , PersistMonadBackend (b (GHandler Auth m)) ~ PersistEntityBackend user - , PersistUnique (b (GHandler Auth m))) + , PersistMonadBackend (b (GHandler m)) ~ PersistEntityBackend user + , PersistUnique (b (GHandler m))) => (Text -> Maybe (Unique user)) -> AuthPlugin m authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet| $newline never @@ -225,7 +223,7 @@ $newline never

Login
- +
Username: diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs index 55bfdc9c..3e8c2c32 100644 --- a/yesod-auth/Yesod/Auth/OpenId.hs +++ b/yesod-auth/Yesod/Auth/OpenId.hs @@ -48,35 +48,33 @@ authOpenId idType extensionFields = |] $ x `asTypeOf` y) [whamlet| $newline never - +