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.Lens.TH (makeLensesWith, abbreviatedFields)
  29 import Data.Maybe (Maybe)
  30 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  31 import Data.Text (Text)
  32 import Data.Time (UTCTime)
  33 import GHC.Show(Show(..))
  34 import Gargantext.Prelude
  35 import Opaleye
  36
  37 ------------------------------------------------------------------------
  38 ------------------------------------------------------------------------
  39
  40 data UserLight = UserLight { userLight_id   :: Int
  41                            , userLight_username :: Text
  42                            , userLight_email    :: Text
  43                            } deriving (Show)
  44
  45 toUserLight :: UserDB -> UserLight
  46 toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
  47
  48 data UserPoly id pass llogin suser
  49               uname fname lname
  50               mail staff active djoined = UserDB { user_id          :: id
  51                                                , user_password    :: pass
  52                                                , user_lastLogin   :: llogin
  53                                                , user_isSuperUser :: suser
  54
  55                                                , user_username    :: uname
  56                                                , user_firstName   :: fname
  57                                                , user_lastName    :: lname
  58                                                , user_email       :: mail
  59
  60                                                , user_isStaff     :: staff
  61                                                , user_isActive    :: active
  62                                                , user_dateJoined  :: djoined
  63                                                } deriving (Show)
  64
  65 type UserWrite = UserPoly (Maybe (Column PGInt4))        (Column PGText)
  66                           (Maybe (Column PGTimestamptz)) (Column PGBool)
  67                                  (Column PGText)         (Column PGText)
  68                                  (Column PGText)         (Column PGText)
  69                                  (Column PGBool)         (Column PGBool)
  70                                  (Maybe (Column PGTimestamptz))
  71
  72 type UserRead  = UserPoly        (Column PGInt4)         (Column PGText)
  73                                  (Column PGTimestamptz)  (Column PGBool)
  74                                  (Column PGText)         (Column PGText)
  75                                  (Column PGText)         (Column PGText)
  76                                  (Column PGBool)         (Column PGBool)
  77                                  (Column PGTimestamptz)
  78
  79 type UserReadNull = UserPoly     (Column (Nullable PGInt4))         (Column (Nullable PGText))
  80                                  (Column (Nullable PGTimestamptz))  (Column (Nullable PGBool))
  81                                  (Column (Nullable PGText))         (Column (Nullable PGText))
  82                                  (Column (Nullable PGText))         (Column (Nullable PGText))
  83                                  (Column (Nullable PGBool))         (Column (Nullable PGBool))
  84                                  (Column (Nullable PGTimestamptz))
  85
  86
  87
  88
  89 type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
  90
  91 $(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
  92 $(makeLensesWith abbreviatedFields   ''UserPoly)
  93
  94
  95 userTable :: Table UserWrite UserRead
  96 userTable = Table "auth_user" (pUserDB UserDB { user_id      = optional "id"
  97                                           , user_password    = required "password"
  98                                           , user_lastLogin   = optional "last_login"
  99                                           , user_isSuperUser = required "is_superuser"
 100                                           , user_username    = required "username"
 101                                           , user_firstName   = required "first_name"
 102                                           , user_lastName    = required "last_name"
 103                                           , user_email       = required "email"
 104                                           , user_isStaff     = required "is_staff"
 105                                           , user_isActive    = required "is_active"
 106                                           , user_dateJoined  = optional "date_joined"
 107                                           }
 108                               )
 109