module Yesod.Auth.OAuth2.Prelude
( YesodOAuth2Exception(..)
, authGetProfile
, scopeParam
, setExtra
, Text
, decodeUtf8
, encodeUtf8
, (.:)
, (.:?)
, (.=)
, (<>)
, FromJSON(..)
, ToJSON(..)
, eitherDecode
, withObject
, throwIO
, OAuth2(..)
, OAuth2Token(..)
, AccessToken(..)
, RefreshToken(..)
, Manager
, YesodAuth(..)
, AuthPlugin(..)
, Creds(..)
, URI
, Host(..)
, module URI.ByteString.Extension
, authOAuth2
, authOAuth2Widget
) where
import Control.Exception.Safe
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Conduit
import Network.OAuth.OAuth2
import URI.ByteString
import URI.ByteString.Extension
import Yesod.Auth
import Yesod.Auth.OAuth2
data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
deriving (Show, Typeable)
instance Exception YesodOAuth2Exception
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
pure (decoded, resp)
fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString
fromAuthGet _ (Right bs) = pure bs
fromAuthGet name (Left err) = throwIO $ InvalidProfileResponse name $ encode err
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
fromAuthJSON name =
either (throwIO . InvalidProfileResponse name . BL8.pack) pure . eitherDecode
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
setExtra token userResponse =
[ ("accessToken", atoken $ accessToken token)
, ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
]