diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs index d9b7be5..e47f5f8 100644 --- a/src/Yesod/Auth/OAuth2/Dispatch.hs +++ b/src/Yesod/Auth/OAuth2/Dispatch.hs @@ -22,10 +22,6 @@ import Yesod.Auth import Yesod.Core -- | How to take an @'OAuth2Token'@ and retrieve user credentials --- --- Usually this means a second authorized request to @api/me.json@. See --- @'fromProfileURL'@ for an example. --- type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m) -- | Dispatch the various OAuth2 handshake routes diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs index 1b5b003..bb681bf 100644 --- a/src/Yesod/Auth/OAuth2/Prelude.hs +++ b/src/Yesod/Auth/OAuth2/Prelude.hs @@ -9,12 +9,11 @@ -- module Yesod.Auth.OAuth2.Prelude ( YesodOAuth2Exception(..) - , invalidProfileResponse - -- * Helpers + -- * Provider helpers , authGetProfile - , setExtra , scopeParam + , setExtra -- * Text , Text @@ -33,7 +32,6 @@ module Yesod.Auth.OAuth2.Prelude -- * Exceptions , throwIO - , tryIO -- * OAuth2 , OAuth2(..) @@ -59,11 +57,6 @@ module Yesod.Auth.OAuth2.Prelude -- * Temporary, until I finish re-structuring modules , authOAuth2 , authOAuth2Widget - - -- * Deprecated, until everything's moved over to @'authGetProfile'@ - , authGetJSON - , fromProfileURL - , maybeExtra ) where import Control.Exception.Safe @@ -95,20 +88,10 @@ instance Exception YesodOAuth2Exception -- | Retrieve a user's profile as JSON -- -- The response should be parsed only far enough to read the required --- @'credsIdent'@. The raw response is returned as well, to be set in --- @'credsExtra'@for consumers to re-use if information they seek is in the --- response already. +-- @'credsIdent'@. Additional information should either be re-parsed by or +-- fetched via additional requests by consumers. -- --- Information requiring other requests should use the access token (also in --- @'credsExtra'@ to make subsequent requests themselves. --- -authGetProfile - :: FromJSON a - => Text -- ^ Plugin name - -> Manager - -> OAuth2Token - -> URI - -> IO (a, BL.ByteString) +authGetProfile :: FromJSON a => Text -> Manager -> OAuth2Token -> URI -> IO (a, BL.ByteString) authGetProfile name manager token url = do resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url decoded <- fromAuthJSON name resp @@ -117,7 +100,7 @@ authGetProfile name manager token url = do -- | Throws a @Left@ result as an @'InvalidProfileResponse'@ fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString fromAuthGet _ (Right bs) = pure bs -- nice -fromAuthGet name (Left err) = throwIO $ invalidProfileResponse name err +fromAuthGet name (Left err) = throwIO $ InvalidProfileResponse name $ encode err -- | Throws a decoding error as an @'InvalidProfileResponse'@ fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a @@ -125,38 +108,19 @@ fromAuthJSON name = -- FIXME: unique exception constructors either (throwIO . InvalidProfileResponse name . BL8.pack) pure . eitherDecode --- | Construct (part of) @'credsExtra'@ container the token and user response +-- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter +scopeParam :: Text -> [Text] -> (ByteString, ByteString) +scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d + +-- | Construct part of @'credsExtra'@ +-- +-- Sets the following keys: +-- +-- - @accessToken@: to support follow-up requests +-- - @userResponseJSON@: to support getting additional information +-- setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)] setExtra token userResponseJSON = [ ("accessToken", atoken $ accessToken token) , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) ] - --- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@ --- --- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which --- is then re-encoded for the exception message. --- --- Deprecated. --- -invalidProfileResponse :: Text -> OAuth2Error Value -> YesodOAuth2Exception -invalidProfileResponse name = InvalidProfileResponse name . encode - --- | Handle the common case of fetching Profile information from a JSON endpoint --- --- Throws @'InvalidProfileResponse'@ if JSON parsing fails --- --- Deprecated. --- -fromProfileURL :: FromJSON a => Text -> URI -> (a -> Creds m) -> FetchCreds m -fromProfileURL name url toCreds manager token = - toCreds . fst <$> authGetProfile name manager token url - --- | A tuple of @scope@ and the given scopes separated by a delimiter -scopeParam :: Text -> [Text] -> (ByteString, ByteString) -scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d - --- | A helper for providing an optional value to credsExtra -maybeExtra :: Text -> Maybe Text -> [(Text, Text)] -maybeExtra k (Just v) = [(k, v)] -maybeExtra _ Nothing = []