yesod-form 0.2
This commit is contained in:
parent
4cc7d9c7d3
commit
c44ee5509e
@ -9,7 +9,7 @@ module Yesod.Auth.Dummy
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod.Auth
|
import Yesod.Auth
|
||||||
import Yesod.Form (runFormPost', stringInput)
|
import Yesod.Form (runInputPost, textField, ireq)
|
||||||
import Yesod.Handler (notFound)
|
import Yesod.Handler (notFound)
|
||||||
import Text.Hamlet (hamlet)
|
import Text.Hamlet (hamlet)
|
||||||
|
|
||||||
@ -18,7 +18,7 @@ authDummy =
|
|||||||
AuthPlugin "dummy" dispatch login
|
AuthPlugin "dummy" dispatch login
|
||||||
where
|
where
|
||||||
dispatch "POST" [] = do
|
dispatch "POST" [] = do
|
||||||
ident <- runFormPost' $ stringInput "ident"
|
ident <- runInputPost $ ireq textField "ident"
|
||||||
setCreds True $ Creds "dummy" ident []
|
setCreds True $ Creds "dummy" ident []
|
||||||
dispatch _ _ = notFound
|
dispatch _ _ = notFound
|
||||||
url = PluginR "dummy" []
|
url = PluginR "dummy" []
|
||||||
|
|||||||
@ -136,7 +136,7 @@ getRegisterR = do
|
|||||||
postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
|
postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
|
||||||
postRegisterR = do
|
postRegisterR = do
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
email <- runFormPost' $ emailInput "email"
|
email <- runInputPost $ ireq emailField "email"
|
||||||
mecreds <- getEmailCreds email
|
mecreds <- getEmailCreds email
|
||||||
(lid, verKey) <-
|
(lid, verKey) <-
|
||||||
case mecreds of
|
case mecreds of
|
||||||
@ -196,9 +196,9 @@ getVerifyR lid key = do
|
|||||||
|
|
||||||
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
|
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
|
||||||
postLoginR = do
|
postLoginR = do
|
||||||
(email, pass) <- runFormPost' $ (,)
|
(email, pass) <- runInputPost $ (,)
|
||||||
<$> emailInput "email"
|
<$> ireq emailField "email"
|
||||||
<*> stringInput "password"
|
<*> ireq textField "password"
|
||||||
mecreds <- getEmailCreds email
|
mecreds <- getEmailCreds email
|
||||||
maid <-
|
maid <-
|
||||||
case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of
|
case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of
|
||||||
@ -215,7 +215,6 @@ postLoginR = do
|
|||||||
Just _aid ->
|
Just _aid ->
|
||||||
setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid?
|
setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid?
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
y <- getYesod
|
|
||||||
mr <- getMessageRender
|
mr <- getMessageRender
|
||||||
setMessage $ mr Msg.InvalidEmailPass
|
setMessage $ mr Msg.InvalidEmailPass
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
@ -257,9 +256,9 @@ getPasswordR = do
|
|||||||
|
|
||||||
postPasswordR :: YesodAuthEmail master => GHandler Auth master ()
|
postPasswordR :: YesodAuthEmail master => GHandler Auth master ()
|
||||||
postPasswordR = do
|
postPasswordR = do
|
||||||
(new, confirm) <- runFormPost' $ (,)
|
(new, confirm) <- runInputPost $ (,)
|
||||||
<$> stringInput "new"
|
<$> ireq textField "new"
|
||||||
<*> stringInput "confirm"
|
<*> ireq textField "confirm"
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
when (new /= confirm) $ do
|
when (new /= confirm) $ do
|
||||||
|
|||||||
@ -46,7 +46,7 @@ authFacebook cid secret perms =
|
|||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
tm <- getRouteToMaster
|
tm <- getRouteToMaster
|
||||||
let fb = Facebook.Facebook cid secret $ render $ tm url
|
let fb = Facebook.Facebook cid secret $ render $ tm url
|
||||||
code <- runFormGet' $ stringInput "code"
|
code <- runInputGet $ ireq textField "code"
|
||||||
at <- liftIO $ Facebook.getAccessToken fb code
|
at <- liftIO $ Facebook.getAccessToken fb code
|
||||||
let Facebook.AccessToken at' = at
|
let Facebook.AccessToken at' = at
|
||||||
so <- liftIO $ Facebook.getGraphData at "me"
|
so <- liftIO $ Facebook.getGraphData at "me"
|
||||||
|
|||||||
@ -115,9 +115,9 @@ postLoginR :: (YesodAuth y,
|
|||||||
PersistBackend (YesodDB y (GGHandler Auth y IO)))
|
PersistBackend (YesodDB y (GGHandler Auth y IO)))
|
||||||
=> GHandler Auth y ()
|
=> GHandler Auth y ()
|
||||||
postLoginR = do
|
postLoginR = do
|
||||||
(mu,mp) <- runFormPost' $ (,)
|
(mu,mp) <- runInputPost $ (,)
|
||||||
<$> maybeStringInput "username"
|
<$> iopt textField "username"
|
||||||
<*> maybeStringInput "password"
|
<*> iopt textField "password"
|
||||||
|
|
||||||
isValid <- case (mu,mp) of
|
isValid <- case (mu,mp) of
|
||||||
(Nothing, _ ) -> return False
|
(Nothing, _ ) -> return False
|
||||||
|
|||||||
@ -22,6 +22,7 @@ import Data.Text (Text, unpack)
|
|||||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
|
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
|
import Control.Applicative ((<$>), (<*>))
|
||||||
|
|
||||||
oauthUrl :: Text -> AuthRoute
|
oauthUrl :: Text -> AuthRoute
|
||||||
oauthUrl name = PluginR name ["forward"]
|
oauthUrl name = PluginR name ["forward"]
|
||||||
@ -51,8 +52,9 @@ authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch lo
|
|||||||
tok <- liftIO $ getTemporaryCredential oauth'
|
tok <- liftIO $ getTemporaryCredential oauth'
|
||||||
redirectText RedirectTemporary (fromString $ authorizeUrl oauth' tok)
|
redirectText RedirectTemporary (fromString $ authorizeUrl oauth' tok)
|
||||||
dispatch "GET" [] = do
|
dispatch "GET" [] = do
|
||||||
verifier <- runFormGet' $ stringInput "oauth_verifier"
|
(verifier, oaTok) <- runInputGet $ (,)
|
||||||
oaTok <- runFormGet' $ stringInput "oauth_token"
|
<$> ireq textField "oauth_verifier"
|
||||||
|
<*> ireq textField "oauth_token"
|
||||||
let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok)
|
let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok)
|
||||||
]
|
]
|
||||||
accTok <- liftIO $ getAccessToken oauth reqTok
|
accTok <- liftIO $ getAccessToken oauth reqTok
|
||||||
|
|||||||
@ -56,10 +56,9 @@ authOpenId =
|
|||||||
<input type="submit" value="#{mr Msg.LoginOpenID}">
|
<input type="submit" value="#{mr Msg.LoginOpenID}">
|
||||||
|]
|
|]
|
||||||
dispatch "GET" ["forward"] = do
|
dispatch "GET" ["forward"] = do
|
||||||
(roid, _, _) <- runFormGet $ stringInput name
|
roid <- runInputGet $ iopt textField name
|
||||||
y <- getYesod
|
|
||||||
case roid of
|
case roid of
|
||||||
FormSuccess oid -> do
|
Just oid -> do
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
let complete' = render $ toMaster complete
|
let complete' = render $ toMaster complete
|
||||||
@ -71,7 +70,7 @@ authOpenId =
|
|||||||
)
|
)
|
||||||
(redirectText RedirectTemporary)
|
(redirectText RedirectTemporary)
|
||||||
res
|
res
|
||||||
_ -> do
|
Nothing -> do
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
mr <- getMessageRender
|
mr <- getMessageRender
|
||||||
setMessage $ mr Msg.NoOpenID
|
setMessage $ mr Msg.NoOpenID
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: yesod-auth
|
name: yesod-auth
|
||||||
version: 0.5.0
|
version: 0.6.0
|
||||||
license: BSD3
|
license: BSD3
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michael Snoyman, Patrick Brisbin
|
author: Michael Snoyman, Patrick Brisbin
|
||||||
@ -34,7 +34,7 @@ library
|
|||||||
, hamlet >= 0.8.1 && < 0.9
|
, hamlet >= 0.8.1 && < 0.9
|
||||||
, yesod-json >= 0.1 && < 0.2
|
, yesod-json >= 0.1 && < 0.2
|
||||||
, containers >= 0.2 && < 0.5
|
, containers >= 0.2 && < 0.5
|
||||||
, yesod-form >= 0.1 && < 0.2
|
, yesod-form >= 0.2 && < 0.3
|
||||||
, transformers >= 0.2 && < 0.3
|
, transformers >= 0.2 && < 0.3
|
||||||
, persistent >= 0.5 && < 0.6
|
, persistent >= 0.5 && < 0.6
|
||||||
, persistent-template >= 0.5 && < 0.6
|
, persistent-template >= 0.5 && < 0.6
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user