Skip to content

haskell-gargantext
haskell-gargantext
Commit 9a23e2d1 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[Flow] using user id. TODO : tests.

parent 75b4fd25
Pipeline #811 failed with stage
    Show whitespace changes
    Inline Side-by-side
    Showing with 161 additions and 143 deletions
    src/Gargantext/API.hs
    View file @ 9a23e2d1
    ......@@ -53,26 +53,15 @@ import Control.Lens
    import Control.Monad.Except (withExceptT, ExceptT)
    import Control.Monad.Reader (ReaderT, runReaderT)
    import Data.Aeson.Encode.Pretty (encodePretty)
    import Data.List (lookup)
    import Data.Swagger
    import Data.Text (Text)
    import Data.Text.Encoding (encodeUtf8)
    import Data.Validity
    import Data.Version (showVersion)
    import GHC.Base (Applicative)
    import GHC.Generics (D1, Meta (..), Rep)
    import GHC.TypeLits (AppendSymbol, Symbol)
    import Network.Wai
    import Network.Wai.Handler.Warp hiding (defaultSettings)
    import qualified Paths_gargantext as PG -- cabal magic build module
    import Servant
    import Servant.Auth as SA
    import Servant.Auth.Server (AuthResult(..))
    import Servant.Auth.Swagger ()
    import Servant.Job.Async
    import Servant.Swagger
    import Servant.Swagger.UI
    import System.IO (FilePath)
    import Data.List (lookup)
    import Data.Text.Encoding (encodeUtf8)
    import GHC.Base (Applicative)
    import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..))
    import Gargantext.API.Count ( CountAPI, count, Query)
    import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
    ......@@ -82,6 +71,7 @@ import Gargantext.API.Orchestrator.Types
    import Gargantext.API.Search (SearchPairsAPI, searchPairs)
    import Gargantext.API.Settings
    import Gargantext.API.Types
    import Gargantext.Core.Types.Individu (User(..))
    import Gargantext.Database.Node.Contact (HyperdataContact)
    import Gargantext.Database.Types.Node
    import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
    ......@@ -89,9 +79,20 @@ import Gargantext.Database.Utils (HasConnectionPool)
    import Gargantext.Prelude
    import Gargantext.Viz.Graph.API
    import Network.HTTP.Types hiding (Query)
    import Network.Wai
    import Network.Wai (Request, requestHeaders)
    import Network.Wai.Handler.Warp hiding (defaultSettings)
    import Network.Wai.Middleware.Cors
    import Network.Wai.Middleware.RequestLogger
    import Servant
    import Servant.Auth as SA
    import Servant.Auth.Server (AuthResult(..))
    import Servant.Auth.Swagger ()
    import Servant.Job.Async
    import Servant.Swagger
    import Servant.Swagger.UI
    import System.IO (FilePath)
    import qualified Paths_gargantext as PG -- cabal magic build module
    import qualified Data.ByteString.Lazy.Char8 as BL8
    import qualified Data.Text.IO as T
    import qualified Gargantext.API.Annuaire as Annuaire
    ......@@ -405,7 +406,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
    -- TODO access
    -- :<|> addUpload
    -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
    :<|> addCorpusWithForm "user1"
    :<|> addCorpusWithForm (UserDBId uid) -- "user1"
    :<|> addCorpusWithQuery
    :<|> addAnnuaireWithForm
    ......@@ -431,15 +432,15 @@ addWithFile cid i f =
    serveJobsAPI $
    JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
    addCorpusWithForm :: Text -> GargServer New.AddWithForm
    addCorpusWithForm username cid =
    addCorpusWithForm :: User -> GargServer New.AddWithForm
    addCorpusWithForm user cid =
    serveJobsAPI $
    JobFunction (\i log ->
    let
    log' x = do
    printDebug "addCorpusWithForm" x
    liftBase $ log x
    in New.addToCorpusWithForm username cid i log')
    in New.addToCorpusWithForm user cid i log')
    addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
    addAnnuaireWithForm cid =
    ......
    src/Gargantext/API/Auth.hs
    View file @ 9a23e2d1
    ......@@ -53,7 +53,7 @@ import Gargantext.Database.Utils (Cmd', CmdM, HasConnectionPool)
    import Gargantext.Prelude hiding (reverse)
    import Test.QuickCheck (elements, oneof)
    import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
    import Gargantext.Core.Types.Individu (Username, Password, arbitraryUsername, arbitraryPassword)
    import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword)
    ---------------------------------------------------
    ......@@ -101,7 +101,7 @@ checkAuthRequest u p
    | not (u `elem` arbitraryUsername) = pure InvalidUser
    | u /= reverse p = pure InvalidPassword
    | otherwise = do
    muId <- head <$> getRoot u
    muId <- head <$> getRoot (UserName u)
    case _node_id <$> muId of
    Nothing -> pure InvalidUser
    Just uid -> do
    ......
    src/Gargantext/API/Corpus/New.hs
    View file @ 9a23e2d1
    ......@@ -42,7 +42,7 @@ import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
    import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
    import Gargantext.Database.Types.Node (CorpusId)
    import Gargantext.Database.Types.Node (ToHyperdataDocument(..))
    import Gargantext.Database.Types.Node (UserId)
    import Gargantext.Core.Types.Individu (UserId, User(..))
    import Gargantext.Prelude
    import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
    import Gargantext.Text.Terms (TermType(..))
    ......@@ -89,13 +89,13 @@ type GetApi = Get '[JSON] ApiInfo
    -- TODO-ACCESS
    -- TODO this is only the POST
    api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
    api _uId (Query q _ as) = do
    api uid (Query q _ as) = do
    cId <- case head as of
    Nothing -> flowCorpusSearchInDatabase "user1" EN q
    Just API.All -> flowCorpusSearchInDatabase "user1" EN q
    Nothing -> flowCorpusSearchInDatabase (UserDBId uid) EN q
    Just API.All -> flowCorpusSearchInDatabase (UserDBId uid) EN q
    Just a -> do
    docs <- liftBase $ API.get a q (Just 1000)
    cId' <- flowCorpus "user1" (Left q) (Multi EN) [docs]
    cId' <- flowCorpus (UserDBId uid) (Left q) (Multi EN) [docs]
    pure cId'
    pure cId
    ......@@ -240,12 +240,12 @@ addToCorpusWithForm' cid (WithForm ft d l) logStatus = do
    pure s'
    -}
    addToCorpusWithForm :: FlowCmdM env err m
    => Text
    => User
    -> CorpusId
    -> WithForm
    -> (ScraperStatus -> m ())
    -> m ScraperStatus
    addToCorpusWithForm username cid (WithForm ft d l _n) logStatus = do
    addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do
    let
    parse = case ft of
    ......@@ -271,7 +271,7 @@ addToCorpusWithForm username cid (WithForm ft d l _n) logStatus = do
    printDebug "Starting extraction : " cid
    -- TODO granularity of the logStatus
    _cid' <- flowCorpus username
    _cid' <- flowCorpus user
    (Right [cid])
    (Multi $ fromMaybe EN l)
    (map (map toHyperdataDocument) docs)
    ......
    src/Gargantext/API/Export.hs
    View file @ 9a23e2d1
    ......@@ -41,7 +41,8 @@ import Gargantext.Database.Config (userMaster)
    import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
    import Gargantext.Database.Node.Select (selectNodesWithUsername)
    import Gargantext.Database.Schema.Ngrams (NgramsType(..))
    import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
    import Gargantext.Database.Schema.Node (defaultList)
    import Gargantext.Database.Types.Errors (HasNodeError)
    import Gargantext.Database.Schema.NodeNode (selectDocNodes)
    import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
    import Gargantext.Database.Utils (Cmd)
    ......
    src/Gargantext/API/Ngrams.hs
    View file @ 9a23e2d1
    ......@@ -146,7 +146,7 @@ import Gargantext.Database.Utils (fromField', HasConnectionPool)
    import Gargantext.Database.Node.Select
    import Gargantext.Database.Ngrams
    --import Gargantext.Database.Lists (listsWith)
    import Gargantext.Database.Schema.Node (HasNodeError)
    import Gargantext.Database.Types.Errors (HasNodeError)
    import Database.PostgreSQL.Simple.FromField (FromField, fromField)
    import qualified Gargantext.Database.Schema.Ngrams as Ngrams
    -- import Gargantext.Database.Schema.NodeNgram hiding (Action)
    ......
    src/Gargantext/API/Node.hs
    View file @ 9a23e2d1
    ......@@ -58,10 +58,11 @@ import Gargantext.Database.Flow.Pairing (pairing)
    import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
    import Gargantext.Database.Node.Children (getChildren)
    import Gargantext.Database.Node.User (NodeUser)
    import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..), getNodeUser)
    import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, getNodeUser)
    import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
    import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
    import Gargantext.Database.Tree (treeDB)
    import Gargantext.Database.Types.Errors (HasNodeError(..))
    import Gargantext.Database.Types.Node
    import Gargantext.Database.Utils -- (Cmd, CmdM)
    import Gargantext.Prelude
    ......
    src/Gargantext/API/Types.hs
    View file @ 9a23e2d1
    ......@@ -45,6 +45,7 @@ import Gargantext.API.Settings
    import Gargantext.API.Orchestrator.Types
    import Gargantext.API.Ngrams
    import Gargantext.Core.Types
    import Gargantext.Database.Types.Errors (NodeError(..), HasNodeError(..))
    import Gargantext.Database.Tree
    import Gargantext.Database.Utils
    import Gargantext.Database.Schema.Node
    ......
    src/Gargantext/Core/Types.hs
    View file @ 9a23e2d1
    ......@@ -164,5 +164,7 @@ data TODO = TODO
    instance ToSchema TODO where
    instance ToParamSchema TODO where
    ----------------------------------------------------------------------------
    src/Gargantext/Core/Types/Individu.hs
    View file @ 9a23e2d1
    ......@@ -20,6 +20,12 @@ module Gargantext.Core.Types.Individu
    import Gargantext.Prelude hiding (reverse)
    import Data.Text (Text, pack, reverse)
    import Gargantext.Database.Types.Node (NodeId)
    type UserId = Int
    data User = UserDBId UserId | UserName Text
    deriving (Eq)
    type Username = Text
    type Password = Text
    ......@@ -38,4 +44,3 @@ arbitraryPassword :: [Password]
    arbitraryPassword = map reverse arbitraryUsername
    src/Gargantext/Database/Flow.hs
    View file @ 9a23e2d1
    ......@@ -38,53 +38,53 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
    )
    where
    import Prelude (String)
    import Data.Either
    import Data.Tuple.Extra (first, second)
    import Data.Traversable (traverse)
    import Debug.Trace (trace)
    import Control.Lens ((^.), view, _Just)
    import Data.Either
    import Data.List (concat)
    import Data.Map (Map, lookup)
    import Data.Maybe (Maybe(..), catMaybes)
    import Data.Monoid
    import Data.Text (Text, splitOn, intercalate)
    import Data.Traversable (traverse)
    import Data.Tuple.Extra (first, second)
    import Debug.Trace (trace)
    import Gargantext.Core (Lang(..))
    import Gargantext.Core.Types (NodePoly(..), Terms(..))
    import Gargantext.Core.Types.Individu (Username)
    import Gargantext.Core.Flow.Types
    import Gargantext.Core.Types (NodePoly(..), Terms(..))
    import Gargantext.Core.Types.Individu (User(..))
    import Gargantext.Core.Types.Main
    import Gargantext.Database.Config (userMaster, corpusMasterName)
    import Gargantext.Database.Flow.Utils (insertDocNgrams)
    import Gargantext.Database.Flow.List
    import Gargantext.Database.Flow.Types
    import Gargantext.Database.Flow.Utils (insertDocNgrams)
    import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
    import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
    import Gargantext.Database.Root (getRoot)
    import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId)
    import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError)
    import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId)
    import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2)
    import Gargantext.Database.Schema.User (getUser, UserLight(..))
    import Gargantext.Database.Schema.User (getUserId)
    import Gargantext.Database.TextSearch (searchInDatabase)
    import Gargantext.Database.Types.Errors (HasNodeError(..), NodeError(..), nodeError)
    import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
    import Gargantext.Database.Utils (Cmd)
    import Gargantext.Ext.IMT (toSchoolName)
    import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
    import Gargantext.Prelude
    import Gargantext.Text.Terms.Eleve (buildTries, toToken)
    import Gargantext.Text.List (buildNgramsLists,StopSize(..))
    import Gargantext.Prelude.Utils hiding (sha)
    import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat)
    import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
    import Gargantext.Text.List (buildNgramsLists,StopSize(..))
    import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText)
    import Gargantext.Text.Terms.Eleve (buildTries, toToken)
    import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
    import Gargantext.Prelude.Utils hiding (sha)
    import Prelude (String)
    import System.FilePath (FilePath)
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified Data.Text as Text
    import qualified Gargantext.Database.Node.Document.Add as Doc (add)
    import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
    import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD
    ------------------------------------------------------------------------
    ......@@ -102,7 +102,7 @@ getDataApi lang limit (ApiIsidoreAuth q) = Isidore.get lang limit Nothing (Jus
    -- UNUSED
    _flowCorpusApi :: ( FlowCmdM env err m)
    => Username -> Either CorpusName [CorpusId]
    => User -> Either CorpusName [CorpusId]
    -> TermType Lang
    -> Maybe Limit
    -> ApiQuery
    ......@@ -114,7 +114,7 @@ _flowCorpusApi u n tt l q = do
    ------------------------------------------------------------------------
    flowAnnuaire :: FlowCmdM env err m
    => Username
    => User
    -> Either CorpusName [CorpusId]
    -> (TermType Lang)
    -> FilePath
    ......@@ -125,7 +125,7 @@ flowAnnuaire u n l filePath = do
    -- UNUSED
    _flowCorpusDebat :: FlowCmdM env err m
    => Username -> Either CorpusName [CorpusId]
    => User -> Either CorpusName [CorpusId]
    -> Limit -> FilePath
    -> m CorpusId
    _flowCorpusDebat u n l fp = do
    ......@@ -137,7 +137,7 @@ _flowCorpusDebat u n l fp = do
    flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs)
    flowCorpusFile :: FlowCmdM env err m
    => Username -> Either CorpusName [CorpusId]
    => User -> Either CorpusName [CorpusId]
    -> Limit -- Limit the number of docs (for dev purpose)
    -> TermType Lang -> FileFormat -> FilePath
    -> m CorpusId
    ......@@ -150,13 +150,13 @@ flowCorpusFile u n l la ff fp = do
    -- TODO query with complex query
    flowCorpusSearchInDatabase :: FlowCmdM env err m
    => Username
    => User
    -> Lang
    -> Text
    -> m CorpusId
    flowCorpusSearchInDatabase u la q = do
    (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
    userMaster
    (UserName userMaster)
    (Left "")
    (Nothing :: Maybe HyperdataCorpus)
    ids <- map fst <$> searchInDatabase cId (stemIt q)
    ......@@ -165,13 +165,13 @@ flowCorpusSearchInDatabase u la q = do
    -- UNUSED
    _flowCorpusSearchInDatabaseApi :: FlowCmdM env err m
    => Username
    => User
    -> Lang
    -> Text
    -> m CorpusId
    _flowCorpusSearchInDatabaseApi u la q = do
    (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
    userMaster
    (UserName userMaster)
    (Left "")
    (Nothing :: Maybe HyperdataCorpus)
    ids <- map fst <$> searchInDatabase cId (stemIt q)
    ......@@ -188,7 +188,7 @@ data CorpusInfo = CorpusName Lang Text
    flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
    => Maybe c
    -> Username
    -> User
    -> Either CorpusName [CorpusId]
    -> TermType Lang
    -> [[a]]
    ......@@ -198,7 +198,7 @@ flow c u cn la docs = do
    flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
    flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
    => Username
    => User
    -> Either CorpusName [CorpusId]
    -> TermType Lang
    -> [[a]]
    ......@@ -208,7 +208,7 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
    ------------------------------------------------------------------------
    flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
    => Lang
    -> Username
    -> User
    -> Either CorpusName [CorpusId]
    -> Maybe c
    -> [NodeId]
    ......@@ -225,7 +225,7 @@ flowCorpusUser l userName corpusName ctype ids = do
    -- printDebug "Node Text Id" tId
    -- User List Flow
    (masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left "") ctype
    (masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") ctype
    ngs <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
    _userListId <- flowList_DbRepo listId ngs
    _mastListId <- getOrMkList masterCorpusId masterUserId
    ......@@ -250,7 +250,7 @@ insertMasterDocs :: ( FlowCmdM env err m
    -> [a]
    -> m [DocId]
    insertMasterDocs c lang hs = do
    (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left corpusMasterName) c
    (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
    -- TODO Type NodeDocumentUnicised
    let docs = map addUniqId hs
    ......@@ -314,20 +314,16 @@ withLang l _ = l
    type CorpusName = Text
    getOrMkRoot :: (HasNodeError err)
    => Username
    => User
    -> Cmd err (UserId, RootId)
    getOrMkRoot username = do
    maybeUserId <- getUser username
    userId <- case maybeUserId of
    Nothing -> nodeError NoUserFound
    Just user -> pure $ userLight_id user
    getOrMkRoot user = do
    userId <- getUserId user
    rootId' <- map _node_id <$> getRoot username
    rootId' <- map _node_id <$> getRoot user
    rootId'' <- case rootId' of
    [] -> mkRoot username userId
    [] -> mkRoot user
    n -> case length n >= 2 of
    True -> nodeError ManyNodeUsers
    False -> pure rootId'
    ......@@ -337,13 +333,13 @@ getOrMkRoot username = do
    getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
    => Username
    => User
    -> Either CorpusName [CorpusId]
    -> Maybe a
    -> Cmd err (UserId, RootId, CorpusId)
    getOrMk_RootWithCorpus username cName c = do
    (userId, rootId) <- getOrMkRoot username
    corpusId'' <- if username == userMaster
    corpusId'' <- if username == UserName userMaster
    then do
    ns <- getCorporaWithParentId rootId
    pure $ map _node_id ns
    ......
    src/Gargantext/Database/Flow/Types.hs
    View file @ 9a23e2d1
    ......@@ -30,7 +30,7 @@ import Gargantext.Core.Flow.Types
    import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
    import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
    import Gargantext.Database.Types.Node (NodeId)
    import Gargantext.Database.Schema.Node (HasNodeError)
    import Gargantext.Database.Types.Errors (HasNodeError)
    import Gargantext.Database.Utils (CmdM)
    type FlowCmdM env err m =
    ......
    src/Gargantext/Database/Root.hs
    View file @ 9a23e2d1
    ......@@ -26,24 +26,25 @@ Portability : POSIX
    module Gargantext.Database.Root where
    import Opaleye (restrict, (.==), Query)
    import Opaleye.PGTypes (pgStrictText, pgInt4)
    import Control.Arrow (returnA)
    import Gargantext.Prelude
    import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
    import Gargantext.Core.Types.Individu (User(..))
    import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Database.Node.User (HyperdataUser)
    import Gargantext.Database.Schema.Node (NodeRead)
    import Gargantext.Database.Schema.Node (pgNodeId)
    import Gargantext.Database.Schema.Node (queryNodeTable)
    import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
    import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Core.Types.Individu (Username)
    import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
    import Gargantext.Database.Utils (Cmd, runOpaQuery)
    import Gargantext.Prelude
    import Opaleye (restrict, (.==), Query)
    import Opaleye.PGTypes (pgStrictText, pgInt4)
    getRoot :: Username -> Cmd err [Node HyperdataUser]
    getRoot :: User -> Cmd err [Node HyperdataUser]
    getRoot = runOpaQuery . selectRoot
    selectRoot :: Username -> Query NodeRead
    selectRoot username = proc () -> do
    selectRoot :: User -> Query NodeRead
    selectRoot (UserName username) = proc () -> do
    row <- queryNodeTable -< ()
    users <- queryUserTable -< ()
    restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
    ......@@ -51,4 +52,15 @@ selectRoot username = proc () -> do
    restrict -< _node_userId row .== (user_id users)
    returnA -< row
    selectRoot (UserDBId uid) = proc () -> do
    row <- queryNodeTable -< ()
    restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
    restrict -< _node_userId row .== (pgInt4 uid)
    returnA -< row
    src/Gargantext/Database/Schema/Node.hs
    View file @ 9a23e2d1
    ......@@ -37,12 +37,14 @@ import Data.Text (Text)
    import Database.PostgreSQL.Simple.FromField (FromField, fromField)
    import GHC.Int (Int64)
    import Gargantext.Core.Types
    import Gargantext.Core.Types.Individu (Username)
    import Gargantext.Database.Types.Errors
    import Gargantext.Core.Types.Individu (User(..))
    import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Database.Queries.Filter (limit', offset')
    import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
    import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser)
    import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
    import Gargantext.Database.Schema.User (getUserId)
    import Gargantext.Database.Utils
    import Gargantext.Prelude hiding (sum, head)
    import Gargantext.Viz.Graph (HyperdataGraph(..))
    ......@@ -51,30 +53,6 @@ import Opaleye hiding (FromField)
    import Opaleye.Internal.QueryArr (Query)
    import Prelude hiding (null, id, map, sum)
    ------------------------------------------------------------------------
    data NodeError = NoListFound
    | NoRootFound
    | NoCorpusFound
    | NoUserFound
    | MkNode
    | UserNoParent
    | HasParent
    | ManyParents
    | NegativeId
    | NotImplYet
    | ManyNodeUsers
    deriving (Show)
    class HasNodeError e where
    _NodeError :: Prism' e NodeError
    nodeError :: (MonadError e m, HasNodeError e) => NodeError -> m a
    nodeError ne = throwError $ _NodeError # ne
    catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
    catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))
    ------------------------------------------------------------------------
    instance FromField HyperdataAny where
    fromField = fromField'
    ......@@ -637,7 +615,12 @@ childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a c
    -- =================================================================== --
    ------------------------------------------------------------------------
    -- | TODO mk all others nodes
    mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
    mkNodeWithParent :: HasNodeError err
    => NodeType
    -> Maybe ParentId
    -> UserId
    -> Name
    -> Cmd err [NodeId]
    mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent
    ------------------------------------------------------------------------
    ......@@ -685,18 +668,24 @@ mkNodeWithParent _ _ _ _ = nodeError NotImplYet
    ------------------------------------------------------------------------
    -- =================================================================== --
    mkRoot :: HasNodeError err
    => User
    -> Cmd err [RootId]
    mkRoot user = do
    uid <- getUserId user
    let una = "username"
    mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
    mkRoot uname uId = case uId > 0 of
    case uid > 0 of
    False -> nodeError NegativeId
    True -> do
    rs <- mkNodeWithParent NodeUser Nothing uId uname
    rs <- mkNodeWithParent NodeUser Nothing uid una
    _ <- case rs of
    [r] -> do
    _ <- mkNodeWithParent NodeFolderPrivate (Just r) uId uname
    _ <- mkNodeWithParent NodeFolderShared (Just r) uId uname
    _ <- mkNodeWithParent NodeFolderPublic (Just r) uId uname
    _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
    _ <- mkNodeWithParent NodeFolderShared (Just r) uid una
    _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una
    pure rs
    _ -> pure rs
    pure rs
    ......
    src/Gargantext/Database/Schema/User.hs
    View file @ 9a23e2d1
    ......@@ -34,27 +34,26 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
    import Data.Text (Text)
    import Data.Time (UTCTime)
    import GHC.Show(Show(..))
    import Gargantext.Core.Types.Individu (Username, arbitraryUsername)
    import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId)
    import Gargantext.Database.Types.Errors
    import Gargantext.Database.Utils
    import Gargantext.Prelude
    import Opaleye
    ------------------------------------------------------------------------
    ------------------------------------------------------------------------
    type UserId = Int
    data UserLight = UserLight { userLight_id :: Int
    , userLight_username :: Text
    , userLight_email :: Text
    } deriving (Show)
    toUserLight :: User -> UserLight
    toUserLight (User id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
    toUserLight :: UserDB -> UserLight
    toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
    data UserPoly id pass llogin suser
    uname fname lname
    mail staff active djoined = User { user_id :: id
    mail staff active djoined = UserDB { user_id :: id
    , user_password :: pass
    , user_lastLogin :: llogin
    , user_isSuperUser :: suser
    ......@@ -93,14 +92,14 @@ type UserReadNull = UserPoly (Column (Nullable PGInt4)) (Column (Nul
    type User = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
    type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
    $(makeAdaptorAndInstance "pUser" ''UserPoly)
    $(makeAdaptorAndInstance "pUserDB" ''UserPoly)
    $(makeLensesWith abbreviatedFields ''UserPoly)
    userTable :: Table UserWrite UserRead
    userTable = Table "auth_user" (pUser User { user_id = optional "id"
    userTable = Table "auth_user" (pUserDB UserDB { user_id = optional "id"
    , user_password = required "password"
    , user_lastLogin = optional "last_login"
    , user_isSuperUser = required "is_superuser"
    ......@@ -122,7 +121,7 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
    gargantextUser :: Username -> UserWrite
    gargantextUser u = User (Nothing) (pgStrictText "password")
    gargantextUser u = UserDB (Nothing) (pgStrictText "password")
    (Nothing) (pgBool True) (pgStrictText u)
    (pgStrictText "first_name")
    (pgStrictText "last_name")
    ......@@ -132,14 +131,13 @@ gargantextUser u = User (Nothing) (pgStrictText "password")
    insertUsersDemo :: Cmd err Int64
    insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername
    ------------------------------------------------------------------
    queryUserTable :: Query UserRead
    queryUserTable = queryTable userTable
    selectUsersLight :: Query UserRead
    selectUsersLight = proc () -> do
    row@(User i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
    row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
    restrict -< i .== 1
    --returnA -< User i p ll is un fn ln m iff ive dj
    returnA -< row
    ......@@ -150,10 +148,10 @@ userWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
    userWith f t xs = find (\x -> f x == t) xs
    -- | Select User with Username
    userWithUsername :: Text -> [User] -> Maybe User
    userWithUsername :: Text -> [UserDB] -> Maybe UserDB
    userWithUsername t xs = userWith user_username t xs
    userWithId :: Int -> [User] -> Maybe User
    userWithId :: Int -> [UserDB] -> Maybe UserDB
    userWithId t xs = userWith user_id t xs
    userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight
    ......@@ -167,7 +165,7 @@ instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    users :: Cmd err [User]
    users :: Cmd err [UserDB]
    users = runOpaQuery queryUserTable
    usersLight :: Cmd err [UserLight]
    ......@@ -177,3 +175,14 @@ getUser :: Username -> Cmd err (Maybe UserLight)
    getUser u = userLightWithUsername u <$> usersLight
    getUserId :: HasNodeError err
    => User
    -> Cmd err UserId
    getUserId (UserDBId uid) = pure uid
    getUserId (UserName u ) = do
    muser <- getUser u
    case muser of
    Just user -> pure $ userLight_id user
    Nothing -> nodeError NoUserFound
    src/Gargantext/Viz/Graph/API.hs
    View file @ 9a23e2d1
    ......@@ -48,7 +48,8 @@ import Gargantext.Database.Config
    import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
    import Gargantext.Database.Schema.Ngrams
    import Gargantext.Database.Node.Select
    import Gargantext.Database.Schema.Node (getNodeWith, getNodeUser, defaultList, insertGraph, HasNodeError)
    import Gargantext.Database.Schema.Node (getNodeWith, getNodeUser, defaultList, insertGraph)
    import Gargantext.Database.Types.Errors (HasNodeError)
    import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
    import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
    import Gargantext.Database.Utils (Cmd)
    ......
    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