From fe190c022e58b6ef791c28b12ec30a882a9ee0c1 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 12 Jan 2022 12:48:04 +0100
Subject: [PATCH] test(restarts): add application crash button to admin test
 page

---
 src/Foundation/Yesod/ErrorHandler.hs | 6 +++++-
 src/Handler/Admin/Test.hs            | 5 ++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/Foundation/Yesod/ErrorHandler.hs b/src/Foundation/Yesod/ErrorHandler.hs
index af67f5b8b..52162aaac 100644
--- a/src/Foundation/Yesod/ErrorHandler.hs
+++ b/src/Foundation/Yesod/ErrorHandler.hs
@@ -16,6 +16,8 @@ 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
 
 errorHandler :: ( MonadSecretBox (HandlerFor UniWorX)
                 , MonadSecretBox (WidgetFor UniWorX)
@@ -85,7 +87,9 @@ errorHandler err = do
 
         errPage = case err of
           NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
-          InternalError err' -> encrypted err' [whamlet|<p .literal-error>#{fromMaybe err' decrypted}|]
+          InternalError err'
+            | "Crash Button" `isPrefixOf` err'   -> liftIO $ exitImmediately ExitSuccess -- DEBUG: just for Testing
+            | otherwise -> encrypted err' [whamlet|<p .literal-error>TEST -#{err'}- -#{show decrypted}- #{fromMaybe err' decrypted}|]
           InvalidArgs errs -> [whamlet|
               <ul>
                 $forall err' <- errs
diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs
index ac62ab491..26a3dfbb5 100644
--- a/src/Handler/Admin/Test.hs
+++ b/src/Handler/Admin/Test.hs
@@ -17,7 +17,7 @@ import Handler.Admin.Test.Download (testDownload)
 
 
 -- BEGIN - Buttons needed only here
-data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example
+data ButtonCreate = CreateMath | CreateInf | CrashApp -- Dummy for Example
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonCreate
 instance Finite ButtonCreate
@@ -27,9 +27,11 @@ nullaryPathPiece ''ButtonCreate camelToPathPiece
 instance Button UniWorX ButtonCreate where
   btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|]
   btnLabel CreateInf  = "Informatik"
+  btnLabel CrashApp   = "Crash Application"
 
   btnClasses CreateMath = [BCIsButton, BCInfo]
   btnClasses CreateInf  = [BCIsButton, BCPrimary]
+  btnClasses CrashApp   = [BCIsButton, BCDanger]
 -- END Button needed only here
 
 emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext)
@@ -82,6 +84,7 @@ postAdminTestR = do
   case btnResult of
     (FormSuccess CreateInf)  -> addMessage Info "Informatik-Knopf gedrückt"
     (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt"
+    (FormSuccess CrashApp)   -> addMessage Error "Crash Button betätigt" >> error "Crash Button"
     FormMissing -> return ()
     _other -> addMessage Warning "KEIN Knopf erkannt"