Merge pull request #2 from meteficha/facebook-logout

Facebook logout support.

Web/Authenticate/BrowserId.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
 module Web.Authenticate.BrowserId
     ( browserIdJs
     , checkAssertion
@@ -8,7 +9,11 @@ import Data.Text (Text)
 import Network.HTTP.Enumerator (parseUrl, responseBody, httpLbs, withManager, method, urlEncodedBody)
 import Data.Aeson (json, Value (Object, String))
 import Data.Attoparsec.Lazy (parse, maybeResult)
+#if MIN_VERSION_aeson(0, 4, 0)
+import qualified Data.HashMap.Lazy as Map
+#else
 import qualified Data.Map as Map
+#endif
 import Data.Text.Encoding (encodeUtf8)
 
 -- | Location of the Javascript file hosted by browserid.org

Web/Authenticate/Facebook.hs

@@ -4,10 +4,13 @@
 module Web.Authenticate.Facebook
     ( Facebook (..)
     , AccessToken (..)
+    , getForwardUrlParams
+    , getForwardUrlWithState
     , getForwardUrl
     , getAccessToken
     , getGraphData
     , getGraphData_
+    , getLogoutUrl
     ) where
 
 import Network.HTTP.Enumerator
@@ -27,6 +30,7 @@ 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
@@ -38,18 +42,27 @@ data Facebook = Facebook
 newtype AccessToken = AccessToken { unAccessToken :: Text }
     deriving (Show, Eq, Read, Ord, Data, Typeable)
 
-getForwardUrl :: Facebook -> [Text] -> Text
+getForwardUrlParams :: Facebook -> [(Text, Text)] -> Text
-getForwardUrl fb perms =
+getForwardUrlParams fb params =
     TE.decodeUtf8 $ toByteString $
     copyByteString "https://graph.facebook.com/oauth/authorize"
     `mappend`
     renderQueryText True
-        ( ("client_id", Just $ facebookClientId fb)
+        (  ("client_id", Just $ facebookClientId fb)
-        : ("redirect_uri", Just $ facebookRedirectUri fb)
+         : ("redirect_uri", Just $ facebookRedirectUri fb)
-        : if null perms
+         : map (id *** Just) params)
-            then []
-            else [("scope", Just $ T.intercalate "," perms)])
 
+-- 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 =
@@ -91,3 +104,12 @@ getGraphData_ a b = getGraphData a b >>= either (throwIO . InvalidJsonException)
 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)]

Web/Authenticate/Rpxnow.hs

@@ -38,7 +38,11 @@ import Data.Attoparsec.Lazy (parse)
 import qualified Data.Attoparsec.Lazy as AT
 import Data.Text (Text)
 import qualified Data.Aeson.Types
+#if MIN_VERSION_aeson(0, 4, 0)
+import qualified Data.HashMap.Lazy as Map
+#else
 import qualified Data.Map as Map
+#endif
 import Control.Applicative ((<$>), (<*>))
 
 -- | Information received from Rpxnow after a valid login.

authenticate.cabal

@@ -1,5 +1,5 @@
 name:            authenticate
-version:         0.10.3
+version:         0.10.4
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman, Hiromi Ishii, Arash Rouhani
@@ -36,6 +36,7 @@ library
                      attoparsec >= 0.9,
                      tls >= 0.7 && < 0.9,
                      containers,
+                     unordered-containers,
                      process >= 1.0.1.1 && < 1.2
     exposed-modules: Web.Authenticate.Rpxnow,
                      Web.Authenticate.OpenId,