fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

test(restarts): add application crash button to admin test page

Browse Source
This commit is contained in:
Steffen Jost 2022-01-12 12:48:04 +01:00
parent ed3bf4ecb3
commit fe190c022e
2 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Foundation/Yesod/ErrorHandler.hs
View File

@ -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

5
src/Handler/Admin/Test.hs
View File

@ -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"