yesod-auth 0.0.0 → 0.1.0
raw patch · 8 files changed
+51/−34 lines, 8 filesdep ~authenticatesetup-changed
Dependency ranges changed: authenticate
Files
- Setup.hs +0/−2
- Setup.lhs +8/−0
- Yesod/Helpers/Auth2.hs +14/−10
- Yesod/Helpers/Auth2/Email.hs +3/−4
- Yesod/Helpers/Auth2/Facebook.hs +1/−2
- Yesod/Helpers/Auth2/OpenId.hs +22/−12
- Yesod/Helpers/Auth2/Rpxnow.hs +1/−2
- yesod-auth.cabal +2/−2
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple+> import System.Cmd (system)++> main :: IO ()+> main = defaultMain
Yesod/Helpers/Auth2.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-} module Yesod.Helpers.Auth2 ( Auth , AuthPlugin (..)@@ -30,7 +31,7 @@ data AuthPlugin m = AuthPlugin { apName :: String , apDispatch :: Method -> [Piece] -> GHandler Auth m ()- , apLogin :: GWidget Auth m ()+ , apLogin :: forall s. (Route Auth -> Route m) -> GWidget s m () } getAuth :: a -> Auth@@ -46,10 +47,14 @@ class Yesod m => YesodAuth m where type AuthId m - -- | Default destination on successful login or logout, if no other+ -- | Default destination on successful login, if no other -- destination exists.- defaultDest :: m -> Route m+ loginDest :: m -> Route m + -- | Default destination on successful logout, if no other+ -- destination exists.+ logoutDest :: m -> Route m+ getAuthId :: Creds m -> GHandler s m (Maybe (AuthId m)) showAuthId :: m -> AuthId m -> String@@ -92,7 +97,7 @@ if doRedirects then do setMessage $ string "You are now logged in"- redirect RedirectTemporary $ defaultDest y+ redirect RedirectTemporary $ loginDest y else return () getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson@@ -117,7 +122,8 @@ getLoginR :: YesodAuth m => GHandler Auth m RepHtml getLoginR = defaultLayout $ do setTitle $ string "Login"- mapM_ apLogin authPlugins+ tm <- liftHandler getRouteToMaster+ mapM_ (flip apLogin tm) authPlugins getLogoutR :: YesodAuth m => GHandler Auth m () getLogoutR = postLogoutR -- FIXME redirect to post@@ -126,7 +132,7 @@ postLogoutR = do y <- getYesod deleteSession credsKey- redirectUltDest RedirectTemporary $ defaultDest y+ redirectUltDest RedirectTemporary $ logoutDest y handlePluginR :: YesodAuth m => String -> [String] -> GHandler Auth m () handlePluginR plugin pieces = do@@ -189,11 +195,9 @@ setCreds True $ Creds "dummy" ident [] dispatch _ _ = notFound url = PluginR "dummy" []- authToMaster = liftHandler getRouteToMaster- login = do- tm <- authToMaster+ login authToMaster = do addBody [$hamlet|-%form!method=post!action=@tm.url@+%form!method=post!action=@authToMaster.url@ Your new identifier is: $ %input!type=text!name=ident %input!type=submit!value="Dummy Login"
Yesod/Helpers/Auth2/Email.hs view
@@ -76,8 +76,7 @@ dispatch "POST" ["set-password"] = go postPasswordR dispatch _ _ = notFound - login' = do- tm <- liftHandler getRouteToMaster+ login' tm = do addBody [$hamlet| %form!method=post!action=@tm.login@ %table@@ -104,7 +103,7 @@ %p Enter your e-mail address below, and a confirmation e-mail will be sent to you. %form!method=post!action=@toMaster.register@ %label!for=email E-mail- %input#email!type=email!name=email!width=150+ %input!type=email!name=email!width=150 %input!type=submit!value=Register |] @@ -229,7 +228,7 @@ setPassword aid salted setMessage $ string "Password updated" y <- getYesod- redirect RedirectTemporary $ defaultDest y+ redirect RedirectTemporary $ loginDest y saltLength :: Int saltLength = 5
Yesod/Helpers/Auth2/Facebook.hs view
@@ -40,8 +40,7 @@ ] setCreds True c dispatch _ _ = notFound- login = do- tm <- liftHandler getRouteToMaster+ login tm = do render <- liftHandler getUrlRender let fb = Facebook.Facebook cid secret $ render $ tm url let furl = Facebook.getForwardUrl fb $ perms
Yesod/Helpers/Auth2/OpenId.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} module Yesod.Helpers.Auth2.OpenId ( authOpenId+ , forwardUrl ) where import Yesod@@ -8,28 +9,30 @@ import qualified Web.Authenticate.OpenId as OpenId import Control.Monad.Attempt +forwardUrl :: AuthRoute+forwardUrl = PluginR "openid" ["forward"]+ authOpenId :: YesodAuth m => AuthPlugin m authOpenId = AuthPlugin "openid" dispatch login where- forward = PluginR "openid" ["forward"] complete = PluginR "openid" ["complete"] name = "openid_identifier"- login = do- tm <- liftHandler getRouteToMaster+ login tm = do+ ident <- newIdent addStyle [$cassius|-#openid+#$ident$ background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%; padding-left: 18px; |] addBody [$hamlet|-%form!method=post!action=@tm.forward@+%form!method=get!action=@tm.forwardUrl@ %label!for=openid OpenID: $- %input#openid!type=text!name=$name$+ %input#$ident$!type=text!name=$name$!value="http://" %input!type=submit!value="Login via OpenID" |]- dispatch "POST" ["forward"] = do- (roid, _, _) <- runFormPost $ stringInput name+ dispatch "GET" ["forward"] = do+ (roid, _, _) <- runFormGet $ stringInput name case roid of FormSuccess oid -> do render <- getUrlRender@@ -39,17 +42,25 @@ attempt (\err -> do setMessage $ string $ show err- redirect RedirectTemporary $ toMaster LoginR)+ redirect RedirectTemporary $ toMaster LoginR+ ) (redirectString RedirectTemporary) res _ -> do toMaster <- getRouteToMaster setMessage $ string "No OpenID identifier found" redirect RedirectTemporary $ toMaster LoginR- dispatch "GET" ["complete"] = do+ dispatch "GET" ["complete"] = completeHelper OpenId.authenticate+ dispatch _ _ = notFound++completeHelper+ :: YesodAuth m+ => ([(String, String)] -> AttemptT (GHandler Auth m) OpenId.Identifier)+ -> GHandler Auth m ()+completeHelper auth = do rr <- getRequest let gets' = reqGetParams rr- res <- runAttemptT $ OpenId.authenticate gets'+ res <- runAttemptT $ auth gets' toMaster <- getRouteToMaster let onFailure err = do setMessage $ string $ show err@@ -57,4 +68,3 @@ let onSuccess (OpenId.Identifier ident) = setCreds True $ Creds "openid" ident [] attempt onFailure onSuccess res- dispatch _ _ = notFound
Yesod/Helpers/Auth2/Rpxnow.hs view
@@ -15,8 +15,7 @@ authRpxnow app apiKey = AuthPlugin "rpxnow" dispatch login where- login = do- tm <- liftHandler getRouteToMaster+ login tm = do let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" [] addBody [$hamlet| %iframe!src="http://$app$.rpxnow.com/openid/embed?token_url=@url@"!scrolling=no!frameBorder=no!allowtransparency=true!style="width:400px;height:240px"
yesod-auth.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-version: 0.0.0+version: 0.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -13,7 +13,7 @@ library build-depends: base >= 4 && < 5- , authenticate >= 0.6.4 && < 0.7+ , authenticate >= 0.6.6 && < 0.7 , bytestring >= 0.9.1.4 && < 0.10 , yesod >= 0.5.1 && < 0.6 , wai >= 0.2 && < 0.3