diff --git a/Web/Authenticate/Facebook.hs b/Web/Authenticate/Facebook.hs index eb8acb36..38d62d81 100644 --- a/Web/Authenticate/Facebook.hs +++ b/Web/Authenticate/Facebook.hs @@ -8,6 +8,8 @@ import Data.Object.Json import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S +import qualified Codec.Binary.UTF8.String +import Numeric (showHex) data Facebook = Facebook { facebookClientId :: String @@ -19,27 +21,43 @@ data Facebook = Facebook newtype AccessToken = AccessToken { unAccessToken :: String } deriving (Show, Eq, Read) +qsEncode :: String -> String +qsEncode = + concatMap go . Codec.Binary.UTF8.String.encode + where + go 32 = "+" -- space + go 46 = "." + go 45 = "-" + go 126 = "~" + go 95 = "_" + go c + | 48 <= c && c <= 57 = [w2c c] + | 65 <= c && c <= 90 = [w2c c] + | 97 <= c && c <= 122 = [w2c c] + go c = '%' : showHex c "" + w2c = toEnum . fromEnum + getForwardUrl :: Facebook -> [String] -> String getForwardUrl fb perms = concat [ "https://graph.facebook.com/oauth/authorize?client_id=" - , facebookClientId fb -- FIXME escape + , qsEncode $ facebookClientId fb , "&redirect_uri=" - , facebookRedirectUri fb -- FIXME escape + , qsEncode $ facebookRedirectUri fb , if null perms then "" - else "&scope=" ++ intercalate "," perms + else "&scope=" ++ qsEncode (intercalate "," perms) ] accessTokenUrl :: Facebook -> String -> String accessTokenUrl fb code = concat [ "https://graph.facebook.com/oauth/access_token?client_id=" - , facebookClientId fb + , qsEncode $ facebookClientId fb , "&redirect_uri=" - , facebookRedirectUri fb + , qsEncode $ facebookRedirectUri fb , "&client_secret=" - , facebookClientSecret fb + , qsEncode $ facebookClientSecret fb , "&code=" - , code + , qsEncode code ] getAccessToken :: Facebook -> String -> IO AccessToken diff --git a/authenticate.cabal b/authenticate.cabal index 0fa909f0..78e12749 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -21,8 +21,9 @@ library tagsoup >= 0.6 && < 0.12, failure >= 0.0.0 && < 0.2, transformers >= 0.1 && < 0.3, - bytestring >= 0.9 && < 0.10 + bytestring >= 0.9 && < 0.10, + utf8-string >= 0.3 && < 0.4 exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.Facebook - ghc-options: -Wall -fno-warn-orphans + ghc-options: -Wall