New sharer ident checked for CI-uniqueness

This commit is contained in:
fr33domlover 2016-05-22 21:24:55 +00:00
parent 1a3f976a81
commit a0d42f9159

View file

@ -19,9 +19,11 @@ module Vervis.Field.Person
) )
where where
import Vervis.Import import Vervis.Import hiding ((==.))
import Data.Char (isDigit) import Data.Char (isDigit)
import Database.Esqueleto
import Data.Char.Local (isAsciiLetter) import Data.Char.Local (isAsciiLetter)
checkLoginTemplate :: Field Handler Text -> Field Handler Text checkLoginTemplate :: Field Handler Text -> Field Handler Text
@ -40,13 +42,12 @@ checkLoginTemplate =
in checkBool ok msg in checkBool ok msg
checkLoginUnique :: Field Handler Text -> Field Handler Text checkLoginUnique :: Field Handler Text -> Field Handler Text
checkLoginUnique = checkM $ \ login -> runDB $ do checkLoginUnique = checkM $ \ login -> do
let sharer = Sharer sames <- runDB $ select $ from $ \ sharer -> do
{ sharerIdent = login where_ $ lower_ (sharer ^. SharerIdent) ==. lower_ (val login)
, sharerName = Nothing limit 1
} return ()
mus <- checkUnique sharer return $ if null sames
return $ if isNothing mus
then Right login then Right login
else Left ("This username is already in use" :: Text) else Left ("This username is already in use" :: Text)
@ -63,7 +64,7 @@ checkPassLength =
\alternative, such as a client TLS certificate, that can work \ \alternative, such as a client TLS certificate, that can work \
\somewhat like SSH and GPG keys." \somewhat like SSH and GPG keys."
minlen = 8 minlen = 8
in checkBool ((>= minlen) . length) msg in checkBool ((>= minlen) . length) msg
passConfirmField :: Field Handler Text passConfirmField :: Field Handler Text
passConfirmField = Field passConfirmField = Field