Implement /register/enabled endpoint
This commit is contained in:
parent
17f1583808
commit
3db1668a6f
3 changed files with 22 additions and 0 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue