fraport/fradrive-old
Archived
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 qualified Network.Wai as W
import System.Exit -- DEBUG: just for testing
import System.Posix.Process -- DEBUG: just for testing
errorHandler :: ( MonadSecretBox (HandlerFor UniWorX) errorHandler :: ( MonadSecretBox (HandlerFor UniWorX)
, MonadSecretBox (WidgetFor UniWorX) , MonadSecretBox (WidgetFor UniWorX)
@ -85,7 +87,9 @@ errorHandler err = do
errPage = case err of errPage = case err of
NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|] 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| InvalidArgs errs -> [whamlet|
<ul> <ul>
$forall err' <- errs $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 -- 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) deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonCreate instance Universe ButtonCreate
instance Finite ButtonCreate instance Finite ButtonCreate
@ -27,9 +27,11 @@ nullaryPathPiece ''ButtonCreate camelToPathPiece
instance Button UniWorX ButtonCreate where instance Button UniWorX ButtonCreate where
btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|] btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|]
btnLabel CreateInf = "Informatik" btnLabel CreateInf = "Informatik"
btnLabel CrashApp = "Crash Application"
btnClasses CreateMath = [BCIsButton, BCInfo] btnClasses CreateMath = [BCIsButton, BCInfo]
btnClasses CreateInf = [BCIsButton, BCPrimary] btnClasses CreateInf = [BCIsButton, BCPrimary]
btnClasses CrashApp = [BCIsButton, BCDanger]
-- END Button needed only here -- END Button needed only here
emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext) emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext)
@ -82,6 +84,7 @@ postAdminTestR = do
case btnResult of case btnResult of
(FormSuccess CreateInf) -> addMessage Info "Informatik-Knopf gedrückt" (FormSuccess CreateInf) -> addMessage Info "Informatik-Knopf gedrückt"
(FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt" (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt"
(FormSuccess CrashApp) -> addMessage Error "Crash Button betätigt" >> error "Crash Button"
FormMissing -> return () FormMissing -> return ()
_other -> addMessage Warning "KEIN Knopf erkannt" _other -> addMessage Warning "KEIN Knopf erkannt"