{-# 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.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Conduit
import Network.OAuth.OAuth2.Compat
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 :: forall a.
FromJSON a =>
Text -> Manager -> OAuth2Token -> URI -> IO (a, ByteString)
authGetProfile Text
name Manager
manager OAuth2Token
token URI
url = do
ByteString
resp <- Text -> Either ByteString ByteString -> IO ByteString
fromAuthGet Text
name forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
authGetBS Manager
manager (OAuth2Token -> AccessToken
accessToken OAuth2Token
token) URI
url
a
decoded <- forall a. FromJSON a => Text -> ByteString -> IO a
fromAuthJSON Text
name ByteString
resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
decoded, ByteString
resp)
fromAuthGet :: Text -> Either BL.ByteString BL.ByteString -> IO BL.ByteString
fromAuthGet :: Text -> Either ByteString ByteString -> IO ByteString
fromAuthGet Text
_ (Right ByteString
bs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
fromAuthGet Text
name (Left ByteString
err) =
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> YesodOAuth2Exception
YesodOAuth2Exception.OAuth2Error Text
name ByteString
err
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
fromAuthJSON :: forall a. FromJSON a => Text -> ByteString -> IO a
fromAuthJSON Text
name =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String -> YesodOAuth2Exception
YesodOAuth2Exception.JSONDecodingError Text
name) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecode
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
scopeParam Text
d = (ByteString
"scope", ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
d
setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
OAuth2Token
token ByteString
userResponse =
[ (Text
"accessToken", AccessToken -> Text
atoken forall a b. (a -> b) -> a -> b
$ OAuth2Token -> AccessToken
accessToken OAuth2Token
token)
, (Text
"userResponse", ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
userResponse)
]
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"refreshToken", ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefreshToken -> Text
rtoken) (OAuth2Token -> Maybe RefreshToken
refreshToken OAuth2Token
token)