Per-sharer ticket workflows

A workflow is a new entity in Vervis. It defines the workflow of a
projects' ticket system. That includes the possible ticket states,
custom ticket fields, various filters and so on. All ticket system
customization is currently planned to be managed using workflows.

Currently workflows are private and per sharer, but the plan is to
support public workflows that can be shared and cloned.

config/models

@@ -153,6 +153,15 @@ Repo
 
     UniqueRepo ident sharer
 
+Workflow
+    sharer SharerId
+    ident  WflIdent
+    name   Text          Maybe
+    desc   Text          Maybe
+    -- scope  WorkflowScope       -- sharer / public / featured
+
+    UniqueWorkflow sharer ident
+
 Ticket
     project  ProjectId
     number   Int

config/routes

@@ -92,6 +92,14 @@
 /s/#ShrIdent/p/#PrjIdent/d/!new              ProjectDevNewR        GET
 /s/#ShrIdent/p/#PrjIdent/d/#ShrIdent         ProjectDevR           GET DELETE POST
 
+-- /w                                           GlobalWorkflowsR      GET POST
+-- /w/!new                                      GlobalWorkflowNewR    GET
+-- /w/#WflIdent                                 GlobalWorkflowR       GET DELETE POST
+
+/s/#ShrIdent/w                               WorkflowsR            GET POST
+/s/#ShrIdent/w/!new                          WorkflowNewR          GET
+/s/#ShrIdent/w/#WflIdent                     WorkflowR             GET DELETE POST
+
 /s/#ShrIdent/p/#PrjIdent/t                   TicketsR              GET POST
 /s/#ShrIdent/p/#PrjIdent/t/!tree             TicketTreeR           GET
 /s/#ShrIdent/p/#PrjIdent/t/!new              TicketNewR            GET

src/Vervis/Application.hs

@@ -63,6 +63,7 @@ import Vervis.Handler.Role
 import Vervis.Handler.Sharer
 import Vervis.Handler.Ticket
 import Vervis.Handler.Wiki
+import Vervis.Handler.Workflow
 
 import Vervis.Ssh (runSsh)
 

src/Vervis/Field/Workflow.hs

@@ -0,0 +1,58 @@
+{- 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.Field.Workflow
+    ( newWorkflowIdentField
+    )
+where
+
+import Vervis.Import hiding ((==.))
+
+import Data.Char (isDigit)
+import Data.Char.Local (isAsciiLetter)
+import Data.Text (split)
+import Database.Esqueleto
+
+import Vervis.Model.Ident (WflIdent, wfl2text, text2wfl)
+
+checkTemplate :: Field Handler Text -> Field Handler Text
+checkTemplate =
+    let charOk c = isAsciiLetter c || isDigit c
+        wordOk w = (not . null) w && all charOk w
+        identOk t = (not . null) t && all wordOk (split (== '-') t)
+        msg :: Text
+        msg =
+            "The workflow identifier must be a sequence of one or more words \
+            \separated by hyphens (‘-’), and each such word may contain \
+            \ASCII letters and digits."
+    in  checkBool identOk msg
+
+checkUniqueCI :: SharerId -> Field Handler WflIdent -> Field Handler WflIdent
+checkUniqueCI sid = checkM $ \ wfl -> do
+    sames <- runDB $ select $ from $ \ workflow -> do
+        where_ $
+            workflow ^. WorkflowSharer ==. val sid &&.
+            lower_ (workflow ^. WorkflowIdent) ==. lower_ (val wfl)
+        limit 1
+        return ()
+    return $ if null sames
+        then Right wfl
+        else Left ("You already have a workflow by that name" :: Text)
+
+workflowIdentField :: Field Handler WflIdent
+workflowIdentField = convertField text2wfl wfl2text $ checkTemplate textField
+
+newWorkflowIdentField :: SharerId -> Field Handler WflIdent
+newWorkflowIdentField sid = checkUniqueCI sid workflowIdentField

src/Vervis/Form/Workflow.hs

@@ -0,0 +1,45 @@
+{- 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.Form.Workflow
+    ( NewWorkflow (..)
+    , newWorkflowForm
+    )
+where
+
+import Vervis.Import hiding (on, isNothing)
+
+import Database.Esqueleto hiding ((==.))
+
+import qualified Database.Esqueleto as E ((==.))
+
+import Vervis.Field.Workflow
+import Vervis.Model
+import Vervis.Model.Ident
+
+data NewWorkflow = NewWorkflow
+    { nwIdent :: WflIdent
+    , nwName  :: Maybe Text
+    , nwDesc  :: Maybe Text
+    }
+
+newWorkflowAForm :: SharerId -> AForm Handler NewWorkflow
+newWorkflowAForm sid = NewWorkflow
+    <$> areq (newWorkflowIdentField sid) "Identifier*" Nothing
+    <*> aopt textField                   "Name"        Nothing
+    <*> aopt textField                   "Description" Nothing
+
+newWorkflowForm :: SharerId -> Form NewWorkflow
+newWorkflowForm sid = renderDivs $ newWorkflowAForm sid

src/Vervis/Foundation.hs

@@ -161,6 +161,14 @@ instance Yesod App where
         (ProjectDevNewR shr _prj   , _   ) -> person shr
         (ProjectDevR shr _prj _dev , _   ) -> person shr
 
+--      (GlobalWorkflowsR          , _   ) -> serverAdmin
+--      (GlobalWorkflowNewR        , _   ) -> serverAdmin
+--      (GlobalWorkflowR _wfl      , _   ) -> serverAdmin
+
+        (WorkflowsR shr            , _   ) -> personOrGroupAdmin shr
+        (WorkflowNewR shr          , _   ) -> personOrGroupAdmin shr
+        (WorkflowR shr _wfl        , _   ) -> personOrGroupAdmin shr
+
         (TicketsR shar _           , True) -> person shar
         (TicketNewR _ _            , _   ) -> personAny
         (TicketR user _ _          , True) -> person user
@@ -186,6 +194,9 @@ instance Yesod App where
         nobody :: Handler AuthResult
         nobody = return $ Unauthorized "This operation is currently disabled"
 
+        serverAdmin :: Handler AuthResult
+        serverAdmin = nobody
+
         personAnd
             :: (Entity Person -> Handler AuthResult) -> Handler AuthResult
         personAnd f = do
@@ -452,6 +463,12 @@ instance YesodBreadcrumbs App where
                                             , Just $ ProjectDevsR shr prj
                                             )
 
+        WorkflowsR shr                   -> ("Workflows", Just $ SharerR shr)
+        WorkflowNewR shr                 -> ("New", Just $ WorkflowsR shr)
+        WorkflowR shr wfl                -> ( wfl2text wfl
+                                            , Just $ WorkflowsR shr
+                                            )
+
         TicketsR shar proj               -> ( "Tickets"
                                             , Just $ ProjectR shar proj
                                             )

src/Vervis/Handler/Workflow.hs

@@ -0,0 +1,97 @@
+{- 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.Workflow
+    ( getWorkflowsR
+    , postWorkflowsR
+    , getWorkflowNewR
+    , getWorkflowR
+    , deleteWorkflowR
+    , postWorkflowR
+    )
+where
+
+import Prelude
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Database.Persist
+import Text.Blaze.Html (Html)
+import Yesod.Auth (requireAuthId)
+import Yesod.Core (defaultLayout)
+import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
+import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Types (FormResult (..))
+import Yesod.Persist.Core (runDB, getBy404)
+
+import Vervis.Form.Workflow
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Model.Ident
+import Vervis.Settings
+import Vervis.Widget.Sharer
+
+getWorkflowsR :: ShrIdent -> Handler Html
+getWorkflowsR shr = do
+    ws <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        selectList [WorkflowSharer ==. sid] []
+    defaultLayout $(widgetFile "workflow/list")
+
+postWorkflowsR :: ShrIdent -> Handler Html
+postWorkflowsR shr = do
+    Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
+    ((result, widget), enctype) <- runFormPost $ newWorkflowForm sid
+    case result of
+        FormSuccess nw -> do
+            let workflow = Workflow
+                    { workflowSharer = sid
+                    , workflowIdent  = nwIdent nw
+                    , workflowName   = nwName nw
+                    , workflowDesc   = nwDesc nw
+                    }
+            runDB $ insert_ workflow
+            setMessage "Workflow added."
+            redirect $ WorkflowR shr (nwIdent nw)
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "workflow/new")
+        FormFailure _l -> do
+            setMessage "Workflow creation failed, see below"
+            defaultLayout $(widgetFile "workflow/new")
+
+getWorkflowNewR :: ShrIdent -> Handler Html
+getWorkflowNewR shr = do
+    Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
+    ((_result, widget), enctype) <- runFormPost $ newWorkflowForm sid
+    defaultLayout $(widgetFile "workflow/new")
+
+getWorkflowR :: ShrIdent -> WflIdent -> Handler Html
+getWorkflowR shr wfl = do
+    w <- runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharer shr
+        Entity _wid w <- getBy404 $ UniqueWorkflow sid wfl
+        return w
+    defaultLayout $(widgetFile "workflow/one")
+
+deleteWorkflowR :: ShrIdent -> WflIdent -> Handler Html
+deleteWorkflowR shr wfl = error "Not implemented, not sure whether to allow it"
+
+postWorkflowR :: ShrIdent -> WflIdent -> Handler Html
+postWorkflowR shr wfl = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "DELETE" -> deleteWorkflowR shr wfl
+        _             -> notFound

src/Vervis/Model/Ident.hs

@@ -31,6 +31,9 @@ module Vervis.Model.Ident
     , RpIdent (..)
     , rp2text
     , text2rp
+    , WflIdent (..)
+    , wfl2text
+    , text2wfl
     )
 where
 
@@ -99,3 +102,13 @@ rp2text = CI.original . unRpIdent
 
 text2rp :: Text -> RpIdent
 text2rp = RpIdent . CI.mk
+
+newtype WflIdent = WflIdent { unWflIdent :: CI Text }
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+wfl2text :: WflIdent -> Text
+wfl2text = CI.original . unWflIdent
+
+text2wfl :: Text -> WflIdent
+text2wfl = WflIdent . CI.mk

templates/workflow/list.hamlet

@@ -0,0 +1,22 @@
+$# 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/>.
+
+<ul>
+  $forall Entity _wid w <- ws
+    <li>
+      <a href=@{WorkflowR shr $ workflowIdent w}>
+        $maybe name <- workflowName w
+          #{name}
+        $nothing
+          #{wfl2text $ workflowIdent w}

templates/workflow/new.hamlet

@@ -0,0 +1,17 @@
+$# 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/>.
+
+<form method="POST" action=@{WorkflowsR shr} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

templates/workflow/one.hamlet

@@ -0,0 +1,24 @@
+$# 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/>.
+
+<p>
+  <form method="POST" action=@{WorkflowR shr wfl}>
+    <input type="hidden" name="_method" value="DELETE">
+    <input type="submit" value="Delete this workflow">
+
+<ul>
+  <li>
+    Human-friendly name: #{fromMaybe "(none)" $ workflowName w}
+  <li>
+    Description: #{fromMaybe "(none)" $ workflowDesc w}

vervis.cabal

@@ -108,6 +108,7 @@ library
                        Vervis.Field.Role
                        Vervis.Field.Sharer
                        Vervis.Field.Ticket
+                       Vervis.Field.Workflow
                        Vervis.Form.Discussion
                        Vervis.Form.Group
                        Vervis.Form.Key
@@ -116,6 +117,7 @@ library
                        Vervis.Form.Repo
                        Vervis.Form.Role
                        Vervis.Form.Ticket
+                       Vervis.Form.Workflow
                        Vervis.Formatting
                        Vervis.Foundation
                        Vervis.Git
@@ -136,6 +138,7 @@ library
                        Vervis.Handler.Sharer
                        Vervis.Handler.Ticket
                        Vervis.Handler.Wiki
+                       Vervis.Handler.Workflow
                        Vervis.Import
                        Vervis.Import.NoFoundation
                        Vervis.MediaType