From 54a956dc3663b6d3fe0540d75983a1845074f21f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 24 Apr 2023 13:45:10 +0000 Subject: [PATCH] chore(error): remove default layout from error handler --- src/Foundation/Yesod/ErrorHandler.hs | 88 ++++++++++++++-------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/src/Foundation/Yesod/ErrorHandler.hs b/src/Foundation/Yesod/ErrorHandler.hs index fb330960b..a8edfbccf 100644 --- a/src/Foundation/Yesod/ErrorHandler.hs +++ b/src/Foundation/Yesod/ErrorHandler.hs @@ -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 -

_{MsgErrorResponseEncrypted} -

-                    #{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
+    --               

_{MsgErrorResponseEncrypted} + --

+    --                 #{ciphertext}
+    --             |]
+    --       if
+    --         | isEncrypted && shouldEncrypt -> displayEncrypted plaintextJson
+    --         | shouldEncrypt -> displayEncrypted =<< encodedSecretBox SecretBoxPretty plaintextJson
+    --         | otherwise -> plaintext
 
-        errPage = case err of
-          NotFound -> [whamlet|

_{MsgErrorResponseNotFound}|] - InternalError err' - | "Crash Button" `isPrefixOf` err' -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing - | otherwise -> encrypted err' [whamlet|

#{fromMaybe err' decrypted}|] - InvalidArgs errs -> [whamlet| -

    - $forall err' <- errs -
  • - #{err'} - |] - NotAuthenticated -> [whamlet|

    _{MsgErrorResponseNotAuthenticated}|] - PermissionDenied err' -> [whamlet|

    #{err'}|] - BadMethod method -> [whamlet|

    _{MsgErrorResponseBadMethod (decodeUtf8 method)}|] - siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do - errPage + -- errPage = case err of + -- NotFound -> [whamlet|

    _{MsgErrorResponseNotFound}|] + -- InternalError err' + -- | "Crash Button" `isPrefixOf` err' -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing + -- | otherwise -> encrypted err' [whamlet|

    #{fromMaybe err' decrypted}|] + -- InvalidArgs errs -> [whamlet| + --

      + -- $forall err' <- errs + --
    • + -- #{err'} + -- |] + -- NotAuthenticated -> [whamlet|

      _{MsgErrorResponseNotAuthenticated}|] + -- PermissionDenied err' -> [whamlet|

      #{err'}|] + -- BadMethod method -> [whamlet|

      _{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