Commit 9a23e2d1 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Flow] using user id. TODO : tests.

parent 75b4fd25
Pipeline #811 failed with stage
......@@ -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 =
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -164,5 +164,7 @@ data TODO = TODO
instance ToSchema TODO where
instance ToParamSchema TODO where
----------------------------------------------------------------------------
......@@ -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
......@@ -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
......
......@@ -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 =
......
......@@ -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
......@@ -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,36 +615,41 @@ 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
------------------------------------------------------------------------
mkNodeWithParent NodeUser Nothing uId name =
mkNodeWithParent NodeUser Nothing uId name =
insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
mkNodeWithParent _ Nothing _ _ = nodeError HasParent
------------------------------------------------------------------------
mkNodeWithParent NodeFolder (Just i) uId name =
mkNodeWithParent NodeFolder (Just i) uId name =
insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
where
hd = defaultFolder
mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
where
hd = defaultFolder
mkNodeWithParent NodeFolderShared (Just i) uId _ =
mkNodeWithParent NodeFolderShared (Just i) uId _ =
insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
where
hd = defaultFolder
mkNodeWithParent NodeFolderPublic (Just i) uId _ =
mkNodeWithParent NodeFolderPublic (Just i) uId _ =
insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
where
hd = defaultFolder
mkNodeWithParent NodeTeam (Just i) uId _ =
mkNodeWithParent NodeTeam (Just i) uId _ =
insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId]
where
hd = defaultFolder
......@@ -685,21 +668,27 @@ mkNodeWithParent _ _ _ _ = nodeError NotImplYet
------------------------------------------------------------------------
-- =================================================================== --
mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
mkRoot uname uId = case uId > 0 of
False -> nodeError NegativeId
True -> do
rs <- mkNodeWithParent NodeUser Nothing uId uname
_ <- case rs of
[r] -> do
_ <- mkNodeWithParent NodeFolderPrivate (Just r) uId uname
_ <- mkNodeWithParent NodeFolderShared (Just r) uId uname
_ <- mkNodeWithParent NodeFolderPublic (Just r) uId uname
pure rs
_ -> pure rs
pure rs
mkRoot :: HasNodeError err
=> User
-> Cmd err [RootId]
mkRoot user = do
uid <- getUserId user
let una = "username"
case uid > 0 of
False -> nodeError NegativeId
True -> do
rs <- mkNodeWithParent NodeUser Nothing uid una
_ <- case rs of
[r] -> do
_ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
_ <- mkNodeWithParent NodeFolderShared (Just r) uid una
_ <- mkNodeWithParent NodeFolderPublic (Just r) uid una
pure rs
_ -> pure rs
pure rs
-- |
-- CorpusDocument is a corpus made from a set of documents
......
......@@ -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
......@@ -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