From 60d9706fe6d0e6cef0b34e0c4926380d9f55d502 Mon Sep 17 00:00:00 2001 From: Saku Laesvuori Date: Mon, 10 Apr 2023 11:37:43 +0300 Subject: [PATCH] Require phone number to register --- Client/FormFields.hs | 17 ++++++++++++++++- Client/Handlers/Applications.hs | 4 ++++ Client/Handlers/Apply.hs | 12 ++++-------- Client/Handlers/Profile.hs | 23 ++++++++++++++++------- Server/API.hs | 7 ++++++- Server/DB/Queries.hs | 2 ++ Server/Types.hs | 33 +++++++++++++++++++++++++++++++++ schema.gql | 7 +++++-- 8 files changed, 86 insertions(+), 19 deletions(-) diff --git a/Client/FormFields.hs b/Client/FormFields.hs index a611111..2e5fb15 100644 --- a/Client/FormFields.hs +++ b/Client/FormFields.hs @@ -21,7 +21,22 @@ emailField = Field , fieldView = \id name otherAttributes result isRequired -> let result' = either (\x -> x) renderEmail result in [whamlet| - + + |] + , fieldEnctype = UrlEncoded + } + +telephoneField :: Field Handler PhoneNumber +telephoneField = Field + { fieldParse = \rawValues _ -> + case rawValues of + [] -> pure $ Right Nothing + [x] -> pure $ maybe (Left "could not parse as a phone number") (Right . Just) $ toPhoneNumber x + _ -> pure $ Left $ "Expected one value" + , fieldView = \id name otherAttributes result isRequired -> + let result' = either (\x -> x) renderPhoneNumber result + in [whamlet| + |] , fieldEnctype = UrlEncoded } diff --git a/Client/Handlers/Applications.hs b/Client/Handlers/Applications.hs index 890970f..8708366 100644 --- a/Client/Handlers/Applications.hs +++ b/Client/Handlers/Applications.hs @@ -31,6 +31,7 @@ query Applications { name nickname email + phoneNumber homeplace birthdate application @@ -85,6 +86,9 @@ applicationsW applications = do Sähköposti #{renderEmail $ fromJust $ email} + + Puhelinnumero + #{renderPhoneNumber $ phoneNumber} $maybe route <- acceptRoute
^{widget} diff --git a/Client/Handlers/Apply.hs b/Client/Handlers/Apply.hs index 0f2ebe2..0645b23 100644 --- a/Client/Handlers/Apply.hs +++ b/Client/Handlers/Apply.hs @@ -25,16 +25,10 @@ import Data.Time (Day) declareLocalTypesInline "schema.gql" [raw| mutation Apply($name: String!, $nickname: String, $homeplace: String!, - $birthdate: Date!, $email: Email!, $password: String!, $application: String!) { + $birthdate: Date!, $email: Email!, $phoneNumber: PhoneNumber!, $password: String!, $application: String!) { apply(email: $email, password: $password, name: $name, nickname: $nickname, - birthdate: $birthdate, homeplace: $homeplace, application: $application) { + birthdate: $birthdate, homeplace: $homeplace, application: $application, phoneNumber: $phoneNumber) { id - name - nickname - email - pendingEmail - homeplace - birthdate } } |] @@ -46,6 +40,7 @@ applyForm = renderDivs $ ApplyArgs <*> areq textField homeplaceSettings Nothing <*> areq dayField' birthdateSettings Nothing <*> areq emailField emailSettings Nothing + <*> areq telephoneField phoneSettings Nothing <*> areq verifiedPasswordField "Salasana" Nothing <*> areq textareaField' applicationSettings Nothing where dayField' :: Field Handler Date @@ -58,6 +53,7 @@ applyForm = renderDivs $ ApplyArgs homeplaceSettings = "Kotipaikka" {fsAttrs = [("placeholder","Espoo")]} birthdateSettings = "Syntymäaika" {fsAttrs = [("placeholder","2000-01-01")]} emailSettings = "Sähköposti" {fsAttrs = [("placeholder","erkki.juhani@esimerkki.fi")]} + phoneSettings = "Puhelinnumero" {fsAttrs = [("placeholder","+358 12 34567890")]} applicationSettings = "Hakemus (eli miksi olet data)" {fsAttrs = [("placeholder","Aloitin opiskelun Otaniemen datalla vuonna 2020.")]} diff --git a/Client/Handlers/Profile.hs b/Client/Handlers/Profile.hs index 910b47a..da7d451 100644 --- a/Client/Handlers/Profile.hs +++ b/Client/Handlers/Profile.hs @@ -32,14 +32,15 @@ query ProfilePage($id: UserID) { pendingEmail homeplace birthdate + phoneNumber } permissions } |] declareLocalTypesInline "schema.gql" [raw| -mutation UpdateProfile($user: UserID, $name: String, $homeplace: String, $nickname: String, $email: Email) { - update(user: $user, name: $name, homeplace: $homeplace, nickname: $nickname, email: $email) { +mutation UpdateProfile($user: UserID, $name: String, $homeplace: String, $nickname: String, $email: Email, $phoneNumber: PhoneNumber) { + update(user: $user, name: $name, homeplace: $homeplace, nickname: $nickname, email: $email, phoneNumber: $phoneNumber) { id } } @@ -58,11 +59,18 @@ passwordForm = renderDivs $ areq verifiedPasswordField "Uusi salasana" Nothing profileForm :: (Maybe UserID) -> (Maybe ProfilePageUser) -> Form UpdateProfileArgs profileForm userID user extraHtml = do - (nameRes, nameView) <- mopt textField "Nimi" (Just $ maybe Nothing (\x -> Just $ name (x ::ProfilePageUser)) user) - (homeRes, homeView) <- mopt textField "Kotipaikka" (Just $ maybe Nothing (\x -> Just $ homeplace (x :: ProfilePageUser)) user) - (nicknameRes, nicknameView) <- mopt textField "Kutsumanimi" (Just $ maybe Nothing (\x -> Just $ nickname (x :: ProfilePageUser)) user) - (emailRes, emailView) <- mopt emailField "Sähköposti" (maybe Nothing (\x -> Just $ email (x :: ProfilePageUser)) user) - let profileUpdateRes = UpdateProfileArgs userID <$> nameRes <*> homeRes <*> nicknameRes <*> emailRes + (nameRes, nameView) <- mopt textField "Nimi" + (Just $ maybe Nothing (\x -> Just $ name (x :: ProfilePageUser)) user) + (homeRes, homeView) <- mopt textField "Kotipaikka" + (Just $ maybe Nothing (\x -> Just $ homeplace (x :: ProfilePageUser)) user) + (nicknameRes, nicknameView) <- mopt textField "Kutsumanimi" + (Just $ maybe Nothing (\x -> Just $ nickname (x :: ProfilePageUser)) user) + (emailRes, emailView) <- mopt emailField "Sähköposti" + (maybe Nothing (\x -> Just $ email (x :: ProfilePageUser)) user) + (phoneNumberRes, phoneNumberView) <- mopt telephoneField "Puhelinnumero" + (Just $ maybe Nothing (\x -> Just $ phoneNumber (x :: ProfilePageUser)) user) + let profileUpdateRes = UpdateProfileArgs userID <$> + nameRes <*> homeRes <*> nicknameRes <*> emailRes <*> phoneNumberRes maybePendingEmail = user >>= \x -> pendingEmail (x :: ProfilePageUser) inputField FieldView {..} = [whamlet|