Initial minimal limited per-repo RBAC system

config/models

@@ -53,6 +53,26 @@ GroupMember
 
     UniqueGroupMember person group
 
+Role
+    ident  RlIdent
+    person PersonId
+    desc   Text
+
+    UniqueRole person ident
+
+Access
+    role RoleId
+    op   Operation
+
+    UniqueAccess role op
+
+Collab
+    repo   RepoId
+    person PersonId
+    role   RoleId
+
+    UniqueCollab repo person
+
 -------------------------------------------------------------------------------
 -- Projects
 -------------------------------------------------------------------------------

config/routes

@@ -50,6 +50,12 @@
 /k/!new                                      KeyNewR           GET
 /k/#KyIdent                                  KeyR              GET DELETE POST
 
+/r                                           RolesR            GET POST
+/r/!new                                      RoleNewR          GET
+/r/#RlIdent                                  RoleR             GET DELETE POST
+/r/#RlIdent/a                                RoleOpsR          GET POST
+/r/#RlIdent/a/!new                           RoleOpNewR        GET
+
 -- ----------------------------------------------------------------------------
 -- Projects
 -- ----------------------------------------------------------------------------

src/Vervis/Application.hs

@@ -59,6 +59,7 @@ import Vervis.Handler.Key
 import Vervis.Handler.Person
 import Vervis.Handler.Project
 import Vervis.Handler.Repo
+import Vervis.Handler.Role
 import Vervis.Handler.Sharer
 import Vervis.Handler.Ticket
 

src/Vervis/Field/Role.hs

@@ -0,0 +1,75 @@
+{- 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.Role
+    ( newRoleIdentField
+    , newOpField
+    )
+where
+
+import Prelude
+
+-- import Control.Monad (void)
+-- import Control.Monad.Trans.Maybe
+-- import Data.Char (isDigit)
+-- import Data.Maybe (isNothing, isJust)
+import Data.Text (Text)
+import Database.Esqueleto
+import Yesod.Form.Fields (textField, selectField, optionsEnum)
+import Yesod.Form.Functions (checkM, convertField)
+import Yesod.Form.Types (Field)
+import Yesod.Persist.Core (runDB)
+
+-- import qualified Data.Text as T (null, all, find, split)
+
+-- import Data.Char.Local (isAsciiLetter)
+import Vervis.Foundation (Handler, AppDB)
+import Vervis.Model
+import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
+import Vervis.Model.Role
+
+checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
+checkUniqueCI pid = checkM $ \ rl -> do
+    sames <- runDB $ select $ from $ \ role -> do
+        where_ $
+            role ^. RolePerson         ==. val pid         &&.
+            lower_ (role ^. RoleIdent) ==. lower_ (val rl)
+        limit 1
+        return ()
+    return $ if null sames
+        then Right rl
+        else Left ("This role name is already in use" :: Text)
+
+roleIdentField :: Field Handler RlIdent
+roleIdentField = convertField text2rl rl2text textField
+
+newRoleIdentField :: PersonId -> Field Handler RlIdent
+newRoleIdentField pid = checkUniqueCI pid roleIdentField
+
+opField :: Field Handler Operation
+opField = selectField optionsEnum
+
+checkOpNew
+    :: AppDB RoleId -> Field Handler Operation -> Field Handler Operation
+checkOpNew getrid = checkM $ \ op -> do
+    ma <- runDB $ do
+        rid <- getrid
+        getBy $ UniqueAccess rid op
+    return $ case ma of
+        Nothing -> Right op
+        Just _  -> Left ("Role already has this operation" :: Text)
+
+newOpField :: AppDB RoleId -> Field Handler Operation
+newOpField getrid = checkOpNew getrid opField

src/Vervis/Form/Role.hs

@@ -0,0 +1,53 @@
+{- 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.Role
+    ( NewRole (..)
+    , newRoleForm
+    , newRoleOpForm
+    )
+where
+
+import Prelude
+
+import Data.Text (Text)
+import Yesod.Form.Fields (textField)
+import Yesod.Form.Functions (areq, renderDivs)
+import Yesod.Form.Types (AForm)
+
+import Vervis.Field.Role
+import Vervis.Foundation (Handler, Form, AppDB)
+import Vervis.Model
+import Vervis.Model.Ident (RlIdent)
+import Vervis.Model.Role
+
+data NewRole = NewRole
+    { nrIdent :: RlIdent
+    , nrDesc  :: Text
+    }
+
+newRoleAForm :: PersonId -> AForm Handler NewRole
+newRoleAForm pid = NewRole
+    <$> areq (newRoleIdentField pid) "Name*"       Nothing
+    <*> areq textField               "Description" Nothing
+
+newRoleForm :: PersonId -> Form NewRole
+newRoleForm pid = renderDivs $ newRoleAForm pid
+
+newRoleOpAForm :: AppDB RoleId -> AForm Handler Operation
+newRoleOpAForm getrid = areq (newOpField getrid) "Operation*" Nothing
+
+newRoleOpForm :: AppDB RoleId -> Form Operation
+newRoleOpForm getrid = renderDivs $ newRoleOpAForm getrid

src/Vervis/Foundation.hs

@@ -129,6 +129,12 @@ instance Yesod App where
         (KeyR _key               , _   ) -> personAny
         (KeyNewR                 , _   ) -> personAny
 
+        (RolesR                  , _   ) -> personAny
+        (RoleNewR                , _   ) -> personAny
+        (RoleR _rl               , _   ) -> personAny
+        (RoleOpsR _rl            , _   ) -> personAny
+        (RoleOpNewR _rl          , _   ) -> personAny
+
         (ReposR shar             , True) -> person shar
         (RepoNewR user           , _   ) -> person user
         (RepoR shar _            , True) -> person shar
@@ -283,11 +289,21 @@ instance YesodBreadcrumbs App where
         GroupNewR                        -> ("New", Just GroupsR)
         GroupR shar                      -> (shr2text shar, Just GroupsR)
         GroupMembersR shar               -> ("Members", Just $ GroupR shar)
+        GroupMemberNewR shar             -> ("New", Just $ GroupMembersR shar)
+        GroupMemberR grp memb            -> ( shr2text memb
+                                            , Just $ GroupMembersR grp
+                                            )
 
         KeysR                            -> ("Keys", Just HomeR)
         KeyNewR                          -> ("New", Just KeysR)
         KeyR key                         -> (ky2text key, Just KeysR)
 
+        RolesR                           -> ("Roles", Just HomeR)
+        RoleNewR                         -> ("New", Just RolesR)
+        RoleR rl                         -> (rl2text rl, Just RolesR)
+        RoleOpsR rl                      -> ("Operations", Just $ RoleR rl)
+        RoleOpNewR rl                    -> ("New", Just $ RoleOpsR rl)
+
         ReposR shar                      -> ("Repos", Just $ PersonR shar)
         RepoNewR shar                    -> ("New", Just $ ReposR shar)
         RepoR shar repo                  -> (rp2text repo, Just $ ReposR shar)

src/Vervis/Handler/Role.hs

@@ -0,0 +1,136 @@
+{- 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.Role
+    ( getRolesR
+    , postRolesR
+    , getRoleNewR
+    , getRoleR
+    , deleteRoleR
+    , postRoleR
+    , getRoleOpsR
+    , postRoleOpsR
+    , getRoleOpNewR
+    )
+where
+
+import Prelude
+
+import Database.Persist
+import Text.Blaze.Html (Html)
+import Yesod.Auth (requireAuthId)
+import Yesod.Core (defaultLayout, setMessage)
+import Yesod.Core.Handler (lookupPostParam, notFound, redirect)
+import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Types (FormResult (..))
+import Yesod.Persist.Core (runDB, getBy404)
+
+import Vervis.Form.Role
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Model.Ident (RlIdent, rl2text)
+import Vervis.Settings (widgetFile)
+
+getRolesR :: Handler Html
+getRolesR = do
+    pid <- requireAuthId
+    roles <- runDB $ selectList [RolePerson ==. pid] []
+    defaultLayout $(widgetFile "role/list")
+
+postRolesR :: Handler Html
+postRolesR = do
+    pid <- requireAuthId
+    ((result, widget), enctype) <- runFormPost $ newRoleForm pid
+    case result of
+        FormSuccess nr -> do
+            runDB $ do
+                let role = Role
+                        { roleIdent  = nrIdent nr
+                        , rolePerson = pid
+                        , roleDesc   = nrDesc nr
+                        }
+                insert_ role
+            redirect $ RolesR
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "role/new")
+        FormFailure _l -> do
+            setMessage "Invalid input, see errors below"
+            defaultLayout $(widgetFile "role/new")
+
+getRoleNewR :: Handler Html
+getRoleNewR = do
+    pid <- requireAuthId
+    ((_result, widget), enctype) <- runFormPost $ newRoleForm pid
+    defaultLayout $(widgetFile "role/new")
+
+getRoleR :: RlIdent -> Handler Html
+getRoleR rl = do
+    pid <- requireAuthId
+    Entity _rid role <- runDB $ getBy404 $ UniqueRole pid rl
+    defaultLayout $(widgetFile "role/one")
+
+deleteRoleR :: RlIdent -> Handler Html
+deleteRoleR rl = do
+    pid <- requireAuthId
+    runDB $ do
+        Entity rid _r <- getBy404 $ UniqueRole pid rl
+        delete rid
+    setMessage "Role deleted."
+    redirect RolesR
+
+postRoleR :: RlIdent -> Handler Html
+postRoleR rl = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "DELETE" -> deleteRoleR rl
+        _             -> notFound
+
+getRoleOpsR :: RlIdent -> Handler Html
+getRoleOpsR rl = do
+    pid <- requireAuthId
+    ops <- runDB $ do
+        Entity rid _r <- getBy404 $ UniqueRole pid rl
+        map (accessOp . entityVal) <$> selectList [AccessRole ==. rid] []
+    defaultLayout $(widgetFile "role/op/list")
+
+postRoleOpsR :: RlIdent -> Handler Html
+postRoleOpsR rl = do
+    pid <- requireAuthId
+    let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl
+    ((result, widget), enctype) <- runFormPost $ newRoleOpForm getrid
+    case result of
+        FormSuccess op -> do
+            runDB $ do
+                rid <- getrid
+                let access = Access
+                        { accessRole = rid
+                        , accessOp   = op
+                        }
+                insert_ access
+            redirect $ RoleOpsR rl
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "role/op/new")
+        FormFailure _l -> do
+            setMessage "Invalid input, see errors below"
+            defaultLayout $(widgetFile "role/op/new")
+
+getRoleOpNewR :: RlIdent -> Handler Html
+getRoleOpNewR rl = do
+    pid <- requireAuthId
+    let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl
+    ((_result, widget), enctype) <- runFormPost $ newRoleOpForm getrid
+    defaultLayout $(widgetFile "role/op/new")

src/Vervis/Model.hs

@@ -27,6 +27,7 @@ import Yesod.Auth.HashDB (HashDBUser (..))
 import Vervis.Model.Group
 import Vervis.Model.Ident
 import Vervis.Model.Repo
+import Vervis.Model.Role
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities at:

src/Vervis/Model/Ident.hs

@@ -22,6 +22,9 @@ module Vervis.Model.Ident
     , KyIdent (..)
     , ky2text
     , text2ky
+    , RlIdent (..)
+    , rl2text
+    , text2rl
     , PrjIdent (..)
     , prj2text
     , text2prj
@@ -67,6 +70,16 @@ ky2text = CI.original . unKyIdent
 text2ky :: Text -> KyIdent
 text2ky = KyIdent . CI.mk
 
+newtype RlIdent = RlIdent { unRlIdent :: CI Text }
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+rl2text :: RlIdent -> Text
+rl2text = CI.original . unRlIdent
+
+text2rl :: Text -> RlIdent
+text2rl = RlIdent . CI.mk
+
 newtype PrjIdent = PrjIdent { unPrjIdent :: CI Text }
     deriving
         (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)

src/Vervis/Model/Role.hs

@@ -0,0 +1,27 @@
+{- 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.Model.Role
+    ( Operation (..)
+    )
+where
+
+import Prelude
+
+import Database.Persist.TH
+
+data Operation = OpRepoPush deriving (Eq, Show, Read, Enum, Bounded)
+
+derivePersistField "Operation"

templates/role/list.hamlet

@@ -0,0 +1,18 @@
+$# 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 _rid role <- roles
+    <li>
+      <a href=@{RoleR $ roleIdent role}>#{rl2text $ roleIdent role}

templates/role/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=@{RolesR} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

templates/role/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/>.
+
+<div>
+  <form method=POST action=@{RoleR rl}>
+    <input type=hidden name=_method value=DELETE>
+    <input type=submit value="Delete this role">
+
+<p>
+  <a href=@{RoleOpsR rl}>Operations
+
+<p>
+  #{roleDesc role}

templates/role/op/list.hamlet

@@ -0,0 +1,18 @@
+$# 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 op <- ops
+    <li>
+      #{show op}

templates/role/op/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=@{RoleOpsR rl} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

vervis.cabal

@@ -84,6 +84,7 @@ library
                        Vervis.Field.Person
                        Vervis.Field.Project
                        Vervis.Field.Repo
+                       Vervis.Field.Role
                        Vervis.Field.Sharer
                        Vervis.Form.Discussion
                        Vervis.Form.Group
@@ -91,6 +92,7 @@ library
                        Vervis.Form.Person
                        Vervis.Form.Project
                        Vervis.Form.Repo
+                       Vervis.Form.Role
                        Vervis.Form.Ticket
                        Vervis.Formatting
                        Vervis.Foundation
@@ -107,6 +109,7 @@ library
                        Vervis.Handler.Repo
                        Vervis.Handler.Repo.Darcs
                        Vervis.Handler.Repo.Git
+                       Vervis.Handler.Role
                        Vervis.Handler.Sharer
                        Vervis.Handler.Ticket
                        Vervis.Import
@@ -116,6 +119,7 @@ library
                        Vervis.Model.Group
                        Vervis.Model.Ident
                        Vervis.Model.Repo
+                       Vervis.Model.Role
                        Vervis.Paginate
                        Vervis.Path
                        Vervis.Readme