Remove qsUrl and utf8-string

OpenId2/Discovery.hs

@@ -28,7 +28,6 @@ import Data.Char
 import Data.List
 import Data.Maybe
 import Network.HTTP.Enumerator
-import qualified Data.ByteString.Lazy.UTF8 as BSLU
 import qualified Data.ByteString.Char8 as S8
 import Control.Arrow (first, (***))
 import Control.Monad.IO.Class (MonadIO (liftIO))

Web/Authenticate/Internal.hs

@@ -1,11 +1,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 module Web.Authenticate.Internal
-    ( qsEncode
+    ( AuthenticateException (..)
-    , qsUrl
-    , AuthenticateException (..)
     ) where
 
-import Codec.Binary.UTF8.String (encode)
 import Numeric (showHex)
 import Data.List (intercalate)
 import Data.Typeable (Typeable)
@@ -18,27 +15,3 @@ data AuthenticateException =
     | AuthenticationException String
   deriving (Show, Typeable)
 instance Exception AuthenticateException
-
-qsUrl :: String -> [(String, String)] -> String -- FIXME remove
-qsUrl s [] = s
-qsUrl url pairs =
-    url ++ delim : intercalate "&" (map qsPair pairs)
-  where
-    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y
-    delim = if '?' `elem` url then '&' else '?'
-
-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/OAuth.hs

@@ -14,7 +14,6 @@ module Web.Authenticate.OAuth
       paramEncode
     ) where
 import Network.HTTP.Enumerator
-import Web.Authenticate.Internal (qsUrl)
 import Data.Data
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -38,6 +37,7 @@ import Data.Enumerator (($$), run_, Stream (..), continue)
 import Data.Monoid (mconcat)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Data.IORef (newIORef, readIORef, atomicModifyIORef)
+import Network.HTTP.Types (renderSimpleQuery)
 
 -- | Data type for OAuth client (consumer).
 data OAuth = OAuth { oauthServerName      :: String        -- ^ Service name
@@ -103,7 +103,7 @@ getTemporaryCredential oa = do
 authorizeUrl :: OAuth           -- ^ OAuth Application
              -> Credential      -- ^ Temporary Credential (Request Token & Secret)
              -> String          -- ^ URL to authorize
-authorizeUrl oa cr = qsUrl (oauthAuthorizeUri oa) [("oauth_token", BS.unpack $ token cr)]
+authorizeUrl oa cr = oauthAuthorizeUri oa ++ BS.unpack (renderSimpleQuery True [("oauth_token", token cr)])
 
 -- | Get Access token.
 getAccessToken, getTokenCredential

Web/Authenticate/OpenId.hs

@@ -12,7 +12,6 @@ import OpenId2.Normalization (normalize)
 import OpenId2.Discovery (discover, Discovery (..))
 import Control.Failure (Failure (failure))
 import OpenId2.Types
-import Web.Authenticate.Internal (qsUrl)
 import Control.Monad (unless)
 import Data.Text.Lazy.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
@@ -21,11 +20,14 @@ import Network.HTTP.Enumerator
     ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect
     , HttpException, withManager
     )
-import Control.Arrow ((***))
+import Control.Arrow ((***), second)
 import Data.List (unfoldr)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text, pack, unpack)
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Blaze.ByteString.Builder (toByteString)
+import Network.HTTP.Types (renderQueryText)
+import Data.Monoid (mappend)
 
 getForwardUrl
     :: ( MonadIO m
@@ -40,10 +42,9 @@ getForwardUrl
 getForwardUrl openid' complete mrealm params = do
     let realm = fromMaybe complete mrealm
     disc <- normalize openid' >>= discover
+    let helper s q = return $ s `mappend` decodeUtf8 (toByteString $ renderQueryText True $ map (second Just) q)
     case disc of
-        Discovery1 server mdelegate ->
+        Discovery1 server mdelegate -> helper server
-            return $ pack $ qsUrl (unpack server)
-                $ map (unpack *** unpack) -- FIXME
                 $ ("openid.mode", "checkid_setup")
                 : ("openid.identity", maybe openid' id mdelegate)
                 : ("openid.return_to", complete)
@@ -55,14 +56,14 @@ getForwardUrl openid' complete mrealm params = do
                     case itype of
                         ClaimedIdent -> i
                         OPIdent -> "http://specs.openid.net/auth/2.0/identifier_select"
-            return $ pack $ qsUrl (unpack p)
+            helper p
                 $ ("openid.ns", "http://specs.openid.net/auth/2.0")
                 : ("openid.mode", "checkid_setup")
-                : ("openid.claimed_id", unpack i')
+                : ("openid.claimed_id", i')
-                : ("openid.identity", unpack i')
+                : ("openid.identity", i')
-                : ("openid.return_to", unpack complete)
+                : ("openid.return_to", complete)
-                : ("openid.realm", unpack realm)
+                : ("openid.realm", realm)
-                : map (unpack *** unpack) params
+                : params
 
 authenticate
     :: ( MonadIO m

authenticate.cabal

@@ -21,7 +21,6 @@ library
                      failure >= 0.0.0 && < 0.2,
                      transformers >= 0.1 && < 0.3,
                      bytestring >= 0.9 && < 0.10,
-                     utf8-string >= 0.3 && < 0.4,
                      network >= 2.2.1 && < 2.4,
                      case-insensitive >= 0.2 && < 0.4,
                      RSA >= 1.0 && < 1.1,