haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split up authenticate and yesod-auth (#232)

Browse Source
This commit is contained in:
Michael Snoyman 2012-01-24 05:44:07 +02:00
parent cdd21df335
commit 225bf0fb63
16 changed files with 170 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
authenticate

@ -1 +1 @@
Subproject commit 35b7cf61c2fde25399e0a88c41c3cf29d60f1895
Subproject commit 32c76842f1c3559ad241d407d6b712461eec9715

1
http-conduit

@ -1 +0,0 @@
Subproject commit cfcbefe93ecea0b84225294b4edc133fd921d8db

9
package-list.sh
View File

@ -1,15 +1,18 @@
#!/bin/bash
pkgs=( ./http-conduit
./yesod-routes
pkgs=( ./yesod-routes
./yesod-core
./yesod-json
./yesod-static
./yesod-persistent
./yesod-newsfeed
./yesod-form
./authenticate
./authenticate/authenticate
./authenticate/authenticate-oauth
./authenticate/authenticate-kerberos
./yesod-auth
./yesod-auth-oauth
./yesod-auth-kerberos
./yesod-sitemap
./yesod-default
./yesod )

25
yesod-auth-kerberos/LICENSE Normal file
View File

@ -0,0 +1,25 @@
The following license covers this documentation, and the source code, except
where otherwise indicated.
Copyright 2010, Michael Snoyman. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

8
yesod-auth-kerberos/Setup.lhs Executable file
View File

@ -0,0 +1,8 @@
#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> import System.Cmd (system)
> main :: IO ()
> main = defaultMain

0
yesod-auth/Yesod/Auth/Kerberos.hs → yesod-auth-kerberos/Yesod/Auth/Kerberos.hs
View File

10
yesod-auth-kerberos/include/qq.h Normal file
View File

@ -0,0 +1,10 @@
-- CPP macro which choses which quasyquotes syntax to use depending
-- on GHC version.
--
-- QQ stands for quasyquote.
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif

39
yesod-auth-kerberos/yesod-auth-kerberos.cabal Normal file
View File

@ -0,0 +1,39 @@
name: yesod-auth-kerberos
version: 0.8.0
license: BSD3
license-file: LICENSE
author: Arash Rouhani
maintainer: Arash Rouhani
synopsis: Kerberos Authentication for Yesod.
category: Web, Yesod
stability: Stable
cabal-version: >= 1.6.0
build-type: Simple
homepage: http://www.yesodweb.com/
extra-source-files: include/qq.h
description: Kerberos Authentication for Yesod.
flag ghc7
library
if flag(ghc7)
build-depends: base >= 4.3 && < 5
cpp-options: -DGHC7
else
build-depends: base >= 4 && < 4.3
build-depends: authenticate-kerberos >= 1.0 && < 1.1
, bytestring >= 0.9.1.4 && < 0.10
, yesod-core >= 0.10 && < 0.11
, yesod-auth >= 0.8 && < 0.9
, text >= 0.7 && < 0.12
, hamlet >= 0.10 && < 0.11
, yesod-form >= 0.4 && < 0.5
, transformers >= 0.2.2 && < 0.3
exposed-modules: Yesod.Auth.Kerberos
ghc-options: -Wall
include-dirs: include
source-repository head
type: git
location: https://github.com/yesodweb/yesod

25
yesod-auth-oauth/LICENSE Normal file
View File

@ -0,0 +1,25 @@
The following license covers this documentation, and the source code, except
where otherwise indicated.
Copyright 2010, Michael Snoyman. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

8
yesod-auth-oauth/Setup.lhs Executable file
View File

@ -0,0 +1,8 @@
#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> import System.Cmd (system)
> main :: IO ()
> main = defaultMain

0
yesod-auth/Yesod/Auth/OAuth.hs → yesod-auth-oauth/Yesod/Auth/OAuth.hs
View File

10
yesod-auth-oauth/include/qq.h Normal file
View File

@ -0,0 +1,10 @@
-- CPP macro which choses which quasyquotes syntax to use depending
-- on GHC version.
--
-- QQ stands for quasyquote.
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif

38
yesod-auth-oauth/yesod-auth-oauth.cabal Normal file
View File

@ -0,0 +1,38 @@
name: yesod-auth-oauth
version: 0.8.0
license: BSD3
license-file: LICENSE
author: Hiromi Ishii
maintainer: Hiromi Ishii
synopsis: OAuth Authentication for Yesod.
category: Web, Yesod
stability: Stable
cabal-version: >= 1.6.0
build-type: Simple
homepage: http://www.yesodweb.com/
extra-source-files: include/qq.h
description: Authentication for Yesod.
flag ghc7
library
if flag(ghc7)
build-depends: base >= 4.3 && < 5
cpp-options: -DGHC7
else
build-depends: base >= 4 && < 4.3
build-depends: authenticate-oauth >= 1.0 && < 1.1
, bytestring >= 0.9.1.4 && < 0.10
, yesod-core >= 0.10 && < 0.11
, yesod-auth >= 0.8 && < 0.9
, text >= 0.7 && < 0.12
, hamlet >= 0.10 && < 0.11
, yesod-form >= 0.4 && < 0.5
exposed-modules: Yesod.Auth.OAuth
ghc-options: -Wall
include-dirs: include
source-repository head
type: git
location: https://github.com/yesodweb/yesod

125
yesod-auth/Yesod/Auth/Facebook.hs
View File

@ -1,125 +0,0 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Auth.Facebook
( authFacebook
, facebookLogin
, facebookUrl
, facebookLogout
, getFacebookAccessToken
) where
#include "qq.h"
import Yesod.Auth
import qualified Web.Authenticate.Facebook as Facebook
import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import Yesod.Form
import Yesod.Handler
import Yesod.Widget
import Data.Text (Text)
import Control.Monad (liftM, mzero, when)
import Data.Monoid (mappend)
import qualified Data.Aeson.Types
import qualified Yesod.Auth.Message as Msg
import Control.Monad.IO.Class (liftIO)
import Control.Exception (throwIO)
-- | Route for login using this authentication plugin.
facebookLogin :: AuthRoute
facebookLogin = PluginR "facebook" ["forward"]
-- | This is just a synonym of 'facebookLogin'. Deprecated since
-- @yesod-auth 0.7.8@, please use 'facebookLogin' instead.
facebookUrl :: AuthRoute
facebookUrl = facebookLogin
{-# DEPRECATED facebookUrl "Please use facebookLogin instead." #-}
-- | Route for logout using this authentication plugin. Per
-- Facebook's policies
-- (<https://developers.facebook.com/policy/>), the user needs to
-- logout from Facebook itself as well.
facebookLogout :: AuthRoute
facebookLogout = PluginR "facebook" ["logout"]
-- | Get Facebook's access token from the session. Returns
-- @Nothing@ if it's not found (probably because the user is not
-- logged in via Facebook). Note that the returned access token
-- may have expired.
getFacebookAccessToken :: GHandler sub master (Maybe Facebook.AccessToken)
getFacebookAccessToken =
liftM (fmap Facebook.AccessToken) (lookupSession facebookAccessTokenKey)
-- | Key used to store Facebook's access token in the client
-- session.
facebookAccessTokenKey :: Text
facebookAccessTokenKey = "_FB"
-- | Authentication plugin using Facebook.
authFacebook :: YesodAuth m
=> Text -- ^ Application ID
-> Text -- ^ Application secret
-> [Text] -- ^ Requested permissions
-> AuthPlugin m
authFacebook cid secret perms =
AuthPlugin "facebook" dispatch login
where
url = PluginR "facebook" []
dispatch "GET" ["forward"] = do
tm <- getRouteToMaster
render <- getUrlRender
let fb = Facebook.Facebook cid secret $ render $ tm url
redirect $ Facebook.getForwardUrl fb perms
dispatch "GET" [] = do
render <- getUrlRender
tm <- getRouteToMaster
let fb = Facebook.Facebook cid secret $ render $ tm url
code <- runInputGet $ ireq textField "code"
master <- getYesod
at <- lift $ Facebook.getAccessToken fb code (authHttpManager master)
let Facebook.AccessToken at' = at
setSession facebookAccessTokenKey at'
so <- lift $ Facebook.getGraphData at "me" (authHttpManager master)
c <- maybe
(liftIO $ throwIO InvalidFacebookResponse)
return
$ either (const Nothing) Just so >>= parseMaybe (parseCreds at')
setCreds True c
dispatch "GET" ["logout"] = do
m <- getYesod
tm <- getRouteToMaster
mtoken <- getFacebookAccessToken
when (redirectToReferer m) setUltDestReferer
case mtoken of
Nothing -> do
-- Well... then just logout from our app.
redirect (tm LogoutR)
Just at -> do
render <- getUrlRender
let logout = Facebook.getLogoutUrl at (render $ tm LogoutR)
redirect logout
dispatch _ _ = notFound
login tm = do
render <- lift getUrlRender
let fb = Facebook.Facebook cid secret $ render $ tm url
let furl = Facebook.getForwardUrl fb $ perms
[QQ(whamlet)|
<p>
<a href="#{furl}">_{Msg.Facebook}
|]
parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m)
parseCreds at' (Object m) = do
id' <- m .: "id"
let id'' = "http://graph.facebook.com/" `mappend` id'
name <- m .:? "name"
email <- m .:? "email"
return
$ Creds "facebook" id''
$ maybe id (\x -> (:) ("verifiedEmail", x)) email
$ maybe id (\x -> (:) ("displayName ", x)) name
[ ("accessToken", at')
]
parseCreds _ _ = mzero

52
yesod-auth/facebook.hs
View File

@ -1,52 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import Yesod
import Yesod.Auth
import Yesod.Auth.Facebook
import Web.Authenticate.Facebook
import Yesod.Form
data FB = FB Facebook
fb :: FB
fb = FB Facebook
{ facebookClientId = "154414801293567"
, facebookClientSecret = "f901e124bee0d162c9188f92b939b370"
, facebookRedirectUri = "http://localhost:3000/facebook"
}
mkYesod "FB" [parseRoutes|
/ RootR GET
/after AfterLoginR GET
/auth AuthR Auth getAuth
|]
getRootR :: Handler ()
getRootR = redirect RedirectTemporary $ AuthR LoginR
getAfterLoginR :: Handler RepHtml
getAfterLoginR = defaultLayout $ return ()
instance Yesod FB where
approot _ = "http://localhost:3000"
instance YesodAuth FB where
type AuthId FB = String
loginDest _ = AfterLoginR
logoutDest _ = AuthR LoginR
getAuthId _ = do
liftIO $ putStrLn "getAuthId"
return $ Just "foo"
authPlugins = return $ authFacebook
"154414801293567"
"f901e124bee0d162c9188f92b939b370"
[]
instance RenderMessage FB FormMessage where
renderMessage _ _ = defaultFormMessage
main :: IO ()
main = warpDebug 3000 fb

3
yesod-auth/yesod-auth.cabal
View File

@ -51,13 +51,10 @@ library
Yesod.Auth.BrowserId
Yesod.Auth.Dummy
Yesod.Auth.Email
Yesod.Auth.Facebook
Yesod.Auth.OpenId
Yesod.Auth.OAuth
Yesod.Auth.Rpxnow
Yesod.Auth.HashDB
Yesod.Auth.Message
Yesod.Auth.Kerberos
Yesod.Auth.GoogleEmail
ghc-options: -Wall
include-dirs: include