Add end-point for returning the current time

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

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

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