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 +$# . + +