Add to challenge submission to API

Foundation.hs

@@ -169,10 +169,11 @@ instance Yesod App where
     isAuthorized (ChallengeReadmeR _) _ = regularAuthorization
     isAuthorized (ChallengeAllSubmissionsR _) _ = regularAuthorization
 
-    isAuthorized (ChallengeMySubmissionsJsonR _) _ = regularAuthorization
+    isAuthorized (ChallengeMySubmissionsJsonR _) _ = return Authorized
     isAuthorized (ChallengeAllSubmissionsJsonR _) _ = return Authorized
-    isAuthorized AddUserR _ = regularAuthorization
-    isAuthorized UserInfoR _ = regularAuthorization
+    isAuthorized AddUserR _ = return Authorized
+    isAuthorized UserInfoR _ = return Authorized
+    isAuthorized (ChallengeSubmissionJsonR _) _ = return Authorized
 
     isAuthorized (ChallengeGraphDataR _) _ = regularAuthorization
     isAuthorized (ChallengeDiscussionR _) _ = regularAuthorization

Handler/Shared.hs

@@ -15,6 +15,8 @@ import qualified Data.Text.Encoding as DTE
 
 import Database.Persist.Sql (fromSqlKey)
 
+import Data.Scientific
+
 import Control.Concurrent.Lifted (threadDelay)
 import Control.Concurrent (forkIO)
 
@@ -99,8 +101,17 @@ runViewProgress = runViewProgress' ViewProgressR
 runOpenViewProgress :: (Channel -> Handler ()) -> Handler TypedContent
 runOpenViewProgress = runViewProgress' OpenViewProgressR
 
+runViewProgressAsynchronously :: (Channel -> Handler ()) -> Handler Value
+runViewProgressAsynchronously action = runViewProgressGeneralized getJobIdAsJson action
+--  where getJobIdAsJson jobId = return $ Number (scientific (toInteger jobId) 0)
+  where getJobIdAsJson jobId = return $ String $ pack $ show jobId
+
 runViewProgress' :: (Int -> Route App) -> (Channel -> Handler ()) -> Handler TypedContent
-runViewProgress' route action = do
+runViewProgress' route action = runViewProgressGeneralized doRedirection action
+  where doRedirection jobId = redirect $ route jobId
+
+runViewProgressGeneralized :: (Int -> Handler v) -> (Channel -> Handler ()) -> Handler v
+runViewProgressGeneralized handler action = do
   App {..} <- getYesod
   jobId <- randomInt
   chan <- liftIO $ atom $ do
@@ -117,7 +128,7 @@ runViewProgress' route action = do
       writeTChan chan Nothing
       m <- readTVar jobs
       writeTVar jobs $ IntMap.delete jobId m
-  redirect $ route jobId
+  handler jobId
 
 data RepoCloningSpec = RepoCloningSpec {
   cloningSpecRepo :: RepoSpec,

Handler/ShowChallenge.hs

@@ -279,8 +279,10 @@ getChallengeSubmissionR name = do
    (formWidget, formEnctype) <- generateFormPost $ submissionForm (Just defaultUrl) (defaultBranch scheme) (repoGitAnnexRemote repo)
    challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
 
-postChallengeSubmissionR :: Text -> Handler TypedContent
-postChallengeSubmissionR name = do
+postChallengeSubmissionJsonR :: Text -> Handler Value
+postChallengeSubmissionJsonR name = do
+    Entity userId _ <- requireAuthPossiblyByToken
+
     (Entity challengeId _) <- runDB $ getBy404 $ UniqueName name
     ((result, _), _) <- runFormPost $ submissionForm Nothing Nothing Nothing
     let submissionData' = case result of
@@ -288,7 +290,19 @@ postChallengeSubmissionR name = do
           _ -> Nothing
         Just submissionData = submissionData'
 
+    runViewProgressAsynchronously $ doCreateSubmission userId challengeId submissionData
+
+postChallengeSubmissionR :: Text -> Handler TypedContent
+postChallengeSubmissionR name = do
     userId <- requireAuthId
+
+    (Entity challengeId _) <- runDB $ getBy404 $ UniqueName name
+    ((result, _), _) <- runFormPost $ submissionForm Nothing Nothing Nothing
+    let submissionData' = case result of
+          FormSuccess res -> Just res
+          _ -> Nothing
+        Just submissionData = submissionData'
+
     runViewProgress $ doCreateSubmission userId challengeId submissionData
 
 postTriggerLocallyR :: Handler TypedContent
@@ -763,7 +777,7 @@ fetchAllSubmissionsView name = do
 
 fetchMySubmissionsView :: Text -> Handler SubmissionsView
 fetchMySubmissionsView name = do
-  userId <- requireAuthId
+  Entity userId _ <- requireAuthPossiblyByToken
   fetchChallengeSubmissionsView (\(Entity _ submission) -> (submissionSubmitter submission == userId)) name
 
 convertTagInfoToView :: (Entity Import.Tag, Entity SubmissionTag) -> TagView

config/routes

@@ -10,12 +10,14 @@
 /view-progress/#Int ViewProgressR GET
 /open-view-progress/#Int OpenViewProgressR GET
 /list-challenges ListChallengesR GET
+
 /api/list-challenges ListChallengesJsonR GET
 /api/leaderboard/#Text LeaderboardJsonR GET
 /api/challenge-my-submissions/#Text ChallengeMySubmissionsJsonR GET
 /api/challenge-all-submissions/#Text ChallengeAllSubmissionsJsonR GET
 /api/user-info UserInfoR GET
 /api/add-user AddUserR GET
+/api/challenge-submission/#Text ChallengeSubmissionJsonR POST
 /list-archived-challenges ListArchivedChallengesR GET
 /challenge-image/#ChallengeId ChallengeImageR GET
 

gonito.cabal

@@ -154,6 +154,7 @@ library
                  , wai-cors
                  , word8
                  , jose-jwt
+                 , scientific
 
 executable         gonito
     if flag(library-only)