split triggering into local and remote

Foundation.hs

@@ -133,6 +133,7 @@ instance Yesod App where
     isAuthorized (AvatarR _) _ = return Authorized
 
     isAuthorized TriggerRemotelyR _ = return Authorized
+    isAuthorized TriggerLocallyR _ = return Authorized
     isAuthorized (OpenViewProgressR _) _ = return Authorized
 
     isAuthorized CreateResetLinkR _ = isAdmin

Handler/ShowChallenge.hs

@@ -32,7 +32,7 @@ import System.IO (readFile)
 
 import Data.Attoparsec.Text
 
-import Data.Text (pack)
+import Data.Text (pack, unpack)
 
 getShowChallengeR :: Text -> Handler Html
 getShowChallengeR name = do
@@ -116,27 +116,31 @@ postChallengeSubmissionR name = do
     userId <- requireAuthId
     runViewProgress $ doCreateSubmission userId challengeId mDescription mTags submissionUrl submissionBranch
 
+postTriggerLocallyR :: Handler TypedContent
+postTriggerLocallyR = do
+  (Just challengeName) <- lookupPostParam "challenge"
+  (Just localId) <- lookupPostParam "user"
+  mBranch <- lookupPostParam "branch"
+  [Entity userId _] <- runDB $ selectList [UserLocalId ==. Just localId] []
+  let localRepo = gitServer ++ localId ++ "/" ++ challengeName
+  trigger userId challengeName localRepo mBranch
+
 postTriggerRemotelyR :: Handler TypedContent
 postTriggerRemotelyR = do
-  (Just localId) <- lookupPostParam "id"
+  (Just challengeName) <- lookupPostParam "challenge"
-  (Just name) <- lookupPostParam "challenge"
   (Just url) <- lookupPostParam "url"
+  (Just token) <- lookupPostParam "token"
   mBranch <- lookupPostParam "branch"
-  let branch = fromMaybe "master" mBranch
+  [Entity userId _] <- runDB $ selectList [UserTriggerToken ==. Just token] []
-  Entity challengeId _ <- runDB $ getBy404 $ UniqueName name
+  trigger userId challengeName url mBranch
-  [Entity userId _] <- runDB $ selectList [UserLocalId ==. Just localId] []
-  isPermitted <- canTrigger userId name url
-  if isPermitted
-    then
-     runOpenViewProgress $ doCreateSubmission userId challengeId Nothing Nothing url branch
-    else
-     return $ toTypedContent ("Cannot be triggered, must be submitted manually at Gonito.net!\n" :: String)
 
-canTrigger userId name url = do
+trigger :: UserId -> Text -> Text -> Maybe Text -> Handler TypedContent
-  user <- runDB $ get404 userId
+trigger userId challengeName url mBranch = do
-  return $ case userLocalId user of
+  let branch = fromMaybe "master" mBranch
-             Just localId -> (url == gitServer ++ localId ++ "/" ++ name)
+  mChallengeEnt <- runDB $ getBy $ UniqueName challengeName
-             Nothing -> False
+  case mChallengeEnt of
+    Just (Entity challengeId _) -> runOpenViewProgress $ doCreateSubmission userId challengeId Nothing Nothing url branch
+    Nothing -> return $ toTypedContent (("Unknown challenge `" ++ (Data.Text.unpack challengeName) ++ "`. Cannot be triggered, must be submitted manually at Gonito.net!\n") :: String)
 
 doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> Text -> Text -> Channel -> Handler ()
 doCreateSubmission userId challengeId mDescription mTags url branch chan = do

config/routes

@@ -21,6 +21,7 @@
 /challenge-discussion/#Text ChallengeDiscussionR GET POST
 /challenge-discussion-rss/#Text ChallengeDiscussionFeedR GET
 /trigger-remotely TriggerRemotelyR POST
+/trigger-locally TriggerLocallyR POST
 
 /q QueryFormR GET POST
 /q/#Text QueryResultsR  GET