{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Yesod.Auth.OAuth2.Prelude
(
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 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
import qualified Yesod.Auth.OAuth2.Exception as 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 $ YesodOAuth2Exception.OAuth2Error name $ encode err
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
fromAuthJSON name =
either (throwIO . YesodOAuth2Exception.JSONDecodingError name) 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)
]
<> maybe [] (pure . ("refreshToken", ) . rtoken) (refreshToken token)