[FIX] History patch working, bug several NRE fixed, needs stemming scores now
[gargantext.git] / src / Gargantext / API / Node / Share.hs
index 99a4eafc36dc856f4ab000c5f4b2935b16aa8c96..61e055b0afe5275fbf4002af000d827359294e95 100644 (file)
@@ -11,7 +11,6 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Node.Share
       where
@@ -21,16 +20,20 @@ import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.API.Prelude
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
 import Gargantext.Database.Action.Share (ShareNodeWith(..))
 import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
+import Gargantext.Database.Action.User
+import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Tree (findNodesWithType)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
+import qualified Data.List as List
 
 ------------------------------------------------------------------------
 data ShareNodeParams = ShareTeamParams   { username :: Text  }
@@ -49,13 +52,48 @@ instance Arbitrary ShareNodeParams where
                        ]
 ------------------------------------------------------------------------
 -- TODO permission
+-- TODO refactor userId which is used twice
+-- TODO change return type for better warning/info/success/error handling on the front
 api :: HasNodeError err
-    => NodeId
+    => User
+    -> NodeId
     -> ShareNodeParams
-    -> Cmd err Int
-api nId (ShareTeamParams user) =
-  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId 
-api nId2 (SharePublicParams nId1) =
+    -> CmdR err Int
+api userInviting nId (ShareTeamParams user') = do
+  user <- case guessUserName user' of
+    Nothing    -> pure user'
+    Just (u,_) -> do
+      isRegistered <- getUserId' (UserName u)
+      case isRegistered of
+        Just _  -> do
+          printDebug "[G.A.N.Share.api]" ("Team shared with " <> u)
+          pure u
+        Nothing -> do
+          username' <- getUsername userInviting
+          _ <- case List.elem username' arbitraryUsername of
+            True  -> do
+              printDebug "[G.A.N.Share.api]" ("demo users are not allowed to invite" :: Text)
+              pure ()
+            False -> do
+              -- TODO better analysis of the composition of what is shared
+              children <- findNodesWithType nId [NodeList] [ NodeFolderShared
+                                                           , NodeTeam
+                                                           , NodeFolder
+                                                           , NodeCorpus
+                                                           ]
+              _ <- case List.null children of
+                True -> do
+                  printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text)
+                  pure 0
+                False -> do 
+                  printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user')
+                  newUsers [user']
+              pure ()
+          pure u
+
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId
+api _uId nId2 (SharePublicParams nId1) =
+
   fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
 
 ------------------------------------------------------------------------