Add format-as-local-time end-point

Also breaking change - version in version-info is a list instead
of string

Foundation.hs

@@ -185,6 +185,7 @@ instance Yesod App where
     isAuthorized (QueryJsonR _) _ = regularAuthorization
     isAuthorized ListTagsJsonR _ = regularAuthorization
     isAuthorized CurrentTimeR _ = return Authorized
+    isAuthorized (FormatAsLocalTimeR _) _ = return Authorized
 
     isAuthorized (ChallengeGraphDataR _) _ = regularAuthorization
     isAuthorized (ChallengeDiscussionR _) _ = regularAuthorization

Handler/ListChallenges.hs

@@ -5,7 +5,6 @@ module Handler.ListChallenges where
 
 import Import hiding (get, fromList, Proxy)
 
-import Handler.Shared
 import PersistSHA1
 
 import Data.HashMap.Strict.InsOrd (fromList)
@@ -121,24 +120,29 @@ versionInfoApi = spec & definitions .~ defs
 
 
 instance ToJSON (Entity Version) where
-    toJSON chEnt@(Entity _ ver) = object
+    toJSON (Entity _ ver) = object
         [ "deadline"  .= versionDeadline ver
-        , "version" .= (formatVersion (versionMajor ver,
+        , "version" .= ((versionMajor ver),
-                                       versionMinor ver,
+                        (versionMinor ver),
-                                       versionPatch ver))
+                        (versionPatch ver))
         , "description" .= versionDescription ver
         , "when" .= versionStamp ver
         , "commit" .= (fromSHA1ToText $ versionCommit ver)
         ]
 
+versionSchema :: Referenced Schema
+versionSchema = Inline $ toSchema (Proxy :: Proxy [Int])
+  & description .~ Just "Challenge version"
+  & example .~ Just (toJSON ([2, 0, 1] :: [Int]))
+
 instance ToSchema (Entity Version) where
   declareNamedSchema _ = do
     stringSchema <- declareSchemaRef (Proxy :: Proxy String)
     return $ NamedSchema (Just "Version") $ mempty
         & type_ .~ SwaggerObject
         & properties .~
-           fromList [  ("deadline", stringSchema)
+           fromList [ ("deadline", stringSchema)
-                    , ("version", stringSchema)
+                    , ("version", versionSchema)
                     , ("description", stringSchema)
                     , ("when", stringSchema)
                     , ("commit", stringSchema)

Handler/ShowChallenge.hs

@@ -18,6 +18,9 @@ import qualified Yesod.Table as Table
 import Control.Concurrent.Lifted (threadDelay)
 
 import Data.Time.LocalTime
+import Data.Time.Clock
+
+import qualified Data.List.Utils as DLU
 
 import Handler.Extract
 import Handler.Shared
@@ -1142,8 +1145,14 @@ getUserInfoR = do
 
 getCurrentTimeR :: Handler Value
 getCurrentTimeR = do
-  theNow <- liftIO $ getZonedTime
+  theNow <- liftIO $ getCurrentTime
-  return $ toJSON $ zonedTimeToLocalTime theNow
+  return $ toJSON theNow
+
+getFormatAsLocalTimeR :: String -> Handler Value
+getFormatAsLocalTimeR t = do
+  let ut = TR.read $ DLU.replace "T" " " $ DLU.replace "Z" " " t
+  tz <- liftIO $ getTimeZone ut
+  return $ toJSON $ utcToLocalTime tz ut
 
 
 getMyEvaluationTriggerTokenJsonR :: Handler Value
@@ -1278,6 +1287,35 @@ declareCurrentTimeApi = do
                  ]
 
 
+formatAsLocalTimeApi :: Swagger
+formatAsLocalTimeApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareFormatAsLocalTimeApi mempty
+
+declareFormatAsLocalTimeApi :: Declare (Definitions Schema) Swagger
+declareFormatAsLocalTimeApi = do
+  -- param schemas
+  response <- declareResponse (Proxy :: Proxy String)
+  let utcTimeSchema = toParamSchema (Proxy :: Proxy String)
+
+  return $ mempty
+    & paths .~
+        fromList [ ("/api/format-as-local-time/{utcTime}",
+                    mempty & DS.get ?~ (mempty
+                                        & parameters .~ [ ]
+                                        & produces ?~ MimeList ["application/json"]
+                                        & description ?~ "Formats the given UTC time stamp as a local time"
+                                        & parameters .~ [ Inline $ mempty
+                                                          & name .~ "utcTime"
+                                                          & required ?~ True
+                                                          & schema .~ ParamOther (mempty
+                                                                                  & in_ .~ ParamPath
+                                                                                  & paramSchema .~ utcTimeSchema) ]
+                                        & at 200 ?~ Inline response))
+                 ]
+
+
+
 myEvaluationTriggerTokenApi :: Swagger
 myEvaluationTriggerTokenApi = spec & definitions .~ defs
   where

Handler/Swagger.hs

@@ -35,7 +35,8 @@ apiDescription = generalApi
                  <> testProgressApi
                  <> viewProgressWithWebSockets
                  <> viewProgressLog
-
+                 <> currentTimeApi
+                 <> formatAsLocalTimeApi
 
 generalApi :: Swagger
 generalApi = (mempty :: Swagger)

config/routes

@@ -35,6 +35,7 @@
 /api/my-teams MyTeamsJsonR GET
 /api/my-evaluation-trigger-token MyEvaluationTriggerTokenJsonR GET
 /api/current-time CurrentTimeR GET
+/api/format-as-local-time/#String FormatAsLocalTimeR GET
 /list-archived-challenges ListArchivedChallengesR GET
 
 /my-teams MyTeamsR GET

gonito.cabal

@@ -165,6 +165,7 @@ library
                  , lens
                  , insert-ordered-containers
                  , yesod-websockets
+                 , MissingH
 
 executable         gonito
     if flag(library-only)