Make extras accessors safer

Even though it's "guaranteed" that values will be present because we set
them, nothing stops end-users from using these functions on Creds values
created by other plugins! Since that seems common, it would be
irresponsible of us to remain so unsafe.
This commit is contained in:
patrick brisbin 2018-02-07 06:54:02 -08:00
parent a2a49a2c57
commit 93258d4468
3 changed files with 15 additions and 20 deletions

View File

@ -44,16 +44,17 @@ authenticate creds = do
eGitHubUser :: Either String GitHubUser
eGitHubUser = getUserResponseJSON creds
-- Avert your eyes
-- Avert your eyes, simplified example
Just accessToken = getAccessToken creds
Right githubUser = eGitHubUser
-- Or make followup requests using our access token
runGitHub (getAccessToken creds) $ userRepositories githubUser
runGitHub accessToken $ userRepositories githubUser
-- Or store it for later
insert User
{ userIdent = credsIdent creds
, userAccessToken = getAccessToken creds
, userAccessToken = accessToken
}
```

View File

@ -20,13 +20,13 @@ library:
dependencies:
- aeson >=0.6 && <1.3
- bytestring >=0.9.1.4
- errors
- hoauth2 >=1.3.0 && <1.6
- http-client >=0.4.0 && <0.6
- http-conduit >=2.0 && <3.0
- http-types >=0.8 && <0.10
- microlens
- random
- safe
- safe-exceptions
- text >=0.7 && <2.0
- transformers >=0.2.2 && <0.6

View File

@ -23,13 +23,14 @@ module Yesod.Auth.OAuth2
, 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 Safe (fromJustNote)
import Yesod.Auth
import Yesod.Auth.OAuth2.Dispatch
import Yesod.Core.Widget
@ -62,22 +63,14 @@ authOAuth2Widget widget name oauth getCreds =
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
getAccessToken :: Creds m -> Maybe AccessToken
getAccessToken =
(AccessToken <$>) . lookup "accessToken" . credsExtra
-- | Read from the values set via @'setExtra'@
--
-- This is unsafe.
--
getUserResponse :: Creds m -> ByteString
getUserResponse = fromStrict . encodeUtf8
. fromJustNote "yesod-auth-oauth2 bug: credsExtra without userResponse"
. lookup "userResponse" . credsExtra
getUserResponse :: Creds m -> Maybe ByteString
getUserResponse =
(fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra
-- | Read from the values set via @'setExtra'@, decode as JSON
--
@ -85,4 +78,5 @@ getUserResponse = fromStrict . encodeUtf8
-- errors.
--
getUserResponseJSON :: FromJSON a => Creds m -> Either String a
getUserResponseJSON = eitherDecode . getUserResponse
getUserResponseJSON =
eitherDecode <=< note "userResponse key not present" . getUserResponse