Continue work on challenge updating

Foundation.hs

@@ -166,6 +166,7 @@ instance Yesod App where
     isAuthorized ListArchivedChallengesR _ = isAdmin
     isAuthorized (ArchiveR _) _ = isAdmin
     isAuthorized (UnarchiveR _) _ = isAdmin
+    isAuthorized (ChallengeUpdateR _) _ = isAdmin
 
     isAuthorized MyScoreR _ = return Authorized
 

Handler/CreateChallenge.hs

@@ -89,6 +89,40 @@ doCreateChallenge name publicUrl publicBranch publicGitAnnexRemote privateUrl pr
         Nothing -> return ()
     Nothing -> return ()
 
+data ChallengeUpdateType = MajorChange | MinorChange | ChallengePatch
+                           deriving (Eq, Enum, Bounded)
+
+instance Show ChallengeUpdateType where
+  show MajorChange = "major change"
+  show MinorChange = "minor change"
+  show ChallengePatch = "patch"
+
+getChallengeUpdateR :: ChallengeId -> Handler Html
+getChallengeUpdateR challengeId = do
+    (formWidget, formEnctype) <- generateFormPost updateChallengeForm
+    defaultLayout $ do
+        setTitle "Welcome To Yesod!"
+        $(widgetFile "update-challenge")
+
+postChallengeUpdateR :: ChallengeId -> Handler TypedContent
+postChallengeUpdateR _ = do
+    ((result, _), _) <- runFormPost updateChallengeForm
+    let challengeData = case result of
+            FormSuccess res -> Just res
+            _ -> Nothing
+        Just (updateType, publicUrl, publicBranch, publicGitAnnexRemote,
+                          privateUrl, privateBranch, privateGitAnnexRemote) = challengeData
+
+    userId <- requireAuthId
+    user <- runDB $ get404 userId
+    if userIsAdmin user
+      then
+       do
+         runViewProgress $ (flip err) "TO BE IMPLEMENTED"
+      else
+        runViewProgress $ (flip err) "MUST BE AN ADMIN TO CREATE A CHALLENGE"
+
+
 defaultMajorVersion :: Int
 defaultMajorVersion = 1
 
@@ -230,3 +264,13 @@ createChallengeForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,)
     <*> areq textField (bfs MsgPrivateUrl) Nothing
     <*> areq textField (bfs MsgBranch) (Just "dont-peek")
     <*> aopt textField (bfs MsgGitAnnexRemote) Nothing
+
+updateChallengeForm :: Form (ChallengeUpdateType, Text, Text, Maybe Text, Text, Text, Maybe Text)
+updateChallengeForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,)
+    <$> areq (radioField optionsEnum) (bfs MsgChangeType) Nothing
+    <*> areq textField (bfs MsgPublicUrl) Nothing
+    <*> areq textField (bfs MsgBranch) (Just "master")
+    <*> aopt textField (bfs MsgGitAnnexRemote) Nothing
+    <*> areq textField (bfs MsgPrivateUrl) Nothing
+    <*> areq textField (bfs MsgBranch) (Just "dont-peek")
+    <*> aopt textField (bfs MsgGitAnnexRemote) Nothing

config/routes

@@ -23,6 +23,7 @@
 /challenge-discussion/#Text ChallengeDiscussionR GET POST
 /challenge-param-graph-data/#Text/#TestId/#Text ChallengeParamGraphDataR GET
 /challenge-discussion-rss/#Text ChallengeDiscussionFeedR GET
+/challenge-update/#ChallengeId ChallengeUpdateR GET POST
 /trigger-remotely TriggerRemotelyR POST
 /trigger-locally TriggerLocallyR POST
 

messages/en.msg

@@ -78,3 +78,7 @@ Dashboard: dashboard
 TargetName: target name
 ShowArchivedChallenges: show archived challenges
 CoursesITeach: courses I teach
+MajorChange: major change
+MinorChange: minor change
+Patch: patch
+ChangeType: change type

templates/show-challenge.hamlet

@@ -10,6 +10,9 @@ $if (checkIfAdmin mUserEnt)
   $if (challengeArchived challenge /= Just True)
     <form method=post action=@{ArchiveR challengeId}#form enctype="text/plain">
       <button>Archive
+    <form method=post action=@{ChallengeUpdateR challengeId}#form enctype="text/plain">
+      <button>Update
+
  $if (challengeArchived challenge == Just True)
     <form method=post action=@{UnarchiveR challengeId}#form enctype="text/plain">
       <button>Unarchive

templates/update-challenge.hamlet

@@ -0,0 +1,7 @@
+<h2>Update a challenge
+
+<p>
+  <form method=post action=@{ChallengeUpdateR challengeId}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <button .btn .btn-primary type="submit">
+       _{MsgAdd} <span class="glyphicon glyphicon-upload"></span>