New ticket post form

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