OpenID uses same qsEncode as Facebook

Web/Authenticate/Facebook.hs

@@ -8,8 +8,7 @@ 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)
+import Web.Authenticate.Internal (qsEncode)
 
 data Facebook = Facebook
     { facebookClientId :: String
@@ -21,22 +20,6 @@ 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="

Web/Authenticate/Internal.hs

@@ -0,0 +1,22 @@
+module Web.Authenticate.Internal
+    ( qsEncode
+    ) where
+
+import Codec.Binary.UTF8.String (encode)
+import Numeric (showHex)
+
+qsEncode :: String -> String
+qsEncode =
+    concatMap go . 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

Web/Authenticate/OpenId.hs

@@ -25,13 +25,14 @@ module Web.Authenticate.OpenId
 
 import Network.HTTP.Enumerator
 import Text.HTML.TagSoup
-import Numeric (showHex)
 import "transformers" Control.Monad.IO.Class
 import Data.Data
 import Control.Failure hiding (Error)
 import Control.Exception
 import Control.Monad (liftM)
 import qualified Data.ByteString.Lazy.Char8 as L8
+import Web.Authenticate.Internal (qsEncode)
+import Data.List (intercalate)
 
 -- | An openid identifier (ie, a URL).
 newtype Identifier = Identifier { identifier :: String }
@@ -80,14 +81,12 @@ getOpenIdVar var content = do
         mhead [] = failure $ MissingVar $ "openid." ++ var
         mhead (x:_) = return x
 
-constructUrl :: String -> [(String, String)] -> String -- FIXME no longer needed, use Request value directly
+constructUrl :: String -> [(String, String)] -> String
 constructUrl url [] = url
-constructUrl url args = url ++ "?" ++ queryString' args
-    where
-        queryString' [] = error "queryString with empty args cannot happen"
-        queryString' [first] = onePair first
-        queryString' (first:rest) = onePair first ++ "&" ++ queryString' rest
-        onePair (x, y) = urlEncode x ++ "=" ++ urlEncode y
+constructUrl url args =
+    url ++ "?" ++ intercalate "&" (map qsPair args)
+  where
+    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y 
 
 -- | Handle a redirect from an OpenID provider and check that the user
 -- logged in properly. If it was successfully, 'return's the openid.
@@ -158,18 +157,3 @@ begins :: String -> String -> Bool
 begins [] _ = True
 begins _ [] = False
 begins (x:xs) (y:ys) = x == y && begins xs ys
-
-urlEncode :: String -> String
-urlEncode = concatMap urlEncodeChar
-
-urlEncodeChar :: Char -> String
-urlEncodeChar x
-    | safeChar (fromEnum x) = return x
-    | otherwise = '%' : showHex (fromEnum x) ""
-
-safeChar :: Int -> Bool
-safeChar x
-    | x >= fromEnum 'a' && x <= fromEnum 'z' = True
-    | x >= fromEnum 'A' && x <= fromEnum 'Z' = True
-    | x >= fromEnum '0' && x <= fromEnum '9' = True
-    | otherwise = False

authenticate.cabal

@@ -26,4 +26,5 @@ library
     exposed-modules: Web.Authenticate.Rpxnow,
                      Web.Authenticate.OpenId,
                      Web.Authenticate.Facebook
+    other-modules:   Web.Authenticate.Internal
     ghc-options:     -Wall