Add functions for reading credsExtra

This commit is contained in:
patrick brisbin 2018-01-27 12:16:33 -05:00
parent 32740037e3
commit 794fbbf7e8
2 changed files with 36 additions and 0 deletions

View File

@ -26,6 +26,7 @@ library:
- http-types >=0.8 && <0.10 - http-types >=0.8 && <0.10
- microlens - microlens
- random - random
- safe
- safe-exceptions - safe-exceptions
- text >=0.7 && <2.0 - text >=0.7 && <2.0
- transformers >=0.2.2 && <0.6 - transformers >=0.2.2 && <0.6

View File

@ -16,11 +16,20 @@ module Yesod.Auth.OAuth2
, oauth2Url , oauth2Url
, authOAuth2 , authOAuth2
, authOAuth2Widget , authOAuth2Widget
-- * Reading our @'credsExtra'@ keys
, getAccessToken
, getUserResponseJSON
, getUserResponse
) where ) where
import Data.Aeson (FromJSON, eitherDecode)
import Data.ByteString.Lazy (ByteString, fromStrict)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Conduit (Manager) import Network.HTTP.Conduit (Manager)
import Network.OAuth.OAuth2 import Network.OAuth.OAuth2
import Safe (fromJustNote)
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.OAuth2.Dispatch import Yesod.Auth.OAuth2.Dispatch
import Yesod.Core.Widget import Yesod.Core.Widget
@ -51,3 +60,29 @@ authOAuth2Widget widget name oauth getCreds =
AuthPlugin name (dispatchAuthRequest name oauth getCreds) login AuthPlugin name (dispatchAuthRequest name oauth getCreds) login
where where
login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|] login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|]
-- | Read from the values set via @'setExtra'@
--
-- This is unsafe.
--
getAccessToken :: Creds m -> AccessToken
getAccessToken = AccessToken
. fromJustNote "yesod-auth-oauth2 bug: credsExtra without accessToken"
. lookup "accessToken" . credsExtra
-- | Read from the values set via @'setExtra'@
--
-- This is unsafe.
--
getUserResponseJSON :: Creds m -> ByteString
getUserResponseJSON = fromStrict . encodeUtf8
. fromJustNote "yesod-auth-oauth2 bug: credsExtra without userResponseJSON"
. lookup "userResponseJSON" . credsExtra
-- | Read from the values set via @'setExtra'@
--
-- This is unsafe if the key is missing, but safe with respect to parsing
-- errors.
--
getUserResponse :: FromJSON a => Creds m -> Either String a
getUserResponse = eitherDecode . getUserResponseJSON