authenticate-oauth-1.7/Web/0000755000000000000000000000000014063567307014073 5ustar0000000000000000authenticate-oauth-1.7/Web/Authenticate/0000755000000000000000000000000014063567307016511 5ustar0000000000000000authenticate-oauth-1.7/Web/Authenticate/OAuth/0000755000000000000000000000000014063567307017531 5ustar0000000000000000authenticate-oauth-1.7/Web/Authenticate/OAuth.hs0000644000000000000000000007026214063567307020074 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings, StandaloneDeriving #-} module Web.Authenticate.OAuth ( -- * Data types OAuth, def, newOAuth, oauthServerName, oauthRequestUri, oauthAccessTokenUri, oauthAuthorizeUri, oauthSignatureMethod, oauthConsumerKey, oauthConsumerSecret, oauthCallback, oauthRealm, oauthVersion, OAuthVersion(..), SignMethod(..), Credential(..), OAuthException(..), -- ** Access token request AccessTokenRequest, defaultAccessTokenRequest, accessTokenAddAuth, accessTokenRequestHook, accessTokenOAuth, accessTokenTemporaryCredential, accessTokenManager, -- * Operations for credentials newCredential, emptyCredential, insert, delete, inserts, injectVerifier, -- * Signature signOAuth, genSign, checkOAuth, -- * Url & operation for authentication -- ** Temporary credentials getTemporaryCredential, getTemporaryCredentialWithScope, getTemporaryCredentialProxy, getTemporaryCredential', -- ** Authorization URL authorizeUrl, authorizeUrl', -- ** Attaching auth to requests addAuthBody, -- ** Finishing authentication getAccessToken, getAccessTokenProxy, getTokenCredential, getTokenCredentialProxy, getAccessToken', getAccessTokenWith, -- * Utility Methods paramEncode, addScope, addMaybeProxy ) where import Blaze.ByteString.Builder (toByteString) import Control.Exception import Control.Arrow (second) import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Except import Crypto.Types.PubKey.RSA (PrivateKey (..)) -- , PublicKey (..) import Data.ByteString.Base64 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Char import Data.Default import Data.Digest.Pure.SHA import qualified Data.IORef as I import Data.List as List (sort, find) import Data.Maybe import Data.Time import Network.HTTP.Client import Network.HTTP.Types (SimpleQuery, parseSimpleQuery) import Network.HTTP.Types (Header) import Network.HTTP.Types (renderSimpleQuery, status200) import Numeric import System.Random #if MIN_VERSION_base(4,7,0) import Data.Data hiding (Proxy (..)) #else import Data.Data #endif import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, hashSHA1, hashSHA256, hashSHA512) ---------------------------------------------------------------------- -- Data types -- | Data type for OAuth client (consumer). -- -- The constructor for this data type is not exposed. -- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance, -- and then use the records below to make modifications. -- This approach allows us to add configuration options without breaking backwards compatibility. data OAuth = OAuth { oauthServerName :: String -- ^ Service name (default: @\"\"@) , oauthRequestUri :: String -- ^ URI to request temporary credential (default: @\"\"@). -- You MUST specify if you use 'getTemporaryCredential'', 'getTemporaryCredentialProxy' -- or 'getTemporaryCredential'; otherwise you can just leave this empty. , oauthAccessTokenUri :: String -- ^ Uri to obtain access token (default: @\"\"@). -- You MUST specify if you use 'getAcessToken' or 'getAccessToken'' or 'getAccessTokenWith'; -- otherwise you can just leave this empty. , oauthAuthorizeUri :: String -- ^ Uri to authorize (default: @\"\"@). -- You MUST specify if you use 'authorizeUrl' or 'authorizeZUrl''; -- otherwise you can just leave this empty. , oauthSignatureMethod :: SignMethod -- ^ Signature Method (default: 'HMACSHA1') , oauthConsumerKey :: BS.ByteString -- ^ Consumer key (You MUST specify) , oauthConsumerSecret :: BS.ByteString -- ^ Consumer Secret (You MUST specify) , oauthCallback :: Maybe BS.ByteString -- ^ Callback uri to redirect after authentication (default: @Nothing@) , oauthRealm :: Maybe BS.ByteString -- ^ Optional authorization realm (default: @Nothing@) , oauthVersion :: OAuthVersion -- ^ OAuth spec version (default: 'OAuth10a') } deriving (Show, Eq, Read, Data, Typeable) data OAuthVersion = OAuth10 -- ^ OAuth protocol ver 1.0 (no oauth_verifier; differs from RFC 5849). | OAuth10a -- ^ OAuth protocol ver 1.0a. This corresponds to community's 1.0a spec and RFC 5849. deriving (Show, Eq, Enum, Ord, Data, Typeable, Read) -- | Default value for OAuth datatype. -- You must specify at least oauthServerName, URIs and Tokens. newOAuth :: OAuth newOAuth = OAuth { oauthSignatureMethod = HMACSHA1 , oauthCallback = Nothing , oauthRealm = Nothing , oauthServerName = "" , oauthRequestUri = "" , oauthAccessTokenUri = "" , oauthAuthorizeUri = "" , oauthConsumerKey = error "You MUST specify oauthConsumerKey parameter." , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." , oauthVersion = OAuth10a } instance Default OAuth where def = newOAuth -- | Data type for signature method. data SignMethod = PLAINTEXT | HMACSHA1 | HMACSHA256 | HMACSHA512 | RSASHA1 PrivateKey | RSASHA256 PrivateKey | RSASHA512 PrivateKey deriving (Show, Eq, Read, Data, Typeable) newtype OAuthException = OAuthException String deriving (Show, Eq, Data, Typeable) instance Exception OAuthException -- | Data type for getAccessTokenWith method. -- -- You can create values of this type using 'defaultAccessTokenRequest'. -- -- Since 1.5.1 data AccessTokenRequest = AccessTokenRequest { accessTokenAddAuth :: (BS.ByteString -> Credential -> Request -> Request) -- ^ add auth hook. -- -- Default: addAuthHeader -- -- Since 1.5.1 , accessTokenRequestHook :: (Request -> Request) -- ^ Request Hook. -- -- Default: @id@ -- -- Since 1.5.1 , accessTokenOAuth :: OAuth -- ^ OAuth Application -- -- Since 1.5.1 , accessTokenTemporaryCredential :: Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -- -- Since 1.5.1 , accessTokenManager :: Manager -- ^ Manager -- -- Since 1.5.1 } -- | Create a value of type 'AccessTokenRequest' with default values filled in. -- -- Note that this is a settings type. More information on usage can be found -- at: . -- -- Since 1.5.1 defaultAccessTokenRequest :: OAuth -> Credential -> Manager -> AccessTokenRequest defaultAccessTokenRequest oauth cred man = AccessTokenRequest { accessTokenAddAuth = addAuthHeader , accessTokenRequestHook = id , accessTokenOAuth = oauth , accessTokenTemporaryCredential = cred , accessTokenManager = man } ---------------------------------------------------------------------- -- Credentials -- | Data type for credential. newtype Credential = Credential -- we can easily change it back to "data" later if needed, right? { unCredential :: [(BS.ByteString, BS.ByteString)] } deriving (Show, Eq, Ord, Read, Data, Typeable) -- | Convenient function to create 'Credential' with OAuth Token and Token Secret. newCredential :: BS.ByteString -- ^ value for oauth_token -> BS.ByteString -- ^ value for oauth_token_secret -> Credential newCredential tok sec = Credential [("oauth_token", tok), ("oauth_token_secret", sec)] -- | Empty credential. emptyCredential :: Credential emptyCredential = Credential [] -- | Insert an oauth parameter into given 'Credential'. insert :: BS.ByteString -- ^ Parameter Name -> BS.ByteString -- ^ Value -> Credential -- ^ Credential -> Credential -- ^ Result insert k v = Credential . insertMap k v . unCredential -- | Convenient method for inserting multiple parameters into credential. inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential inserts = flip $ foldr (uncurry insert) -- | Remove an oauth parameter for key from given 'Credential'. delete :: BS.ByteString -- ^ Parameter name -> Credential -- ^ Credential -> Credential -- ^ Result delete key = Credential . deleteMap key . unCredential -- | Insert @oauth-verifier@ on a 'Credential'. injectVerifier :: BS.ByteString -> Credential -> Credential injectVerifier = insert "oauth_verifier" ---------------------------------------------------------------------- -- Signature -- | Add OAuth headers & sign to 'Request'. signOAuth :: MonadIO m => OAuth -- ^ OAuth Application -> Credential -- ^ Credential -> Request -- ^ Original Request -> m Request -- ^ Signed OAuth Request signOAuth oa crd req = signOAuth' oa crd True addAuthHeader req -- | More flexible signOAuth signOAuth' :: MonadIO m => OAuth -- ^ OAuth Application -> Credential -- ^ Credential -> Bool -- ^ whether to insert oauth_body_hash or not -> (BS.ByteString -> Credential -> Request -> Request) -- ^ signature style -> Request -- ^ Original Request -> m Request -- ^ Signed OAuth Request signOAuth' oa crd withHash add_auth req = do crd' <- addTimeStamp =<< addNonce crd mhash <- moauth_body_hash let tok = addHashToCred mhash $ injectOAuthToCred oa crd' sign <- genSign oa tok req let prefix = case oauthRealm oa of Nothing -> "OAuth " Just v -> "OAuth realm=\"" `BS.append` v `BS.append` "\"," return $ add_auth prefix (insert "oauth_signature" sign tok) req where -- adding extension https://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/oauth-bodyhash.html moauth_body_hash = if not withHash || isBodyFormEncoded (requestHeaders req) then return Nothing else (Just . encode . BSL.toStrict . bytestringDigest . sha1 . BSL.fromStrict) `liftM` loadBodyBS req -- encodeHash (Just h) = "oauth_body_hash=\"" `BS.append` paramEncode h `BS.append` "\"," -- encodeHash Nothing = "" addHashToCred (Just h) = insert "oauth_body_hash" h addHashToCred Nothing = id -- | Generate OAuth signature. Used by 'signOAuth'. genSign :: MonadIO m => OAuth -> Credential -> Request -> m BS.ByteString genSign oa tok req = case oauthSignatureMethod oa of HMACSHA1 -> do text <- getBaseString tok req let key = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] return $ encode $ toStrict $ bytestringDigest $ hmacSha1 (fromStrict key) text HMACSHA256 -> do text <- getBaseString tok req let key = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] return $ encode $ toStrict $ bytestringDigest $ hmacSha256 (fromStrict key) text HMACSHA512 -> do text <- getBaseString tok req let key = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] return $ encode $ toStrict $ bytestringDigest $ hmacSha512 (fromStrict key) text PLAINTEXT -> return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] RSASHA1 pr -> liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA1 pr) (getBaseString tok req) RSASHA256 pr -> liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA256 pr) (getBaseString tok req) RSASHA512 pr -> liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA512 pr) (getBaseString tok req) -- | Test existing OAuth signature. -- Since 1.5.2 checkOAuth :: MonadIO m => OAuth -> Credential -> Request -> ExceptT OAuthException m Request checkOAuth oa crd req = if isBodyFormEncoded origHeaders then checkOAuthB oa crd req else do case mosig of Nothing -> throwE $ OAuthException "oauth_signature parameter not found" Just osig -> do mhash <- moauth_body_hash case (\oh nh -> oh == paramEncode nh) `liftM` moauth_body_hash_orig `ap` mhash of Just False -> throwE $ OAuthException "Failed test of oauth_body_hash" _ -> let tok = addHashToCred mhash . injectOAuthToCred oa $ inserts (remParams authParams) crd in genSign oa tok req {requestHeaders = catMaybes [mtypeHeader]} >>= \nsig -> if osig == paramEncode nsig then return req else throwE $ OAuthException "Failed test of oauth_signature" where origHeaders = requestHeaders req mauthHeader = List.find ( ("Authorization" ==) . fst) $ origHeaders mtypeHeader = List.find ( ("Content-Type" ==) . fst) $ origHeaders authParams = (map parseParam . BS.split ',' . BS.drop 6 . snd) `liftM` mauthHeader remParams Nothing = [] remParams (Just ms) = filter ( not . flip elem ("realm" : "oauth_signature" : map fst (unCredential crd)) . fst) ms mosig = fmap snd . join $ List.find (("oauth_signature" ==) . fst) `liftM` authParams parseParam = second (BS.takeWhile ('"' /=) . BS.drop 1 . BS.dropWhile ('"' /=)) . splitEq . BS.dropWhile (' ' ==) splitEq s = case BS.elemIndex '=' s of Nothing -> (s,"") Just i -> BS.splitAt i s moauth_body_hash_orig = join $ (fmap snd . List.find ( ("oauth_body_hash" ==) . fst)) `liftM` authParams moauth_body_hash = if moauth_body_hash_orig == Nothing then return Nothing else (Just . encode . BSL.toStrict . bytestringDigest . sha1 . BSL.fromStrict) `liftM` loadBodyBS req addHashToCred (Just h) = insert "oauth_body_hash" h addHashToCred Nothing = id checkOAuthB :: MonadIO m => OAuth -> Credential -> Request -> ExceptT OAuthException m Request checkOAuthB oa crd req0 = do (mosig, reqBody) <- getSig `liftM` loadBodyBS req0 let req = req0 {requestBody = RequestBodyBS reqBody} case mosig of "" -> throwE $ OAuthException "oauth_signature parameter not found" osig -> do nsig <- genSign oa crd req if osig == paramEncode nsig then return req0 else throwE $ OAuthException "Failed test of oauth_signature" where getSig b = let (h1 , r ) = BS.breakSubstring "&oauth_signature=" b (sig, h2) = BS.breakSubstring "&" $ BS.drop 17 r in (sig, h1 `BS.append` h2) ---------------------------------------------------------------------- -- Temporary credentails -- | Get temporary credential for requesting acces token. getTemporaryCredential :: MonadIO m => OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential = getTemporaryCredential' id -- | Get temporary credential for requesting access token with Scope parameter. getTemporaryCredentialWithScope :: MonadIO m => BS.ByteString -- ^ Scope parameter string -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporay Credential (Request Token & Secret). getTemporaryCredentialWithScope bs = getTemporaryCredential' (addScope bs) -- | Get temporary credential for requesting access token via the proxy. getTemporaryCredentialProxy :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredentialProxy p oa m = getTemporaryCredential' (addMaybeProxy p) oa m getTemporaryCredential' :: MonadIO m => (Request -> Request) -- ^ Request Hook -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential' hook oa manager = do let req = fromJust $ parseUrl $ oauthRequestUri oa crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential req' <- signOAuth' oa crd False addAuthHeader $ hook (req { method = "POST" }) rsp <- liftIO $ httpLbs req' manager if responseStatus rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp return $ Credential dic else liftIO . throwIO . OAuthException $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack (responseBody rsp) ---------------------------------------------------------------------- -- Authorization URL -- | URL to obtain OAuth verifier. authorizeUrl :: OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (Request Token & Secret) -> String -- ^ URL to authorize authorizeUrl = authorizeUrl' $ \oa -> const [("oauth_consumer_key", oauthConsumerKey oa)] -- | Convert OAuth and Credential to URL to authorize. -- This takes function to choice parameter to pass to the server other than -- /oauth_callback/ or /oauth_token/. authorizeUrl' :: (OAuth -> Credential -> SimpleQuery) -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (Request Token & Secret) -> String -- ^ URL to authorize authorizeUrl' f oa cr = oauthAuthorizeUri oa ++ BS.unpack (renderSimpleQuery True queries) where fixed = ("oauth_token", token cr):f oa cr queries = case oauthCallback oa of Nothing -> fixed Just callback -> ("oauth_callback", callback):fixed ---------------------------------------------------------------------- -- Finishing authentication -- | Get Access token. getAccessToken, getTokenCredential :: MonadIO m => OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -> Manager -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken = getAccessToken' id -- | Get Access token via the proxy. getAccessTokenProxy, getTokenCredentialProxy :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -> Manager -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessTokenProxy p = getAccessToken' $ addMaybeProxy p getAccessToken' :: MonadIO m => (Request -> Request) -- ^ Request Hook -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -> Manager -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken' hook oauth cr manager = do maybe_access_token <- getAccessTokenWith AccessTokenRequest { accessTokenAddAuth = addAuthHeader , accessTokenRequestHook = hook , accessTokenOAuth = oauth , accessTokenTemporaryCredential = cr , accessTokenManager = manager } case maybe_access_token of Left error_response -> liftIO . throwIO . OAuthException $ "Gaining OAuth Token Credential Failed: " ++ BSL.unpack (responseBody error_response) Right access_token -> return access_token getAccessTokenWith :: MonadIO m => AccessTokenRequest -- ^ extensible parameters -> m (Either (Response BSL.ByteString) Credential ) -- ^ Token Credential (Access Token & Secret) or the conduit response on failures getAccessTokenWith params = do let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" } rsp <- liftIO $ flip httpLbs manager =<< signOAuth' oa (if oauthVersion oa == OAuth10 then delete "oauth_verifier" cr else cr) False add_auth req if responseStatus rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp return $ Right $ Credential dic else return $ Left rsp where add_auth = accessTokenAddAuth params hook = accessTokenRequestHook params oa = accessTokenOAuth params cr = accessTokenTemporaryCredential params manager = accessTokenManager params getTokenCredential = getAccessToken getTokenCredentialProxy = getAccessTokenProxy baseTime :: UTCTime baseTime = UTCTime day 0 where day = ModifiedJulianDay 40587 showSigMtd :: SignMethod -> BS.ByteString showSigMtd PLAINTEXT = "PLAINTEXT" showSigMtd HMACSHA1 = "HMAC-SHA1" showSigMtd HMACSHA256 = "HMAC-SHA256" showSigMtd HMACSHA512 = "HMAC-SHA512" showSigMtd (RSASHA1 _) = "RSA-SHA1" showSigMtd (RSASHA256 _) = "RSA-SHA256" showSigMtd (RSASHA512 _) = "RSA-SHA512" addNonce :: MonadIO m => Credential -> m Credential addNonce cred = do nonce <- liftIO $ replicateM 10 (randomRIO ('a','z')) -- FIXME very inefficient return $ insert "oauth_nonce" (BS.pack nonce) cred addTimeStamp :: MonadIO m => Credential -> m Credential addTimeStamp cred = do stamp <- (floor . (`diffUTCTime` baseTime)) `liftM` liftIO getCurrentTime return $ insert "oauth_timestamp" (BS.pack $ show (stamp :: Integer)) cred injectOAuthToCred :: OAuth -> Credential -> Credential injectOAuthToCred oa cred = inserts [ ("oauth_signature_method", showSigMtd $ oauthSignatureMethod oa) , ("oauth_consumer_key", oauthConsumerKey oa) , ("oauth_version", "1.0") ] cred -- | Place the authentication information in a URL encoded body instead of the Authorization header. -- -- Note that the first parameter is used for realm in addAuthHeader, and this -- function needs the same type. The parameter, however, is unused. -- -- Since 1.5.1 addAuthBody :: a -> Credential -> Request -> Request addAuthBody _ (Credential cred) req = urlEncodedBody (filterCreds cred) req addAuthHeader :: BS.ByteString -> Credential -> Request -> Request addAuthHeader prefix (Credential cred) req = req { requestHeaders = insertMap "Authorization" (renderAuthHeader prefix cred) $ requestHeaders req } renderAuthHeader :: BS.ByteString -> [(BS.ByteString, BS.ByteString)] -> BS.ByteString renderAuthHeader prefix = (prefix `BS.append`) . BS.intercalate "," . map (\(a,b) -> BS.concat [paramEncode a, "=\"", paramEncode b, "\""]) . filterCreds filterCreds :: [(BS.ByteString, BS.ByteString)] -> [(BS.ByteString, BS.ByteString)] -- as per http://oauth.net/core/1.0a -- 9.1.1. Normalize Request Parameters -- everything except "realm" parameter should be encoded -- 6.1.1, 6.1.2, 6.2.1, 6.3.2 and 7 allow encoding anything in the authorization parameters -- 6.2.3 is only limited to oauth_token and oauth_verifier (although query params are allowed) -- 6.3.1 does not allow specifing other params, so no need to filter them (it is an error anyway) filterCreds = filter (not . flip elem ["realm", "oauth_token_secret"] . fst ) --filterCreds = filter ((`elem` [ "oauth_consumer_key" -- , "oauth_token" -- , "oauth_signature" -- , "oauth_signature_method" -- , "oauth_timestamp" -- , "oauth_nonce" -- , "oauth_verifier" -- , "oauth_version" -- , "oauth_callback" -- ] ) . fst ) getBaseString :: MonadIO m => Credential -> Request -> m BSL.ByteString getBaseString tok req = do let bsMtd = BS.map toUpper $ method req isHttps = secure req scheme = if isHttps then "https" else "http" bsPort = if (isHttps && port req /= 443) || (not isHttps && port req /= 80) then ':' `BS.cons` BS.pack (show $ port req) else "" bsURI = BS.concat [scheme, "://", host req, bsPort, path req] bsQuery = parseSimpleQuery $ queryString req bsBodyQ <- if isBodyFormEncoded $ requestHeaders req then liftM parseSimpleQuery $ loadBodyBS req else return [] let bsAuthParams = filterCreds $ unCredential tok allParams = bsQuery++bsBodyQ++bsAuthParams bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sort $ map (\(a,b) -> (paramEncode a,paramEncode b)) allParams -- parameter encoding method in OAuth is slight different from ordinary one. -- So this is OK. return . BSL.fromStrict $ BS.intercalate "&" $ map paramEncode [bsMtd, bsURI, bsParams] ---------------------------------------------------------------------- -- Utilities -- | Encode a string using the percent encoding method for OAuth. paramEncode :: BS.ByteString -> BS.ByteString paramEncode = BS.concatMap escape where escape c | isAscii c && (isAlpha c || isDigit c || c `elem` ("-._~" :: String)) = BS.singleton c | otherwise = let num = map toUpper $ showHex (ord c) "" oct = '%' : replicate (2 - length num) '0' ++ num in BS.pack oct addScope :: BS.ByteString -> Request -> Request addScope scope req | BS.null scope = req | otherwise = urlEncodedBody [("scope", scope)] req token, tokenSecret :: Credential -> BS.ByteString token = fromMaybe "" . lookup "oauth_token" . unCredential tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential addMaybeProxy :: Maybe Proxy -> Request -> Request addMaybeProxy p req = req { proxy = p } insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)] insertMap key val = ((key,val):) . filter ((/=key).fst) deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)] deleteMap k = filter ((/=k).fst) toStrict :: BSL.ByteString -> BS.ByteString toStrict = BS.concat . BSL.toChunks fromStrict :: BS.ByteString -> BSL.ByteString fromStrict = BSL.fromChunks . return loadBodyBS :: MonadIO m => Request -> m BS.ByteString loadBodyBS = toBS . requestBody toBS :: MonadIO m => RequestBody -> m BS.ByteString toBS (RequestBodyLBS l) = return $ toStrict l toBS (RequestBodyBS s) = return s toBS (RequestBodyBuilder _ b) = return $ toByteString b toBS (RequestBodyStream _ givesPopper) = toBS' givesPopper toBS (RequestBodyStreamChunked givesPopper) = toBS' givesPopper #if MIN_VERSION_http_client(0, 4, 28) toBS (RequestBodyIO op) = liftIO op >>= toBS #else #endif toBS' :: MonadIO m => GivesPopper () -> m BS.ByteString toBS' gp = liftIO $ do ref <- I.newIORef BS.empty gp (go ref) I.readIORef ref where go ref popper = loop id where loop front = do bs <- popper if BS.null bs then I.writeIORef ref $ BS.concat $ front [] else loop (front . (bs:)) isBodyFormEncoded :: [Header] -> Bool isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type" authenticate-oauth-1.7/Web/Authenticate/OAuth/IO.hs0000644000000000000000000001045114063567307020375 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} -- | This Module provides interface for the instance of 'MonadIO' instead of 'MonadIO'. -- What this module do is just adding 'withManager' or 'runResourceT'. module Web.Authenticate.OAuth.IO {-# DEPRECATED "This module is deprecated; rewrite your code using MonadResource" #-} ( module Web.Authenticate.OAuth, getAccessToken, getTemporaryCredential, getTemporaryCredentialWithScope, getTemporaryCredentialProxy, getTemporaryCredential', getTokenCredential, getAccessTokenProxy, getTokenCredentialProxy, getAccessToken' ) where import Network.HTTP.Client import qualified Web.Authenticate.OAuth as OA import Web.Authenticate.OAuth hiding (getAccessToken, getTemporaryCredential, getTemporaryCredentialWithScope, getTemporaryCredentialProxy, getTemporaryCredential', getTokenCredential, getTemporaryCredentialWithScope, getAccessTokenProxy, getTemporaryCredentialProxy, getTokenCredentialProxy, getAccessToken', getTemporaryCredential') import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as BS -- | Get temporary credential for requesting acces token. getTemporaryCredential :: MonadIO m => OA.OAuth -- ^ OAuth Application -> m OA.Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential = liftIO . withManager defaultManagerSettings . OA.getTemporaryCredential -- | Get temporary credential for requesting access token with Scope parameter. getTemporaryCredentialWithScope :: MonadIO m => BS.ByteString -- ^ Scope parameter string -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporay Credential (Request Token & Secret). getTemporaryCredentialWithScope bs oa = liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredentialWithScope bs oa -- | Get temporary credential for requesting access token via the proxy. getTemporaryCredentialProxy :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredentialProxy p oa = liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredential' (addMaybeProxy p) oa getTemporaryCredential' :: MonadIO m => (Request -> Request) -- ^ Request Hook -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential' hook oa = liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredential' hook oa -- | Get Access token. getAccessToken, getTokenCredential :: MonadIO m => OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessToken oa cr -- | Get Access token via the proxy. getAccessTokenProxy, getTokenCredentialProxy :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessTokenProxy p oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessTokenProxy p oa cr getAccessToken' :: MonadIO m => (Request -> Request) -- ^ Request Hook -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken' hook oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessToken' hook oa cr getTokenCredential = getAccessToken getTokenCredentialProxy = getAccessTokenProxy authenticate-oauth-1.7/LICENSE0000644000000000000000000000253014063567307014363 0ustar0000000000000000The following license covers this documentation, and the source code, except where otherwise indicated. Copyright 2008, Michael Snoyman. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. authenticate-oauth-1.7/Setup.lhs0000755000000000000000000000016214063567307015170 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain authenticate-oauth-1.7/authenticate-oauth.cabal0000644000000000000000000000306414063574116020135 0ustar0000000000000000cabal-version: >= 1.10 name: authenticate-oauth version: 1.7 license: BSD3 license-file: LICENSE author: Hiromi Ishii maintainer: Hiromi Ishii, Artem Chirkin synopsis: Library to authenticate with OAuth for Haskell web applications. description: API docs and the README are available at . category: Web stability: Stable build-type: Simple homepage: http://github.com/yesodweb/authenticate extra-source-files: README.md ChangeLog.md library default-language: Haskell2010 build-depends: base >= 4.10 && < 5 , http-client >= 0.3 , transformers >= 0.1 && < 0.6 , bytestring >= 0.9 , crypto-pubkey-types >= 0.1 && < 0.5 , RSA >= 2.0 && < 2.5 , time , data-default , base64-bytestring >= 0.1 && < 1.3 , SHA >= 1.4 && < 1.7 , random , http-types >= 0.6 , blaze-builder , transformers-compat >= 0.3 exposed-modules: Web.Authenticate.OAuth, Web.Authenticate.OAuth.IO ghc-options: -Wall source-repository head type: git location: git://github.com/yesodweb/authenticate.git authenticate-oauth-1.7/README.md0000644000000000000000000000007314063567307014635 0ustar0000000000000000## authenticate-oauth OAuth authentication, e.g. Twitter. authenticate-oauth-1.7/ChangeLog.md0000644000000000000000000000106314063567307015527 0ustar0000000000000000## 1.7 * Add support for following new SignMethod `HMACSHA256`, `HMACSHA512`, `RSASHA256`, `RSASHA512` ## 1.6 * Add checkOAuth * Add support for [oauth_body_hash extension](https://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/oauth-bodyhash.html) in `checkOAuth` and `signOAuth`; this might have slightly changed `checkOAuth` behavior. ## 1.5.1.2 * Allow newest transformers ## 1.5.1 * [Add getAccessTokenWith #42](https://github.com/yesodweb/authenticate/pull/42) ## 1.5.0.2 * [Allow RSA-2.1 #41](https://github.com/yesodweb/authenticate/pull/41)