Permalink
Browse files

Removed Facebook

  • Loading branch information...
1 parent 35b7cf6 commit 22f331b726ac142bde3765d98aa3c539f148ae39 @snoyberg snoyberg committed Jan 24, 2012
Showing with 1 addition and 122 deletions.
  1. +0 −119 Web/Authenticate/Facebook.hs
  2. +1 −3 authenticate.cabal
@@ -1,119 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Web.Authenticate.Facebook
- ( Facebook (..)
- , AccessToken (..)
- , getForwardUrlParams
- , getForwardUrlWithState
- , getForwardUrl
- , getAccessToken
- , getGraphData
- , getGraphData_
- , getLogoutUrl
- ) where
-
-import Network.HTTP.Conduit
-import Data.Conduit (ResourceT)
-import Control.Monad.IO.Class (liftIO)
-import Network.HTTP.Types (parseSimpleQuery)
-import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as L8
-import Data.Data (Data)
-import Data.Typeable (Typeable)
-import Control.Exception (Exception, throwIO)
-import Data.Attoparsec.Lazy (parse, eitherResult)
-import qualified Data.ByteString.Char8 as S8
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import Blaze.ByteString.Builder (toByteString, copyByteString)
-import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-import Network.HTTP.Types (renderQueryText)
-import Data.Monoid (mappend)
-import Data.ByteString (ByteString)
-import Control.Arrow ((***))
-
-data Facebook = Facebook
- { facebookClientId :: Text
- , facebookClientSecret :: Text
- , facebookRedirectUri :: Text
- }
- deriving (Show, Eq, Read, Ord, Data, Typeable)
-
-newtype AccessToken = AccessToken { unAccessToken :: Text }
- deriving (Show, Eq, Read, Ord, Data, Typeable)
-
-getForwardUrlParams :: Facebook -> [(Text, Text)] -> Text
-getForwardUrlParams fb params =
- TE.decodeUtf8 $ toByteString $
- copyByteString "https://graph.facebook.com/oauth/authorize"
- `mappend`
- renderQueryText True
- ( ("client_id", Just $ facebookClientId fb)
- : ("redirect_uri", Just $ facebookRedirectUri fb)
- : map (id *** Just) params)
-
--- Internal function used to simplify getForwardUrl & getForwardUrlWithState
-getForwardUrlWithExtra_ :: Facebook -> [Text] -> [(Text, Text)] -> Text
-getForwardUrlWithExtra_ fb perms extra = getForwardUrlParams fb $ (if null perms
- then id
- else (("scope", T.intercalate "," perms):)) extra
-
-getForwardUrlWithState :: Facebook -> [Text] -> Text -> Text
-getForwardUrlWithState fb perms state = getForwardUrlWithExtra_ fb perms [("state", state)]
-
-getForwardUrl :: Facebook -> [Text] -> Text
-getForwardUrl fb perms = getForwardUrlWithExtra_ fb perms []
-
-accessTokenUrl :: Facebook -> Text -> ByteString
-accessTokenUrl fb code =
- toByteString $
- copyByteString "https://graph.facebook.com/oauth/access_token"
- `mappend`
- renderQueryText True
- [ ("client_id", Just $ facebookClientId fb)
- , ("redirect_uri", Just $ facebookRedirectUri fb)
- , ("code", Just code)
- , ("client_secret", Just $ facebookClientSecret fb)
- ]
-
-getAccessToken :: Facebook -> Text -> Manager -> ResourceT IO AccessToken
-getAccessToken fb code manager = do
- let url = accessTokenUrl fb code
- req <- liftIO $ parseUrl $ S8.unpack url
- Response _ _ b <- httpLbs req manager
- let params = parseSimpleQuery $ S8.concat $ L8.toChunks b
- case lookup "access_token" params of
- Just x -> return $ AccessToken $ T.pack $ S8.unpack x
- Nothing -> error $ "Invalid facebook response: " ++ L8.unpack b
-
-graphUrl :: AccessToken -> Text -> ByteString
-graphUrl (AccessToken s) func =
- toByteString $
- copyByteString "https://graph.facebook.com/"
- `mappend` fromText func
- `mappend` renderQueryText True [("access_token", Just s)]
-
-getGraphData :: AccessToken -> Text -> Manager -> ResourceT IO (Either String Value)
-getGraphData at func manager = do
- let url = graphUrl at func
- req <- liftIO $ parseUrl $ S8.unpack url
- Response _ _ b <- httpLbs req manager
- return $ eitherResult $ parse json b
-
-getGraphData_ :: AccessToken -> Text -> Manager -> ResourceT IO Value
-getGraphData_ a b m = getGraphData a b m >>= either (liftIO . throwIO . InvalidJsonException) return
-
-data InvalidJsonException = InvalidJsonException String
- deriving (Show, Typeable)
-instance Exception InvalidJsonException
-
--- | Logs out the user from their Facebook session.
-getLogoutUrl :: AccessToken
- -> Text -- ^ URL the user should be directed to in your site domain.
- -> Text -- ^ Logout URL in @https://www.facebook.com/@.
-getLogoutUrl (AccessToken s) next =
- TE.decodeUtf8 $ toByteString $
- copyByteString "https://www.facebook.com/logout.php"
- `mappend` renderQueryText True [("next", Just next), ("access_token", Just s)]
View
@@ -5,8 +5,7 @@ license-file: LICENSE
author: Michael Snoyman, Hiromi Ishii, Arash Rouhani
maintainer: Michael Snoyman <michael@snoyman.com>
synopsis: Authentication methods for Haskell web applications.
-description: Focus is on third-party authentication methods, such as OpenID,
- rpxnow and Facebook.
+description: Focus is on third-party authentication methods, such as OpenID and BrowserID.
category: Web
stability: Stable
cabal-version: >= 1.6
@@ -43,7 +42,6 @@ library
Web.Authenticate.BrowserId,
Web.Authenticate.OpenId.Providers,
Web.Authenticate.OAuth,
- Web.Authenticate.Facebook
Web.Authenticate.Kerberos
other-modules: Web.Authenticate.Internal,
OpenId2.Discovery,

0 comments on commit 22f331b

Please sign in to comment.