forked from filipg/gonito
More swagger
This commit is contained in:
parent
301343e3a2
commit
98325e47b6
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user