fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: persist bearer tokens in session

Browse Source
This commit is contained in:
Gregor Kleen 2020-04-07 14:31:55 +02:00
parent 6283f01b9f
commit d8040e7aa8
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Foundation.hs
View File

@ -100,6 +100,8 @@ import UnliftIO.Pool
import qualified Web.ServerSession.Core as ServerSession import qualified Web.ServerSession.Core as ServerSession
import qualified Web.ServerSession.Frontend.Yesod.Jwt as JwtSession import qualified Web.ServerSession.Frontend.Yesod.Jwt as JwtSession
import Jose.Jwt (Jwt(..))
-- | Convenient Type Synonyms: -- | Convenient Type Synonyms:
type DB = YesodDB UniWorX type DB = YesodDB UniWorX
type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, Widget) 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. -- 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 -- 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. -- 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 where
updateFavouritesMiddleware :: Handler a -> Handler a updateFavouritesMiddleware :: Handler a -> Handler a
updateFavouritesMiddleware handler = (*> handler) . runMaybeT $ do updateFavouritesMiddleware handler = (*> handler) . runMaybeT $ do
@ -1545,6 +1547,13 @@ instance Yesod UniWorX where
addCustomHeader HeaderAlerts . decodeUtf8 . urlEncode True . toStrict . JSON.encode addCustomHeader HeaderAlerts . decodeUtf8 . urlEncode True . toStrict . JSON.encode
observeYesodCacheSizeMiddleware :: Handler a -> Handler a observeYesodCacheSizeMiddleware :: Handler a -> Handler a
observeYesodCacheSizeMiddleware handler = handler `finally` observeYesodCacheSize 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` -- Since we implement `errorHandler` ourselves we don't need `defaultMessageWidget`
defaultMessageWidget _title _body = error "defaultMessageWidget: undefined" defaultMessageWidget _title _body = error "defaultMessageWidget: undefined"