yesod-auth 0.5.0 → 0.6.0
raw patch · 9 files changed
+55/−78 lines, 9 filesdep ~yesod-form
Dependency ranges changed: yesod-form
Files
- Yesod/Auth.hs +8/−14
- Yesod/Auth/Dummy.hs +2/−2
- Yesod/Auth/Email.hs +20/−31
- Yesod/Auth/Facebook.hs +4/−10
- Yesod/Auth/HashDB.hs +3/−3
- Yesod/Auth/Message.hs +4/−2
- Yesod/Auth/OAuth.hs +4/−2
- Yesod/Auth/OpenId.hs +8/−12
- yesod-auth.cabal +2/−2
Yesod/Auth.hs view
@@ -25,7 +25,6 @@ import Yesod.Core import Yesod.Persist import Yesod.Json-import Text.Blaze import Language.Haskell.TH.Syntax hiding (lift) import qualified Network.Wai as W import Text.Hamlet (hamlet)@@ -36,9 +35,9 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import Web.Routes.Quasi (toSinglePiece, fromSinglePiece) import Yesod.Auth.Message (AuthMessage, defaultMessage) import qualified Yesod.Auth.Message as Msg+import Yesod.Form (FormMessage) data Auth = Auth @@ -61,7 +60,7 @@ , credsExtra :: [(Text, Text)] } -class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where+class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where type AuthId m -- | Default destination on successful login, if no other@@ -79,17 +78,15 @@ -- | What to show on the login page. loginHandler :: GHandler Auth m RepHtml loginHandler = defaultLayout $ do- setTitle "Login"+ setTitleI Msg.LoginTitle tm <- lift getRouteToMaster mapM_ (flip apLogin tm) authPlugins renderAuthMessage :: m -> [Text] -- ^ languages- -> AuthMessage -> Html+ -> AuthMessage -> Text renderAuthMessage _ _ = defaultMessage -type Texts = [Text]- mkYesodSub "Auth" [ ClassP ''YesodAuth [VarT $ mkName "master"] ]@@ -113,8 +110,6 @@ setCreds doRedirects creds = do y <- getYesod maid <- getAuthId creds- l <- languages- let mr = renderMessage Auth y l case maid of Nothing -> if doRedirects@@ -131,14 +126,14 @@ |] sendResponse rh Just ar -> do- setMessage $ mr Msg.InvalidLogin+ setMessageI Msg.InvalidLogin redirect RedirectTemporary ar else return () Just aid -> do setSession credsKey $ toSinglePiece aid if doRedirects then do- setMessage $ mr Msg.NowLoggedIn+ setMessageI Msg.NowLoggedIn redirectUltDest RedirectTemporary $ loginDest y else return () @@ -229,6 +224,5 @@ Just z -> redirect RedirectTemporary z Nothing -> permissionDenied "Please configure authRoute" -instance YesodAuth m => YesodMessage Auth m where- type Message Auth m = AuthMessage- renderMessage = const renderAuthMessage+instance YesodAuth m => RenderMessage m AuthMessage where+ renderMessage = renderAuthMessage
Yesod/Auth/Dummy.hs view
@@ -9,7 +9,7 @@ ) where import Yesod.Auth-import Yesod.Form (runFormPost', stringInput)+import Yesod.Form (runInputPost, textField, ireq) import Yesod.Handler (notFound) import Text.Hamlet (hamlet) @@ -18,7 +18,7 @@ AuthPlugin "dummy" dispatch login where dispatch "POST" [] = do- ident <- runFormPost' $ stringInput "ident"+ ident <- runInputPost $ ireq textField "ident" setCreds True $ Creds "dummy" ident [] dispatch _ _ = notFound url = PluginR "dummy" []
Yesod/Auth/Email.hs view
@@ -81,7 +81,6 @@ AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod l <- lift languages- let mr = renderMessage (getAuth 'x') y l #if GHC7 [whamlet| #else@@ -90,16 +89,16 @@ <form method="post" action="@{tm loginR}"> <table> <tr>- <th>#{mr Msg.Email}+ <th>_{Msg.Email} <td> <input type="email" name="email"> <tr>- <th>#{mr Msg.Password}+ <th>_{Msg.Password} <td> <input type="password" name="password"> <tr> <td colspan="2">- <input type="submit" value=#{mr Msg.LoginViaEmail}>+ <input type="submit" value=_{Msg.LoginViaEmail}> <a href="@{tm registerR}">I don't have an account |] where@@ -117,9 +116,8 @@ getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml getRegisterR = do toMaster <- getRouteToMaster- mr <- getMessageRender defaultLayout $ do- setTitle $ mr Msg.RegisterLong+ setTitleI Msg.RegisterLong addWidget #if GHC7 [whamlet|@@ -136,7 +134,7 @@ postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml postRegisterR = do y <- getYesod- email <- runFormPost' $ emailInput "email"+ email <- runInputPost $ ireq emailField "email" mecreds <- getEmailCreds email (lid, verKey) <- case mecreds of@@ -153,9 +151,8 @@ tm <- getRouteToMaster let verUrl = render $ tm $ verify (toSinglePiece lid) verKey sendVerifyEmail email verKey verUrl- mr <- getMessageRender defaultLayout $ do- setTitle $ mr Msg.ConfirmationEmailSentTitle+ setTitleI Msg.ConfirmationEmailSentTitle addWidget #if GHC7 [whamlet|@@ -178,13 +175,11 @@ Just _uid -> do setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid? toMaster <- getRouteToMaster- mr <- getMessageRender- setMessage $ mr Msg.AddressVerified+ setMessageI Msg.AddressVerified redirect RedirectTemporary $ toMaster setpassR _ -> return ()- mr <- getMessageRender defaultLayout $ do- setTitle $ mr Msg.InvalidKey+ setTitleI Msg.InvalidKey addWidget #if GHC7 [whamlet|@@ -196,9 +191,9 @@ postLoginR :: YesodAuthEmail master => GHandler Auth master () postLoginR = do- (email, pass) <- runFormPost' $ (,)- <$> emailInput "email"- <*> stringInput "password"+ (email, pass) <- runInputPost $ (,)+ <$> ireq emailField "email"+ <*> ireq textField "password" mecreds <- getEmailCreds email maid <- case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of@@ -215,9 +210,7 @@ Just _aid -> setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid? Nothing -> do- y <- getYesod- mr <- getMessageRender- setMessage $ mr Msg.InvalidEmailPass+ setMessageI Msg.InvalidEmailPass toMaster <- getRouteToMaster redirect RedirectTemporary $ toMaster LoginR @@ -225,14 +218,13 @@ getPasswordR = do toMaster <- getRouteToMaster maid <- maybeAuthId- mr <- getMessageRender case maid of Just _ -> return () Nothing -> do- setMessage $ mr Msg.BadSetPass+ setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR defaultLayout $ do- setTitle $ mr Msg.SetPassTitle+ setTitleI Msg.SetPassTitle addWidget #if GHC7 [whamlet|@@ -257,26 +249,23 @@ postPasswordR :: YesodAuthEmail master => GHandler Auth master () postPasswordR = do- (new, confirm) <- runFormPost' $ (,)- <$> stringInput "new"- <*> stringInput "confirm"+ (new, confirm) <- runInputPost $ (,)+ <$> ireq textField "new"+ <*> ireq textField "confirm" toMaster <- getRouteToMaster y <- getYesod when (new /= confirm) $ do- mr <- getMessageRender- setMessage $ mr Msg.PassMismatch+ setMessageI Msg.PassMismatch redirect RedirectTemporary $ toMaster setpassR maid <- maybeAuthId aid <- case maid of Nothing -> do- mr <- getMessageRender- setMessage $ mr Msg.BadSetPass+ setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR Just aid -> return aid salted <- liftIO $ saltPass new setPassword aid salted- mr <- getMessageRender- setMessage $ mr Msg.PassUpdated+ setMessageI Msg.PassUpdated redirect RedirectTemporary $ loginDest y saltLength :: Int
Yesod/Auth/Facebook.hs view
@@ -15,8 +15,6 @@ import Yesod.Form import Yesod.Handler import Yesod.Widget-import Yesod.Request (languages)-import Text.Hamlet (hamlet) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Data.Text (Text)@@ -46,7 +44,7 @@ render <- getUrlRender tm <- getRouteToMaster let fb = Facebook.Facebook cid secret $ render $ tm url- code <- runFormGet' $ stringInput "code"+ code <- runInputGet $ ireq textField "code" at <- liftIO $ Facebook.getAccessToken fb code let Facebook.AccessToken at' = at so <- liftIO $ Facebook.getGraphData at "me"@@ -58,17 +56,13 @@ render <- lift getUrlRender let fb = Facebook.Facebook cid secret $ render $ tm url let furl = Facebook.getForwardUrl fb $ perms- y <- lift getYesod- l <- lift languages- let mr = renderMessage (getAuth 'x') y l- addHtml #if GHC7- [hamlet|+ [whamlet| #else- [$hamlet|+ [$whamlet| #endif <p>- <a href="#{furl}">#{mr Msg.Facebook}+ <a href="#{furl}">_{Msg.Facebook} |] parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m)
Yesod/Auth/HashDB.hs view
@@ -115,9 +115,9 @@ PersistBackend (YesodDB y (GGHandler Auth y IO))) => GHandler Auth y () postLoginR = do- (mu,mp) <- runFormPost' $ (,)- <$> maybeStringInput "username"- <*> maybeStringInput "password"+ (mu,mp) <- runInputPost $ (,)+ <$> iopt textField "username"+ <*> iopt textField "password" isValid <- case (mu,mp) of (Nothing, _ ) -> return False
Yesod/Auth/Message.hs view
@@ -33,8 +33,9 @@ | LoginViaEmail | InvalidLogin | NowLoggedIn+ | LoginTitle -defaultMessage :: AuthMessage -> Html+defaultMessage :: AuthMessage -> Text defaultMessage NoOpenID = "No OpenID identifier found" defaultMessage LoginOpenID = "Login via OpenID" defaultMessage Email = "Email"@@ -45,7 +46,7 @@ defaultMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" defaultMessage (ConfirmationEmailSent email) = "A confirmation e-mail has been sent to " `mappend`- toHtml email `mappend`+ email `mappend` "." defaultMessage AddressVerified = "Address verified, please set a new password" defaultMessage InvalidKeyTitle = "Invalid verification key"@@ -62,3 +63,4 @@ defaultMessage LoginViaEmail = "Login via email" defaultMessage InvalidLogin = "Invalid login" defaultMessage NowLoggedIn = "You are now logged in"+defaultMessage LoginTitle = "Login"
Yesod/Auth/OAuth.hs view
@@ -22,6 +22,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.ByteString (ByteString)+import Control.Applicative ((<$>), (<*>)) oauthUrl :: Text -> AuthRoute oauthUrl name = PluginR name ["forward"]@@ -51,8 +52,9 @@ tok <- liftIO $ getTemporaryCredential oauth' redirectText RedirectTemporary (fromString $ authorizeUrl oauth' tok) dispatch "GET" [] = do- verifier <- runFormGet' $ stringInput "oauth_verifier"- oaTok <- runFormGet' $ stringInput "oauth_token"+ (verifier, oaTok) <- runInputGet $ (,)+ <$> ireq textField "oauth_verifier"+ <*> ireq textField "oauth_token" let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok) ] accTok <- liftIO $ getAccessToken oauth reqTok
Yesod/Auth/OpenId.hs view
@@ -43,23 +43,20 @@ padding-left: 18px; |] l <- lift languages- let mr = renderMessage (getAuth 'x') y l- addHamlet #if GHC7- [hamlet|+ [whamlet| #else- [$hamlet|+ [$whamlet| #endif <form method="get" action="@{tm forwardUrl}">- <label for="#{ident}">OpenID: + <label for="#{ident}">OpenID: # <input id="#{ident}" type="text" name="#{name}" value="http://">- <input type="submit" value="#{mr Msg.LoginOpenID}">+ <input type="submit" value="_{Msg.LoginOpenID}"> |] dispatch "GET" ["forward"] = do- (roid, _, _) <- runFormGet $ stringInput name- y <- getYesod+ roid <- runInputGet $ iopt textField name case roid of- FormSuccess oid -> do+ Just oid -> do render <- getUrlRender toMaster <- getRouteToMaster let complete' = render $ toMaster complete@@ -71,10 +68,9 @@ ) (redirectText RedirectTemporary) res- _ -> do+ Nothing -> do toMaster <- getRouteToMaster- mr <- getMessageRender- setMessage $ mr Msg.NoOpenID+ setMessageI Msg.NoOpenID redirect RedirectTemporary $ toMaster LoginR dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues dispatch "GET" ["complete"] = do
yesod-auth.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-version: 0.5.0+version: 0.6.0 license: BSD3 license-file: LICENSE author: Michael Snoyman, Patrick Brisbin@@ -34,7 +34,7 @@ , hamlet >= 0.8.1 && < 0.9 , yesod-json >= 0.1 && < 0.2 , containers >= 0.2 && < 0.5- , yesod-form >= 0.1 && < 0.2+ , yesod-form >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3 , persistent >= 0.5 && < 0.6 , persistent-template >= 0.5 && < 0.6