1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-12 00:35:08 +09:00
vervis/src/Vervis/Field/Role.hs
fr33domlover c0965a4c47 Default roles for repos and turn user/anon collab tables into proj/repo fields
* Repo collab now supports basic default roles developer/user/guest like
  project collab does
* User/Anon collab for repos and projects are now stored as fields instead of
  in dedicated tables, there was never a need for dedicated tables but I didn't
  see that before
* Repo push op is now part of `ProjectOperation`
* `RepoRole` and related code has been entirely removed, only project roles
  remain and they're used for both repos and projects
* This is the first not-totally-trivial DB migration in Vervis, it's automatic
  but please be careful and report errors
2019-01-29 22:24:32 +00:00

70 lines
2.3 KiB
Haskell

{- 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
( newProjectRoleIdentField
, newProjectOpField
)
where
import Prelude
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 Vervis.Foundation (Handler, AppDB)
import Vervis.Model
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
import Vervis.Model.Role
roleIdentField :: Field Handler RlIdent
roleIdentField = convertField text2rl rl2text textField
newProjectRoleIdentField :: SharerId -> Field Handler RlIdent
newProjectRoleIdentField sid = checkUniqueCI roleIdentField
where
checkUniqueCI :: Field Handler RlIdent -> Field Handler RlIdent
checkUniqueCI = checkM $ \ rl -> do
sames <- runDB $ select $ from $ \ role -> do
where_ $
role ^. ProjectRoleSharer ==. val sid &&.
lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl)
limit 1
return ()
return $ if null sames
then Right rl
else Left ("This role name is already in use" :: Text)
newProjectOpField :: AppDB ProjectRoleId -> Field Handler ProjectOperation
newProjectOpField getrid = checkOpNew getrid opField
where
opField :: Field Handler ProjectOperation
opField = selectField optionsEnum
checkOpNew
:: AppDB ProjectRoleId
-> Field Handler ProjectOperation
-> Field Handler ProjectOperation
checkOpNew getrid = checkM $ \ op -> do
ma <- runDB $ do
rid <- getrid
getBy $ UniqueProjectAccess rid op
return $ case ma of
Nothing -> Right op
Just _ -> Left ("Role already has this operation" :: Text)