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 Gargantext.Database.Query.Table.User
  19 import Gargantext.Core.Types.Individu
  20 import Gargantext.Database.Prelude
  21 import Gargantext.Prelude
  22 import Gargantext.Prelude.Mail (gargMail)
  23 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
  24 import Gargantext.Database.Action.Flow (getOrMkRoot)
  25
  26
  27 ------------------------------------------------------------------------
  28 mkUser :: HasNodeError err => NewUser GargPassword -> Cmd err Int64
  29 mkUser u = mkUsers [u]
  30
  31 mkUsers :: HasNodeError err => [NewUser GargPassword] -> Cmd err Int64
  32 mkUsers 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 gargMail
  37   pure r
  38
  39 ------------------------------------------------------------------------
  40 rmUser :: HasNodeError err => User -> Cmd err Int64
  41 rmUser (UserName un) = deleteUsers [un]
  42 rmUser _ = nodeError NotImplYet
  43
  44 -- TODO
  45 rmUsers :: HasNodeError err => [User] -> Cmd err Int64
  46 rmUsers [] = pure 0
  47 rmUsers _  = undefined