From d8040e7aa864e2078962ed2c938ae91408dd9e50 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 7 Apr 2020 14:31:55 +0200 Subject: [PATCH] feat: persist bearer tokens in session --- src/Foundation.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 66568e795..bc289fd3e 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -100,6 +100,8 @@ import UnliftIO.Pool import qualified Web.ServerSession.Core as ServerSession import qualified Web.ServerSession.Frontend.Yesod.Jwt as JwtSession +import Jose.Jwt (Jwt(..)) + -- | Convenient Type Synonyms: type DB = YesodDB UniWorX type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, Widget) @@ -1511,7 +1513,7 @@ instance Yesod UniWorX where -- b) Validates that incoming write requests include that token in either a header or POST parameter. -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. - yesodMiddleware = observeYesodCacheSizeMiddleware . languagesMiddleware appLanguages . headerMessagesMiddleware . defaultYesodMiddleware . normalizeRouteMiddleware . defaultCsrfMiddleware . updateFavouritesMiddleware + yesodMiddleware = observeYesodCacheSizeMiddleware . languagesMiddleware appLanguages . headerMessagesMiddleware . defaultYesodMiddleware . normalizeRouteMiddleware . defaultCsrfMiddleware . updateFavouritesMiddleware . storeBearerMiddleware where updateFavouritesMiddleware :: Handler a -> Handler a updateFavouritesMiddleware handler = (*> handler) . runMaybeT $ do @@ -1545,6 +1547,13 @@ instance Yesod UniWorX where addCustomHeader HeaderAlerts . decodeUtf8 . urlEncode True . toStrict . JSON.encode observeYesodCacheSizeMiddleware :: Handler a -> Handler a observeYesodCacheSizeMiddleware handler = handler `finally` observeYesodCacheSize + storeBearerMiddleware :: Handler a -> Handler a + storeBearerMiddleware handler = do + askBearer >>= \case + Just (Jwt bs) -> setSessionBS (toPathPiece SessionBearer) bs + Nothing -> return () + + handler -- Since we implement `errorHandler` ourselves we don't need `defaultMessageWidget` defaultMessageWidget _title _body = error "defaultMessageWidget: undefined"