Commit dc484896 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Annuanire][Contact] Route + script.

parent 229f0d44
...@@ -23,7 +23,7 @@ import Data.Either ...@@ -23,7 +23,7 @@ import Data.Either
import Prelude (read) import Prelude (read)
import Control.Exception (finally) import Control.Exception (finally)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile) import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire)
import Gargantext.Text.Corpus.Parsers (FileFormat(..)) import Gargantext.Text.Corpus.Parsers (FileFormat(..))
import Gargantext.Database.Utils (Cmd, ) import Gargantext.Database.Utils (Cmd, )
import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument) import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument)
...@@ -41,9 +41,10 @@ import Control.Monad.IO.Class (liftIO) ...@@ -41,9 +41,10 @@ import Control.Monad.IO.Class (liftIO)
main :: IO () main :: IO ()
main = do main = do
[userCreate, user, name, iniPath, limit, corpusPath] <- getArgs [fun, user, name, iniPath, limit, corpusPath] <- getArgs
--{- --{-
let createUsers :: Cmd GargError Int64 let createUsers :: Cmd GargError Int64
createUsers = insertUsersDemo createUsers = insertUsersDemo
...@@ -51,8 +52,13 @@ main = do ...@@ -51,8 +52,13 @@ main = do
--tt = (Unsupervised EN 6 0 Nothing) --tt = (Unsupervised EN 6 0 Nothing)
tt = (Multi EN) tt = (Multi EN)
format = CsvGargV3 -- CsvHalFormat --WOS format = CsvGargV3 -- CsvHalFormat --WOS
cmd :: forall m. FlowCmdM DevEnv GargError m => m CorpusId corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
cmd = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath corpus = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath
annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
annuaire = flowAnnuaire (cs user) (Left "Annuaire") (Multi EN) corpusPath
{- {-
let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
debatCorpus = do debatCorpus = do
...@@ -64,13 +70,18 @@ main = do ...@@ -64,13 +70,18 @@ main = do
flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs) flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
--} --}
withDevEnv iniPath $ \env -> do withDevEnv iniPath $ \env -> do
_ <- if userCreate == "true" _ <- if fun == "users"
then runCmdDev env createUsers then runCmdDev env createUsers
else pure 0 --(cs "false") else pure 0 --(cs "false")
_ <- runCmdDev env cmd _ <- if fun == "corpus"
then runCmdDev env corpus
else pure 0 --(cs "false")
_ <- if fun == "annuaire"
then runCmdDev env annuaire
else pure 0
{- {-
_ <- if corpusType == "csv" _ <- if corpusType == "csv"
then runCmdDev env csvCorpus then runCmdDev env csvCorpus
......
...@@ -70,7 +70,7 @@ import Text.Blaze.Html (Html) ...@@ -70,7 +70,7 @@ import Text.Blaze.Html (Html)
--import Gargantext.API.Swagger --import Gargantext.API.Swagger
--import Gargantext.Database.Node.Contact (HyperdataContact) import Gargantext.Database.Node.Contact (HyperdataContact)
import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..)) import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..))
import Gargantext.API.Count ( CountAPI, count, Query) import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer) import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
...@@ -249,6 +249,11 @@ type GargPrivateAPI' = ...@@ -249,6 +249,11 @@ type GargPrivateAPI' =
:<|> "annuaire":> Summary "Annuaire endpoint" :<|> "annuaire":> Summary "Annuaire endpoint"
:> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire :> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire
:<|> "annuaire" :> Summary "Contact endpoint"
:> Capture "annuaire_id" NodeId
:> "contact" :> Capture "contact_id" NodeId
:> NodeNodeAPI HyperdataContact
-- Document endpoint -- Document endpoint
:<|> "document":> Summary "Document endpoint" :<|> "document":> Summary "Document endpoint"
:> Capture "id" DocId :> "ngrams" :> TableNgramsApi :> Capture "id" DocId :> "ngrams" :> TableNgramsApi
...@@ -329,6 +334,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) ...@@ -329,6 +334,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid
:<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid
:<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid
:<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid
:<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy uid <$> PathNode <*> apiNgramsTableDoc :<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy uid <$> PathNode <*> apiNgramsTableDoc
:<|> count -- TODO: undefined :<|> count -- TODO: undefined
:<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <$> PathNode <*> searchPairs -- TODO: move elsewhere :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <$> PathNode <*> searchPairs -- TODO: move elsewhere
......
...@@ -102,7 +102,7 @@ checkAuthRequest u p ...@@ -102,7 +102,7 @@ checkAuthRequest u p
| not (u `elem` arbitraryUsername) = pure InvalidUser | not (u `elem` arbitraryUsername) = pure InvalidUser
| u /= reverse p = pure InvalidPassword | u /= reverse p = pure InvalidPassword
| otherwise = do | otherwise = do
muId <- head <$> getRoot "user1" -- TODO user1 hard-coded muId <- head <$> getRoot u
case _node_id <$> muId of case _node_id <$> muId of
Nothing -> pure InvalidUser Nothing -> pure InvalidUser
Just uid -> do Just uid -> do
...@@ -179,7 +179,7 @@ instance Arbitrary AuthValid where ...@@ -179,7 +179,7 @@ instance Arbitrary AuthValid where
, tr <- [1..3] , tr <- [1..3]
] ]
data PathId = PathNode NodeId | PathDoc ListId DocId data PathId = PathNode NodeId | PathNodeNode ListId DocId
withAccessM :: (CmdM env err m, HasServerError err) withAccessM :: (CmdM env err m, HasServerError err)
=> UserId => UserId
...@@ -190,13 +190,12 @@ withAccessM uId (PathNode id) m = do ...@@ -190,13 +190,12 @@ withAccessM uId (PathNode id) m = do
d <- id `isDescendantOf` NodeId uId d <- id `isDescendantOf` NodeId uId
if d then m else m -- serverError err401 if d then m else m -- serverError err401
withAccessM uId (PathDoc cId docId) m = do withAccessM 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` NodeId uId
if a && d if True -- a && d
then m then m
else m -- serverError err401 else m
withAccess :: forall env err m api. withAccess :: forall env err m api.
(GargServerC env err m, HasServer api '[]) => (GargServerC env err m, HasServer api '[]) =>
...@@ -208,16 +207,9 @@ withAccess p _ uId id = hoistServer p f ...@@ -208,16 +207,9 @@ withAccess p _ uId id = hoistServer p f
f :: forall a. m a -> m a f :: forall a. m a -> m a
f = withAccessM uId id f = withAccessM uId id
{- | Collaborative Schema {- | Collaborative Schema
User at his root can create Teams Folder User at his root can create Teams Folder
User can create Team in Teams Folder. User can create Team in Teams Folder.
User can invite User in Team as NodeNode only if Team in his parents. User can invite User in Team as NodeNode only if Team in his parents.
All users can access to the Team folder as if they were owner. All users can access to the Team folder as if they were owner.
-} -}
...@@ -164,11 +164,13 @@ type ChildrenApi a = Summary " Summary children" ...@@ -164,11 +164,13 @@ type ChildrenApi a = Summary " Summary children"
type NodeNodeAPI a = Get '[JSON] (Node a) type NodeNodeAPI a = Get '[JSON] (Node a)
nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> CorpusId -> NodeId -> GargServer (NodeNodeAPI a) nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> CorpusId -> NodeId -> GargServer (NodeNodeAPI a)
nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathDoc cId nId) nodeNodeAPI' nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
where where
nodeNodeAPI' :: GargServer (NodeNodeAPI a) nodeNodeAPI' :: GargServer (NodeNodeAPI a)
nodeNodeAPI' = getNode nId p nodeNodeAPI' = getNode nId p
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy. -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a) nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a)
...@@ -207,6 +209,8 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i ...@@ -207,6 +209,8 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
-- Annuaire -- Annuaire
-- :<|> query -- :<|> query
------------------------------------------------------------------------ ------------------------------------------------------------------------
data RenameNode = RenameNode { r_name :: Text } data RenameNode = RenameNode { r_name :: Text }
deriving (Generic) deriving (Generic)
......
...@@ -37,6 +37,7 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list) ...@@ -37,6 +37,7 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
, flowCorpusSearchInDatabase , flowCorpusSearchInDatabase
, getOrMkRoot , getOrMkRoot
, getOrMkRootWithCorpus , getOrMkRootWithCorpus
, flowAnnuaire
) )
where where
import Prelude (String) import Prelude (String)
...@@ -120,9 +121,9 @@ _flowCorpusApi u n tt l q = do ...@@ -120,9 +121,9 @@ _flowCorpusApi u n tt l q = do
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- UNUSED -- UNUSED
_flowAnnuaire :: FlowCmdM env err m flowAnnuaire :: FlowCmdM env err m
=> Username -> Either CorpusName [CorpusId] -> (TermType Lang) -> FilePath -> m AnnuaireId => Username -> Either CorpusName [CorpusId] -> (TermType Lang) -> FilePath -> m AnnuaireId
_flowAnnuaire u n l filePath = do flowAnnuaire u n l filePath = do
docs <- liftIO $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]]) docs <- liftIO $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
......
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