From 0d372c636a735b4003448ab2518f6354b08ca042 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 13 Oct 2020 14:22:23 +0200 Subject: [PATCH] feat(authorisation): cookie-active-auth-tags --- config/settings.yml | 5 ++++ messages/uniworx/de-de-formal.msg | 6 ++-- messages/uniworx/en-eu.msg | 7 +++-- src/Foundation/Instances.hs | 1 + src/Foundation/Yesod/Middleware.hs | 10 ++++++- src/Handler/Profile.hs | 10 +++++-- src/Model/Types/Security.hs | 30 +++++++++++++++++-- src/Utils/Cookies/Registered.hs | 2 +- ...ookie-active-auth-tags.de-de-formal.hamlet | 2 ++ .../cookie-active-auth-tags.en-eu.hamlet | 2 ++ 10 files changed, 63 insertions(+), 12 deletions(-) create mode 100644 templates/i18n/changelog/cookie-active-auth-tags.de-de-formal.hamlet create mode 100644 templates/i18n/changelog/cookie-active-auth-tags.en-eu.hamlet diff --git a/config/settings.yml b/config/settings.yml index 9524f75b2..3b64d7f84 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -196,6 +196,11 @@ cookies: same-site: lax http-only: false secure: "_env:COOKIES_SECURE:true" + ACTIVE-AUTH-TAGS: + expires: 12622780800 + same-site: lax + http-only: true + secure: "_env:COOKIES_SECURE:true" user-defaults: max-favourites: 12 diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 37e635897..aba2c9510 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -805,6 +805,8 @@ PersonalInfoExamAchievementsWip: Die Anzeige von Prüfungsergebnissen wird momen PersonalInfoOwnTutorialsWip: Die Anzeige von Tutorien, zu denen Sie als Tutor eingetragen sind wird momentan an dieser Stelle leider noch nicht unterstützt. PersonalInfoTutorialsWip: Die Anzeige von Tutorien, zu denen Sie angemeldet sind wird momentan an dieser Stelle leider noch nicht unterstützt. +ActiveAuthTagsSaveCookie: In Cookie speichern? +ActiveAuthTagsSaveCookieTip: Falls gesetzt werden die aktivierten Authorisierungsprädikate zusätzlich zur aktiven Session auch in einem persistenten Cookie gespeichert. Dies kann vor Allem in Kombination mit Tab-Containern nützlich sein. ActiveAuthTags: Aktivierte Authorisierungsprädikate InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet @@ -1466,9 +1468,9 @@ ExternalExamUsers coursen@CourseName examn@ExamName: Teilnehmer: #{coursen}, #{e TitleMetrics: Metriken -AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren. +AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. AuthPredsActive: Aktive Authorisierungsprädikate -AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert +AuthPredsActiveChanged: Authorisierungseinstellungen gespeichert AuthTagFree: Seite ist universell zugänglich AuthTagAdmin: Nutzer ist Administrator AuthTagExamOffice: Nutzer ist mit Prüfungsverwaltung beauftragt diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index d581d1730..6b9f93c16 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -802,6 +802,9 @@ PersonalInfoExamAchievementsWip: The feature to display your exam achievements h PersonalInfoOwnTutorialsWip: The feature to display tutorials you have been assigned to as tutor has not yet been implemented. PersonalInfoTutorialsWip: The feature to display tutorials you have registered for has not yet been implemented. +ActiveAuthTagsSaveCookie: Save in cookie? +ActiveAuthTagsSaveCookieTip: Should the configuration of active authorisation predicates be additionally saved in a persistent cookie? This may be especially useful if using container tabs. + ActiveAuthTags: Active authorisation predicates InvalidDateTimeFormat: Invalid date and time format. YYYY-MM-DDTHH:MM[:SS] expected @@ -1466,9 +1469,9 @@ ExternalExamUsers coursen examn: Exam participants: #{coursen}, #{examn} TitleMetrics: Metrics -AuthPredsInfo: To view their own courses like a participant would, administrators and correctors can deactivate the checking of their credentials temporarily. Disabled authorisation predicates always fail. This means that deactivated predicates are not checked to grant access where it would otherwise not be permitted. These settings are only temporary, until your session expires i.e. your browser-cookie does. By deactivating predicates you can lock yourself out temporarily, at most. +AuthPredsInfo: To view their own courses like a participant would, administrators and correctors can deactivate the checking of their credentials temporarily. Disabled authorisation predicates always fail. This means that deactivated predicates are not checked to grant access where it would otherwise not be permitted. AuthPredsActive: Active authorisation predicates -AuthPredsActiveChanged: Authorisation settings saved for the current session +AuthPredsActiveChanged: Successfully saved authorisation settings AuthTagFree: Page is freely accessable AuthTagAdmin: User is administrator AuthTagExamOffice: User is part of an exam office diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index a5d305981..aa8f4bb50 100644 --- a/src/Foundation/Instances.hs +++ b/src/Foundation/Instances.hs @@ -160,6 +160,7 @@ instance YesodAuth UniWorX where app <- getYesod let mr | Just lang <- mlang = renderMessage app . map (Text.intercalate "-") . reverse . inits $ Text.splitOn "-" lang | otherwise = renderMessage app [] + addMessage Success . toHtml $ mr Auth.NowLoggedIn onErrorHtml dest msg = do diff --git a/src/Foundation/Yesod/Middleware.hs b/src/Foundation/Yesod/Middleware.hs index 1a7183602..3c9fb713c 100644 --- a/src/Foundation/Yesod/Middleware.hs +++ b/src/Foundation/Yesod/Middleware.hs @@ -26,7 +26,7 @@ yesodMiddleware :: ( BearerAuthSite UniWorX , BackendCompatible SqlBackend (YesodPersistBackend UniWorX) ) => HandlerFor UniWorX res -> HandlerFor UniWorX res -yesodMiddleware = storeBearerMiddleware . csrfMiddleware . dryRunMiddleware . observeYesodCacheSizeMiddleware . languagesMiddleware appLanguages . headerMessagesMiddleware . defaultYesodMiddleware . normalizeRouteMiddleware . updateFavouritesMiddleware +yesodMiddleware = storeBearerMiddleware . csrfMiddleware . dryRunMiddleware . observeYesodCacheSizeMiddleware . languagesMiddleware appLanguages . headerMessagesMiddleware . defaultYesodMiddleware . normalizeRouteMiddleware . updateFavouritesMiddleware . setActiveAuthTagsMiddleware where dryRunMiddleware :: HandlerFor UniWorX a -> HandlerFor UniWorX a dryRunMiddleware handler = do @@ -98,6 +98,14 @@ yesodMiddleware = storeBearerMiddleware . csrfMiddleware . dryRunMiddleware . ob Nothing -> return () handler + setActiveAuthTagsMiddleware :: HandlerFor UniWorX a -> HandlerFor UniWorX a + setActiveAuthTagsMiddleware handler = do + mtagActive <- lookupSessionJson SessionActiveAuthTags :: HandlerFor UniWorX (Maybe AuthTagActive) + when (is _Nothing mtagActive) $ do + mAuthTagActive <- lookupRegisteredCookieJson CookieActiveAuthTags + for_ mAuthTagActive $ setSessionJson SessionActiveAuthTags . review _ReducedActiveAuthTags + + handler updateFavourites :: forall m backend. ( MonadHandler m, HandlerSite m ~ UniWorX diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index a71375fc1..743bb67f2 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -817,8 +817,9 @@ postAuthPredsR = do | authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag) | otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag) - ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard - $ AuthTagActive <$> funcForm taForm (fslI MsgActiveAuthTags) True + ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard $ (,) + <$> apopt checkBoxField (fslI MsgActiveAuthTagsSaveCookie & setTooltip MsgActiveAuthTagsSaveCookieTip) (Just False) + <*> fmap AuthTagActive (funcForm taForm (fslI MsgActiveAuthTags) True) mReferer <- runMaybeT $ do param <- MaybeT (lookupGetParam $ toPathPiece GetReferer) <|> MaybeT (lookupPostParam $ toPathPiece GetReferer) @@ -837,7 +838,10 @@ postAuthPredsR = do ^{authActiveWidget} |] - formResult authActiveRes $ \authTagActive -> do + formResult authActiveRes $ \(saveCookie, authTagActive) -> do + when saveCookie $ if + | authTagActive == def -> deleteRegisteredCookie CookieActiveAuthTags + | otherwise -> setRegisteredCookieJson CookieActiveAuthTags $ authTagActive ^. _ReducedActiveAuthTags setSessionJson SessionActiveAuthTags authTagActive modifySessionJson SessionInactiveAuthTags . fmap $ Set.filter (not . authTagIsActive authTagActive) addMessageI Success MsgAuthPredsActiveChanged diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index f984a38d9..02001722f 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -108,12 +108,15 @@ instance Default AuthTagActive where _ -> True instance ToJSON AuthTagActive where - toJSON v = toJSON . HashMap.fromList $ map (id &&& authTagIsActive v) universeF + toJSON v = toJSON . HashMap.fromList $ map (toPathPiece &&& authTagIsActive v) universeF instance FromJSON AuthTagActive where parseJSON = Aeson.withObject "AuthTagActive" $ \o -> do - o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap AuthTag Bool) - return . AuthTagActive $ \n -> fromMaybe (authTagIsActive def n) $ HashMap.lookup n o' + o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap Text Bool) + fmap toAuthTagActive . flip ifoldMapM o' $ \k v -> maybeT mempty $ do + k' <- hoistMaybe $ fromPathPiece k + return $ HashMap.singleton k' v + where toAuthTagActive o = AuthTagActive $ \n -> fromMaybe (authTagIsActive def n) $ HashMap.lookup n o instance Hashable AuthTagActive where hashWithSalt s = foldl' hashWithSalt s . authTagIsActive @@ -127,6 +130,27 @@ derivePersistFieldJSON ''AuthTagActive getSessionActiveAuthTags :: MonadHandler m => m AuthTagActive getSessionActiveAuthTags = fromMaybe def <$> lookupSessionJson SessionActiveAuthTags +newtype ReducedActiveAuthTags = ReducedActiveAuthTags (HashMap AuthTag Bool) + deriving newtype (Monoid, Semigroup) + +instance ToJSON ReducedActiveAuthTags where + toJSON (ReducedActiveAuthTags a) = toJSON $ HashMap.fromList [ (toPathPiece k, v) | (k, v) <- HashMap.toList a ] + +instance FromJSON ReducedActiveAuthTags where + parseJSON = Aeson.withObject "ReducedActiveAuthTags" $ \o -> do + o' <- parseJSON $ Aeson.Object o :: Aeson.Parser (HashMap Text Bool) + fmap ReducedActiveAuthTags . flip ifoldMap o' $ \k v -> maybeT mempty $ do + k' <- hoistMaybe $ fromPathPiece k + return $ HashMap.singleton k' v + +_ReducedActiveAuthTags :: Iso' AuthTagActive ReducedActiveAuthTags +_ReducedActiveAuthTags = iso toReducedActiveAuthTags fromReducedActiveAuthTags + where + toReducedActiveAuthTags a = ReducedActiveAuthTags . flip foldMap universeF $ \n -> if + | authTagIsActive a n /= authTagIsActive def n -> HashMap.singleton n $ authTagIsActive a n + | otherwise -> mempty + fromReducedActiveAuthTags (ReducedActiveAuthTags hm) = AuthTagActive $ \n -> fromMaybe (authTagIsActive def n) $ HashMap.lookup n hm + data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a } deriving (Eq, Ord, Read, Show, Generic, Typeable) diff --git a/src/Utils/Cookies/Registered.hs b/src/Utils/Cookies/Registered.hs index 14a91c9fe..e279eec81 100644 --- a/src/Utils/Cookies/Registered.hs +++ b/src/Utils/Cookies/Registered.hs @@ -31,7 +31,7 @@ import Data.Char (isAscii) import Data.Monoid (Last(..)) -data RegisteredCookie = CookieSession | CookieXSRFToken | CookieLang | CookieSystemMessageState +data RegisteredCookie = CookieSession | CookieXSRFToken | CookieLang | CookieSystemMessageState | CookieActiveAuthTags deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) deriving anyclass (Universe, Finite, Hashable) diff --git a/templates/i18n/changelog/cookie-active-auth-tags.de-de-formal.hamlet b/templates/i18n/changelog/cookie-active-auth-tags.de-de-formal.hamlet new file mode 100644 index 000000000..2c4aea002 --- /dev/null +++ b/templates/i18n/changelog/cookie-active-auth-tags.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Aktive Authorisierungsprädikate können nun in einem persistenten Cookie gespeichert werden diff --git a/templates/i18n/changelog/cookie-active-auth-tags.en-eu.hamlet b/templates/i18n/changelog/cookie-active-auth-tags.en-eu.hamlet new file mode 100644 index 000000000..888ecf351 --- /dev/null +++ b/templates/i18n/changelog/cookie-active-auth-tags.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Active authorisation predicates can now be saved as a persistent cookie