Commit d3547991 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] Invitation through Shared node

parent 5bbe1df1
...@@ -25,6 +25,8 @@ import Test.QuickCheck.Arbitrary ...@@ -25,6 +25,8 @@ import Test.QuickCheck.Arbitrary
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.User
import Gargantext.Database.Action.User.New
import Gargantext.Database.Action.Share (ShareNodeWith(..)) import Gargantext.Database.Action.Share (ShareNodeWith(..))
import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish) import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
...@@ -52,10 +54,21 @@ instance Arbitrary ShareNodeParams where ...@@ -52,10 +54,21 @@ instance Arbitrary ShareNodeParams where
api :: HasNodeError err api :: HasNodeError err
=> NodeId => NodeId
-> ShareNodeParams -> ShareNodeParams
-> Cmd err Int -> CmdR err Int
api nId (ShareTeamParams user) = api nId (ShareTeamParams user') = do
user <- case guessUserName user' of
Nothing -> pure user'
Just (u,_) -> do
isRegistered <- getUserId' (UserName u)
case isRegistered of
Just _ -> pure u
Nothing -> do
_ <- newUsers [u]
pure u
fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId
api nId2 (SharePublicParams nId1) = api nId2 (SharePublicParams nId1) =
fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2 fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -68,7 +68,7 @@ type ErrC err = ...@@ -68,7 +68,7 @@ type ErrC err =
) )
type GargServerC env err m = type GargServerC env err m =
( CmdM' env err m ( CmdRandom env err m
, EnvC env , EnvC env
, ErrC err , ErrC err
) )
......
...@@ -32,13 +32,12 @@ publicNodeTypes :: [NodeType] ...@@ -32,13 +32,12 @@ publicNodeTypes :: [NodeType]
publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile] publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile]
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
, snwu_user :: User } , snwu_user :: User
}
| ShareNodeWith_Node { snwn_nodetype :: NodeType | ShareNodeWith_Node { snwn_nodetype :: NodeType
, snwn_node_id :: NodeId , snwn_node_id :: NodeId
} }
------------------------------------------------------------------------ ------------------------------------------------------------------------
shareNodeWith :: HasNodeError err shareNodeWith :: HasNodeError err
=> ShareNodeWith => ShareNodeWith
...@@ -86,7 +85,6 @@ delFolderTeam u nId = do ...@@ -86,7 +85,6 @@ delFolderTeam u nId = do
folderSharedId <- getFolderId u NodeFolderShared folderSharedId <- getFolderId u NodeFolderShared
deleteNodeNode folderSharedId nId deleteNodeNode folderSharedId nId
unPublish :: HasNodeError err unPublish :: HasNodeError err
=> ParentId -> NodeId => ParentId -> NodeId
-> Cmd err Int -> Cmd err Int
......
...@@ -27,16 +27,25 @@ import Gargantext.Prelude ...@@ -27,16 +27,25 @@ import Gargantext.Prelude
getUserId :: HasNodeError err getUserId :: HasNodeError err
=> User => User
-> Cmd err UserId -> Cmd err UserId
getUserId (UserDBId uid) = pure uid getUserId u = do
getUserId (RootId rid) = do maybeUser <- getUserId' u
case maybeUser of
Nothing -> nodeError NoUserFound
Just u -> pure u
getUserId' :: HasNodeError err
=> User
-> Cmd err (Maybe UserId)
getUserId' (UserDBId uid) = pure (Just uid)
getUserId' (RootId rid) = do
n <- getNode rid n <- getNode rid
pure $ _node_userId n pure $ Just $ _node_userId n
getUserId (UserName u ) = do getUserId' (UserName u ) = do
muser <- getUser u muser <- getUser u
case muser of case muser of
Just user -> pure $ userLight_id user Just user -> pure $ Just $ userLight_id user
Nothing -> nodeError NoUserFound Nothing -> pure Nothing
getUserId UserPublic = nodeError NoUserFound getUserId' UserPublic = pure Nothing
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Username = Text -- | Username = Text
......
...@@ -26,7 +26,7 @@ import Gargantext.Prelude ...@@ -26,7 +26,7 @@ import Gargantext.Prelude
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Prelude.Crypto.Pass.User (gargPass) import Gargantext.Prelude.Crypto.Pass.User (gargPass)
import Gargantext.Prelude.Mail (gargMail, GargMail(..)) import Gargantext.Prelude.Mail (gargMail, GargMail(..))
import qualified Data.List as List
------------------------------------------------------------------------ ------------------------------------------------------------------------
type EmailAddress = Text type EmailAddress = Text
...@@ -42,14 +42,19 @@ newUserQuick :: (MonadRandom m) ...@@ -42,14 +42,19 @@ newUserQuick :: (MonadRandom m)
=> Text -> m (NewUser GargPassword) => Text -> m (NewUser GargPassword)
newUserQuick n = do newUserQuick n = do
pass <- gargPass pass <- gargPass
let (u,_m) = guessUserName n let u = case guessUserName n of
Just (u', _m) -> u'
Nothing -> panic "Email invalid"
pure (NewUser u n (GargPassword pass)) pure (NewUser u n (GargPassword pass))
guessUserName :: Text -> (Text,Text) isEmail :: Text -> Bool
isEmail = ((==) 2) . List.length . (splitOn "@")
guessUserName :: Text -> Maybe (Text,Text)
guessUserName n = case splitOn "@" n of guessUserName n = case splitOn "@" n of
[u',m'] -> if m' /= "" then (u',m') [u',m'] -> if m' /= "" then Just (u',m')
else panic "Email Invalid" else Nothing
_ -> panic "Email invalid" _ -> Nothing
------------------------------------------------------------------------ ------------------------------------------------------------------------
newUser' :: HasNodeError err newUser' :: HasNodeError err
=> Text -> NewUser GargPassword -> Cmd err Int64 => Text -> NewUser GargPassword -> Cmd err Int64
......
...@@ -80,10 +80,17 @@ type CmdM env err m = ...@@ -80,10 +80,17 @@ type CmdM env err m =
, HasConfig env , HasConfig env
) )
type CmdRandom env err m =
( CmdM' env err m
, HasConnectionPool env
, HasConfig env
, MonadRandom m
)
type Cmd'' env err a = forall m. CmdM'' env err m => m a type Cmd'' env err a = forall m. CmdM'' env err m => m a
type Cmd' env err a = forall m. CmdM' env err m => m a type Cmd' env err a = forall m. CmdM' env err m => m a
type Cmd err a = forall m env. CmdM env err m => m a type Cmd err a = forall m env. CmdM env err m => m a
type CmdR err a = forall m env. CmdRandom env err m => m a
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment