New ticket creation via POST

src/Vervis/Handler/Ticket.hs

@@ -26,14 +26,15 @@ import Prelude
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Time.Format (formatTime, defaultTimeLocale)
-import Database.Esqueleto hiding ((==.))
+import Database.Esqueleto hiding ((==.), (+=.), update)
 import Database.Persist
 import Text.Blaze.Html (Html, toHtml)
 import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout)
-import Yesod.Core.Handler (notFound)
+import Yesod.Core.Handler (redirectUltDest, setMessage)
 import Yesod.Core.Widget (setTitle)
 import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Types (FormResult (..))
 import Yesod.Persist.Core (runDB, get404, getBy404)
 
 import qualified Data.Text as T (intercalate, pack)
@@ -67,7 +68,26 @@ getTicketsR shar proj = do
         $(widgetFile "ticket/list")
 
 postTicketsR :: Text -> Text -> Handler Html
-postTicketsR shar proj = notFound
+postTicketsR shar proj = do
+    Entity pid project <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        getBy404 $ UniqueProject proj sid
+    let next = projectNextTicket project
+    author <- requireAuthId
+    ((result, widget), enctype) <- runFormPost $ newTicketForm pid next author
+    case result of
+        FormSuccess ticket -> do
+            runDB $ do
+                update pid [ProjectNextTicket +=. 1]
+                insert_ ticket
+            setMessage "Ticket created."
+            redirectUltDest HomeR
+        FormMissing -> do
+            setMessage "Field(s) missing."
+            defaultLayout $(widgetFile "ticket/new")
+        FormFailure _l -> do
+            setMessage "Ticket creation failed, see errors below."
+            defaultLayout $(widgetFile "ticket/new")
 
 getTicketNewR :: Text -> Text -> Handler Html
 getTicketNewR shar proj = do