From a713f6af2d06cc6280dfb1e0ac51e8cb11d32b30 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 19 Jul 2011 17:57:02 +0300 Subject: [PATCH] Remove qsUrl and utf8-string --- OpenId2/Discovery.hs | 1 - Web/Authenticate/Internal.hs | 29 +---------------------------- Web/Authenticate/OAuth.hs | 4 ++-- Web/Authenticate/OpenId.hs | 25 +++++++++++++------------ authenticate.cabal | 1 - 5 files changed, 16 insertions(+), 44 deletions(-) diff --git a/OpenId2/Discovery.hs b/OpenId2/Discovery.hs index dd4fee41..d91e4ea8 100644 --- a/OpenId2/Discovery.hs +++ b/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)) diff --git a/Web/Authenticate/Internal.hs b/Web/Authenticate/Internal.hs index 535005de..84d7d9ee 100644 --- a/Web/Authenticate/Internal.hs +++ b/Web/Authenticate/Internal.hs @@ -1,11 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} module Web.Authenticate.Internal - ( qsEncode - , qsUrl - , AuthenticateException (..) + ( 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 diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs index c9287e95..b182ea4a 100644 --- a/Web/Authenticate/OAuth.hs +++ b/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 diff --git a/Web/Authenticate/OpenId.hs b/Web/Authenticate/OpenId.hs index ab4b689c..2e8d3561 100644 --- a/Web/Authenticate/OpenId.hs +++ b/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 -> - return $ pack $ qsUrl (unpack server) - $ map (unpack *** unpack) -- FIXME + Discovery1 server mdelegate -> helper server $ ("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.identity", unpack i') - : ("openid.return_to", unpack complete) - : ("openid.realm", unpack realm) - : map (unpack *** unpack) params + : ("openid.claimed_id", i') + : ("openid.identity", i') + : ("openid.return_to", complete) + : ("openid.realm", realm) + : params authenticate :: ( MonadIO m diff --git a/authenticate.cabal b/authenticate.cabal index d29813bd..014d48e7 100644 --- a/authenticate.cabal +++ b/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,