src/Gargantext/Database/Schema/User.hs

   1 {-|
   2 Module      : Gargantext.Database.user
   3 Description : User Database management tools
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Functions to deal with users, database side.
  11 -}
  12
  13 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  14 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  15
  16 {-# LANGUAGE TemplateHaskell             #-}
  17 {-# LANGUAGE FlexibleContexts            #-}
  18 {-# LANGUAGE FlexibleInstances           #-}
  19 {-# LANGUAGE MultiParamTypeClasses       #-}
  20 {-# LANGUAGE FunctionalDependencies      #-}
  21 {-# LANGUAGE Arrows                      #-}
  22 {-# LANGUAGE NoImplicitPrelude           #-}
  23 {-# LANGUAGE OverloadedStrings           #-}
  24 {-# LANGUAGE RankNTypes                  #-}
  25
  26 module Gargantext.Database.Schema.User where
  27
  28 import Control.Arrow (returnA)
  29 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  30 import Data.Eq(Eq(..))
  31 import Data.List (find)
  32 import Data.Maybe (Maybe)
  33 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  34 import Data.Text (Text)
  35 import Data.Time (UTCTime)
  36 import GHC.Show(Show(..))
  37 import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId)
  38 import Gargantext.Database.Admin.Types.Errors
  39 import Gargantext.Database.Admin.Utils
  40 import Gargantext.Prelude
  41 import Opaleye
  42
  43 ------------------------------------------------------------------------
  44 ------------------------------------------------------------------------
  45
  46 data UserLight = UserLight { userLight_id   :: Int
  47                            , userLight_username :: Text
  48                            , userLight_email    :: Text
  49                            } deriving (Show)
  50
  51 toUserLight :: UserDB -> UserLight
  52 toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
  53
  54 data UserPoly id pass llogin suser
  55               uname fname lname
  56               mail staff active djoined = UserDB { user_id          :: id
  57                                                , user_password    :: pass
  58                                                , user_lastLogin   :: llogin
  59                                                , user_isSuperUser :: suser
  60
  61                                                , user_username    :: uname
  62                                                , user_firstName   :: fname
  63                                                , user_lastName    :: lname
  64                                                , user_email       :: mail
  65
  66                                                , user_isStaff     :: staff
  67                                                , user_isActive    :: active
  68                                                , user_dateJoined  :: djoined
  69                                                } deriving (Show)
  70
  71 type UserWrite = UserPoly (Maybe (Column PGInt4))        (Column PGText)
  72                           (Maybe (Column PGTimestamptz)) (Column PGBool)
  73                                  (Column PGText)         (Column PGText)
  74                                  (Column PGText)         (Column PGText)
  75                                  (Column PGBool)         (Column PGBool)
  76                                  (Maybe (Column PGTimestamptz))
  77
  78 type UserRead  = UserPoly        (Column PGInt4)         (Column PGText)
  79                                  (Column PGTimestamptz)  (Column PGBool)
  80                                  (Column PGText)         (Column PGText)
  81                                  (Column PGText)         (Column PGText)
  82                                  (Column PGBool)         (Column PGBool)
  83                                  (Column PGTimestamptz)
  84
  85 type UserReadNull = UserPoly     (Column (Nullable PGInt4))         (Column (Nullable PGText))
  86                                  (Column (Nullable PGTimestamptz))  (Column (Nullable PGBool))
  87                                  (Column (Nullable PGText))         (Column (Nullable PGText))
  88                                  (Column (Nullable PGText))         (Column (Nullable PGText))
  89                                  (Column (Nullable PGBool))         (Column (Nullable PGBool))
  90                                  (Column (Nullable PGTimestamptz))
  91
  92
  93
  94
  95 type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
  96
  97 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
  98 $(makeLensesWith abbreviatedFields   ''UserPoly)
  99
 100
 101 userTable :: Table UserWrite UserRead
 102 userTable = Table "auth_user" (pUserDB UserDB { user_id      = optional "id"
 103                                           , user_password    = required "password"
 104                                           , user_lastLogin   = optional "last_login"
 105                                           , user_isSuperUser = required "is_superuser"
 106                                           , user_username    = required "username"
 107                                           , user_firstName   = required "first_name"
 108                                           , user_lastName    = required "last_name"
 109                                           , user_email       = required "email"
 110                                           , user_isStaff     = required "is_staff"
 111                                           , user_isActive    = required "is_active"
 112                                           , user_dateJoined  = optional "date_joined"
 113                                           }
 114                               )
 115