[FIX] Clean Text before sending it to NLP micro services + tests + clean code for...
[gargantext.git] / src / Gargantext / Database / Action / Share.hs
index ab70621fa32c62e50c093aded328aa8328d593b0..5405e7ab6bc7330b46f881412d8379e36ee55b61 100644 (file)
@@ -1,6 +1,6 @@
 {-|
 Module      : Gargantext.Database.Action.Share
-Description : 
+Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -10,39 +10,87 @@ Portability : POSIX
 -}
 
 
+{-# LANGUAGE Arrows                 #-}
+
 module Gargantext.Database.Action.Share
   where
 
-import Control.Lens (view)
-import Gargantext.Database
+import Control.Arrow (returnA)
+import Control.Lens (view, (^.))
+import Data.Maybe (catMaybes)
+import Data.Text (Text)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database
+import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
-import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Admin.Types.Node
+-- import Gargantext.Database.Query.Join (leftJoin3')
 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
-import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode)
+import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode, queryNodeNodeTable)
+import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node
-import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Prelude
+import Gargantext.Utils.Tuple (uncurryMaybe)
+import Opaleye hiding (not)
+import qualified Opaleye as O
 
--- | TODO move in Config of Gargantext
+-- | TODO move in PhyloConfig of Gargantext
 publicNodeTypes :: [NodeType]
-publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo]
+publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile]
 
 ------------------------------------------------------------------------
-
 data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
-                                        , snwu_user    :: User }
+                                        , snwu_user     :: User
+                                        }
                    | ShareNodeWith_Node { snwn_nodetype :: NodeType
-                                        , snwn_node_id :: NodeId
+                                        , snwn_node_id  :: NodeId
                                         }
+------------------------------------------------------------------------
+deleteMemberShip :: HasNodeError err => [(SharedFolderId, TeamNodeId)] -> Cmd err [Int]
+deleteMemberShip xs = mapM (\(s,t) -> deleteNodeNode s t) xs
 
 ------------------------------------------------------------------------
+
+type SharedFolderId = NodeId
+type TeamNodeId     = NodeId
+
+-- List members of a Team
+-- Result gives the username and its SharedFolderId that has to be eventually
+-- used for the membership
+membersOf :: HasNodeError err
+          => TeamNodeId -> Cmd err [(Text, SharedFolderId)]
+membersOf nId = do
+  res <- runOpaQuery $ membersOfQuery nId
+  pure $ catMaybes (uncurryMaybe <$> res)
+
+
+membersOfQuery :: TeamNodeId
+               -> SelectArr () (MaybeFields (Field SqlText), MaybeFields (Field SqlInt4))
+membersOfQuery (NodeId teamId) = proc () -> do
+  (nn, n, u) <- nodeNode_node_User -< ()
+  restrict -< (nn ^. nn_node2_id) .== sqlInt4 teamId
+  returnA -< ( user_username <$> u
+             , view node_id <$> n)
+
+
+nodeNode_node_User :: O.Select ( NodeNodeRead
+                               , MaybeFields NodeRead
+                               , MaybeFields UserRead )
+nodeNode_node_User = proc () -> do
+  nn <- queryNodeNodeTable -< ()
+  n <- optionalRestrict queryNodeTable -<
+    \n' -> (n' ^. node_id) .== (nn ^. nn_node1_id)
+  u <- optionalRestrict queryUserTable -<
+    \u' -> (view node_user_id <$> n) .=== justFields (user_id u')
+
+  returnA -< (nn, n, u)
+
+------------------------------------------------------------------------
+-- To Share a Node Team with a user, use this function
+-- basically used with the invitation to a team
 shareNodeWith :: HasNodeError err
               => ShareNodeWith
               -> NodeId
@@ -53,11 +101,14 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
   if not (hasNodeType nodeToCheck NodeTeam)
     then errorWith "[G.D.A.S.shareNodeWith] Can share node Team only"
     else
-      if (view node_userId nodeToCheck == userIdCheck)
+      if (view node_user_id nodeToCheck == userIdCheck)
         then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
         else do
           folderSharedId  <- getFolderId u NodeFolderShared
-          insertDB ([NodeNode folderSharedId n Nothing Nothing]:: [NodeNode])
+          insertDB ([NodeNode { _nn_node1_id = folderSharedId
+                              , _nn_node2_id = n
+                              , _nn_score = Nothing
+                              , _nn_category = Nothing }]:: [NodeNode])
 
 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
   nodeToCheck <- getNode n
@@ -67,7 +118,10 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
     else do
       folderToCheck <- getNode nId
       if hasNodeType folderToCheck NodeFolderPublic
-         then insertDB ([NodeNode nId n Nothing Nothing] :: [NodeNode])
+         then insertDB ([NodeNode { _nn_node1_id = nId
+                                  , _nn_node2_id = n
+                                  , _nn_score = Nothing
+                                  , _nn_category = Nothing }] :: [NodeNode])
          else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
 
 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
@@ -89,9 +143,7 @@ delFolderTeam u nId = do
   folderSharedId <- getFolderId u NodeFolderShared
   deleteNodeNode folderSharedId nId
 
-
 unPublish :: HasNodeError err
           => ParentId -> NodeId
           -> Cmd err Int
 unPublish p n = deleteNodeNode p n
-