add scopes to user page

src/Aggreact.hs

@@ -82,7 +82,7 @@ serverAuthenticated Settings{..} authresult =
        homepageAPI commentHandler authresult
   :<|> commentAPI (Aggreact.Comments.Handlers userHandler commentHandler authorizationHandler) authresult
   :<|> slugAPI (Aggreact.Slugs.Handlers userHandler slugHandler authorizationHandler) authresult
-  :<|> userAPI userHandler authresult
+  :<|> userAPI userHandler authorizationHandler authresult
 
 data Settings =
   Settings { cookieSettings :: CookieSettings

src/Aggreact/Authorization.hs

@@ -37,7 +37,7 @@ import           Protolude
 import           Aggreact.Scopes         (Access (..), Scope (..), Scopes,
                                           displayScope, displayScopes)
 import           Aggreact.Servant.Errors (forbidden)
-import           Aggreact.Users          (NewUser (..), Role (..), User)
+import           Aggreact.Users.Types    (NewUser (..), Role (..), User)
 
 import qualified Data.Set                as Set
 import qualified Data.Text               as Text

src/Aggreact/Servant/Errors.hs

@@ -19,7 +19,8 @@
 module Aggreact.Servant.Errors where
 
 import           Aggreact.Html                 (boilerplate)
-import           Aggreact.Users                (User, loginWidget)
+import           Aggreact.Users.Types          (User)
+import           Aggreact.Users.Views          (loginWidget)
 
 import           Network.HTTP.Types            (hContentType)
 import           Protolude

src/Aggreact/Users/Server.hs

@@ -42,6 +42,7 @@ where
 
 import           Protolude
 
+import           Aggreact.Authorization        (AuthorizationHandler (..))
 import           Aggreact.Users.StoreService
 import           Aggreact.Users.Types
 import           Aggreact.Users.Views
@@ -65,32 +66,38 @@ type UserAPI =
                :> PostCreated '[HTML,JSON] RegisteredUserPage
 
 userAPI :: UserHandler
-        -- -> AuthorizationHandler
+        -> AuthorizationHandler
         -> AuthResult User
         -> Server UserAPI
-userAPI userHandler authResult =
+userAPI userHandler authHandler authResult =
   let muser = case authResult of
         (Servant.Auth.Server.Authenticated user) -> Just user
         _                                        -> Nothing
   in
-       getUserByNick muser userHandler
+       getUserByNick muser userHandler authHandler
   :<|> deleteUserById muser userHandler
   :<|> listUsers muser userHandler
   :<|> postUser muser userHandler
 
 -- GET User
-getUserByNick :: Maybe User -> UserHandler -> Nick -> Handler UserPage
-getUserByNick muser userHandler userNick = do
+getUserByNick :: Maybe User
+              -> UserHandler
+              -> AuthorizationHandler
+              -> Nick
+              -> Handler UserPage
+getUserByNick muser userHandler AuthorizationHandler{..} userNick = do
   SQL.SR (SQL.Paginated mu _ _) <- liftIO $
     searchUsers userHandler Filter {params = ["nick" := userNick]}
   case mu of
     []  -> Err.notFound "user not found"
-    [u] -> pure (UserPage u muser)
+    [u] -> do
+      let scopes = userScopes (Just u)
+      return (UserPage u muser scopes)
     _   -> Err.internalServerError "Incoherent DB"
 
-getUserById :: Maybe User -> UserHandler -> Id -> Handler UserPage
-getUserById muser userHandler userId = do
+getUserById :: Maybe User -> UserHandler -> AuthorizationHandler -> Id -> Handler UserPage
+getUserById muser userHandler AuthorizationHandler{..} userId = do
   mu <- liftIO $ readUser userHandler userId
   case mu of
     Nothing -> Err.notFound "user not found"
-    Just u  -> pure (UserPage u muser)
+    Just u  -> pure (UserPage u muser (userScopes (Just u)))

src/Aggreact/Users/Views.hs

@@ -43,6 +43,7 @@ where
 import           Protolude
 
 import           Aggreact.Html                    (boilerplate, cvt, urlEncode)
+import           Aggreact.Scopes
 import           Aggreact.Users.StoreService
 import           Aggreact.Users.Types
 
@@ -61,6 +62,7 @@ data UserPage =
   UserPage
   { user  :: User
   , muser :: Maybe User
+  , scopes :: Scopes
   }
 
 instance ToJSON UserPage where
@@ -72,6 +74,12 @@ instance H.ToMarkup UserPage where
     H.h2 $
       H.a ! A.href ("/users/" <> cvt (urlEncode n)) $ H.text (toS n)
     showUser user
+    showScopes scopes
+
+showScopes :: Scopes -> H.Markup
+showScopes scopes = H.div $ do
+  H.label "scopes"
+  H.text (displayScopes scopes)
 
 showUser :: User -> H.Markup
 showUser user = do