mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-09-10 03:24:57 +02:00
Remove unused functions, reduce Prelude interface
This commit is contained in:
parent
c586c72df7
commit
32740037e3
@ -22,10 +22,6 @@ import Yesod.Auth
|
|||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
|
|
||||||
-- | How to take an @'OAuth2Token'@ and retrieve user credentials
|
-- | 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)
|
type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m)
|
||||||
|
|
||||||
-- | Dispatch the various OAuth2 handshake routes
|
-- | Dispatch the various OAuth2 handshake routes
|
||||||
|
|||||||
@ -9,12 +9,11 @@
|
|||||||
--
|
--
|
||||||
module Yesod.Auth.OAuth2.Prelude
|
module Yesod.Auth.OAuth2.Prelude
|
||||||
( YesodOAuth2Exception(..)
|
( YesodOAuth2Exception(..)
|
||||||
, invalidProfileResponse
|
|
||||||
|
|
||||||
-- * Helpers
|
-- * Provider helpers
|
||||||
, authGetProfile
|
, authGetProfile
|
||||||
, setExtra
|
|
||||||
, scopeParam
|
, scopeParam
|
||||||
|
, setExtra
|
||||||
|
|
||||||
-- * Text
|
-- * Text
|
||||||
, Text
|
, Text
|
||||||
@ -33,7 +32,6 @@ module Yesod.Auth.OAuth2.Prelude
|
|||||||
|
|
||||||
-- * Exceptions
|
-- * Exceptions
|
||||||
, throwIO
|
, throwIO
|
||||||
, tryIO
|
|
||||||
|
|
||||||
-- * OAuth2
|
-- * OAuth2
|
||||||
, OAuth2(..)
|
, OAuth2(..)
|
||||||
@ -59,11 +57,6 @@ module Yesod.Auth.OAuth2.Prelude
|
|||||||
-- * Temporary, until I finish re-structuring modules
|
-- * Temporary, until I finish re-structuring modules
|
||||||
, authOAuth2
|
, authOAuth2
|
||||||
, authOAuth2Widget
|
, authOAuth2Widget
|
||||||
|
|
||||||
-- * Deprecated, until everything's moved over to @'authGetProfile'@
|
|
||||||
, authGetJSON
|
|
||||||
, fromProfileURL
|
|
||||||
, maybeExtra
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
@ -95,20 +88,10 @@ instance Exception YesodOAuth2Exception
|
|||||||
-- | Retrieve a user's profile as JSON
|
-- | Retrieve a user's profile as JSON
|
||||||
--
|
--
|
||||||
-- The response should be parsed only far enough to read the required
|
-- The response should be parsed only far enough to read the required
|
||||||
-- @'credsIdent'@. The raw response is returned as well, to be set in
|
-- @'credsIdent'@. Additional information should either be re-parsed by or
|
||||||
-- @'credsExtra'@for consumers to re-use if information they seek is in the
|
-- fetched via additional requests by consumers.
|
||||||
-- response already.
|
|
||||||
--
|
--
|
||||||
-- Information requiring other requests should use the access token (also in
|
authGetProfile :: FromJSON a => Text -> Manager -> OAuth2Token -> URI -> IO (a, BL.ByteString)
|
||||||
-- @'credsExtra'@ to make subsequent requests themselves.
|
|
||||||
--
|
|
||||||
authGetProfile
|
|
||||||
:: FromJSON a
|
|
||||||
=> Text -- ^ Plugin name
|
|
||||||
-> Manager
|
|
||||||
-> OAuth2Token
|
|
||||||
-> URI
|
|
||||||
-> IO (a, BL.ByteString)
|
|
||||||
authGetProfile name manager token url = do
|
authGetProfile name manager token url = do
|
||||||
resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url
|
resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url
|
||||||
decoded <- fromAuthJSON name resp
|
decoded <- fromAuthJSON name resp
|
||||||
@ -117,7 +100,7 @@ authGetProfile name manager token url = do
|
|||||||
-- | Throws a @Left@ result as an @'InvalidProfileResponse'@
|
-- | Throws a @Left@ result as an @'InvalidProfileResponse'@
|
||||||
fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString
|
fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString
|
||||||
fromAuthGet _ (Right bs) = pure bs -- nice
|
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'@
|
-- | Throws a decoding error as an @'InvalidProfileResponse'@
|
||||||
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
|
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
|
||||||
@ -125,38 +108,19 @@ fromAuthJSON name =
|
|||||||
-- FIXME: unique exception constructors
|
-- FIXME: unique exception constructors
|
||||||
either (throwIO . InvalidProfileResponse name . BL8.pack) pure . eitherDecode
|
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 :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
|
||||||
setExtra token userResponseJSON =
|
setExtra token userResponseJSON =
|
||||||
[ ("accessToken", atoken $ accessToken token)
|
[ ("accessToken", atoken $ accessToken token)
|
||||||
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
|
, ("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 = []
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user