Commit c7586811 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

initial stepping stone

parent caafe0e7
...@@ -50,12 +50,12 @@ import Gargantext.API.Admin.Auth.Types ...@@ -50,12 +50,12 @@ import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types 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 (MailModel(..), mail)
import Gargantext.Core.Mail.Types (mailSettings) import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..)) import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM) 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.Prelude (Cmd', CmdM, CmdCommon)
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree (isDescendantOf, isIn) import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
...@@ -133,29 +133,31 @@ authCheck _env (BasicAuthData login password) = pure $ ...@@ -133,29 +133,31 @@ authCheck _env (BasicAuthData login password) = pure $
-} -}
withAccessM :: (CmdM env err m, HasServerError err) withAccessM :: (CmdM env err m, HasServerError err)
=> UserId => AuthenticatedUser
-> PathId -> PathId
-> m a -> m a
-> m a -> m a
withAccessM uId (PathNode id) m = do withAccessM (AuthenticatedUser uId) (PathNode id) m = do
d <- id `isDescendantOf` NodeId uId d <- id `isDescendantOf` uId
if d then m else m -- serverError err401 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 ? _a <- isIn cId docId -- TODO use one query for all ?
_d <- cId `isDescendantOf` NodeId uId _d <- cId `isDescendantOf` uId
if True -- a && d if True -- a && d
then m 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. withAccess :: forall env err m api.
(GargServerC env err m, HasServer 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 ServerT api m -> ServerT api m
withAccess p _ uId id = hoistServer p f withAccess p _ ur id = hoistServer p f
where where
f :: forall a. m a -> m a f :: forall a. m a -> m a
f = withAccessM uId id f = withAccessM ur id
{- | Collaborative Schema {- | Collaborative Schema
User at his root can create Teams Folder User at his root can create Teams Folder
......
...@@ -107,7 +107,10 @@ instance Arbitrary AuthValid where ...@@ -107,7 +107,10 @@ instance Arbitrary AuthValid where
, u <- [1..3] , 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
--------------------------- ---------------------------
......
...@@ -22,7 +22,7 @@ import Data.Aeson (FromJSON, ToJSON) ...@@ -22,7 +22,7 @@ import Data.Aeson (FromJSON, ToJSON)
import Servant import Servant
import Gargantext.API.Admin.Auth (withAccess) 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.API.Prelude
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM) import Gargantext.Database.Prelude -- (Cmd, CmdM)
...@@ -39,7 +39,7 @@ contextAPI :: forall proxy a. ...@@ -39,7 +39,7 @@ contextAPI :: forall proxy a.
, FromJSON a , FromJSON a
, ToJSON a , ToJSON a
) => proxy a ) => proxy a
-> UserId -> AuthenticatedUser
-> ContextId -> ContextId
-> GargServer (ContextAPI a) -> GargServer (ContextAPI a)
contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode id') contextAPI' contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode id') contextAPI'
......
...@@ -35,7 +35,7 @@ import Data.Swagger ...@@ -35,7 +35,7 @@ import Data.Swagger
import Data.Text (Text()) import Data.Text (Text())
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth (withAccess) 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.Admin.EnvTypes
import Gargantext.API.Metrics import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus) import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
...@@ -180,7 +180,7 @@ type NodeNodeAPI a = Get '[JSON] (Node a) ...@@ -180,7 +180,7 @@ type NodeNodeAPI a = Get '[JSON] (Node a)
nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a) nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
=> proxy a => proxy a
-> UserId -> AuthenticatedUser
-> CorpusId -> CorpusId
-> NodeId -> NodeId
-> GargServer (NodeNodeAPI a) -> GargServer (NodeNodeAPI a)
...@@ -194,10 +194,10 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI ...@@ -194,10 +194,10 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
nodeAPI :: forall proxy a. nodeAPI :: forall proxy a.
( HyperdataC a ( HyperdataC a
) => proxy a ) => proxy a
-> UserId -> AuthenticatedUser
-> NodeId -> NodeId
-> ServerT (NodeAPI a) (GargM Env GargError) -> 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 where
nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError) nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
nodeAPI' = getNodeWith id' p nodeAPI' = getNodeWith id' p
......
...@@ -49,6 +49,7 @@ import Gargantext.Database.Admin.Types.Node ...@@ -49,6 +49,7 @@ import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), {-printDebug,-}) import Gargantext.Prelude (($), {-printDebug,-})
import qualified Gargantext.Utils.Aeson as GUA import qualified Gargantext.Utils.Aeson as GUA
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.API.Admin.Auth.Types
------------------------------------------------------------------------ ------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint" type API = "contact" :> Summary "Contact endpoint"
...@@ -57,9 +58,10 @@ type API = "contact" :> Summary "Contact endpoint" ...@@ -57,9 +58,10 @@ type API = "contact" :> Summary "Contact endpoint"
:> NodeNodeAPI HyperdataContact :> NodeNodeAPI HyperdataContact
api :: UserId -> CorpusId -> ServerT API (GargM Env GargError) api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env GargError)
api uid cid = (api_async (RootId (NodeId uid)) cid) api authUser@(AuthenticatedUser (NodeId uid)) cid =
:<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid) (api_async (RootId (NodeId uid)) cid)
:<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -238,18 +238,18 @@ serverGargAdminAPI = roots ...@@ -238,18 +238,18 @@ serverGargAdminAPI = roots
serverPrivateGargAPI' serverPrivateGargAPI'
:: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError) :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser (NodeId uid))
= serverGargAdminAPI = serverGargAdminAPI
:<|> nodeAPI (Proxy :: Proxy HyperdataAny) uid :<|> nodeAPI (Proxy :: Proxy HyperdataAny) authenticatedUser
:<|> contextAPI (Proxy :: Proxy HyperdataAny) uid :<|> contextAPI (Proxy :: Proxy HyperdataAny) authenticatedUser
:<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) authenticatedUser
:<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) authenticatedUser
:<|> CorpusExport.getCorpus -- uid :<|> CorpusExport.getCorpus -- uid
-- :<|> nodeAPI (Proxy :: Proxy HyperdataContact) uid -- :<|> nodeAPI (Proxy :: Proxy HyperdataContact) uid
:<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser
:<|> Contact.api uid :<|> Contact.api authenticatedUser
:<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy uid :<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy authenticatedUser
<$> PathNode <*> apiNgramsTableDoc <$> PathNode <*> apiNgramsTableDoc
:<|> DocumentExport.api uid :<|> DocumentExport.api uid
...@@ -259,13 +259,13 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) ...@@ -259,13 +259,13 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
-- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
-- <$> PathNode <*> Search.api -- TODO: move elsewhere -- <$> PathNode <*> Search.api -- TODO: move elsewhere
:<|> withAccess (Proxy :: Proxy GraphAPI) Proxy uid :<|> withAccess (Proxy :: Proxy GraphAPI) Proxy authenticatedUser
<$> PathNode <*> graphAPI uid -- TODO: mock <$> PathNode <*> graphAPI uid -- TODO: mock
:<|> withAccess (Proxy :: Proxy TreeAPI) Proxy uid :<|> withAccess (Proxy :: Proxy TreeAPI) Proxy authenticatedUser
<$> PathNode <*> treeAPI <$> PathNode <*> treeAPI
:<|> withAccess (Proxy :: Proxy TreeFlatAPI) Proxy uid :<|> withAccess (Proxy :: Proxy TreeFlatAPI) Proxy authenticatedUser
<$> PathNode <*> treeFlatAPI <$> PathNode <*> treeFlatAPI
:<|> members uid :<|> members uid
......
...@@ -77,6 +77,6 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -77,6 +77,6 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
result <- runClientM (auth_api authPayload) (clientEnv port) result <- runClientM (auth_api authPayload) (clientEnv port)
let expected = AuthResponse { let expected = AuthResponse {
_authRes_valid = Nothing _authRes_valid = Nothing
, _authRes_inval = Just $ AuthInvalid "Invalid password" , _authRes_inval = Just $ AuthInvalid "Invalid username or password"
} }
result `shouldBe` (Right expected) result `shouldBe` (Right expected)
...@@ -125,4 +125,4 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -125,4 +125,4 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \token -> do
protected token "GET" (mkUrl port "/node/1") "" protected token "GET" (mkUrl port "/node/1") ""
`shouldRespondWith` 403 `shouldRespondWith` 401
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment