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 mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
  29 mkUser address u = mkUsers address [u]
  30
  31 mkUsers :: HasNodeError err => Text -> [NewUser GargPassword] -> Cmd err Int64
  32 mkUsers address us = do
  33   us' <- liftBase    $ mapM toUserHash us
  34   r   <- insertUsers $ map toUserWrite us'
  35   _   <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
  36   _   <- liftBase    $ mapM (mail address) us
  37   pure r
  38 ------------------------------------------------------------------------
  39 updateUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
  40 updateUser address u = do
  41   u' <- liftBase   $ toUserHash   u
  42   n  <- updateUserDB $ toUserWrite  u'
  43   _  <- liftBase   $ mail address u
  44   pure n
  45
  46 ------------------------------------------------------------------------
  47 -- TODO gargantext.ini config
  48 mail :: Text -> NewUser GargPassword -> IO ()
  49 mail address nu@(NewUser u m _) = gargMail (GargMail m (Just u) subject body)
  50   where
  51     subject = "[Your Garg Account]"
  52     body    = logInstructions address nu
  53
  54 -- TODO put this in a configurable file (path in gargantext.ini)
  55 logInstructions :: Text -> NewUser GargPassword -> Text
  56 logInstructions address (NewUser u _ (GargPassword p)) =
  57   unlines [ "Hello"
  58           , "You have been invited to test the new GarganText platform!"
  59           , ""
  60           , "You can log on to: "  <> address
  61           , "Your login is: "      <> u
  62           , "Your password is: "   <> p
  63           , ""
  64           , "Please read the full terms of use on:"
  65           , "https://gitlab.iscpif.fr/humanities/tofu/tree/master"
  66           , ""
  67           , "Your feedback will be valuable for further development"
  68           , "of the platform, do not hesitate to contact us and"
  69           , "to contribute on our forum:"
  70           , "     https://discourse.iscpif.fr/c/gargantext"
  71           , ""
  72           , "With our best regards,"
  73           , "-- "
  74           , "The Gargantext Team (CNRS)"
  75           ]
  76
  77 ------------------------------------------------------------------------
  78 rmUser :: HasNodeError err => User -> Cmd err Int64
  79 rmUser (UserName un) = deleteUsers [un]
  80 rmUser _ = nodeError NotImplYet
  81
  82 -- TODO
  83 rmUsers :: HasNodeError err => [User] -> Cmd err Int64
  84 rmUsers [] = pure 0
  85 rmUsers _  = undefined