Implement /register/enabled endpoint

This commit is contained in:
Pere Lev 2024-07-05 22:23:29 +03:00
parent 17f1583808
commit 3db1668a6f
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
3 changed files with 22 additions and 0 deletions

View file

@ -849,6 +849,7 @@ instance YesodBreadcrumbs App where
DvaraR _ -> ("OAuth", Just HomeR)
ActorKey1R -> ("Actor Key 1", Just HomeR)
ActorKey2R -> ("Actor Key 2", Just HomeR)
RegisterEnabledR -> ("", Nothing)
HomeR -> ("Home", Nothing)
BrowseR -> ("Browse", Just HomeR)

View file

@ -18,6 +18,7 @@ module Vervis.Handler.Client
( getResendVerifyEmailR
, getActorKey1R
, getActorKey2R
, getRegisterEnabledR
, getHomeR
, getBrowseR
@ -70,10 +71,12 @@ import Control.Monad.Trans.Except
import Data.Bifunctor
import Data.Bitraversable
import Data.Function
import Data.Maybe
import Data.List
import Data.Text (Text)
import Data.Time.Clock
import Data.Traversable
import Dvara
import Database.Persist
import Network.HTTP.Types.Method
import Text.Blaze.Html (preEscapedToHtml)
@ -149,6 +152,22 @@ getActorKey1R = serveInstanceKey fst ActorKey1R
getActorKey2R :: Handler TypedContent
getActorKey2R = serveInstanceKey snd ActorKey2R
requireAppAuth :: Handler ()
requireAppAuth = do
ma <- getDvaraAuth
case ma of
Nothing -> notAuthenticated
Just (_app, user, _scopes) ->
if isJust user
then permissionDenied "An application access token is required"
else pure ()
getRegisterEnabledR :: Handler ()
getRegisterEnabledR = do
requireAppAuth
enabled <- asksSite $ appRegister . appSettings
unless enabled $ invalidArgs ["enabled"]
getHomeR :: Handler Html
getHomeR = do
mp <- maybeAuth

View file

@ -118,6 +118,8 @@
/akey1 ActorKey1R GET
/akey2 ActorKey2R GET
/register/enabled RegisterEnabledR GET
---- Client ------------------------------------------------------------------
/ HomeR GET