diff --git a/stack.yaml b/stack.yaml index 9744f955..96ea6a46 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-2.17 +resolver: lts-3.7 packages: - ./yesod-core - ./yesod-static @@ -13,6 +13,3 @@ packages: - ./yesod - ./yesod-eventsource - ./yesod-websockets -extra-deps: - - wai-app-static-3.1.0 - - nonce-1.0.2 diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index 4f79ad1c..bc075887 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.8 + +* GoogleEmail2: proper error message when permission denied + ## 1.4.7 * add a runHttpRequest function for handling HTTP errors diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index 822baf01..d7097f95 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -50,14 +50,17 @@ module Yesod.Auth.GoogleEmail2 import Yesod.Auth (Auth, AuthPlugin (AuthPlugin), AuthRoute, Creds (Creds), Route (PluginR), YesodAuth, - runHttpRequest, setCredsRedirect) + runHttpRequest, setCredsRedirect, + logoutDest) import qualified Yesod.Auth.Message as Msg import Yesod.Core (HandlerSite, HandlerT, MonadHandler, TypedContent, getRouteToParent, getUrlRender, invalidArgs, lift, liftIO, lookupGetParam, lookupSession, notFound, redirect, - setSession, whamlet, (.:)) + setSession, whamlet, (.:), + setMessage, getYesod, authRoute, + toHtml) import Blaze.ByteString.Builder (fromByteString, toByteString) @@ -187,7 +190,18 @@ authPlugin storeToken clientID clientSecret = mcode <- lookupGetParam "code" code <- case mcode of - Nothing -> invalidArgs ["Missing code paramter"] + Nothing -> do + merr <- lookupGetParam "error" + case merr of + Nothing -> invalidArgs ["Missing code paramter"] + Just err -> do + master <- lift getYesod + let msg = + case err of + "access_denied" -> "Access denied" + _ -> "Unknown error occurred: " `T.append` err + setMessage $ toHtml msg + lift $ redirect $ logoutDest master Just c -> return c render <- getUrlRender diff --git a/yesod-auth/openid.hs b/yesod-auth/openid.hs index c614ccf8..f5d475ec 100644 --- a/yesod-auth/openid.hs +++ b/yesod-auth/openid.hs @@ -27,7 +27,7 @@ getRootR = getAfterLoginR getAfterLoginR :: Handler RepHtml getAfterLoginR = do mauth <- maybeAuthId - defaultLayout $ addHamlet [hamlet| + defaultLayout [whamlet|

Auth: #{show mauth} $maybe _ <- mauth

@@ -38,21 +38,22 @@ $nothing |] instance Yesod BID where - approot = ApprootStatic "http://localhost:3000" + approot = guessApproot instance YesodAuth BID where type AuthId BID = Text loginDest _ = AfterLoginR logoutDest _ = AuthR LoginR getAuthId = return . Just . credsIdentClaimed - authPlugins _ = [authOpenId] + authPlugins _ = [authOpenId Claimed []] authHttpManager = httpManager + maybeAuthId = lookupSession credsKey instance RenderMessage BID FormMessage where renderMessage _ _ = defaultFormMessage main :: IO () main = do - m <- newManager def + m <- newManager tlsManagerSettings toWaiApp (BID m) >>= run 3000 diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index ffcf6e7e..b04a9d5b 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.4.7 +version: 1.4.8 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 3a144933..0791ddf1 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,4 +1,8 @@ -## 1.4.16.1 +## 1.4.16 + +* Add `guessApproot` + +## 1.4.15.1 * bugfix neverExpires leaked threads diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 2a157ca5..b3a3cf7d 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -71,6 +71,8 @@ module Yesod.Core , MonadWidget (..) , getRouteToParent , defaultLayoutSub + -- * Approot + , guessApproot -- * Misc , yesodVersion , yesodRender diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 0f6408bd..47f4fb49 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -56,6 +56,7 @@ import Yesod.Core.Internal.Session import Yesod.Core.Widget import Control.Monad.Trans.Class (lift) import Data.CaseInsensitive (CI) +import qualified Network.Wai.Request -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required. @@ -826,3 +827,19 @@ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++ where line = show . fst . loc_start char = show . snd . loc_start + +-- | Guess the approot based on request headers. For more information, see +-- "Network.Wai.Middleware.Approot" +-- +-- In the case of headers being unavailable, it falls back to 'ApprootRelative' +-- +-- Since 1.4.16 +guessApproot :: Approot site +guessApproot = ApprootRequest $ \_master req -> + case W.requestHeaderHost req of + Nothing -> "" + Just host -> + (if Network.Wai.Request.appearsSecure req + then "https://" + else "http://") + `T.append` TE.decodeUtf8With TEE.lenientDecode host diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 5f172be2..924e7c17 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.15.1 +version: 1.4.16 license: MIT license-file: LICENSE author: Michael Snoyman @@ -25,7 +25,7 @@ library build-depends: base >= 4.3 && < 5 , time >= 1.1.4 , wai >= 3.0 - , wai-extra >= 3.0.5 + , wai-extra >= 3.0.7 , bytestring >= 0.9.1.4 , text >= 0.7 , template-haskell