chore(error): remove default layout from error handler

This commit is contained in:
Steffen Jost 2023-04-24 13:45:10 +00:00
parent 5720ba58c8
commit 54a956dc36

View File

@ -72,39 +72,51 @@ 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'
| isEncrypted && shouldEncrypt -> do
addHeader "Encrypted-Error-Message" "True"
return err'
| shouldEncrypt -> do
addHeader "Encrypted-Error-Message" "True"
encodedSecretBox SecretBoxPretty err'
| otherwise -> return $ fromMaybe err' decrypted
InvalidArgs errs -> return . Text.unlines . map (Text.replace "\n" "\n\t") $ errs
_other -> return Text.empty
provideRep . fmap PrettyValue $ case err of
PermissionDenied err' -> return $ object [ "message" JSON..= err' ]
InternalError err'
@ -120,15 +132,3 @@ errorHandler err = do
| otherwise -> return $ object [ "message" JSON..= fromMaybe err' decrypted ]
InvalidArgs errs -> return $ object [ "messages" JSON..= errs ]
_other -> return $ object []
provideRep $ case err of
PermissionDenied err' -> return err'
InternalError err'
| isEncrypted && shouldEncrypt -> do
addHeader "Encrypted-Error-Message" "True"
return err'
| shouldEncrypt -> do
addHeader "Encrypted-Error-Message" "True"
encodedSecretBox SecretBoxPretty err'
| otherwise -> return $ fromMaybe err' decrypted
InvalidArgs errs -> return . Text.unlines . map (Text.replace "\n" "\n\t") $ errs
_other -> return Text.empty