src/Gargantext/Database/Query/Tree/Root.hs

   1 {-|
   2 Module      : Gargantext.Database.Root
   3 Description : Main requests to get root of users
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE ConstraintKinds        #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE TemplateHaskell        #-}
  18
  19 module Gargantext.Database.Query.Tree.Root
  20   where
  21
  22 import Data.Either (Either, fromLeft, fromRight)
  23 import Control.Arrow (returnA)
  24 import Gargantext.Core.Types.Main (CorpusName)
  25 import Gargantext.Core.Types.Individu (User(..))
  26 import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
  27 import Gargantext.Database.Query.Table.Node.Error
  28 import Gargantext.Database.Admin.Types.Node
  29 import Gargantext.Database.Query.Table.Node
  30 import Gargantext.Database.Query.Table.Node.User (HyperdataUser)
  31 import Gargantext.Database.Action.Flow.Utils (getUserId)
  32 import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
  33 import Gargantext.Database.Schema.Node (queryNodeTable)
  34 import Gargantext.Database.Action.Node
  35 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
  36 import Gargantext.Database.Admin.Types.Node (Node, NodeType(NodeUser), pgNodeId)
  37 import Gargantext.Database.Prelude (Cmd, runOpaQuery)
  38 import Gargantext.Prelude
  39 import Opaleye (restrict, (.==), Query)
  40 import Opaleye.PGTypes (pgStrictText, pgInt4)
  41
  42
  43
  44 getOrMkRoot :: (HasNodeError err)
  45             => User
  46             -> Cmd err (UserId, RootId)
  47 getOrMkRoot user = do
  48   userId <- getUserId user
  49
  50   rootId' <- map _node_id <$> getRoot user
  51
  52   rootId'' <- case rootId' of
  53         []  -> mkRoot user
  54         n   -> case length n >= 2 of
  55             True  -> nodeError ManyNodeUsers
  56             False -> pure rootId'
  57
  58   rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
  59   pure (userId, rootId)
  60
  61
  62 getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
  63                       => User
  64                       -> Either CorpusName [CorpusId]
  65                       -> Maybe a
  66                       -> Cmd err (UserId, RootId, CorpusId)
  67 getOrMk_RootWithCorpus user cName c = do
  68   (userId, rootId) <- getOrMkRoot user
  69   corpusId'' <- if user == UserName userMaster
  70                   then do
  71                     ns <- getCorporaWithParentId rootId
  72                     pure $ map _node_id ns
  73                   else
  74                     pure $ fromRight [] cName
  75
  76   corpusId' <- if corpusId'' /= []
  77                   then pure corpusId''
  78                   else do
  79                     c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
  80                     _tId <- case head c' of
  81                               Nothing -> pure [0]
  82                               Just c'' -> mkNode NodeTexts c'' userId
  83                     pure c'
  84
  85   corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
  86   pure (userId, rootId, corpusId)
  87
  88
  89
  90
  91
  92
  93 mkRoot :: HasNodeError err
  94        => User
  95        -> Cmd err [RootId]
  96 mkRoot user = do
  97
  98   -- TODO
  99   -- udb <- getUserDb user
 100   -- let uid = user_id udb
 101   uid <- getUserId user
 102
 103   -- TODO ? Which name for user Node ?
 104   let una = "username"
 105
 106   case uid > 0 of
 107      False -> nodeError NegativeId
 108      True  -> do
 109        rs <- mkNodeWithParent NodeUser Nothing uid una
 110        _ <- case rs of
 111          [r] -> do
 112            _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
 113            _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
 114            _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
 115            pure rs
 116          _   -> pure rs
 117        pure rs
 118
 119 getRoot :: User -> Cmd err [Node HyperdataUser]
 120 getRoot = runOpaQuery . selectRoot
 121
 122 selectRoot :: User -> Query NodeRead
 123 selectRoot (UserName username) = proc () -> do
 124     row   <- queryNodeTable -< ()
 125     users <- queryUserTable -< ()
 126     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
 127     restrict -< user_username  users .== (pgStrictText username)
 128     restrict -< _node_userId   row   .== (user_id users)
 129     returnA  -< row
 130
 131 selectRoot (UserDBId uid) = proc () -> do
 132     row   <- queryNodeTable -< ()
 133     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
 134     restrict -< _node_userId   row   .== (pgInt4 uid)
 135     returnA  -< row
 136
 137 selectRoot (RootId nid) =
 138  proc () -> do
 139     row   <- queryNodeTable -< ()
 140     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
 141     restrict -< _node_id   row   .== (pgNodeId nid)
 142     returnA  -< row
 143