Skip to content

Instantly share code, notes, and snippets.

@rober-m
Last active September 16, 2023 09:53
Show Gist options
  • Save rober-m/3318a600b788b73d925f2f4ed171fd6f to your computer and use it in GitHub Desktop.
Save rober-m/3318a600b788b73d925f2f4ed171fd6f to your computer and use it in GitHub Desktop.
Create user in IHP
-- Web/Controller/Users.hs
action CreateUserAction = do
let user = newRecord @User
-- Get the value from the password confirmation input field.
let passwordConfirmation = param @Text "passwordConfirmation"
user
|> fill @["email", "passwordHash"]
-- We ensure that the error message doesn't include
-- the entered password.
|> validateField #passwordHash (isEqual passwordConfirmation |> withCustomErrorMessage "Passwords don't match")
|> validateField #passwordHash nonEmpty
|> validateField #email isEmail
-- After this validation, since it's operation on the IO, we'll need to use >>=.
|> validateIsUnique #email
>>= ifValid \case
Left user -> render NewView { .. }
Right user -> do
hashed <- hashPassword user.passwordHash
user <- user
|> set #passwordHash hashed
|> createRecord
setSuccessMessage "You have registered successfully"
redirectToPath "/"
-- Web/View/Layout.hs
-- Add loginButton to the navbar and add it at the end:
navbar :: Html
navbar = [hsx|
<nav class="navbar navbar-expand-lg navbar-light bg-light">
<a class="navbar-brand ms-4" href="/">Hlogger</a>
<ul class="navbar-nav ms-auto me-4">
<li class="nav-item me-4">
<a class="navbar-link btn" href={NewUserAction}>Sign In</a>
</li>
<li class="nav-item">
{ loginButton }
</li>
</ul>
</nav>
|]
where
loginButton :: Html
loginButton = case currentUserOrNothing of
Just currentUser -> [hsx|
<a class="navbar-link btn btn-primary js-delete js-delete-no-confirm" href={DeleteSessionAction}>Logout</a>
|]
Nothing -> [hsx|<a class="navbar-link btn btn-primary" href={NewSessionAction}>Login</a> |]
-- Web/View/Users/New.hs
-- Change renderForm to match this:
renderForm :: User -> Html
renderForm user = formFor user [hsx|
{(textField #email)}
{(passwordField #passwordHash) {fieldLabel = "Password", required = True}}
{(passwordField #passwordHash) { required = True, fieldLabel = "Password confirmation", fieldName = "passwordConfirmation", validatorResult = Nothing }}
{submitButton}
|]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment