101 lines
4.0 KiB
Haskell
101 lines
4.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
|
|
|
module Utils.Users
|
|
( AuthenticationKind(..)
|
|
, AddUserData(..)
|
|
, addNewUser
|
|
) where
|
|
|
|
import Import
|
|
|
|
data AuthenticationKind = AuthKindLDAP | AuthKindPWHash | AuthKindNoLogin
|
|
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Universe, Finite)
|
|
--instance Universe AuthenticationKind
|
|
--instance Finite AuthenticationKind
|
|
embedRenderMessage ''UniWorX ''AuthenticationKind id
|
|
nullaryPathPiece ''AuthenticationKind $ camelToPathPiece' 2
|
|
|
|
mkAuthMode :: AuthenticationKind -> AuthenticationMode
|
|
mkAuthMode AuthKindLDAP = AuthLDAP
|
|
mkAuthMode AuthKindPWHash = AuthPWHash ""
|
|
mkAuthMode AuthKindNoLogin = AuthNoLogin
|
|
|
|
{-
|
|
classifyAuth :: AuthenticationMode -> AuthenticationKind
|
|
classifyAuth AuthLDAP = AuthKindLDAP
|
|
classifyAuth AuthPWHash{} = AuthKindPWHash
|
|
classifyAuth AuthNoLogin = AuthKindNoLogin
|
|
-}
|
|
|
|
data AddUserData = AddUserData
|
|
{ audTitle :: Maybe Text
|
|
, audFirstName :: Text
|
|
, audSurname :: UserSurname
|
|
, audDisplayName :: UserDisplayName
|
|
, audDisplayEmail :: UserEmail
|
|
, audMatriculation :: Maybe UserMatriculation
|
|
, audSex :: Maybe Sex
|
|
, audBirthday :: Maybe Day
|
|
, audMobile :: Maybe Text
|
|
, audTelephone :: Maybe Text
|
|
, audFPersonalNumber :: Maybe Text
|
|
, audFDepartment :: Maybe Text
|
|
, audPostAddress :: Maybe StoredMarkup
|
|
, audPrefersPostal :: Bool
|
|
, audPinPassword :: Maybe Text
|
|
, audEmail :: UserEmail
|
|
, audIdent :: UserIdent
|
|
, audAuth :: AuthenticationKind
|
|
}
|
|
|
|
-- | Adds a new user to database, no background jobs are scheduled, no notifications send
|
|
addNewUser :: AddUserData -> Handler (Maybe UserId)
|
|
addNewUser AddUserData{..} = do
|
|
now <- liftIO getCurrentTime
|
|
UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
|
|
let
|
|
newUser = User
|
|
{ userIdent = audIdent
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = userDefaultTheme
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userShowSex = userDefaultShowSex
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
, userNotificationSettings = def
|
|
, userLanguages = Nothing
|
|
, userCsvOptions = def
|
|
, userTokensIssuedAfter = Nothing
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = audFPersonalNumber
|
|
, userLastAuthentication = Nothing
|
|
, userEmail = audEmail
|
|
, userDisplayName = audDisplayName
|
|
, userDisplayEmail = audDisplayEmail
|
|
, userFirstName = audFirstName
|
|
, userSurname = audSurname
|
|
, userTitle = audTitle
|
|
, userSex = audSex
|
|
, userBirthday = audBirthday
|
|
, userMobile = audMobile
|
|
, userTelephone = audTelephone
|
|
, userCompanyPersonalNumber = audFPersonalNumber
|
|
, userCompanyDepartment = audFDepartment
|
|
, userPostAddress = audPostAddress
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = audPrefersPostal
|
|
, userPinPassword = audPinPassword
|
|
, userMatrikelnummer = audMatriculation
|
|
, userAuthentication = mkAuthMode audAuth
|
|
}
|
|
runDB $ insertUnique newUser |