From 75d16e4b73b440cf9d3485484e500a622fd54ab4 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Thu, 2 Sep 2021 20:58:17 +0200
Subject: [PATCH] Add end-point for returning the current time

---
 Foundation.hs            |  1 +
 Handler/ShowChallenge.hs | 29 +++++++++++++++++++++++++++++
 config/routes            |  1 +
 3 files changed, 31 insertions(+)

diff --git a/Foundation.hs b/Foundation.hs
index 0810e86..b9d99f8 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -184,6 +184,7 @@ instance Yesod App where
     isAuthorized (ChallengeReadmeInMarkdownR _) _ = regularAuthorization
     isAuthorized (QueryJsonR _) _ = regularAuthorization
     isAuthorized ListTagsJsonR _ = regularAuthorization
+    isAuthorized CurrentTimeR _ = return Authorized
 
     isAuthorized (ChallengeGraphDataR _) _ = regularAuthorization
     isAuthorized (ChallengeDiscussionR _) _ = regularAuthorization
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 50541d3..2863682 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -17,6 +17,8 @@ import qualified Yesod.Table as Table
 
 import Control.Concurrent.Lifted (threadDelay)
 
+import Data.Time.LocalTime
+
 import Handler.Extract
 import Handler.Shared
 import Handler.Runner
@@ -1138,6 +1140,12 @@ getUserInfoR = do
   (Entity _ user) <- requireAuthPossiblyByToken
   return $ String $ userIdent user
 
+getCurrentTimeR :: Handler Value
+getCurrentTimeR = do
+  theNow <- liftIO $ getZonedTime
+  return $ toJSON $ zonedTimeToLocalTime theNow
+
+
 getMyEvaluationTriggerTokenJsonR :: Handler Value
 getMyEvaluationTriggerTokenJsonR = do
   (Entity _ user) <- requireAuthPossiblyByToken
@@ -1249,6 +1257,27 @@ declareUserInfoApi = do
                                         & at 200 ?~ Inline response))
                  ]
 
+currentTimeApi :: Swagger
+currentTimeApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareCurrentTimeApi mempty
+
+declareCurrentTimeApi :: Declare (Definitions Schema) Swagger
+declareCurrentTimeApi = do
+  -- param schemas
+  response <- declareResponse (Proxy :: Proxy String)
+
+  return $ mempty
+    & paths .~
+        fromList [ ("/api/current-time",
+                    mempty & DS.get ?~ (mempty
+                                        & parameters .~ [ ]
+                                        & produces ?~ MimeList ["application/json"]
+                                        & description ?~ "Returns the current time as measured on the server side"
+                                        & at 200 ?~ Inline response))
+                 ]
+
+
 myEvaluationTriggerTokenApi :: Swagger
 myEvaluationTriggerTokenApi = spec & definitions .~ defs
   where
diff --git a/config/routes b/config/routes
index 9d471db..f592fc7 100644
--- a/config/routes
+++ b/config/routes
@@ -34,6 +34,7 @@
 /api/list-tags ListTagsJsonR GET
 /api/my-teams MyTeamsJsonR GET
 /api/my-evaluation-trigger-token MyEvaluationTriggerTokenJsonR GET
+/api/current-time CurrentTimeR GET
 /list-archived-challenges ListArchivedChallengesR GET
 
 /my-teams MyTeamsR GET