{-# 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
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 :: 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 (Either ByteString ByteString -> IO ByteString)
-> IO (Either ByteString ByteString) -> IO ByteString
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 <- Text -> ByteString -> IO a
forall a. FromJSON a => Text -> ByteString -> IO a
fromAuthJSON Text
name ByteString
resp
(a, ByteString) -> IO (a, ByteString)
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) = ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
fromAuthGet Text
name (Left ByteString
err) =
YesodOAuth2Exception -> IO ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (YesodOAuth2Exception -> IO ByteString)
-> YesodOAuth2Exception -> IO ByteString
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 :: Text -> ByteString -> IO a
fromAuthJSON Text
name =
(String -> IO a) -> (a -> IO a) -> Either String a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (YesodOAuth2Exception -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (YesodOAuth2Exception -> IO a)
-> (String -> YesodOAuth2Exception) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String -> YesodOAuth2Exception
YesodOAuth2Exception.JSONDecodingError Text
name) a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either String a -> IO a)
-> (ByteString -> Either String a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
scopeParam Text
d = (ByteString
"scope", ) (ByteString -> (ByteString, ByteString))
-> ([Text] -> ByteString) -> [Text] -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
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 (AccessToken -> Text) -> AccessToken -> Text
forall a b. (a -> b) -> a -> b
$ OAuth2Token -> AccessToken
accessToken OAuth2Token
token)
, (Text
"userResponse", ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
userResponse)
]
[(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
-> (RefreshToken -> [(Text, Text)])
-> Maybe RefreshToken
-> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Text, Text) -> [(Text, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text) -> [(Text, Text)])
-> (RefreshToken -> (Text, Text)) -> RefreshToken -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"refreshToken", ) (Text -> (Text, Text))
-> (RefreshToken -> Text) -> RefreshToken -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefreshToken -> Text
rtoken) (OAuth2Token -> Maybe RefreshToken
refreshToken OAuth2Token
token)