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