diff --git a/Foundation.hs b/Foundation.hs index b9d99f8..949b5a2 100644 --- a/Foundation.hs +++ b/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 diff --git a/Handler/ListChallenges.hs b/Handler/ListChallenges.hs index d584e7c..647b0a1 100644 --- a/Handler/ListChallenges.hs +++ b/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, - versionMinor ver, - versionPatch ver)) + , "version" .= ((versionMajor ver), + (versionMinor 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) - , ("version", stringSchema) + fromList [ ("deadline", stringSchema) + , ("version", versionSchema) , ("description", stringSchema) , ("when", stringSchema) , ("commit", stringSchema) diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 2863682..ee0aa4d 100644 --- a/Handler/ShowChallenge.hs +++ b/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 - return $ toJSON $ zonedTimeToLocalTime theNow + theNow <- liftIO $ getCurrentTime + 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 diff --git a/Handler/Swagger.hs b/Handler/Swagger.hs index 29c205b..f1a1e26 100644 --- a/Handler/Swagger.hs +++ b/Handler/Swagger.hs @@ -35,7 +35,8 @@ apiDescription = generalApi <> testProgressApi <> viewProgressWithWebSockets <> viewProgressLog - + <> currentTimeApi + <> formatAsLocalTimeApi generalApi :: Swagger generalApi = (mempty :: Swagger) diff --git a/config/routes b/config/routes index f592fc7..c12f476 100644 --- a/config/routes +++ b/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 diff --git a/gonito.cabal b/gonito.cabal index c4a8d17..ff83dc5 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -165,6 +165,7 @@ library , lens , insert-ordered-containers , yesod-websockets + , MissingH executable gonito if flag(library-only)