hoauth2 0.2.5.1 → 0.2.6
raw patch · 7 files changed
+313/−311 lines, 7 filesdep ~bytestringdep ~http-conduit
Dependency ranges changed: bytestring, http-conduit
Files
- example/Google/test.hs +11/−2
- example/Weibo/test.hs +4/−10
- hoauth2.cabal +11/−11
- src/Network/OAuth/OAuth2.hs +159/−0
- src/Network/OAuth/OAuth2/HttpClient.hs +128/−0
- src/Network/OAuth2/HTTP/HttpClient.hs +0/−128
- src/Network/OAuth2/OAuth2.hs +0/−160
example/Google/test.hs view
@@ -17,8 +17,8 @@ import Network.HTTP.Types (renderSimpleQuery, parseSimpleQuery) import System.Environment -import Network.OAuth2.HTTP.HttpClient-import Network.OAuth2.OAuth2+import Network.OAuth.OAuth2.HttpClient+import Network.OAuth.OAuth2 import Google.Key @@ -59,6 +59,8 @@ print accessToken res <- validateToken accessToken print res+ res2 <- userinfo accessToken+ print res2 where extraParams = renderSimpleQuery False googleScopeEmail @@ -74,3 +76,10 @@ -- Token Validation validateToken accessToken = doSimplePostRequest ("https://www.googleapis.com/oauth2/v1/tokeninfo", (accessTokenToParam accessToken))++-- | fetch user email.+-- for more information, please check the playround site.+--+userinfo accessToken = doSimpleGetRequest (appendQueryParam+ "https://www.googleapis.com/oauth2/v2/userinfo"+ (accessTokenToParam accessToken))
example/Weibo/test.hs view
@@ -30,23 +30,17 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.Conduit (MonadResource) -import Network.OAuth2.HTTP.HttpClient-import Network.OAuth2.OAuth2+import Network.OAuth.OAuth2.HttpClient+import Network.OAuth.OAuth2 import Weibo.Key--weibooauth :: OAuth2-weibooauth = weiboKey { oauthOAuthorizeEndpoint = "https://api.weibo.com/oauth2/authorize"- , oauthAccessTokenEndpoint = "https://api.weibo.com/oauth2/access_token" - , oauthAccessToken = Nothing- } main :: IO () main = do - print $ authorizationUrl weibooauth+ print $ authorizationUrl weiboKeys putStrLn "visit the url and paste code here: " code <- getLine- token <- requestAccessToken weibooauth (sToBS code)+ token <- requestAccessToken weiboKeys (sToBS code) print token sToBS :: String -> BS.ByteString
hoauth2.cabal view
@@ -1,9 +1,9 @@ Name: hoauth2 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy)-Version: 0.2.5.1+Version: 0.2.6 Synopsis: hoauth2-Description: +Description: Haskell OAuth2 authentication. . Tested following services@@ -21,12 +21,12 @@ Category: Network Build-type: Simple stability: alpha-tested-with: GHC <= 7.4.1+tested-with: GHC <= 7.6.1 -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: +Extra-source-files: README.md example/Google/test.hs example/Weibo/test.hs@@ -40,28 +40,28 @@ Library hs-source-dirs: src- Exposed-modules: - Network.OAuth2.HTTP.HttpClient- Network.OAuth2.OAuth2+ Exposed-modules:+ Network.OAuth.OAuth2.HttpClient+ Network.OAuth.OAuth2 Build-Depends: aeson >= 0.6 && < 0.7, base >= 4 && < 5, text >= 0.11 && < 0.12,- bytestring >= 0.9 && < 0.10,+ bytestring >= 0.9 && < 0.11, bytestring-show >= 0.3.5 && < 0.4, conduit >= 0.5 && < 0.6,- http-conduit >= 1.8.3 && < 1.8.4,+ http-conduit >= 1.8.4 && < 1.8.5, http-types >= 0.7 && < 0.8, monad-control >= 0.3 && < 0.4, mtl >= 1 && < 2.2, transformers >= 0.2 && < 0.4, resourcet >= 0.4.0.2 && < 0.4.1, random- + if impl(ghc >= 6.12.0) ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields- -fno-warn-orphans + -fno-warn-orphans
+ src/Network/OAuth/OAuth2.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A simple OAuth2 Haskell binding.+-- (This is supposed to be independent with http client.)++module Network.OAuth.OAuth2 where++import Control.Applicative ((<$>), (<*>))+import Control.Exception+import Control.Monad (mzero)+import Data.Aeson+import qualified Data.ByteString as BS+import Data.Maybe (fromMaybe)+import Data.Typeable (Typeable)+import Network.HTTP.Types (renderSimpleQuery)++--------------------------------------------------+-- Data Types+--------------------------------------------------++-- | Query Parameter Representation+--+data OAuth2 = OAuth2 { oauthClientId :: BS.ByteString+ , oauthClientSecret :: BS.ByteString+ , oauthOAuthorizeEndpoint :: BS.ByteString+ , oauthAccessTokenEndpoint :: BS.ByteString+ , oauthCallback :: Maybe BS.ByteString+ , oauthAccessToken :: Maybe BS.ByteString+ -- ^ TODO: why not Maybe AccessToken???+ } deriving (Show, Eq)++-- | Simple Exception representation.+data OAuthException = OAuthException String+ deriving (Show, Eq, Typeable)++-- | OAuthException is kind of Exception.+--+instance Exception OAuthException++-- | The gained Access Token. Use @Data.Aeson.decode@ to decode string to @AccessToken@.+-- The @refresheToken@ is special at some case.+-- e.g. https://developers.google.com/accounts/docs/OAuth2+--+data AccessToken = AccessToken { accessToken :: BS.ByteString+ , refreshToken :: Maybe BS.ByteString }+ deriving (Show)++-- | Parse JSON data into {AccessToken}+--+instance FromJSON AccessToken where+ parseJSON (Object o) = AccessToken+ <$> o .: "access_token"+ <*> o .:? "refresh_token"+ parseJSON _ = mzero++--------------------------------------------------+-- Types Synonym+--------------------------------------------------++-- | type synonym of query parameters+type QueryParams = [(BS.ByteString, BS.ByteString)]++-- | type synonym of post body content+type PostBody = [(BS.ByteString, BS.ByteString)]++-- | type synonym of a URI+type URI = BS.ByteString++-- | Access Code that is required for fetching Access Token+type AccessCode = BS.ByteString+++--------------------------------------------------+-- URLs+--------------------------------------------------++-- | Prepare the authorization URL.+-- Redirect to this URL asking for user interactive authentication.+--+authorizationUrl :: OAuth2 -> URI+authorizationUrl oa = oauthOAuthorizeEndpoint oa `appendQueryParam` queryStr+ where queryStr = transform' [ ("client_id", Just $ oauthClientId oa)+ , ("response_type", Just "code")+ , ("redirect_uri", oauthCallback oa)]+++-- | Prepare URL and the request body query for fetching access token.+--+accessTokenUrl :: OAuth2+ -> AccessCode -- ^ access code gained via authorization URL+ -> (URI, PostBody) -- ^ access token request URL plus the request body.+accessTokenUrl oa code = accessTokenUrl' oa code (Just "authorization_code")+++accessTokenUrl' :: OAuth2+ -> AccessCode -- ^ access code gained via authorization URL+ -> Maybe BS.ByteString -- ^ Grant Type+ -> (URI, PostBody) -- ^ access token request URL plus the request body.+accessTokenUrl' oa code gt = (uri, body)+ where uri = oauthAccessTokenEndpoint oa+ body = transform' [ ("client_id", Just $ oauthClientId oa)+ , ("client_secret", Just $ oauthClientSecret oa)+ , ("code", Just code)+ , ("redirect_uri", oauthCallback oa)+ , ("grant_type", gt) ]++-- | Using a Refresh Token.+-- obtain a new access token by sending a refresh token to the Authorization server.+--+refreshAccessTokenUrl :: OAuth2+ -> BS.ByteString -- ^ refresh token gained via authorization URL+ -> (URI, PostBody) -- ^ refresh token request URL plus the request body.+refreshAccessTokenUrl oa rtoken = (uri, body)+ where uri = oauthAccessTokenEndpoint oa+ body = transform' [ ("client_id", Just $ oauthClientId oa)+ , ("client_secret", Just $ oauthClientSecret oa)+ , ("grant_type", Just "refresh_token")+ , ("refresh_token", Just rtoken) ]++--------------------------------------------------+-- UTILs+--------------------------------------------------++-- | Append query parameters with '?'+appendQueryParam :: URI -> QueryParams -> URI+appendQueryParam uri q = uri `BS.append` renderSimpleQuery True q++-- | Append query parameters with '&'.+appendQueryParam' :: URI -> QueryParams -> URI+appendQueryParam' uri q = uri `BS.append` "&" `BS.append` renderSimpleQuery False q++-- | For GET method API.+appendAccessToken :: URI -- ^ Base URI+ -> OAuth2 -- ^ OAuth has Authorized Access Token+ -> URI -- ^ Combined Result+appendAccessToken uri oauth = appendQueryParam uri+ (token $ oauthAccessToken oauth)+ where token :: Maybe BS.ByteString -> QueryParams+ token = accessTokenToParam . fromMaybe ""++-- | Create QueryParams with given access token value.+--+accessTokenToParam :: BS.ByteString -> QueryParams+accessTokenToParam token = [("access_token", token)]+++-- | lift value in the Maybe and abonda Nothing+transform' :: [(a, Maybe b)] -> [(a, b)]+transform' = foldr step' []+ where step' :: (a, Maybe b) -> [(a, b)] -> [(a, b)]+ step' (a, Just b) xs = (a, b):xs+ step' _ xs = xs+++ -- Expect Access Token exists+ -- FIXME: append empty when Nothing+ --uri `BS.append` renderSimpleQuery True (accessTokenToParam $ token oauth)+
+ src/Network/OAuth/OAuth2/HttpClient.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A simple http client for request OAuth2 tokens and several utils.++module Network.OAuth.OAuth2.HttpClient where++import Control.Exception+import Control.Monad (liftM)+import Control.Monad.Trans.Resource (ResourceT)+import Data.Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.HTTP.Conduit+import Network.HTTP.Types (renderSimpleQuery)+import qualified Network.HTTP.Types as HT++import Network.OAuth.OAuth2++--------------------------------------------------+-- Fetch AccessToken; RefreshAccessToken+--------------------------------------------------++-- | Request (via POST method) "Access Token".+--+-- FIXME: what if @requestAccessToken'@ return error?+--+requestAccessToken :: OAuth2 -- ^ OAuth Data+ -> BS.ByteString -- ^ Authentication code gained after authorization+ -> IO (Maybe AccessToken) -- ^ Access Token+requestAccessToken oa code = doJSONPostRequest (accessTokenUrl oa code)+++-- | Request the "Refresh Token".+--+refreshAccessToken :: OAuth2+ -> BS.ByteString -- ^ refresh token gained after authorization+ -> IO (Maybe AccessToken)+refreshAccessToken oa rtoken = doJSONPostRequest (refreshAccessTokenUrl oa rtoken)+++--------------------------------------------------+-- conduit http request+--------------------------------------------------++-- | Conduct post request.+--+doSimplePostRequest :: (URI, PostBody) -- ^ The URI and request body for fetching token.+ -> IO BSL.ByteString -- ^ Response as ByteString+doSimplePostRequest (uri, body) = doPostRequst (bsToS uri) body >>= handleResponse++-- | Conduct post request and return response as JSON.+--+doJSONPostRequest :: FromJSON a+ => (URI, PostBody) -- ^ The URI and request body for fetching token.+ -> IO (Maybe a) -- ^ Response as ByteString+doJSONPostRequest (uri, body) = doPostRequst (bsToS uri) body+ >>= liftM decode . handleResponse++-- | Conduct GET request.+--+doSimpleGetRequest :: URI -- ^ URL+ -> IO BSL.ByteString -- ^ Response as ByteString+doSimpleGetRequest url = doGetRequest (bsToS url) [] >>= handleResponse++-- | Conduct GET request and return response as JSON.+--+doJSONGetRequest :: FromJSON a+ => URI -- ^ Full URL+ -> IO (Maybe a) -- ^ Response as ByteString+doJSONGetRequest url = doGetRequest (bsToS url) []+ >>= liftM decode . handleResponse+++-- | Conduct GET request with given URL by append extra parameters provided.+--+doGetRequest :: String -- ^ URL+ -> [(BS.ByteString, BS.ByteString)] -- ^ Extra Parameters+ -> IO (Response BSL.ByteString) -- ^ Response+doGetRequest url pm = doGetRequestWithReq url pm id++-- | TODO: can not be `Request m -> Request m`, why??+--+doGetRequestWithReq :: String -- ^ URL+ -> [(BS.ByteString, BS.ByteString)] -- ^ Extra Parameters+ -> (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ update Request+ -> IO (Response BSL.ByteString) -- ^ Response+doGetRequestWithReq url pm f = do+ req <- parseUrl $ url ++ bsToS (renderSimpleQuery True pm)+ let req' = (updateRequestHeaders .f) req+ withManager $ httpLbs req'+++-- | Conduct POST request with given URL with post body data.+--+doPostRequst :: String -- ^ URL+ -> [(BS.ByteString, BS.ByteString)] -- ^ Data to Post Body+ -> IO (Response BSL.ByteString) -- ^ Response+doPostRequst url body = doPostRequstWithReq url body id++doPostRequstWithReq :: String -- ^ URL+ -> [(BS.ByteString, BS.ByteString)] -- ^ Data to Post Body+ -> (Request (ResourceT IO) -> Request (ResourceT IO))+ -> IO (Response BSL.ByteString) -- ^ Response+doPostRequstWithReq url body f = do+ req <- parseUrl url+ let req' = (updateRequestHeaders . f) req+ withManager $ httpLbs (urlEncodedBody body req')+++--------------------------------------------------+-- Utils+--------------------------------------------------++handleResponse :: Response BSL.ByteString -> IO BSL.ByteString+handleResponse rsp = if (HT.statusCode . responseStatus) rsp == 200+ then return (responseBody rsp)+ else throwIO . OAuthException $+ "Gaining token failed: " ++ BSL.unpack (responseBody rsp)++updateRequestHeaders :: Request m -> Request m+updateRequestHeaders req = req { requestHeaders = [ (HT.hAccept, "application/json") ] }++bsToS :: BS.ByteString -> String+bsToS = T.unpack . T.decodeUtf8
− src/Network/OAuth2/HTTP/HttpClient.hs
@@ -1,128 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}---- | A simple http client for request OAuth2 tokens and several utils.--module Network.OAuth2.HTTP.HttpClient where--import Control.Exception-import Control.Monad (liftM)-import Control.Monad.Trans.Resource (ResourceT)-import Data.Aeson-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Network.HTTP.Conduit-import Network.HTTP.Types (renderSimpleQuery)-import qualified Network.HTTP.Types as HT--import Network.OAuth2.OAuth2------------------------------------------------------- Fetch AccessToken; RefreshAccessToken------------------------------------------------------- | Request (via POST method) "Access Token".------ FIXME: what if @requestAccessToken'@ return error?----requestAccessToken :: OAuth2 -- ^ OAuth Data- -> BS.ByteString -- ^ Authentication code gained after authorization- -> IO (Maybe AccessToken) -- ^ Access Token-requestAccessToken oa code = doJSONPostRequest (accessTokenUrl oa code)----- | Request the "Refresh Token".----refreshAccessToken :: OAuth2- -> BS.ByteString -- ^ refresh token gained after authorization- -> IO (Maybe AccessToken)-refreshAccessToken oa rtoken = doJSONPostRequest (refreshAccessTokenUrl oa rtoken)-------------------------------------------------------- conduit http request------------------------------------------------------- | Conduct post request.----doSimplePostRequest :: (URI, PostBody) -- ^ The URI and request body for fetching token.- -> IO BSL.ByteString -- ^ Response as ByteString-doSimplePostRequest (uri, body) = doPostRequst (bsToS uri) body >>= handleResponse---- | Conduct post request and return response as JSON.----doJSONPostRequest :: FromJSON a- => (URI, PostBody) -- ^ The URI and request body for fetching token.- -> IO (Maybe a) -- ^ Response as ByteString-doJSONPostRequest (uri, body) = doPostRequst (bsToS uri) body- >>= liftM decode . handleResponse---- | Conduct GET request.----doSimpleGetRequest :: URI -- ^ URL- -> IO BSL.ByteString -- ^ Response as ByteString-doSimpleGetRequest url = doGetRequest (bsToS url) [] >>= handleResponse---- | Conduct GET request and return response as JSON.----doJSONGetRequest :: FromJSON a- => URI -- ^ Full URL- -> IO (Maybe a) -- ^ Response as ByteString-doJSONGetRequest url = doGetRequest (bsToS url) []- >>= liftM decode . handleResponse----- | Conduct GET request with given URL by append extra parameters provided.----doGetRequest :: String -- ^ URL- -> [(BS.ByteString, BS.ByteString)] -- ^ Extra Parameters- -> IO (Response BSL.ByteString) -- ^ Response-doGetRequest url pm = doGetRequestWithReq url pm id---- | TODO: can not be `Request m -> Request m`, why??----doGetRequestWithReq :: String -- ^ URL- -> [(BS.ByteString, BS.ByteString)] -- ^ Extra Parameters- -> (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ update Request- -> IO (Response BSL.ByteString) -- ^ Response-doGetRequestWithReq url pm f = do- req <- parseUrl $ url ++ bsToS (renderSimpleQuery True pm)- let req' = (updateRequestHeaders .f) req- withManager $ httpLbs req'----- | Conduct POST request with given URL with post body data.----doPostRequst :: String -- ^ URL- -> [(BS.ByteString, BS.ByteString)] -- ^ Data to Post Body- -> IO (Response BSL.ByteString) -- ^ Response-doPostRequst url body = doPostRequstWithReq url body id--doPostRequstWithReq :: String -- ^ URL- -> [(BS.ByteString, BS.ByteString)] -- ^ Data to Post Body- -> (Request (ResourceT IO) -> Request (ResourceT IO))- -> IO (Response BSL.ByteString) -- ^ Response-doPostRequstWithReq url body f = do- req <- parseUrl url- let req' = (updateRequestHeaders . f) req- withManager $ httpLbs (urlEncodedBody body req')-------------------------------------------------------- Utils-----------------------------------------------------handleResponse :: Response BSL.ByteString -> IO BSL.ByteString-handleResponse rsp = if (HT.statusCode . responseStatus) rsp == 200- then return (responseBody rsp)- else throwIO . OAuthException $- "Gaining token failed: " ++ BSL.unpack (responseBody rsp)--updateRequestHeaders :: Request m -> Request m-updateRequestHeaders req = req { requestHeaders = [ (HT.hAccept, "application/json") ] }--bsToS :: BS.ByteString -> String-bsToS = T.unpack . T.decodeUtf8
− src/Network/OAuth2/OAuth2.hs
@@ -1,160 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}---- | A simple OAuth2 Haskell binding.--- (This is supposed to be independent with http client.)--module Network.OAuth2.OAuth2 where--import Control.Applicative ((<$>), (<*>))-import Control.Exception-import Control.Monad (mzero)-import Data.Aeson-import qualified Data.ByteString as BS-import Data.Maybe (fromMaybe)-import Data.Typeable (Typeable)-import Network.HTTP.Types (renderSimpleQuery)------------------------------------------------------- Data Types------------------------------------------------------- | Query Parameter Representation----data OAuth2 = OAuth2 { oauthClientId :: BS.ByteString- , oauthClientSecret :: BS.ByteString- , oauthOAuthorizeEndpoint :: BS.ByteString- , oauthAccessTokenEndpoint :: BS.ByteString- , oauthCallback :: Maybe BS.ByteString- , oauthAccessToken :: Maybe BS.ByteString- -- ^ TODO: why not Maybe AccessToken???- } deriving (Show, Eq)---- | Simple Exception representation.-data OAuthException = OAuthException String- deriving (Show, Eq, Typeable)---- | OAuthException is kind of Exception.----instance Exception OAuthException---- | The gained Access Token. Use @Data.Aeson.decode@ to decode string to @AccessToken@.--- The @refresheToken@ is special at some case.--- e.g. https://developers.google.com/accounts/docs/OAuth2----data AccessToken = AccessToken { accessToken :: BS.ByteString- , refreshToken :: Maybe BS.ByteString }- deriving (Show)---- | Parse JSON data into {AccessToken}----instance FromJSON AccessToken where- parseJSON (Object o) = AccessToken- <$> o .: "access_token"- <*> o .:? "refresh_token"- parseJSON _ = mzero------------------------------------------------------- Types Synonym------------------------------------------------------- | type synonym of query parameters-type QueryParams = [(BS.ByteString, BS.ByteString)]---- | type synonym of post body content-type PostBody = [(BS.ByteString, BS.ByteString)]---- | type synonym of a URI-type URI = BS.ByteString---- | Access Code that is required for fetching Access Token-type AccessCode = BS.ByteString-------------------------------------------------------- URLs------------------------------------------------------- | Prepare the authorization URL.--- Redirect to this URL asking for user interactive authentication.----authorizationUrl :: OAuth2 -> URI-authorizationUrl oa = oauthOAuthorizeEndpoint oa `appendQueryParam` queryStr- where queryStr = transform' [ ("client_id", Just $ oauthClientId oa)- , ("response_type", Just "code")- , ("redirect_uri", oauthCallback oa)]----- | Prepare URL and the request body query for fetching access token.----accessTokenUrl :: OAuth2- -> AccessCode -- ^ access code gained via authorization URL- -> (URI, PostBody) -- ^ access token request URL plus the request body.-accessTokenUrl oa code = accessTokenUrl' oa code (Just "authorization_code")---accessTokenUrl' :: OAuth2- -> AccessCode -- ^ access code gained via authorization URL- -> Maybe BS.ByteString -- ^ Grant Type- -> (URI, PostBody) -- ^ access token request URL plus the request body.-accessTokenUrl' oa code gt = (uri, body)- where uri = oauthAccessTokenEndpoint oa- body = transform' [ ("client_id", Just $ oauthClientId oa)- , ("client_secret", Just $ oauthClientSecret oa)- , ("code", Just code)- , ("redirect_uri", oauthCallback oa)- , ("grant_type", gt) ]---- | Using a Refresh Token.--- obtain a new access token by sending a refresh token to the Authorization server.----refreshAccessTokenUrl :: OAuth2- -> BS.ByteString -- ^ refresh token gained via authorization URL- -> (URI, PostBody) -- ^ refresh token request URL plus the request body.-refreshAccessTokenUrl oa rtoken = (uri, body)- where uri = oauthAccessTokenEndpoint oa- body = transform' [ ("client_id", Just $ oauthClientId oa)- , ("client_secret", Just $ oauthClientSecret oa)- , ("grant_type", Just "refresh_token")- , ("refresh_token", Just rtoken) ]------------------------------------------------------- UTILs------------------------------------------------------- | Append query parameters with '?'-appendQueryParam :: URI -> QueryParams -> URI-appendQueryParam uri q = uri `BS.append` renderSimpleQuery True q---- | Append query parameters with '&'.-appendQueryParam' :: URI -> QueryParams -> URI-appendQueryParam' uri q = uri `BS.append` "&" `BS.append` renderSimpleQuery False q----- | For GET method API.-appendAccessToken :: URI -- ^ Base URI- -> OAuth2 -- ^ OAuth has Authorized Access Token- -> URI -- ^ Combined Result-appendAccessToken uri oauth = appendQueryParam uri- (token $ oauthAccessToken oauth)- where token :: Maybe BS.ByteString -> QueryParams- token = accessTokenToParam . fromMaybe ""---- | Create QueryParams with given access token value.----accessTokenToParam :: BS.ByteString -> QueryParams-accessTokenToParam token = [("access_token", token)]----- | lift value in the Maybe and abonda Nothing-transform' :: [(a, Maybe b)] -> [(a, b)]-transform' = foldr step' []- where step' :: (a, Maybe b) -> [(a, b)] -> [(a, b)]- step' (a, Just b) xs = (a, b):xs- step' _ xs = xs--- -- Expect Access Token exists- -- FIXME: append empty when Nothing- --uri `BS.append` renderSimpleQuery True (accessTokenToParam $ token oauth)-