From ec4947254aa6bcb40b2f908e1359e1c223258737 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Wed, 14 Nov 2018 20:59:40 +0100
Subject: [PATCH] Fix slack hook

---
 Handler/Shared.hs        | 13 ++++++++-----
 Handler/ShowChallenge.hs | 38 +++++++++++++++++++++++---------------
 2 files changed, 31 insertions(+), 20 deletions(-)

diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index 80412b5..fa3b586 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -409,9 +409,12 @@ runSlackHook hook message = do
 
   R.runReq def $ do
     let payload = object [ "text" .= message ]
-    (_ :: JsonResponse Value) <- R.req R.POST
-                                hookUrl
-                                (R.ReqBodyJson payload)
-                                R.jsonResponse
-                                mempty
+    (_ :: IgnoreResponse) <- R.req R.POST
+                                 hookUrl
+                                 (R.ReqBodyJson payload)
+                                 R.ignoreResponse
+                                 mempty
     return ()
+
+slackLink app title addr = "<" ++ link ++ "|" ++ title ++ ">"
+  where link = (appRoot $ appSettings app) ++ "/" ++ addr
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index ae3bcb6..3fa7aa9 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -242,6 +242,7 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
     Just repoId -> do
 
       challenge <- runDB $ get404 challengeId
+      user <- runDB $ get404 userId
 
       activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
       let (Entity mainTestId mainTest) = getMainTest activeTests
@@ -295,6 +296,14 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
 
       outs <- getOuts chan submissionId (gonitoMetadataGeneralParams gonitoMetadata)
 
+      currentTagIds <- runDB $ selectList [SubmissionTagSubmission ==. submissionId] []
+
+      runDB $ addTags submissionId (gonitoMetadataTags gonitoMetadata)  (
+        map (submissionTagTag . entityVal) currentTagIds)
+      msg chan "SUBMISSION CREATED"
+
+      app <- getYesod
+
       newScores <- mapM (getScoreForOut mainTestId) outs
       let newScores' = catMaybes newScores
       let newScores'' = case getMetricOrdering (testMetric mainTest) of
@@ -308,19 +317,25 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
                     (s:_) -> if compOp s b
                              then
                               do
-                                app <- getYesod
-                                let submissionLink = (appRoot $ appSettings app) ++ "/q/" ++ (fromSHA1ToText (repoCurrentCommit repo))
-                                let message = ("Whoa! New best result for '"
-                                               ++ (challengeName challenge)
-                                               ++ "' challenge, "
+                                let submissionLink = slackLink app "submission" ("q/" ++ (fromSHA1ToText (repoCurrentCommit repo)))
+                                let challengeLink = slackLink app (challengeTitle challenge) ("challenge/"
+                                                                                              ++ (challengeName challenge))
+                                let message = ("Whoa! New best result for "
+                                               ++ challengeLink
+                                               ++ " challenge by "
+                                               ++ (fromMaybe "???" $ userName user)
+                                               ++ ", "
                                                ++ (T.pack $ show $ testMetric mainTest)
+                                               ++ ": "
+                                               ++ (formatScore (testPrecision mainTest) s)
                                                ++ " ("
                                                ++ (if s > b
                                                    then "+"
                                                    else "")
-                                               ++ (T.pack $ show $ s-b)
-                                               ++ ")"
-                                               ++ " See <" ++ submissionLink ++ "|Submission>")
+                                               ++ (formatScore (testPrecision mainTest) (s-b))
+                                               ++ ")."
+                                               ++ " See " ++ submissionLink ++ "."
+                                               ++ " :clap:")
                                 msg chan message
                                 case appNewBestResultSlackHook $ appSettings app of
                                   Just hook -> liftIO $ runSlackHook hook message
@@ -330,13 +345,6 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
                     [] -> return ()
         Nothing -> return ()
 
-      currentTagIds <- runDB $ selectList [SubmissionTagSubmission ==. submissionId] []
-
-      runDB $ addTags submissionId (gonitoMetadataTags gonitoMetadata)  (
-        map (submissionTagTag . entityVal) currentTagIds)
-      msg chan "SUBMISSION CREATED"
-
-      app <- getYesod
       if appAutoOpening $ appSettings app
         then
           doMakePublic userId submissionId chan