From 3db1668a6ff5b6766c082ca7b6c245432677a786 Mon Sep 17 00:00:00 2001
From: Pere Lev <pere@towards.vision>
Date: Fri, 5 Jul 2024 22:23:29 +0300
Subject: [PATCH] Implement /register/enabled endpoint

---
 src/Vervis/Foundation.hs     |  1 +
 src/Vervis/Handler/Client.hs | 19 +++++++++++++++++++
 th/routes                    |  2 ++
 3 files changed, 22 insertions(+)

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