Use displayException instead of show for payload of InternalError

yesod-core/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-core
 
+## 1.6.28.0
+
+* Capture exception value in internal errors [#1860](https://github.com/yesodweb/yesod/pull/1869)
+
 ## 1.6.27.1
 
 * Set `base >= 4.11` for less CPP and imports [#1876](https://github.com/yesodweb/yesod/pull/1876)

yesod-core/src/Yesod/Core/Class/Yesod.hs

@@ -700,13 +700,14 @@ defaultErrorHandler (InvalidArgs ia) = selectRep $ do
     provideRep $ return ("Invalid Arguments: " <> T.intercalate " " ia)
 
 defaultErrorHandler (InternalError e) = do
-    $logErrorS "yesod-core" e
+    let exceptionString = displayException e
+    $logErrorS "yesod-core" exceptionString
     selectRep $ do
         provideRep $ defaultLayout $ defaultMessageWidget
             "Internal Server Error"
-            [hamlet|<pre>#{e}|]
-        provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
-        provideRep $ return $ "Internal Server Error: " <> e
+            [hamlet|<pre>#{exceptionString}|]
+        provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= exceptionString]
+        provideRep $ return $ "Internal Server Error: " <> exceptionString
 
 defaultErrorHandler (BadMethod m) = selectRep $ do
     provideRep $ defaultLayout $ defaultMessageWidget

yesod-core/src/Yesod/Core/Internal/Response.hs

@@ -100,7 +100,7 @@ evaluateContent (ContentBuilder b mlen) = handle f $ do
     len `seq` return (Right $ ContentBuilder (lazyByteString lbs) mlen')
   where
     f :: SomeException -> IO (Either ErrorResponse Content)
-    f = return . Left . InternalError . T.pack . show
+    f = return . Left . InternalError
 evaluateContent c = return (Right c)
 
 getStatus :: ErrorResponse -> H.Status

yesod-core/src/Yesod/Core/Internal/Run.hs

@@ -9,7 +9,7 @@
 
 module Yesod.Core.Internal.Run
   ( toErrorHandler
-  , errFromShow
+  , errFromDisplayException
   , basicRunHandler
   , handleError
   , handleContents
@@ -56,17 +56,10 @@ import           UnliftIO.Exception
 
 -- | Convert a synchronous exception into an ErrorResponse
 toErrorHandler :: SomeException -> IO ErrorResponse
-toErrorHandler e0 = handleAny errFromShow $
+toErrorHandler e0 = handleAny errFromDisplayException $
     case fromException e0 of
         Just (HCError x) -> evaluate $!! x
-        _ -> errFromShow e0
-
--- | Generate an @ErrorResponse@ based on the shown version of the exception
-errFromShow :: SomeException -> IO ErrorResponse
-errFromShow x = do
-  text <- evaluate (T.pack $ show x) `catchAny` \_ ->
-          return (T.pack "Yesod.Core.Internal.Run.errFromShow: show of an exception threw an exception")
-  return $ InternalError text
+        _ -> InternalError e0
 
 -- | Do a basic run of a handler, getting some contents and the final
 -- @GHState@. The @GHState@ unfortunately may contain some impure
@@ -125,7 +118,7 @@ handleError :: RunHandlerEnv sub site
             -> IO YesodResponse
 handleError rhe yreq resState finalSession headers e0 = do
     -- Find any evil hidden impure exceptions
-    e <- (evaluate $!! e0) `catchAny` errFromShow
+    e <- (evaluate $!! e0) `catchAny` errFromDisplayException
 
     -- Generate a response, leveraging the updated session and
     -- response headers
@@ -260,7 +253,7 @@ runFakeHandler :: forall site m a . (Yesod site, MonadIO m) =>
                -> HandlerFor site a
                -> m (Either ErrorResponse a)
 runFakeHandler fakeSessionMap logger site handler = liftIO $ do
-  ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")
+  ret <- I.newIORef (Left $ InternalError $ toException (EUnsafe.ErrorCall "runFakeHandler: no result"))
   maxExpires <- getCurrentMaxExpiresRFC1123
   let handler' = liftIO . I.writeIORef ret . Right =<< handler
   let yapp = runHandler

yesod-core/src/Yesod/Core/Types.hs

@@ -338,7 +338,7 @@ data ErrorResponse =
         -- ^ The requested resource was not found.
         -- Examples of when this occurs include when an incorrect URL is used, or @yesod-persistent@'s 'get404' doesn't find a value.
         -- HTTP status: 404.
-    | InternalError !Text
+    | InternalError !SomeException
         -- ^ Some sort of unexpected exception.
         -- If your application uses `throwIO` or `error` to throw an exception, this is the form it would take.
         -- HTTP status: 500.