Removed Facebook

Web/Authenticate/Facebook.hs

@@ -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)]

authenticate.cabal

@@ -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,