initial stepping stone

src/Gargantext/API/Admin/Auth.hs

@@ -50,12 +50,12 @@ import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types
-import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError, GargM, GargError)
+import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError, GargM, GargError, serverError)
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (Cmd', CmdM, CmdCommon)
 import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
@@ -133,29 +133,31 @@ authCheck _env (BasicAuthData login password) = pure $
 -}
 
 withAccessM :: (CmdM env err m, HasServerError err)
-            => UserId
+            => AuthenticatedUser
             -> PathId
             -> m a
             -> m a
-withAccessM uId (PathNode id) m = do
-  d <- id `isDescendantOf` NodeId uId
+withAccessM (AuthenticatedUser uId) (PathNode id) m = do
+  d <- id `isDescendantOf` uId
   if d then m else m -- serverError err401
 
-withAccessM uId (PathNodeNode cId docId) m = do
+withAccessM (AuthenticatedUser uId) (PathNodeNode cId docId) m = do
   _a <- isIn cId docId -- TODO use one query for all ?
-  _d <- cId `isDescendantOf` NodeId uId
+  _d <- cId `isDescendantOf` uId
   if True -- a && d
      then m
-     else m
+     else m -- serverError err401
+withAccessM (AuthenticatedUser uId) (PathNodeOwner id) m = do
+  if uId == id then m else serverError err401
 
 withAccess :: forall env err m api.
               (GargServerC env err m, HasServer api '[]) =>
-              Proxy api -> Proxy m -> UserId -> PathId ->
+              Proxy api -> Proxy m -> AuthenticatedUser -> PathId ->
               ServerT api m -> ServerT api m
-withAccess p _ uId id = hoistServer p f
+withAccess p _ ur id = hoistServer p f
   where
     f :: forall a. m a -> m a
-    f = withAccessM uId id
+    f = withAccessM ur id
 
 {- | Collaborative Schema
 User at his root can create Teams Folder

src/Gargantext/API/Admin/Auth/Types.hs

@@ -107,7 +107,10 @@ instance Arbitrary AuthValid where
                        , u <-  [1..3]
                        ]
 
-data PathId = PathNode NodeId | PathNodeNode ListId DocId
+data PathId = PathNode NodeId
+            | PathNodeNode ListId DocId
+            -- | The captured NodeId must be exactly equal to the logged-in user's NodeId.
+            | PathNodeOwner NodeId
 
 
 ---------------------------

src/Gargantext/API/Context.hs

@@ -22,7 +22,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Servant
 
 import Gargantext.API.Admin.Auth (withAccess)
-import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser)
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
@@ -39,7 +39,7 @@ contextAPI :: forall proxy a.
        , FromJSON a
        , ToJSON a
        ) => proxy a
-         -> UserId
+         -> AuthenticatedUser
          -> ContextId
          -> GargServer (ContextAPI a)
 contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode id') contextAPI'

src/Gargantext/API/Node.hs

@@ -35,7 +35,7 @@ import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Auth (withAccess)
-import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..))
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
@@ -180,7 +180,7 @@ type NodeNodeAPI a = Get '[JSON] (Node a)
 
 nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
             => proxy a
-            -> UserId
+            -> AuthenticatedUser
             -> CorpusId
             -> NodeId
             -> GargServer (NodeNodeAPI a)
@@ -194,10 +194,10 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
 nodeAPI :: forall proxy a.
        ( HyperdataC a
        ) => proxy a
-         -> UserId
+         -> AuthenticatedUser
          -> NodeId
          -> ServerT (NodeAPI a) (GargM Env GargError)
-nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
+nodeAPI p authenticatedUser@(AuthenticatedUser (NodeId uId)) id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNodeOwner id') nodeAPI'
   where
     nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
     nodeAPI' =  getNodeWith   id' p

src/Gargantext/API/Node/Contact.hs

@@ -49,6 +49,7 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (($), {-printDebug,-})
 import qualified Gargantext.Utils.Aeson as GUA
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
+import Gargantext.API.Admin.Auth.Types
 
 ------------------------------------------------------------------------
 type API = "contact" :> Summary "Contact endpoint"
@@ -57,9 +58,10 @@ type API = "contact" :> Summary "Contact endpoint"
             :> NodeNodeAPI HyperdataContact
 
 
-api :: UserId -> CorpusId -> ServerT API (GargM Env GargError)
-api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
-          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
+api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env GargError)
+api authUser@(AuthenticatedUser (NodeId uid)) cid =
+       (api_async   (RootId (NodeId                   uid)) cid)
+  :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
 
 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
 ------------------------------------------------------------------------

src/Gargantext/API/Routes.hs

@@ -238,18 +238,18 @@ serverGargAdminAPI =  roots
 
 serverPrivateGargAPI'
   :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
-serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
+serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser (NodeId uid))
        =  serverGargAdminAPI
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
-     :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      uid
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
-     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      authenticatedUser
+     :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      authenticatedUser
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   authenticatedUser
+     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      authenticatedUser
      :<|> CorpusExport.getCorpus   -- uid
  --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
-     :<|> Contact.api uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser
+     :<|> Contact.api authenticatedUser
 
-     :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid
+     :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy authenticatedUser
           <$> PathNode <*> apiNgramsTableDoc
 
      :<|> DocumentExport.api uid
@@ -259,13 +259,13 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
      --     <$> PathNode <*> Search.api -- TODO: move elsewhere
 
-     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid
+     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy authenticatedUser
           <$> PathNode <*> graphAPI uid -- TODO: mock
 
-     :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid
+     :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy authenticatedUser
           <$> PathNode <*> treeAPI
 
-     :<|> withAccess (Proxy :: Proxy TreeFlatAPI)    Proxy uid
+     :<|> withAccess (Proxy :: Proxy TreeFlatAPI)    Proxy authenticatedUser
           <$> PathNode <*> treeFlatAPI
 
      :<|> members uid

test/Test/API/Authentication.hs

@@ -77,6 +77,6 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         result <- runClientM (auth_api authPayload) (clientEnv port)
         let expected = AuthResponse {
                        _authRes_valid = Nothing
-                     , _authRes_inval = Just $ AuthInvalid "Invalid password"
+                     , _authRes_inval = Just $ AuthInvalid "Invalid username or password"
                      }
         result `shouldBe` (Right expected)

test/Test/API/Private.hs

@@ -125,4 +125,4 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \token -> do
             protected token "GET" (mkUrl port "/node/1") ""
-              `shouldRespondWith` 403
+              `shouldRespondWith` 401