Add userMe policy and isomorphic GQLType UserId instance

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -15,6 +15,7 @@ module Gargantext.API.Auth.PolicyCheck (
   , nodeSuper
   , nodeUser
   , nodeChecks
+  , userMe
   , alwaysAllow
   , alwaysDeny
   ) where
@@ -72,13 +73,15 @@ data AccessPolicyManager = AccessPolicyManager
 data AccessCheck
   = -- | Grants access if the input 'NodeId' is a descendant of the
     -- one for the logged-in user.
-    AC_node_descendant  NodeId
+    AC_node_descendant  !NodeId
     -- | Grants access if the input 'NodeId' is shared with the logged-in user.
-  | AC_node_shared  NodeId
+  | AC_node_shared      !NodeId
     -- | Grants access if the input 'NodeId' /is/ the logged-in user.
-  | AC_user_node        NodeId
+  | AC_user_node        !NodeId
+    -- | Grants access if the logged-in user is the user.
+  | AC_user             !UserId
     -- | Grants access if the logged-in user is the master user.
-  | AC_master_user      NodeId
+  | AC_master_user      !NodeId
     -- | Always grant access, effectively a public route.
   | AC_always_allow
     -- | Always denies access.
@@ -129,6 +132,8 @@ check (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
   AC_user_node requestedNodeId
     -> do ownedByMe <- requestedNodeId `isOwnedBy` loggedUserUserId
           enforce err403 $ (loggedUserNodeId == requestedNodeId || ownedByMe)
+  AC_user requestedUserId
+    -> enforce err403 $ (loggedUserUserId == requestedUserId)
   AC_master_user _requestedNodeId
     -> do
       masterUsername <- _gc_masteruser <$> view hasConfig
@@ -146,6 +151,9 @@ check (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
 nodeUser :: NodeId -> BoolExpr AccessCheck
 nodeUser = BConst . Positive . AC_user_node
 
+userMe :: UserId -> BoolExpr AccessCheck
+userMe = BConst . Positive . AC_user
+
 nodeSuper :: NodeId -> BoolExpr AccessCheck
 nodeSuper = BConst . Positive . AC_master_user
 

src/Gargantext/API/GraphQL/Node.hs

@@ -63,8 +63,6 @@ resolveNodes
   -> NodeArgs
   -> GqlM e env [Node]
 resolveNodes autUser mgr NodeArgs { node_id } =
-  -- FIXME(adn) We should have a way to enforce the access policy on
-  -- the public or public folders, instead of using 'alwaysAllow'.
   withPolicy autUser mgr (nodeChecks $ NN.UnsafeMkNodeId node_id) $ dbNodes node_id
 
 resolveNodesCorpus

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -69,8 +69,6 @@ resolveTree :: (CmdCommon env)
             -> TreeArgs
             -> GqlM e env (TreeFirstLevel (GqlM e env))
 resolveTree autUser mgr TreeArgs { root_id } =
-  -- FIXME(adn) We should have a way to enforce the access policy on
-  -- the public or public folders, instead of using 'alwaysAllow'.
   withPolicy autUser mgr (nodeChecks $ UnsafeMkNodeId root_id) $ dbTree root_id
 
 dbTree :: (CmdCommon env) =>

src/Gargantext/API/GraphQL/User.hs

@@ -55,8 +55,8 @@ resolveUsers
   -> UserArgs
   -> GqlM e env [User (GqlM e env)]
 resolveUsers autUser mgr UserArgs { user_id } = do
-  -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
-  withPolicy autUser mgr alwaysAllow $ dbUsers user_id
+  -- We are given the /node id/ of the logged-in user.
+  withPolicy autUser mgr (nodeChecks $ UnsafeMkNodeId user_id) $ dbUsers user_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers :: (CmdCommon env)

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -113,7 +113,7 @@ resolveUserInfos
   -> UserInfoArgs -> GqlM e env [UserInfo]
 resolveUserInfos autUser mgr UserInfoArgs { user_id } =
   -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
-  withPolicy autUser mgr alwaysAllow $ dbUsers (UnsafeMkUserId user_id)
+  withPolicy autUser mgr (userMe $ UnsafeMkUserId user_id) $ dbUsers (UnsafeMkUserId user_id)
 
 -- | Mutation for user info
 updateUserInfo

src/Gargantext/Database/Admin/Types/Node.hs

@@ -15,6 +15,7 @@ Portability : POSIX
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
@@ -26,7 +27,8 @@ import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Csv qualified as Csv
 import Data.Either
-import Data.Morpheus.Types (GQLType)
+import Data.Morpheus.Kind (SCALAR)
+import Data.Morpheus.Types
 import Data.Swagger
 import Data.Text (unpack, pack)
 import Data.Time (UTCTime)
@@ -59,7 +61,15 @@ newtype UserId = UnsafeMkUserId { _UserId :: Int }
   deriving stock (Show, Eq, Ord, Generic)
   deriving newtype (ToSchema, ToJSON, FromJSON, FromField, ToField)
 
-instance GQLType UserId
+-- The 'UserId' is isomprohic to an 'Int'.
+instance GQLType UserId where
+  type KIND UserId = SCALAR
+
+instance EncodeScalar UserId where
+  encodeScalar = encodeScalar . _UserId
+
+instance DecodeScalar UserId where
+  decodeScalar = fmap UnsafeMkUserId . decodeScalar
 
 instance ResourceId UserId where
   isPositive = (> 0) . _UserId