haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Percent encoding for Facebook

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-04 07:05:53 +02:00
parent bdb6f2011f
commit d742893f04
2 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
Web/Authenticate/Facebook.hs
View File

@ -8,6 +8,8 @@ import Data.Object.Json
import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Codec.Binary.UTF8.String
import Numeric (showHex)
data Facebook = Facebook data Facebook = Facebook
{ facebookClientId :: String { facebookClientId :: String
@ -19,27 +21,43 @@ data Facebook = Facebook
newtype AccessToken = AccessToken { unAccessToken :: String } newtype AccessToken = AccessToken { unAccessToken :: String }
deriving (Show, Eq, Read) 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 :: Facebook -> [String] -> String
getForwardUrl fb perms = concat getForwardUrl fb perms = concat
[ "https://graph.facebook.com/oauth/authorize?client_id=" [ "https://graph.facebook.com/oauth/authorize?client_id="
, facebookClientId fb -- FIXME escape , qsEncode $ facebookClientId fb
, "&redirect_uri=" , "&redirect_uri="
, facebookRedirectUri fb -- FIXME escape , qsEncode $ facebookRedirectUri fb
, if null perms , if null perms
then "" then ""
else "&scope=" ++ intercalate "," perms else "&scope=" ++ qsEncode (intercalate "," perms)
] ]
accessTokenUrl :: Facebook -> String -> String accessTokenUrl :: Facebook -> String -> String
accessTokenUrl fb code = concat accessTokenUrl fb code = concat
[ "https://graph.facebook.com/oauth/access_token?client_id=" [ "https://graph.facebook.com/oauth/access_token?client_id="
, facebookClientId fb , qsEncode $ facebookClientId fb
, "&redirect_uri=" , "&redirect_uri="
, facebookRedirectUri fb , qsEncode $ facebookRedirectUri fb
, "&client_secret=" , "&client_secret="
, facebookClientSecret fb , qsEncode $ facebookClientSecret fb
, "&code=" , "&code="
, code , qsEncode code
] ]
getAccessToken :: Facebook -> String -> IO AccessToken getAccessToken :: Facebook -> String -> IO AccessToken

5
authenticate.cabal
View File

@ -21,8 +21,9 @@ library
tagsoup >= 0.6 && < 0.12, tagsoup >= 0.6 && < 0.12,
failure >= 0.0.0 && < 0.2, failure >= 0.0.0 && < 0.2,
transformers >= 0.1 && < 0.3, 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, exposed-modules: Web.Authenticate.Rpxnow,
Web.Authenticate.OpenId, Web.Authenticate.OpenId,
Web.Authenticate.Facebook Web.Authenticate.Facebook
ghc-options: -Wall -fno-warn-orphans ghc-options: -Wall