From 19194426c2cefc1c063b96276f4ecf8fbaba4b8f Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Fri, 5 Jul 2024 23:27:35 +0300
Subject: [PATCH] Implement /register/available

---
 API.md                       |  3 ++-
 src/Vervis/Foundation.hs     |  1 +
 src/Vervis/Handler/Client.hs | 31 +++++++++++++++++++++++++++++--
 th/routes                    |  1 +
 4 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/API.md b/API.md
index 16e8ced..bac89df 100644
--- a/API.md
+++ b/API.md
@@ -130,12 +130,13 @@ is disabled on this server, and the account is ready to be used.
 
 ### Verify account
 
-The email contains a token, which you can end via a POST request to the
+The email contains a token, which you can send via a POST request to the
 `/register/verify` endpoint, in order to verify and enable the account:
 
 ```sh
 curl -X POST \
     -H 'Authorization: Bearer our_application_access_token_here' \
+    -F 'username=alice' \
     -F 'token=pRiW8ayeuN7UBW4qAKg9qRBE0DUVCIof' \
     https://vervis.example/register/verify
 ```
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index fa229b2..bb41895 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -850,6 +850,7 @@ instance YesodBreadcrumbs App where
         ActorKey1R         -> ("Actor Key 1", Just HomeR)
         ActorKey2R         -> ("Actor Key 2", Just HomeR)
         RegisterEnabledR   -> ("", Nothing)
+        RegisterAvailableR -> ("", Nothing)
 
         HomeR          -> ("Home", Nothing)
         BrowseR        -> ("Browse", Just HomeR)
diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs
index 249916c..931c250 100644
--- a/src/Vervis/Handler/Client.hs
+++ b/src/Vervis/Handler/Client.hs
@@ -19,6 +19,7 @@ module Vervis.Handler.Client
     , getActorKey1R
     , getActorKey2R
     , getRegisterEnabledR
+    , getRegisterAvailableR
 
     , getHomeR
     , getBrowseR
@@ -165,8 +166,34 @@ requireAppAuth = do
 getRegisterEnabledR :: Handler ()
 getRegisterEnabledR = do
     requireAppAuth
-    enabled <- asksSite $ appRegister . appSettings
-    unless enabled $ invalidArgs ["enabled"]
+    settings <- asksSite appSettings
+    unless (appRegister settings) $ invalidArgs ["disabled"]
+    room <-
+        case appAccounts settings of
+            Nothing -> return True
+            Just cap -> do
+                current <- runDB $ count ([] :: [Filter Person])
+                return $ current < cap
+    unless room $ invalidArgs ["full"]
+
+getRegisterAvailableR :: Handler ()
+getRegisterAvailableR = do
+    requireAppAuth
+    settings <- asksSite appSettings
+    unless (appRegister settings) $ invalidArgs ["disabled"]
+    room <-
+        case appAccounts settings of
+            Nothing -> return True
+            Just cap -> do
+                current <- runDB $ count ([] :: [Filter Person])
+                return $ current < cap
+    unless room $ invalidArgs ["full"]
+
+    username <-
+        runInputPost $ ireq (checkM checkValidUsername textField) "username"
+    maybePerson <-
+        runDB $ getBy $ UniquePersonUsername $ text2username username
+    unless (isNothing maybePerson) $ invalidArgs ["taken"]
 
 getHomeR :: Handler Html
 getHomeR = do
diff --git a/th/routes b/th/routes
index 6ce8a48..18fe4f8 100644
--- a/th/routes
+++ b/th/routes
@@ -119,6 +119,7 @@
 /akey2        ActorKey2R         GET
 
 /register/enabled RegisterEnabledR GET
+/register/available RegisterAvailableR GET
 
 ---- Client ------------------------------------------------------------------