Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
+
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Action.User
- where
+ where
--- import Data.Maybe (catMaybes)
-import Data.Text (Text, unlines)
+import Data.Text (Text)
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.User
-import Gargantext.Core.Types.Individu
-import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Schema.Node
import Gargantext.Prelude
-import Gargantext.Prelude.Mail (gargMail, GargMail(..))
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
-import Gargantext.Database.Action.Flow (getOrMkRoot)
-
------------------------------------------------------------------------
-mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
-mkUser address u = mkUsers address [u]
+getUserLightWithId :: HasNodeError err => Int -> Cmd err UserLight
+getUserLightWithId i = do
+ candidates <- head <$> getUsersWithId i
+ case candidates of
+ Nothing -> nodeError NoUserFound
+ Just u -> pure u
-mkUsers :: HasNodeError err => Text -> [NewUser GargPassword] -> Cmd err Int64
-mkUsers address us = do
- us' <- liftBase $ mapM toUserHash us
- r <- insertUsers $ map toUserWrite us'
- _ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
- _ <- liftBase $ mapM (mail address) us
- pure r
+getUserLightDB :: HasNodeError err => User -> Cmd err UserLight
+getUserLightDB u = do
+ userId <- getUserId u
+ userLight <- getUserLightWithId userId
+ pure userLight
------------------------------------------------------------------------
--- TODO gargantext.ini config
-mail :: Text -> NewUser GargPassword -> IO ()
-mail address nu@(NewUser u m _) = gargMail (GargMail m (Just u) subject body)
- where
- subject = "[Your Garg Account]"
- body = logInstructions address nu
+getUserId :: HasNodeError err
+ => User
+ -> Cmd err UserId
+getUserId u = do
+ maybeUser <- getUserId' u
+ case maybeUser of
+ Nothing -> nodeError NoUserFound
+ Just u' -> pure u'
--- TODO put this in a configurable file (path in gargantext.ini)
-logInstructions :: Text -> NewUser GargPassword -> Text
-logInstructions address (NewUser u _ (GargPassword p)) =
- unlines [ "Hello"
- , "You have been invited to test the new GarganText platform!"
- , ""
- , "You can log on to: " <> address
- , "Your login is: " <> u
- , "Your password is: " <> p
- , ""
- , "Please read the full terms of use on:"
- , "https://gitlab.iscpif.fr/humanities/tofu/tree/master"
- , ""
- , "Your feedback will be valuable for further development"
- , "of the platform, do not hesitate to contact us and"
- , "to contribute on our forum:"
- , " https://discourse.iscpif.fr/c/gargantext"
- , ""
- , "With our best regards,"
- , "-- "
- , "The Gargantext Team (CNRS)"
- ]
+getUserId' :: HasNodeError err
+ => User
+ -> Cmd err (Maybe UserId)
+getUserId' (UserDBId uid) = pure (Just uid)
+getUserId' (RootId rid) = do
+ n <- getNode rid
+ pure $ Just $ _node_user_id n
+getUserId' (UserName u ) = do
+ muser <- getUser u
+ case muser of
+ Just user -> pure $ Just $ userLight_id user
+ Nothing -> pure Nothing
+getUserId' UserPublic = pure Nothing
------------------------------------------------------------------------
+-- | Username = Text
+-- UserName is User
+-- that is confusing, we should change this
+type Username = Text
+getUsername :: HasNodeError err
+ => User
+ -> Cmd err Username
+getUsername (UserName u) = pure u
+getUsername (UserDBId i) = do
+ users <- getUsersWithId i
+ case head users of
+ Just u -> pure $ userLight_username u
+ Nothing -> nodeError $ NodeError "G.D.A.U.getUserName: User not found with that id"
+getUsername (RootId rid) = do
+ n <- getNode rid
+ getUsername (UserDBId $ _node_user_id n)
+getUsername UserPublic = pure "UserPublic"
+--------------------------------------------------------------------------
+-- getRootId is in Gargantext.Database.Query.Tree.Root
-------------------------------------------------------------------------
-rmUser :: HasNodeError err => User -> Cmd err Int64
-rmUser (UserName un) = deleteUsers [un]
-rmUser _ = nodeError NotImplYet
-
--- TODO
-rmUsers :: HasNodeError err => [User] -> Cmd err Int64
-rmUsers [] = pure 0
-rmUsers _ = undefined