aboutsummaryrefslogtreecommitdiffhomepage
path: root/new-account.lisp
blob: 653818a0da668e40f9b998cbaf0154a4651c647e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
;;;; new-account.lisp

(in-package :vampire)

(defparameter +username-regex+
  (ppcre:create-scanner "^[a-zA-Z0-9\_\\-!@#$^&*]{3,25}$"))



(defun new-accout-page (body)
  (include-style body)
  (with-clog-create body
      (div (:class "row")
           (div ()  (section (:h2 :content "Create a new account"))
                (form (:bind new-user-form)
                      (form-element (:text :bind invite))
                      (span (:bind invite-status))
                      (br ())
                      (form-element (:text :bind name))
                      (span (:bind name-status))
                      (br ())
                      (form-element (:password :bind pw))
                      (br ())
                      (form-element (:password :bind pw-confirm))
                      (span (:bind pw-confirm-status))
                      (br ())
                      (button (:content "Make Account" :bind submit))))
           (div (:bind name-help :hidden t)
                (p (:content  "3-25 characters, no spaces, numbers, letters, or !@#$^&*()_-"))))

    (setf (place-holder invite) "Invite Code"
          (place-holder name) "Name"
          (place-holder pw) "Password"
          (place-holder pw-confirm) "Repeat Password")

    (set-on-blur
     invite
     (thunk*
         (setf (inner-html invite-status)
               (if (invite-by-code (value invite))
                   "✔"
                   "Bad Invite Code"))))
    (set-on-blur
     name
     (thunk*
       (let ((name (value name)))
         (setf (text name-status)
               (cond
                 ((not (ppcre:all-matches +username-regex+ name))
                  (setf (visiblep name-help) t)                  
                  "Invalid Name.")
                 ((user-with-name name)
                  (setf (visiblep name-help) nil)                  
                  "Name Already Taken")
                 (t
                  (setf (visiblep name-help) nil)                  
                  "✔"))))))

    (set-on-key-press
     pw-confirm
     (thunk*
       (setf (text pw-confirm-status)
          (if (string-equal (value pw) (value pw-confirm))
              "✔"
              "Passwords Do Not Match"))))

    (set-on-click
     submit
     (thunk*
       (if (loop for status in (list pw-confirm-status name-status invite-status)
                 always (string-equal "✔" (text status)))
           (if (use-invite-with-code (value invite) (value name) (value pw))
               (setf (url (location body)) "/login")
               (alert (window body) "An error occurred while making your account."))
           (alert (window body) "Plase double check your inputs."))))))