start to add functionality for signing new users up.

src/web.lisp

@@ -50,10 +50,57 @@
 	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
 	  ((uiop:file-exists-p (ritherdon-archive.config:database-name))
 	   `(,+service-unavailable+ (:location "/")))
-	   ;; (render #P"initial-setup.html" `(:token ,(auth:csrf-token))))
+	  ;; (render #P"initial-setup.html" `(:token ,(auth:csrf-token))))
 	  (t (nera-db:init-db
 	      (lack.request:request-body-parameters ningle:*request*))
-	     (redirect "/dashboard"))))) ; Redirect to /setup-complete?
+	     ;; Redirect to /setup-complete?
+	     (utils:set-alert "All set-up. Log-in to continue.")
+	     (redirect "/login")))))
+
+(defroute ("/sign-up" :method :GET) ()
+  (if (= +false+ (site-settings::enable-sign-up-p (nera:get-site-settings)))
+      (progn
+	(utils:set-alert "This feature has been disabled.")
+	(redirect "/"))
+      (hermetic:auth (:logged-in)
+		    ;; Authorised (Logged in users can't sign-up).
+		    (progn
+		      (utils:set-alert
+		       "You need to be signed out to create a new account.")
+		      (redirect "/dashboard"))
+		    ;; Not Authorised
+		    (let ((alert (utils:get-and-reset-alert)))
+		      (render "sign-up.html"
+			      `(:token ,(auth:csrf-token)
+				:alert ,alert))))))
+
+(defroute ("/sign-up" :method :POST) ()
+  (destructuring-bind
+      (&key username display-name password password-check
+	 authenticity-token &allow-other-keys)
+      (utils:request-params
+       (lack.request:request-body-parameters ningle:*request*))
+    (cond ((not (string= authenticity-token (auth:csrf-token)))
+	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
+	  ((not (string= password password-check))
+	   (utils:set-alert "Passwords don't match.")
+	   (redirect "/sign-up"))
+	  ((find t (mapcar
+		    #'utils:string-is-nil-or-empty?
+		    `(,username ,display-name ,password)))
+	   (utils:set-alert "Incomplete form. Please fill out every section.")
+	   (redirect "/sign-up"))
+	  (t (hermetic:auth
+	      (:logged-in)
+	      ;; Authorised (Logged in user can't sign-up).
+	      (progn (utils:set-alert "Logged in users are not allowed to create account.")
+		     (redirect "/dashboard"))
+	      ;; Not Authorised
+	      (progn
+		(nera-db:create-user username display-name password +false+)
+		(utils:set-alert "Account created.")
+		(redirect "/login")))))))
+
 
 (defroute ("/login" :method :GET) ()
   (hermetic:auth (:logged-in)
@@ -137,7 +184,7 @@
     (cond ((not (string= authenticity-token (auth:csrf-token)))
 	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
 	  ((not (string= new-password password-check))
-	   (utils:set-alert "Password don't match.")
+	   (utils:set-alert "Passwords don't match.")
 	   (redirect "/user/edit"))
 	  (t (hermetic:auth
 	      (:logged-in)