diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index e0128f4..fa229b2 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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) diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 6b28ca1..249916c 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -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 diff --git a/th/routes b/th/routes index ed2ee00..6ce8a48 100644 --- a/th/routes +++ b/th/routes @@ -118,6 +118,8 @@ /akey1 ActorKey1R GET /akey2 ActorKey2R GET +/register/enabled RegisterEnabledR GET + ---- Client ------------------------------------------------------------------ / HomeR GET