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
  14 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  15
  16 {-# LANGUAGE DeriveAnyClass              #-}
  17 {-# LANGUAGE FunctionalDependencies      #-}
  18 {-# LANGUAGE Arrows                      #-}
  19 {-# LANGUAGE TemplateHaskell             #-}
  20
  21 module Gargantext.Database.Schema.User where
  22
  23 import Data.Morpheus.Types (GQLType(typeOptions))
  24 import Data.Text (Text)
  25 import Data.Time (UTCTime)
  26 import qualified Gargantext.API.GraphQL.Utils as GAGU
  27 import Gargantext.Core.Utils.Prefix (unPrefix)
  28 import Gargantext.Core.Types.Individu (GargPassword, toGargPassword)
  29 import Gargantext.Database.Prelude (fromField')
  30 import Gargantext.Prelude
  31 import GHC.Generics (Generic)
  32 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  33 import Data.Aeson.TH (deriveJSON)
  34
  35 -- FIXME PLZ : the import below leads to an error, why ?
  36 -- import Gargantext.Database.Schema.Prelude hiding (makeLensesWith, abbreviatedFields, makeAdaptorAndInstance)
  37
  38 -- When FIXED : Imports to remove:
  39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  40 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  41 import Opaleye hiding (FromField)
  42 import Opaleye.Internal.Table (Table(..))
  43 ------------------------------------------------------------------------
  44 data UserLight = UserLight { userLight_id                   :: !Int
  45                            , userLight_username             :: !Text
  46                            , userLight_email                :: !Text
  47                            , userLight_password             :: !GargPassword
  48                            , userLight_forgot_password_uuid :: !(Maybe Text)
  49                            } deriving (Show, Generic)
  50 instance GQLType UserLight where
  51   typeOptions _ = GAGU.unPrefix "userLight_"
  52
  53 toUserLight :: UserDB -> UserLight
  54 toUserLight (UserDB { user_id
  55                     , user_password
  56                     , user_username
  57                     , user_email }) = UserLight { userLight_id = user_id
  58                                                 , userLight_username = user_username
  59                                                 , userLight_email = user_email
  60                                                 , userLight_password = toGargPassword user_password
  61                                                 , userLight_forgot_password_uuid = Nothing }
  62
  63
  64 data UserPoly id pass llogin suser
  65               uname fname lname
  66               mail staff active djoined
  67               fpuuid =
  68     UserDB { user_id                   :: !id
  69            , user_password             :: !pass
  70            , user_lastLogin            :: !llogin
  71            , user_isSuperUser          :: !suser
  72
  73            , user_username             :: !uname
  74            , user_firstName            :: !fname
  75            , user_lastName             :: !lname
  76            , user_email                :: !mail
  77
  78            , user_isStaff              :: !staff
  79            , user_isActive             :: !active
  80            , user_dateJoined           :: !djoined
  81
  82            , user_forgot_password_uuid :: !fpuuid
  83            } deriving (Show, Generic)
  84
  85
  86 type UserWrite = UserPoly (Maybe (Column SqlInt4))        (Column SqlText)
  87                           (Maybe (Column SqlTimestamptz)) (Column SqlBool)
  88                                  (Column SqlText)         (Column SqlText)
  89                                  (Column SqlText)         (Column SqlText)
  90                                  (Column SqlBool)         (Column SqlBool)
  91                                  (Maybe (Column SqlTimestamptz))
  92                                  (Maybe (Column SqlText))
  93
  94 type UserRead  = UserPoly        (Column SqlInt4)         (Column SqlText)
  95                                  (Column SqlTimestamptz)  (Column SqlBool)
  96                                  (Column SqlText)         (Column SqlText)
  97                                  (Column SqlText)         (Column SqlText)
  98                                  (Column SqlBool)         (Column SqlBool)
  99                                  (Column SqlTimestamptz)
 100                                  (Column SqlText)
 101
 102 type UserReadNull = UserPoly     (Column (Nullable SqlInt4))         (Column SqlText)
 103                                  (Column (Nullable SqlTimestamptz))  (Column SqlBool)
 104                                  (Column SqlText)                    (Column SqlText)
 105                                  (Column SqlText)                    (Column SqlText)
 106                                  (Column SqlBool)                    (Column SqlBool)
 107                                  (Column (Nullable SqlTimestamptz))
 108                                  (Column (Nullable SqlText))
 109
 110 type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime (Maybe Text)
 111
 112 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
 113 $(makeLensesWith abbreviatedFields   ''UserPoly)
 114
 115 userTable :: Table UserWrite UserRead
 116 userTable = Table "auth_user"
 117   (pUserDB UserDB { user_id                   = optionalTableField "id"
 118                   , user_password             = requiredTableField "password"
 119                   , user_lastLogin            = optionalTableField "last_login"
 120                   , user_isSuperUser          = requiredTableField "is_superuser"
 121                   , user_username             = requiredTableField "username"
 122                   , user_firstName            = requiredTableField "first_name"
 123                   , user_lastName             = requiredTableField "last_name"
 124                   , user_email                = requiredTableField "email"
 125                   , user_isStaff              = requiredTableField "is_staff"
 126                   , user_isActive             = requiredTableField "is_active"
 127                   , user_dateJoined           = optionalTableField "date_joined"
 128                   , user_forgot_password_uuid = optionalTableField "forgot_password_uuid"
 129                   }
 130       )
 131
 132 instance FromField UserLight where
 133   fromField = fromField'
 134
 135 instance FromField UserDB where
 136   fromField = fromField'
 137
 138 $(deriveJSON (unPrefix "userLight_") ''UserLight)
 139 $(deriveJSON (unPrefix "user_") ''UserPoly)