src/Gargantext/Database/Action/User.hs

   1 {-|
   2 Module      : Gargantext.Database.Action.User
   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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 module Gargantext.Database.Action.User
  15   where
  16
  17 -- import Data.Maybe (catMaybes)
  18 import Data.Text (Text, unlines)
  19 import Gargantext.Database.Query.Table.User
  20 import Gargantext.Core.Types.Individu
  21 import Gargantext.Database.Prelude
  22 import Gargantext.Prelude
  23 import Gargantext.Prelude.Mail (gargMail, GargMail(..))
  24 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
  25 import Gargantext.Database.Action.Flow (getOrMkRoot)
  26
  27
  28 ------------------------------------------------------------------------
  29 mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
  30 mkUser address u = mkUsers address [u]
  31
  32 mkUsers :: HasNodeError err => Text -> [NewUser GargPassword] -> Cmd err Int64
  33 mkUsers address us = do
  34   us' <- liftBase    $ mapM toUserHash us
  35   r   <- insertUsers $ map toUserWrite us'
  36   _   <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
  37   _   <- liftBase    $ mapM (mail address) us
  38   pure r
  39
  40 ------------------------------------------------------------------------
  41 -- TODO gargantext.ini config
  42 mail :: Text -> NewUser GargPassword -> IO ()
  43 mail address nu@(NewUser u m _) = gargMail (GargMail m (Just u) subject body)
  44   where
  45     subject = "[Your Garg Account]"
  46     body    = logInstructions address nu
  47
  48 -- TODO put this in a configurable file (path in gargantext.ini)
  49 logInstructions :: Text -> NewUser GargPassword -> Text
  50 logInstructions address (NewUser u _ (GargPassword p)) =
  51   unlines [ "Hello"
  52           , "You have been invited to test the new GarganText platform!"
  53           , ""
  54           , "You can log on to: "  <> address
  55           , "Your login is: "      <> u
  56           , "Your password is: "   <> p
  57           , ""
  58           , "Please read the full terms of use on:"
  59           , "https://gitlab.iscpif.fr/humanities/tofu/tree/master"
  60           , ""
  61           , "Your feedback will be valuable for further development"
  62           , "of the platform, do not hesitate to contact us and"
  63           , "to contribute on our forum:"
  64           , "     https://discourse.iscpif.fr/c/gargantext"
  65           , ""
  66           , "With our best regards,"
  67           , "-- "
  68           , "The Gargantext Team (CNRS)"
  69           ]
  70
  71 ------------------------------------------------------------------------
  72
  73
  74 ------------------------------------------------------------------------
  75 rmUser :: HasNodeError err => User -> Cmd err Int64
  76 rmUser (UserName un) = deleteUsers [un]
  77 rmUser _ = nodeError NotImplYet
  78
  79 -- TODO
  80 rmUsers :: HasNodeError err => [User] -> Cmd err Int64
  81 rmUsers [] = pure 0
  82 rmUsers _  = undefined