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) DvaraR _ -> ("OAuth", Just HomeR)
ActorKey1R -> ("Actor Key 1", Just HomeR) ActorKey1R -> ("Actor Key 1", Just HomeR)
ActorKey2R -> ("Actor Key 2", Just HomeR) ActorKey2R -> ("Actor Key 2", Just HomeR)
RegisterEnabledR -> ("", Nothing)
HomeR -> ("Home", Nothing) HomeR -> ("Home", Nothing)
BrowseR -> ("Browse", Just HomeR) BrowseR -> ("Browse", Just HomeR)

View file

@ -18,6 +18,7 @@ module Vervis.Handler.Client
( getResendVerifyEmailR ( getResendVerifyEmailR
, getActorKey1R , getActorKey1R
, getActorKey2R , getActorKey2R
, getRegisterEnabledR
, getHomeR , getHomeR
, getBrowseR , getBrowseR
@ -70,10 +71,12 @@ import Control.Monad.Trans.Except
import Data.Bifunctor import Data.Bifunctor
import Data.Bitraversable import Data.Bitraversable
import Data.Function import Data.Function
import Data.Maybe
import Data.List import Data.List
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Clock import Data.Time.Clock
import Data.Traversable import Data.Traversable
import Dvara
import Database.Persist import Database.Persist
import Network.HTTP.Types.Method import Network.HTTP.Types.Method
import Text.Blaze.Html (preEscapedToHtml) import Text.Blaze.Html (preEscapedToHtml)
@ -149,6 +152,22 @@ getActorKey1R = serveInstanceKey fst ActorKey1R
getActorKey2R :: Handler TypedContent getActorKey2R :: Handler TypedContent
getActorKey2R = serveInstanceKey snd ActorKey2R 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 :: Handler Html
getHomeR = do getHomeR = do
mp <- maybeAuth mp <- maybeAuth

View file

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