Slack announcements can be tested

Application.hs

@@ -62,6 +62,7 @@ import Handler.Dashboard
 import Handler.Evaluate
 import Handler.Swagger
 import Handler.Team
+import Handler.Announcements
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Foundation.hs

@@ -166,6 +166,8 @@ instance Yesod App where
     isAuthorized (EditAchievementR _) _ = isAdmin
     isAuthorized ExtraPointsR _ = isAdmin
 
+    isAuthorized TestAnnouncementsR _ = isAdmin
+
     isAuthorized DashboardR _ = regularAuthorization
 
     isAuthorized (ShowChallengeR _) _ = regularAuthorization

Handler/Announcements.hs

@@ -0,0 +1,23 @@
+module Handler.Announcements where
+
+import Import
+
+import Handler.Shared
+
+getTestAnnouncementsR :: Handler Html
+getTestAnnouncementsR = do
+  app <- getYesod
+
+  let webHook = appNewBestResultSlackHook $ appSettings app
+
+  let name = case appLocation $ appSettings app of
+               Just loc -> "Gonito@" ++ loc
+               Nothing -> "Gonito"
+
+  case webHook of
+    Just hook -> liftIO $ runSlackHook hook ("Test message from " ++ (slackLink app name ""))
+    Nothing -> return ()
+
+  defaultLayout $ do
+    setTitle "Test announcements"
+    $(widgetFile "test-announcements")

config/routes

@@ -16,6 +16,8 @@
 /api/test-progress/#Int/#Int TestProgressJsonR GET
 /list-challenges ListChallengesR GET
 
+/test-announcements TestAnnouncementsR GET
+
 /api/list-challenges ListChallengesJsonR GET
 /api/leaderboard/#Text LeaderboardJsonR GET
 /api/challenge-my-submissions/#Text ChallengeMySubmissionsJsonR GET

gonito.cabal

@@ -63,6 +63,7 @@ library
                      Handler.Swagger
                      Handler.JWT
                      Handler.Team
+                     Handler.Announcements
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT

messages/en.msg

@@ -106,3 +106,4 @@ AsTeam: As team
 InviteToTeam: Invite to team (give the identifier/login of a user)
 Join: Join
 NoTests: SOMETHING IS WRONG WITH THE CHALLENGE, THERE ARE NO TESTS DEFINED. MAYBE TEST DIRECTORY ARE MISSING OR THE CHALLENGE WAS CREATED/UPDATE IN THE INVALID MANNER
+TestAnnouncements: test announcements

templates/default-layout.hamlet

@@ -37,6 +37,7 @@
                             <li><a href="@{CoursesITeachR}">_{MsgCoursesITeach}</a>
                             <li><a href="@{ListArchivedChallengesR}">_{MsgShowArchivedChallenges}</a>
                             <li><a href="@{ListAnnotationsR}">_{MsgShowAnnotations}</a>
+                            <li><a href="@{TestAnnouncementsR}">_{MsgTestAnnouncements}</a>
 
           <ul class="nav navbar-nav navbar-collapse collapse navbar-right">
             <li class="dropdown">

templates/test-announcements.hamlet

@@ -0,0 +1,4 @@
+$maybe _ <- webHook
+  <p>A test message was sent!
+$nothing
+  <p>No webhook integrated. No test message sent.