{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Yesod.Auth.OAuth2
( OAuth2(..)
, FetchCreds
, Manager
, OAuth2Token(..)
, Creds(..)
, oauth2Url
, authOAuth2
, authOAuth2Widget
, getAccessToken
, getRefreshToken
, getUserResponse
, getUserResponseJSON
) where
import Control.Error.Util (note)
import Control.Monad ((<=<))
import Data.Aeson (FromJSON, eitherDecode)
import Data.ByteString.Lazy (ByteString, fromStrict)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Conduit (Manager)
import Network.OAuth.OAuth2
import Yesod.Auth
import Yesod.Auth.OAuth2.Dispatch
import Yesod.Core.Widget
oauth2Url :: Text -> AuthRoute
oauth2Url name = PluginR name ["forward"]
authOAuth2 :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m
authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
authOAuth2Widget
:: YesodAuth m
=> WidgetFor m ()
-> Text
-> OAuth2
-> FetchCreds m
-> AuthPlugin m
authOAuth2Widget widget name oauth getCreds =
AuthPlugin name (dispatchAuthRequest name oauth getCreds) login
where
login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|]
getAccessToken :: Creds m -> Maybe AccessToken
getAccessToken =
(AccessToken <$>) . lookup "accessToken" . credsExtra
getRefreshToken :: Creds m -> Maybe RefreshToken
getRefreshToken =
(RefreshToken <$>) . lookup "refreshToken" . credsExtra
getUserResponse :: Creds m -> Maybe ByteString
getUserResponse =
(fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra
getUserResponseJSON :: FromJSON a => Creds m -> Either String a
getUserResponseJSON =
eitherDecode <=< note "userResponse key not present" . getUserResponse