haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-01-11 19:58:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Improve error message for invalid Approots

Browse Source 
Closes #87
This commit is contained in:
patrick brisbin 2018-02-13 09:10:04 -05:00
parent 34d4d76220
commit a91f85ff38
No known key found for this signature in database
GPG Key ID: 4243EA839B9CC425
1 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Yesod/Auth/OAuth2/Dispatch.hs
View File

@ -8,7 +8,7 @@ module Yesod.Auth.OAuth2.Dispatch
, dispatchAuthRequest
) where
import Control.Exception.Safe (tryIO)
import Control.Exception.Safe (throwString, tryIO)
import Control.Monad (unless)
import Data.Monoid ((<>))
import Data.Text (Text)
@ -79,9 +79,17 @@ withCallbackAndState :: Text -> OAuth2 -> Text -> AuthHandler m OAuth2
withCallbackAndState name oauth2 csrf = do
let url = PluginR name ["callback"]
render <- getParentUrlRender
return oauth2
-- FIXME: an invalid AppRoot can blow this up
{ oauthCallback = Just $ unsafeFromText $ render url
let callbackText = render url
callback <- maybe
(throwString
$ "Invalid callback URI: "
<> T.unpack callbackText
<> ". Not using an absolute Approot?"
) pure $ fromText callbackText
pure oauth2
{ oauthCallback = Just callback
, oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth2
`withQuery` [("state", encodeUtf8 csrf)]
}