From 5e04f951f21867b985282ab06bb7fe6d77ce6b77 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Tue, 7 Jun 2016 10:01:57 +0000
Subject: [PATCH] Ticket claim requests in DB and personal list view of them

---
 config/models                          |  8 +++++++
 config/routes                          |  2 ++
 src/Vervis/Foundation.hs               |  6 +++++
 src/Vervis/Handler/Ticket.hs           | 20 ++++++++++++++++
 templates/person/claim-requests.hamlet | 32 ++++++++++++++++++++++++++
 templates/personal-overview.hamlet     |  5 ++++
 6 files changed, 73 insertions(+)
 create mode 100644 templates/person/claim-requests.hamlet

diff --git a/config/models b/config/models
index 3ae1d5d..c087a28 100644
--- a/config/models
+++ b/config/models
@@ -132,6 +132,14 @@ Ticket
 
     UniqueTicket project number
 
+TicketClaimRequest
+    person  PersonId
+    ticket  TicketId
+    message Text
+    created UTCTime
+
+    UniqueTicketClaimRequest person ticket
+
 Discussion
     nextMessage Int
 
diff --git a/config/routes b/config/routes
index 6617559..ba2dd48 100644
--- a/config/routes
+++ b/config/routes
@@ -50,6 +50,8 @@
 /k/!new                                      KeyNewR           GET
 /k/#KyIdent                                  KeyR              GET DELETE POST
 
+/cr                                          ClaimRequestsR    GET
+
 /s/#ShrIdent/rr                              RepoRolesR        GET POST
 /s/#ShrIdent/rr/!new                         RepoRoleNewR      GET
 /s/#ShrIdent/rr/#RlIdent                     RepoRoleR         GET DELETE POST
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index f1e3339..afe531a 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -130,6 +130,8 @@ instance Yesod App where
         (KeyR _key                 , _   ) -> personAny
         (KeyNewR                   , _   ) -> personAny
 
+        (ClaimRequestsR            , _   ) -> personAny
+
         (RepoRolesR shr            , _   ) -> personOrGroupAdmin shr
         (RepoRoleNewR shr          , _   ) -> personOrGroupAdmin shr
         (RepoRoleR shr _rl         , _   ) -> personOrGroupAdmin shr
@@ -366,6 +368,10 @@ instance YesodBreadcrumbs App where
         KeyNewR                          -> ("New", Just KeysR)
         KeyR key                         -> (ky2text key, Just KeysR)
 
+        ClaimRequestsR                   -> ( "Ticket Claim Requests"
+                                            , Just HomeR
+                                            )
+
         RepoRolesR shr                   -> ("Repo Roles", Just $ SharerR shr)
         RepoRoleNewR shr                 -> ("New", Just $ RepoRolesR shr)
         RepoRoleR shr rl                 -> (rl2text rl, Just $ RepoRolesR shr)
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index 8249b43..a2bb85b 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -29,6 +29,7 @@ module Vervis.Handler.Ticket
     , getTicketAssignR
     , postTicketAssignR
     , postTicketUnassignR
+    , getClaimRequestsR
     , getTicketDiscussionR
     , postTicketDiscussionR
     , getTicketMessageR
@@ -385,6 +386,25 @@ postTicketUnassignR shr prj num = do
     setMessage $ fromMaybe "The ticket is now unassigned." mmsg
     redirect $ TicketR shr prj num
 
+getClaimRequestsR :: Handler Html
+getClaimRequestsR = do
+    pid <- requireAuthId
+    rqs <- runDB $ select $ from $
+        \ (tcr `InnerJoin` ticket `InnerJoin` project `InnerJoin` sharer) -> do
+            on $ project ^. ProjectSharer E.==. sharer ^. SharerId
+            on $ ticket ^. TicketProject E.==. project ^. ProjectId
+            on $ tcr ^. TicketClaimRequestTicket E.==. ticket ^. TicketId
+            where_ $ tcr ^. TicketClaimRequestPerson E.==. val pid
+            orderBy [desc $ tcr ^. TicketClaimRequestCreated]
+            return
+                ( sharer ^. SharerIdent
+                , project ^. ProjectIdent
+                , ticket ^. TicketNumber
+                , ticket ^. TicketTitle
+                , tcr ^. TicketClaimRequestCreated
+                )
+    defaultLayout $(widgetFile "person/claim-requests")
+
 selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
 selectDiscussionId shar proj tnum = do
     Entity sid _sharer <- getBy404 $ UniqueSharer shar
diff --git a/templates/person/claim-requests.hamlet b/templates/person/claim-requests.hamlet
new file mode 100644
index 0000000..2de7dfc
--- /dev/null
+++ b/templates/person/claim-requests.hamlet
@@ -0,0 +1,32 @@
+$# 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/>.
+
+<table>
+  <tr>
+    <th>Project
+    <th># 
+    <th>Title
+    <th>Created on
+  $forall (Value shr, Value prj, Value num, Value title, Value time) <- rqs
+    <tr>
+      <td>
+        <a href=@{SharerR shr}>#{shr2text shr}
+        /
+        <a href=@{ProjectR shr prj}>#{prj2text prj}
+      <td>
+        <a href=@{TicketR shr prj num}>#{num}
+      <td>
+        <a href=@{TicketR shr prj num}>#{title}
+      <td>
+        #{showDate time}
diff --git a/templates/personal-overview.hamlet b/templates/personal-overview.hamlet
index 59abe74..d9a7e32 100644
--- a/templates/personal-overview.hamlet
+++ b/templates/personal-overview.hamlet
@@ -40,3 +40,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <p>
   <a href=@{ProjectRolesR ident}>Project roles
+
+<h2>Ticket claim requests
+
+<p>
+  <a href=@{ClaimRequestsR}>Ticket claim requests