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

chore(error): revert 54a956dc36 ff since it did not help towards #40

Browse Source
This commit is contained in:
Steffen Jost 2023-12-13 16:20:17 +01:00
parent db77850c4f
commit ce45d26a21
1 changed files with 38 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
src/Foundation/Yesod/ErrorHandler.hs
View File

@ -9,9 +9,9 @@ module Foundation.Yesod.ErrorHandler
import Import.NoFoundation hiding (errorHandler)
import Foundation.Type
-- import Foundation.I18n
import Foundation.I18n
import Foundation.Authorization
-- import Foundation.SiteLayout
import Foundation.SiteLayout
import Foundation.Routes
import Foundation.DB
@ -20,15 +20,15 @@ import qualified Data.Text as Text
import qualified Network.Wai as W
-- import System.Exit -- DEBUG: just for testing
-- import System.Posix.Process -- DEBUG: just for testing
import System.Exit -- DEBUG: just for testing
import System.Posix.Process -- DEBUG: just for testing
errorHandler :: ( MonadSecretBox (HandlerFor UniWorX)
-- , MonadSecretBox (WidgetFor UniWorX)
, MonadSecretBox (WidgetFor UniWorX)
, MonadSecretBox (ExceptT EncodedSecretBoxException (HandlerFor UniWorX))
, MonadAuth (HandlerFor UniWorX)
, BearerAuthSite UniWorX
-- , YesodPersistBackend UniWorX ~ SqlBackend
, YesodPersistBackend UniWorX ~ SqlBackend
)
=> ErrorResponse -> HandlerFor UniWorX TypedContent
errorHandler err = do
@ -72,39 +72,39 @@ errorHandler err = do
setSessionJson SessionError sessErr
selectRep $ do
-- provideRep $ do
-- mr <- getMessageRender
-- let
-- encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX ()
-- encrypted plaintextJson plaintext = do
-- let displayEncrypted ciphertext =
-- [whamlet|
-- $newline never
-- <p>_{MsgErrorResponseEncrypted}
-- <pre .literal-error>
-- #{ciphertext}
-- |]
-- if
-- | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
-- | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
-- | otherwise -> plaintext
provideRep $ do
mr <- getMessageRender
let
encrypted :: Text -> WidgetFor UniWorX () -> WidgetFor UniWorX ()
encrypted plaintextJson plaintext = do
let displayEncrypted ciphertext =
[whamlet|
$newline never
<p>_{MsgErrorResponseEncrypted}
<pre .literal-error>
#{ciphertext}
|]
if
| isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
| shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
| otherwise -> plaintext
-- errPage = case err of
-- NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
-- InternalError err'
-- | "Crash Button" `isPrefixOf` err' -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
-- | otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
-- InvalidArgs errs -> [whamlet|
-- <ul>
-- $forall err' <- errs
-- <li .literal-error>
-- #{err'}
-- |]
-- NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
-- PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
-- BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-- siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
-- errPage
errPage = case err of
NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
InternalError err'
| "Crash Button" `isPrefixOf` err' -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
| otherwise -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
InvalidArgs errs -> [whamlet|
<ul>
$forall err' <- errs
<li .literal-error>
#{err'}
|]
NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
errPage
provideRep $ case err of
PermissionDenied err' -> return err'
InternalError err'