Implement /register/available

This commit is contained in:
Pere Lev 2024-07-05 23:27:35 +03:00
parent 3db1668a6f
commit 19194426c2
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
4 changed files with 33 additions and 3 deletions

3
API.md
View file

@ -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
```

View file

@ -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)

View file

@ -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

View file

@ -119,6 +119,7 @@
/akey2 ActorKey2R GET
/register/enabled RegisterEnabledR GET
/register/available RegisterAvailableR GET
---- Client ------------------------------------------------------------------