src/Gargantext/API/Node/Share.hs

   1 {-|
   2 Module      : Gargantext.API.Node.Share
   3 Description :
   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
  12 {-# LANGUAGE TemplateHaskell    #-}
  13 {-# LANGUAGE TypeOperators      #-}
  14
  15 module Gargantext.API.Node.Share
  16       where
  17
  18 import Data.Aeson
  19 import Data.Swagger
  20 import Data.Text (Text)
  21 import GHC.Generics (Generic)
  22 import Gargantext.API.Prelude
  23 import Gargantext.Core.NLP (HasNLPServer)
  24 import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
  25 import Gargantext.Database.Action.Share (ShareNodeWith(..))
  26 import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
  27 import Gargantext.Database.Action.User
  28 import Gargantext.Database.Action.User.New
  29 import Gargantext.Database.Admin.Types.Node
  30 import Gargantext.Database.Prelude
  31 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
  32 import Gargantext.Database.Query.Tree (findNodesWithType)
  33 import Gargantext.Prelude
  34 import Servant
  35 import Test.QuickCheck (elements)
  36 import Test.QuickCheck.Arbitrary
  37 import qualified Data.List as List
  38 import qualified Data.Text as Text
  39 import qualified Gargantext.Utils.Aeson as GUA
  40
  41 ------------------------------------------------------------------------
  42 data ShareNodeParams = ShareTeamParams   { username :: Text  }
  43                      | SharePublicParams { node_id  :: NodeId}
  44   deriving (Generic)
  45 ------------------------------------------------------------------------
  46 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  47 instance FromJSON  ShareNodeParams where
  48   parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
  49 instance ToJSON    ShareNodeParams where
  50   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
  51 instance ToSchema  ShareNodeParams
  52 instance Arbitrary ShareNodeParams where
  53   arbitrary = elements [ ShareTeamParams "user1"
  54                        , SharePublicParams (NodeId 1)
  55                        ]
  56 ------------------------------------------------------------------------
  57 -- TODO permission
  58 -- TODO refactor userId which is used twice
  59 -- TODO change return type for better warning/info/success/error handling on the front
  60 api :: (HasNodeError err, HasNLPServer env, CmdRandom env err m)
  61     => User
  62     -> NodeId
  63     -> ShareNodeParams
  64     -> m Int
  65 api userInviting nId (ShareTeamParams user') = do
  66   let user'' = Text.toLower user'
  67   user <- case guessUserName user'' of
  68     Nothing    -> pure user''
  69     Just (u,_) -> do
  70       isRegistered <- getUserId' (UserName u)
  71       case isRegistered of
  72         Just _  -> do
  73           -- printDebug "[G.A.N.Share.api]" ("Team shared with " <> u)
  74           pure u
  75         Nothing -> do
  76           username' <- getUsername userInviting
  77           _ <- case List.elem username' arbitraryUsername of
  78             True  -> do
  79               -- printDebug "[G.A.N.Share.api]" ("Demo users are not allowed to invite" :: Text)
  80               pure ()
  81             False -> do
  82               -- TODO better analysis of the composition of what is shared
  83               children <- findNodesWithType nId [NodeList] [ NodeFolderShared
  84                                                            , NodeTeam
  85                                                            , NodeFolder
  86                                                            , NodeCorpus
  87                                                            ]
  88               _ <- case List.null children of
  89                 True -> do
  90                   -- printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text)
  91                   pure 0
  92                 False -> do
  93                   -- printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user'')
  94                   newUsers [user'']
  95               pure ()
  96           pure u
  97
  98   fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId
  99 api _uId nId2 (SharePublicParams nId1) =
 100
 101   fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
 102
 103 ------------------------------------------------------------------------
 104 type API = Summary " Share Node with username"
 105          :> ReqBody '[JSON] ShareNodeParams
 106          :> Post    '[JSON] Int
 107
 108 ------------------------------------------------------------------------
 109 type Unpublish = Summary " Unpublish Node"
 110                :> Capture "node_id" NodeId
 111                :> Put '[JSON] Int
 112
 113 unPublish :: NodeId -> GargServer Unpublish
 114 unPublish n = DB.unPublish n