{- 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.Repo ( mkIdentField ) where import Vervis.Import hiding ((==.)) import Data.Char (isDigit) import Data.Char.Local (isAsciiLetter) import Data.Text (split) import Database.Esqueleto hiding (isNothing) checkIdentTemplate :: Field Handler Text -> Field Handler Text checkIdentTemplate = 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 repo 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 -- | Make sure the repo identifier is unique. The DB schema only requires that -- a repo identifier is unique within its project, but I'd like to enforce a -- stronger condition: A repo identifier must be unique within its sharer's -- repos. I'm not yet sure it's a good thing, but it's much easier to maintain -- now and relax later, than relax now and have problems later when there are -- already conflicting names. checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text checkIdentUnique sid = checkM $ \ ident -> do l <- runDB $ select $ from $ \ (project, repo) -> do where_ $ project ^. ProjectSharer ==. val sid &&. repo ^. RepoProject ==. project ^. ProjectId &&. repo ^. RepoIdent ==. val ident limit 1 return () return $ if isNothing $ listToMaybe l then Right ident else Left ("You already have a repo by that name" :: Text) mkIdentField :: SharerId -> Field Handler Text mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField