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