From 220567148570e4141e4cedf9cfebdaa4ac3a93ec Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Wed, 24 Feb 2021 14:11:30 +0100
Subject: [PATCH] Add end-point for challenge versions

---
 Foundation.hs             |  1 +
 Handler/ListChallenges.hs | 67 ++++++++++++++++++++++++++++++++++++++-
 Handler/Swagger.hs        |  1 +
 config/routes             |  1 +
 4 files changed, 69 insertions(+), 1 deletion(-)

diff --git a/Foundation.hs b/Foundation.hs
index 9b1bfc9..93b4a0e 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -155,6 +155,7 @@ instance Yesod App where
     isAuthorized ListChallengesR _ = regularAuthorization
     isAuthorized ListChallengesJsonR _ = regularAuthorization
     isAuthorized (ChallengeInfoJsonR _) _ = regularAuthorization
+    isAuthorized (VersionInfoJsonR _) _ = regularAuthorization
     isAuthorized (LeaderboardJsonR _) _ = regularAuthorization
     isAuthorized (ViewVariantR _ ) _ = regularAuthorization
     isAuthorized (ViewVariantTestR _ _) _ = regularAuthorization
diff --git a/Handler/ListChallenges.hs b/Handler/ListChallenges.hs
index a795eb0..36446f8 100644
--- a/Handler/ListChallenges.hs
+++ b/Handler/ListChallenges.hs
@@ -5,6 +5,9 @@ module Handler.ListChallenges where
 
 import Import hiding (get, fromList, Proxy)
 
+import Handler.Shared
+import PersistSHA1
+
 import Data.HashMap.Strict.InsOrd (fromList)
 
 import Data.Proxy
@@ -69,6 +72,7 @@ instance ToJSON (Entity Challenge) where
         , "starred" .= challengeStarred ch
         , "archived" .= challengeArchived ch
         , "imageUrl" .= (("/" <>) <$> intercalate "/" <$> fst <$> renderRoute <$> imageUrl chEnt)
+        , "version" .= (fromSHA1ToText $ challengeVersion ch)
         ]
 
 instance ToSchema (Entity Challenge) where
@@ -84,8 +88,63 @@ instance ToSchema (Entity Challenge) where
                     , ("starred", booleanSchema)
                     , ("archived", booleanSchema)
                     , ("imageUrl", stringSchema)
+                    , ("version", stringSchema)
                     ]
-        & required .~ [ "name", "title", "description", "starred", "archived" ]
+        & required .~ [ "name", "title", "description", "starred", "archived", "version" ]
+
+
+declareVersionInfoSwagger :: Declare (Definitions Schema) Swagger
+declareVersionInfoSwagger = do
+  -- param schemas
+  versionInfoResponse      <- declareResponse (Proxy :: Proxy (Entity Version))
+  let versionHashSchema = toParamSchema (Proxy :: Proxy String)
+
+  return $ mempty
+    & paths .~
+        [ ("/api/version-info/{challengeName}",
+            mempty & get ?~ (mempty
+                                 & parameters .~ [ Inline $ mempty
+                                                   & name .~ "versionHash"
+                                                   & required ?~ True
+                                                   & schema .~ ParamOther (mempty
+                                                                            & in_ .~ ParamPath
+                                                                            & paramSchema .~ versionHashSchema) ]
+                                        & produces ?~ MimeList ["application/json"]
+                                        & description ?~ "Returns information about a challenge version"
+                                        & at 200 ?~ Inline versionInfoResponse))
+        ]
+
+versionInfoApi :: Swagger
+versionInfoApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareVersionInfoSwagger mempty
+
+
+instance ToJSON (Entity Version) where
+    toJSON chEnt@(Entity _ ver) = object
+        [ "deadline"  .= versionDeadline ver
+        , "version" .= (formatVersion (versionMajor ver,
+                                       versionMinor ver,
+                                       versionPatch ver))
+        , "description" .= versionDescription ver
+        , "when" .= versionStamp ver
+        , "commit" .= (fromSHA1ToText $ versionCommit ver)
+        ]
+
+instance ToSchema (Entity Version) where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (Proxy :: Proxy String)
+    booleanSchema <- declareSchemaRef (Proxy :: Proxy Bool)
+    return $ NamedSchema (Just "Challenge") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("deadline", stringSchema)
+                    , ("version", stringSchema)
+                    , ("description", stringSchema)
+                    , ("when", stringSchema)
+                    , ("commit", stringSchema)
+                    ]
+        & required .~ [ "version", "description", "when", "commit" ]
 
 
 generalListChallengesJson :: [Filter Challenge] -> Handler Value
@@ -111,6 +170,12 @@ getChallengeInfoJsonR challengeName = do
   entCh <- runDB $ getBy404 $ UniqueName challengeName
   return $ toJSON entCh
 
+getVersionInfoJsonR :: Text -> Handler Value
+getVersionInfoJsonR versionHash = do
+  theVersion <- runDB $ getBy404 $ UniqueVersionByCommit $ fromTextToSHA1 versionHash
+  return $ toJSON theVersion
+
+
 getChallengeImageR :: ChallengeId -> Handler Html
 getChallengeImageR challengeId = do
    challenge <- runDB $ get404 challengeId
diff --git a/Handler/Swagger.hs b/Handler/Swagger.hs
index bd14f78..5f8de32 100644
--- a/Handler/Swagger.hs
+++ b/Handler/Swagger.hs
@@ -21,6 +21,7 @@ apiDescription = generalApi
                  <> challengeReadmeInMarkdownApi
                  <> queryApi
                  <> challengeSubmissionApi
+                 <> versionInfoApi
 
 generalApi :: Swagger
 generalApi = (mempty :: Swagger)
diff --git a/config/routes b/config/routes
index 658ffe3..a2b9e86 100644
--- a/config/routes
+++ b/config/routes
@@ -22,6 +22,7 @@
 /api/challenge-image/#ChallengeId ChallengeImageR GET
 /api/query/#Text QueryJsonR GET
 /api/challenge-info/#Text ChallengeInfoJsonR GET
+/api/version-info/#Text VersionInfoJsonR GET
 /list-archived-challenges ListArchivedChallengesR GET
 
 /challenge/#Text ShowChallengeR GET