Percent encoding for Facebook

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

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