Functions to deal with users, database side.
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.User where
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Data.Maybe (Maybe)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Text (Text)
import Data.Time (UTCTime)
-import GHC.Show(Show(..))
import Gargantext.Prelude
-import Opaleye
+import GHC.Generics (Generic)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import Data.Aeson.TH (deriveJSON)
+import Gargantext.Database.Prelude (fromField')
+import Gargantext.Core.Utils.Prefix (unPrefix)
-------------------------------------------------------------------------
-------------------------------------------------------------------------
+-- FIXME PLZ : the import below leads to an error, why ?
+-- import Gargantext.Database.Schema.Prelude hiding (makeLensesWith, abbreviatedFields, makeAdaptorAndInstance)
+
+-- When FIXED : Imports to remove:
+import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Opaleye hiding (FromField)
-data UserLight = UserLight { userLight_id :: Int
- , userLight_username :: Text
- , userLight_email :: Text
- } deriving (Show)
+------------------------------------------------------------------------
+data UserLight = UserLight { userLight_id :: !Int
+ , userLight_username :: !Text
+ , userLight_email :: !Text
+ , userLight_password :: !Text
+ } deriving (Show, Generic)
toUserLight :: UserDB -> UserLight
-toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
+toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p
+
data UserPoly id pass llogin suser
uname fname lname
mail staff active djoined =
- UserDB { user_id :: id
- , user_password :: pass
- , user_lastLogin :: llogin
- , user_isSuperUser :: suser
+ UserDB { user_id :: !id
+ , user_password :: !pass
+ , user_lastLogin :: !llogin
+ , user_isSuperUser :: !suser
- , user_username :: uname
- , user_firstName :: fname
- , user_lastName :: lname
- , user_email :: mail
+ , user_username :: !uname
+ , user_firstName :: !fname
+ , user_lastName :: !lname
+ , user_email :: !mail
+
+ , user_isStaff :: !staff
+ , user_isActive :: !active
+ , user_dateJoined :: !djoined
+ } deriving (Show, Generic)
- , user_isStaff :: staff
- , user_isActive :: active
- , user_dateJoined :: djoined
- } deriving (Show)
type UserWrite = UserPoly (Maybe (Column PGInt4)) (Column PGText)
(Maybe (Column PGTimestamptz)) (Column PGBool)
(Column (Nullable PGBool)) (Column (Nullable PGBool))
(Column (Nullable PGTimestamptz))
-
-
-
type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
$(makeAdaptorAndInstance "pUserDB" ''UserPoly)
$(makeLensesWith abbreviatedFields ''UserPoly)
-
userTable :: Table UserWrite UserRead
-userTable = Table "auth_user" (pUserDB UserDB { user_id = optional "id"
- , user_password = required "password"
- , user_lastLogin = optional "last_login"
- , user_isSuperUser = required "is_superuser"
- , user_username = required "username"
- , user_firstName = required "first_name"
- , user_lastName = required "last_name"
- , user_email = required "email"
- , user_isStaff = required "is_staff"
- , user_isActive = required "is_active"
- , user_dateJoined = optional "date_joined"
- }
- )
-
+userTable = Table "auth_user"
+ (pUserDB UserDB { user_id = optionalTableField "id"
+ , user_password = requiredTableField "password"
+ , user_lastLogin = optionalTableField "last_login"
+ , user_isSuperUser = requiredTableField "is_superuser"
+ , user_username = requiredTableField "username"
+ , user_firstName = requiredTableField "first_name"
+ , user_lastName = requiredTableField "last_name"
+ , user_email = requiredTableField "email"
+ , user_isStaff = requiredTableField "is_staff"
+ , user_isActive = requiredTableField "is_active"
+ , user_dateJoined = optionalTableField "date_joined"
+ }
+ )
+
+instance FromField UserLight where
+ fromField = fromField'
+
+instance FromField UserDB where
+ fromField = fromField'
+
+$(deriveJSON (unPrefix "userLight_") ''UserLight)
+$(deriveJSON (unPrefix "user_") ''UserPoly)