More swagger

Handler/ShowChallenge.hs

@@ -815,6 +815,39 @@ getAddUserR = do
           return $ Bool True
     Nothing -> return $ Bool False
 
+declareAllSubmissionsApi :: String -> String -> Declare (Definitions Schema) Swagger
+declareAllSubmissionsApi q d = do
+  -- param schemas
+  let challengeNameSchema = toParamSchema (Proxy :: Proxy String)
+
+  allSubmissionsResponse <- declareResponse (Proxy :: Proxy SubmissionsView)
+
+  return $ mempty
+    & paths .~
+        fromList [ ("/api/" ++ q ++ "/{challengeName}",
+                    mempty & DS.get ?~ (mempty
+                                        & parameters .~ [ Inline $ mempty
+                                                          & name .~ "challengeName"
+                                                          & required ?~ True
+                                                          & schema .~ ParamOther (mempty
+                                                                                  & in_ .~ ParamPath
+                                                                                  & paramSchema .~ challengeNameSchema) ]
+                                        & produces ?~ MimeList ["application/json"]
+                                        & description ?~ "d"
+                                        & at 200 ?~ Inline allSubmissionsResponse))
+                 ]
+
+
+allSubmissionsApi :: Swagger
+allSubmissionsApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare (declareAllSubmissionsApi "challenge-all-submissions" "Returns all submissions for a challenge") mempty
+
+mySubmissionsApi :: Swagger
+mySubmissionsApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare (declareAllSubmissionsApi "challenge-my-submissions" "Returns all submissions for a challenge for the user") mempty
+
 getChallengeAllSubmissionsJsonR :: Text -> Handler Value
 getChallengeAllSubmissionsJsonR challengeName = do
   v <- fetchAllSubmissionsView challengeName
@@ -918,6 +951,21 @@ instance ToJSON EvaluationView where
         , "test" .= evaluationViewTest e
         ]
 
+instance ToSchema EvaluationView where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy String)
+    doubleSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy Double)
+    testRefSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy TestReference)
+    return $ NamedSchema (Just "Evaluation") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("score", stringSchema)
+                     , ("full-score", doubleSchema)
+                     , ("test", testRefSchema)
+                    ]
+        & required .~ [ "score", "full-score", "test" ]
+
+
 data TagView = TagView {
   tagViewName :: Text,
   tagViewDescription :: Maybe Text,
@@ -930,6 +978,20 @@ instance ToJSON TagView where
        , "accepted" .= tagViewAccepted t
        ]
 
+instance ToSchema TagView where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy String)
+    boolSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy Bool)
+    return $ NamedSchema (Just "Tag") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("name", stringSchema)
+                     , ("description", stringSchema)
+                     , ("accepted", boolSchema)
+                    ]
+        & required .~ [ "name", "description" ]
+
+
 data SubmissionView = SubmissionView {
   submissionViewId :: Int64,
   submissionViewVariantId :: Int64,
@@ -965,6 +1027,36 @@ instance ToJSON SubmissionView where
     , "isPublic" .= submissionViewIsPublic s
     ]
 
+instance ToSchema SubmissionView where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy String)
+    boolSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy Bool)
+    intSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy Int)
+    intsSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy [Int])
+    tagsSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy [TagView])
+    evalsSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy [EvaluationView])
+    return $ NamedSchema (Just "SubmissionView") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("id", intSchema)
+                     , ("variant", intSchema)
+                     , ("rank", intSchema)
+                     , ("submitter", stringSchema)
+                     , ("when", stringSchema)
+                     , ("version", intsSchema)
+                     , ("description", stringSchema)
+                     , ("tags", tagsSchema)
+                     , ("hash", stringSchema)
+                     , ("evaluations", evalsSchema)
+                     , ("isOwner", boolSchema)
+                     , ("isReevaluable", boolSchema)
+                     , ("isVisible", boolSchema)
+                     , ("isPublic", boolSchema)
+                    ]
+        & required .~ [ "id", "variant", "rank", "submitter", "when", "version",
+                        "description", "tags", "hash", "evaluations",
+                        "isOwner", "isReevaluable", "isVisible", "isPublic" ]
+
 data SubmissionsView = SubmissionsView {
   submissionsViewSubmissions :: [SubmissionView],
   submissionsViewTests :: [TestReference]
@@ -976,6 +1068,18 @@ instance ToJSON SubmissionsView where
       "submissions" .= submissionsViewSubmissions ss
     ]
 
+instance ToSchema SubmissionsView where
+  declareNamedSchema _ = do
+    submissionViewsSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy [SubmissionView])
+    testRefsSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy [TestReference])
+    return $ NamedSchema (Just "Tag") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("tests", submissionViewsSchema)
+                     , ("submissions", testRefsSchema)
+                    ]
+        & required .~ [ "tests", "submission" ]
+
 getChallengeSubmissions :: ((Entity Submission) -> Bool) -> Text -> Handler Html
 getChallengeSubmissions condition name = do
   Entity challengeId challenge <- runDB $ getBy404 $ UniqueName name

Handler/Swagger.hs

@@ -12,7 +12,7 @@ getSwaggerR :: Handler Value
 getSwaggerR = return $ toJSON apiDescription
 
 apiDescription :: Swagger
-apiDescription = generalApi <> listChallengesApi <> leaderboardApi
+apiDescription = generalApi <> listChallengesApi <> leaderboardApi <> allSubmissionsApi <> mySubmissionsApi
 
 generalApi :: Swagger
 generalApi = (mempty :: Swagger)

Handler/Tables.hs

@@ -29,6 +29,13 @@ import GEval.EvaluationScheme
 
 import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..))
 
+import Data.Swagger hiding (get)
+import qualified Data.Swagger as DS
+import Data.Swagger.Declare
+import Data.Proxy as DPR
+import Control.Lens hiding ((.=), (^.))
+import Data.HashMap.Strict.InsOrd (fromList)
+
 data TestReference = TestReference Text Text
                      deriving (Show, Eq, Ord)
 
@@ -38,6 +45,16 @@ instance ToJSON TestReference where
           "metric" .= metric
         ]
 
+instance ToSchema TestReference where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (DPR.Proxy :: DPR.Proxy String)
+    return $ NamedSchema (Just "TestReference") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           Data.HashMap.Strict.InsOrd.fromList [  ("name", stringSchema)
+                                               , ("metric", stringSchema)
+                                               ]
+        & required .~ [ "name", "metric" ]
 
 getTestReference :: Entity Test -> TestReference
 getTestReference (Entity _ test) = TestReference (Data.Text.pack $ show $ testMetric test) (testName test)
@@ -51,7 +68,7 @@ data LeaderboardEntry = LeaderboardEntry {
   leaderboardBestVariantId :: VariantId,
   leaderboardEvaluationMap :: Map TestReference Evaluation,
   leaderboardNumberOfSubmissions :: Int,
-  leaderboardTags :: [(Entity Tag, Entity SubmissionTag)],
+  leaderboardTags :: [(Entity Import.Tag, Entity SubmissionTag)],
   leaderboardParams :: [Parameter],
   leaderboardVersion :: (Int, Int, Int)
 }
@@ -61,7 +78,7 @@ data TableEntry = TableEntry {
   tableEntryVariant :: Entity Variant,
   tableEntrySubmitter :: Entity User,
   tableEntryMapping :: Map TestReference Evaluation,
-  tableEntryTagsInfo :: [(Entity Tag, Entity SubmissionTag)],
+  tableEntryTagsInfo :: [(Entity Import.Tag, Entity SubmissionTag)],
   tableEntryParams :: [Entity Parameter],
   tableEntryRank :: Int,
   tableEntryVersion :: (Int, Int, Int) }
@@ -456,7 +473,7 @@ getScore testId variantId = do
 
 data BasicSubmissionInfo = BasicSubmissionInfo {
   basicSubmissionInfoUser :: User,
-  basicSubmissionInfoTagEnts :: [(Entity Tag, Entity SubmissionTag)],
+  basicSubmissionInfoTagEnts :: [(Entity Import.Tag, Entity SubmissionTag)],
   basicSubmissionInfoVersion :: Version }
 
 getBasicSubmissionInfo :: (MonadIO m, PersistQueryRead backend,