diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 7ff6e44cd..6dd1468a0 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -548,6 +548,8 @@ UnauthorizedWorkflowRead: Der Workflow enthält aktuell keine Zustände oder Dat UnauthorizedWorkflowInstancesNotEmpty: Es gibt Workflow Instanzen für die Sie einen neuen laufenden Workflow initiieren dürfen UnauthorizedWorkflowWorkflowsNotEmpty: Es gibt laufende Workflows, die Sie einsehen dürfen UnauthorizedWorkflowFiles: Sie dürfen die angegebenen Workflow-Dateien nicht im angegebenen historischen Zustand herunterladen +UnauthorizedNotAuthenticatedInDifferentApproot: Sie konnten im Kontext einer separierten Domain (z.B. zum sicheren Download von Dateien) nicht authentifiziert werden. Vermutlich haben Sie kein oder ein abgelaufenes Token verwendet. Sie können versuchen auf die gewünschte Resource mit einem neu generierten Download-Link zuzugreifen. +UnauthorizedCsrfDisabled: Ihre Anfrage hätte wmgl. Änderungen am Server-Zustand ausgelöst. Da die sog. CSRF-Protection für Ihre Anfrage deaktiviert ist, musste sie daher abgelehnt werden. WorkflowRoleUserMismatch: Sie sind nicht einer der vom Workflow geforderten Benutzer WorkflowRoleAlreadyInitiated: Dieser Workflow wurde bereits initiiert diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 0704d6c81..494dc2230 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -545,6 +545,8 @@ UnauthorizedWorkflowRead: The workflow currently contains no states or data you UnauthorizedWorkflowInstancesNotEmpty: There are workflow instances for which you are allowed to initiate a new running workflow UnauthorizedWorkflowWorkflowsNotEmpty: There are running workflows, which you may view UnauthorizedWorkflowFiles: You are not allowed to download the given workflow files in the given historical state +UnauthorizedNotAuthenticatedInDifferentApproot: You could not be authenticated in the context of a separate domain (e.g. for secure downloading of files). You probably used no or an expired token. You can try to access the resource with a newly generated download link. +UnauthorizedCsrfDisabled: Your request might have triggered a state change on the server. Since CSRF-protection was disabled for your request, it had to be rejected. WorkflowRoleUserMismatch: You aren't any of the users authorized by the workflow WorkflowRoleAlreadyInitiated: This workflow was already initiated diff --git a/src/Foundation/Yesod/ErrorHandler.hs b/src/Foundation/Yesod/ErrorHandler.hs index 2720300dc..efae38c85 100644 --- a/src/Foundation/Yesod/ErrorHandler.hs +++ b/src/Foundation/Yesod/ErrorHandler.hs @@ -20,6 +20,7 @@ import qualified Network.Wai as W errorHandler :: ( MonadSecretBox (HandlerFor UniWorX) , MonadSecretBox (WidgetFor UniWorX) + , MonadSecretBox (ExceptT EncodedSecretBoxException (HandlerFor UniWorX)) , MonadAuth (HandlerFor UniWorX) , BearerAuthSite UniWorX , Button UniWorX ButtonSubmit @@ -28,27 +29,20 @@ errorHandler :: ( MonadSecretBox (HandlerFor UniWorX) ) => ErrorResponse -> HandlerFor UniWorX TypedContent errorHandler err = do - -- when (is _NotAuthenticated err) $ do - -- authed <- is _Just <$> maybeAuthId - -- unless authed $ do - -- mCurrent <- getCurrentRoute - -- gets' <- reqGetParams <$> getRequest - -- wai <- waiRequest - -- maybe clearUltDest setUltDest $ do - -- current <- mCurrent - -- case current of - -- _ | W.requestMethod wai `notElem` ["GET"] -> Nothing - -- ErrorR -> Nothing - -- current' -> Just (current', gets') - -- $logInfoS "errorHandler" "Redirect to LoginR" - -- redirect $ AuthR LoginR - - shouldEncrypt <- do - canDecrypt <- (== Authorized) <$> evalAccess AdminErrMsgR True - shouldEncrypt <- getsYesod $ view _appEncryptErrors - return $ shouldEncrypt && not canDecrypt + let shouldEncrypt' = getsYesod $ view _appEncryptErrors + canDecrypt' = is _Authorized <$> evalAccess AdminErrMsgR True + decrypted' <- runMaybeT $ do + internalErrorContent <- hoistMaybe $ err ^? _InternalError + exceptTMaybe $ encodedSecretBoxOpen @Text internalErrorContent + let isEncrypted = is _Just decrypted' + shouldEncrypt <- andM + [ shouldEncrypt' + , return $ not isEncrypted + , not <$> canDecrypt' + ] + let decrypted = guardOnM (not shouldEncrypt) decrypted' - sessErr <- bool return (_InternalError $ encodedSecretBox SecretBoxShort) shouldEncrypt err + sessErr <- bool return (traverseOf _InternalError $ encodedSecretBox SecretBoxShort) shouldEncrypt err void . runMaybeT $ do reqHost <- MaybeT $ W.requestHeaderHost <$> waiRequest @@ -57,28 +51,44 @@ errorHandler err = do authErr <- lift $ encodedAuth sessErr redirect (ErrorR, [(toPathPiece GetError, authErr)]) + when (is _NotAuthenticated err) $ do + authed <- is _Just <$> maybeAuthId + unless authed $ do + mCurrent <- getCurrentRoute + gets' <- reqGetParams <$> getRequest + wai <- waiRequest + maybe clearUltDest setUltDest $ do + current <- mCurrent + case current of + _ | W.requestMethod wai `notElem` ["GET"] -> Nothing + ErrorR -> Nothing + current' -> Just (current', gets') + $logInfoS "errorHandler" "Redirect to LoginR" + redirect $ AuthR LoginR + setSessionJson SessionError sessErr selectRep $ do provideRep $ do mr <- getMessageRender let - encrypted :: ToJSON a => a -> WidgetFor UniWorX () -> WidgetFor UniWorX () + encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX () encrypted plaintextJson plaintext = do - if - | shouldEncrypt -> do - ciphertext <- encodedSecretBox SecretBoxPretty plaintextJson - + let displayEncrypted ciphertext = [whamlet| + $newline never

_{MsgErrorResponseEncrypted} 

                     #{ciphertext}
                 |]
+          if
+            | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
+            | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
             | otherwise -> plaintext
 
         errPage = case err of
           NotFound -> [whamlet|
_{MsgErrorResponseNotFound}|]
-          InternalError err' -> encrypted err' [whamlet|
#{err'}|]
+          InternalError err' -> encrypted err' [whamlet|
#{fromMaybe err' decrypted}|]
           InvalidArgs errs -> [whamlet|