From 687aa68a04f1c5292382d87780e36c502397d23d Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 8 Aug 2016 11:05:19 +0000 Subject: [PATCH] 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 | 9 ++++ config/routes | 8 +++ src/Vervis/Application.hs | 1 + src/Vervis/Field/Workflow.hs | 58 ++++++++++++++++++++ src/Vervis/Form/Workflow.hs | 45 ++++++++++++++++ src/Vervis/Foundation.hs | 17 ++++++ src/Vervis/Handler/Workflow.hs | 97 ++++++++++++++++++++++++++++++++++ src/Vervis/Model/Ident.hs | 13 +++++ templates/workflow/list.hamlet | 22 ++++++++ templates/workflow/new.hamlet | 17 ++++++ templates/workflow/one.hamlet | 24 +++++++++ vervis.cabal | 3 ++ 12 files changed, 314 insertions(+) create mode 100644 src/Vervis/Field/Workflow.hs create mode 100644 src/Vervis/Form/Workflow.hs create mode 100644 src/Vervis/Handler/Workflow.hs create mode 100644 templates/workflow/list.hamlet create mode 100644 templates/workflow/new.hamlet create mode 100644 templates/workflow/one.hamlet diff --git a/config/models b/config/models index f48cf19..bf21d84 100644 --- a/config/models +++ b/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 diff --git a/config/routes b/config/routes index 29a9b8d..c78f900 100644 --- a/config/routes +++ b/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 diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 79a75a4..b95b96c 100644 --- a/src/Vervis/Application.hs +++ b/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) diff --git a/src/Vervis/Field/Workflow.hs b/src/Vervis/Field/Workflow.hs new file mode 100644 index 0000000..28a8967 --- /dev/null +++ b/src/Vervis/Field/Workflow.hs @@ -0,0 +1,58 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +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 diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs new file mode 100644 index 0000000..1bbfd25 --- /dev/null +++ b/src/Vervis/Form/Workflow.hs @@ -0,0 +1,45 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index b76ccef..525bc25 100644 --- a/src/Vervis/Foundation.hs +++ b/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 ) diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs new file mode 100644 index 0000000..2abd2e2 --- /dev/null +++ b/src/Vervis/Handler/Workflow.hs @@ -0,0 +1,97 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +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 diff --git a/src/Vervis/Model/Ident.hs b/src/Vervis/Model/Ident.hs index 1bdf8bc..5d683a5 100644 --- a/src/Vervis/Model/Ident.hs +++ b/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 diff --git a/templates/workflow/list.hamlet b/templates/workflow/list.hamlet new file mode 100644 index 0000000..4016bc8 --- /dev/null +++ b/templates/workflow/list.hamlet @@ -0,0 +1,22 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +