From db89e940a5ee5a71761a5d6106e40b98a4717dcb Mon Sep 17 00:00:00 2001
From: Rian Hunter <rian@alum.mit.edu>
Date: Tue, 29 Nov 2011 15:31:58 -0800
Subject: [PATCH] Add new functions, getForwardUrlWithState that takes an extra
 state query arg for authenticating with facebook, also getForwardUrlParams
 that takes arbitrary query params for future-proofing

---
 Web/Authenticate/Facebook.hs | 26 +++++++++++++++++++-------
 1 file changed, 19 insertions(+), 7 deletions(-)

diff --git a/Web/Authenticate/Facebook.hs b/Web/Authenticate/Facebook.hs
index 97ace9ec..188853b6 100644
--- a/Web/Authenticate/Facebook.hs
+++ b/Web/Authenticate/Facebook.hs
@@ -4,6 +4,8 @@
 module Web.Authenticate.Facebook
     ( Facebook (..)
     , AccessToken (..)
+    , getForwardUrlParams
+    , getForwardUrlWithState
     , getForwardUrl
     , getAccessToken
     , getGraphData
@@ -27,6 +29,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 +41,27 @@ data Facebook = Facebook
 newtype AccessToken = AccessToken { unAccessToken :: Text }
     deriving (Show, Eq, Read, Ord, Data, Typeable)
 
-getForwardUrl :: Facebook -> [Text] -> Text
-getForwardUrl fb perms =
+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)
-        : if null perms
-            then []
-            else [("scope", Just $ T.intercalate "," perms)])
+        ([ ("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 []
+                                                                   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 =