New ticket post form

config/routes

@@ -40,10 +40,6 @@
 /u/#Text/k/!new                         KeyNewR           GET
 /u/#Text/k/#Text                        KeyR              GET
 
-/u/#Text/p                              ProjectsR         GET POST
-/u/#Text/p/!new                         ProjectNewR       GET
-/u/#Text/p/#Text                        ProjectR          GET
-
 /u/#Text/r                              ReposR            GET POST
 /u/#Text/r/!new                         RepoNewR          GET
 /u/#Text/r/#Text                        RepoR             GET
@@ -53,7 +49,13 @@
 /u/#Text/r/#Text/git/info/refs          GitRefDiscoverR   GET
 --/u/#Text/r/#Text/git/git-upload-pack    GitUploadRequestR POST
 
--- /u/#Text/p/#Text/t           TicketsR   GET
--- /u/#Text/p/#Text/t/#TicketId TicketR    GET
+/u/#Text/p                              ProjectsR         GET POST
+/u/#Text/p/!new                         ProjectNewR       GET
+/u/#Text/p/#Text                        ProjectR          GET
+
+/u/#Text/p/#Text/t                      TicketsR          GET POST
+/u/#Text/p/#Text/t/new                  TicketNewR        GET
+-- /u/#Text/p/#Text/t/#Int                 TicketR           GET
+
 -- /u/#Text/p/#Text/w           WikiR      GET
 -- /u/#Text/p/#Text/w/+Texts    WikiPageR  GET

src/Vervis/Application.hs

@@ -58,6 +58,7 @@ import Vervis.Handler.Key
 import Vervis.Handler.Person
 import Vervis.Handler.Project
 import Vervis.Handler.Repo
+import Vervis.Handler.Ticket
 
 import Vervis.Ssh (runSsh)
 

src/Vervis/Foundation.hs

@@ -115,6 +115,7 @@ instance Yesod App where
         loggedInAs user "You can’t watch keys of other users"
     isAuthorized (KeyNewR user) _ =
         loggedInAs user "You can’t add keys for other users"
+    isAuthorized (TicketNewR _ _) _ = loggedIn
     isAuthorized _ _ = return Authorized
 
     -- This function creates static content files in the static folder
@@ -217,6 +218,13 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
 -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
 
+loggedIn :: Handler AuthResult
+loggedIn = do
+    mpid <- maybeAuthId
+    case mpid of
+        Nothing   -> return AuthenticationRequired
+        Just _pid -> return Authorized
+
 loggedInAs :: Text -> Text -> Handler AuthResult
 loggedInAs ident msg = do
     mp <- maybeAuth

src/Vervis/Handler/Ticket.hs

@@ -0,0 +1,56 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Handler.Ticket
+    ( getTicketsR
+    , postTicketsR
+    , getTicketNewR
+    )
+where
+
+import Prelude
+
+import Data.Text (Text)
+import Database.Persist.Types (Entity (..))
+import Text.Blaze.Html (Html, toHtml)
+import Yesod.Core (defaultLayout)
+import Yesod.Core.Handler (notFound)
+import Yesod.Core.Widget (setTitle)
+import Yesod.Form.Functions (runFormPost)
+import Yesod.Persist.Core (runDB, getBy404)
+
+import qualified Data.Text as T (intercalate)
+
+import Vervis.Form.Ticket
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Settings (widgetFile)
+
+getTicketsR :: Text -> Text -> Handler Html
+getTicketsR shar proj = notFound
+
+postTicketsR :: Text -> Text -> Handler Html
+postTicketsR shar proj = notFound
+
+getTicketNewR :: Text -> Text -> Handler Html
+getTicketNewR shar proj = do
+    Entity pid project <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        getBy404 $ UniqueProject proj sid
+    let next = projectNextTicket project
+    ((_result, widget), enctype) <- runFormPost $ newTicketForm pid next
+    defaultLayout $ do
+        setTitle $ toHtml $ T.intercalate " :: " [shar, proj, "New ticket"]
+        $(widgetFile "ticket/new")

src/Vervis/Handler/Util.hs

@@ -18,7 +18,7 @@ module Vervis.Handler.Util
     )
 where
 
-import Vervis.Import
+import Vervis.Import hiding (loggedIn)
 
 loggedIn :: Handler Bool
 loggedIn = isJust <$> maybeAuthId

templates/ticket/new.hamlet

@@ -0,0 +1,21 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<h1>#{shar} :: #{proj} :: New ticket
+
+Enter the details and click "Submit" to create a new ticket.
+
+<form method=POST action=@{TicketsR shar proj} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

vervis.cabal

@@ -70,6 +70,7 @@ library
                        Vervis.Handler.Person
                        Vervis.Handler.Project
                        Vervis.Handler.Repo
+                       Vervis.Handler.Ticket
                        Vervis.Handler.Util
                        Vervis.Path
                        Vervis.Ssh