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(..), typeDirective)
  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
  51 instance GQLType UserLight where
  52   directives _ = typeDirective (GAGU.RemovePrefix "asdf")
  53
  54 toUserLight :: UserDB -> UserLight
  55 toUserLight (UserDB { user_id
  56                     , user_password
  57                     , user_username
  58                     , user_email }) = UserLight { userLight_id = user_id
  59                                                 , userLight_username = user_username
  60                                                 , userLight_email = user_email
  61                                                 , userLight_password = toGargPassword user_password
  62                                                 , userLight_forgot_password_uuid = Nothing }
  63
  64
  65 data UserPoly id pass llogin suser
  66               uname fname lname
  67               mail staff active djoined
  68               fpuuid =
  69     UserDB { user_id                   :: !id
  70            , user_password             :: !pass
  71            , user_lastLogin            :: !llogin
  72            , user_isSuperUser          :: !suser
  73
  74            , user_username             :: !uname
  75            , user_firstName            :: !fname
  76            , user_lastName             :: !lname
  77            , user_email                :: !mail
  78
  79            , user_isStaff              :: !staff
  80            , user_isActive             :: !active
  81            , user_dateJoined           :: !djoined
  82
  83            , user_forgot_password_uuid :: !fpuuid
  84            } deriving (Show, Generic)
  85
  86
  87 type UserWrite = UserPoly (Maybe (Column SqlInt4))        (Column SqlText)
  88                           (Maybe (Column SqlTimestamptz)) (Column SqlBool)
  89                                  (Column SqlText)         (Column SqlText)
  90                                  (Column SqlText)         (Column SqlText)
  91                                  (Column SqlBool)         (Column SqlBool)
  92                                  (Maybe (Column SqlTimestamptz))
  93                                  (Maybe (Column SqlText))
  94
  95 type UserRead  = UserPoly        (Column SqlInt4)         (Column SqlText)
  96                                  (Column SqlTimestamptz)  (Column SqlBool)
  97                                  (Column SqlText)         (Column SqlText)
  98                                  (Column SqlText)         (Column SqlText)
  99                                  (Column SqlBool)         (Column SqlBool)
 100                                  (Column SqlTimestamptz)
 101                                  (Column SqlText)
 102
 103 type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime (Maybe Text)
 104
 105 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
 106 $(makeLensesWith abbreviatedFields   ''UserPoly)
 107
 108 userTable :: Table UserWrite UserRead
 109 userTable = Table "auth_user"
 110   (pUserDB UserDB { user_id                   = optionalTableField "id"
 111                   , user_password             = requiredTableField "password"
 112                   , user_lastLogin            = optionalTableField "last_login"
 113                   , user_isSuperUser          = requiredTableField "is_superuser"
 114                   , user_username             = requiredTableField "username"
 115                   , user_firstName            = requiredTableField "first_name"
 116                   , user_lastName             = requiredTableField "last_name"
 117                   , user_email                = requiredTableField "email"
 118                   , user_isStaff              = requiredTableField "is_staff"
 119                   , user_isActive             = requiredTableField "is_active"
 120                   , user_dateJoined           = optionalTableField "date_joined"
 121                   , user_forgot_password_uuid = optionalTableField "forgot_password_uuid"
 122                   }
 123       )
 124
 125 instance FromField UserLight where
 126   fromField = fromField'
 127
 128 instance FromField UserDB where
 129   fromField = fromField'
 130
 131 $(deriveJSON (unPrefix "userLight_") ''UserLight)
 132 $(deriveJSON (unPrefix "user_") ''UserPoly)