{-|
Module      : Gargantext.Database.user
Description : User Database management tools
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Functions to deal with users, database side.
-}


{-# OPTIONS_GHC -fno-warn-orphans        #-}

{-# LANGUAGE DeriveAnyClass              #-}
{-# LANGUAGE FunctionalDependencies      #-}
{-# LANGUAGE Arrows                      #-}
{-# LANGUAGE TemplateHaskell             #-}

module Gargantext.Database.Schema.User where

import Data.Morpheus.Types (GQLType(typeOptions))
import Data.Text (Text)
import Data.Time (UTCTime)
import qualified Gargantext.API.GraphQL.Utils as GAGU
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Prelude (fromField')
import Gargantext.Prelude
import GHC.Generics (Generic)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import Data.Aeson.TH (deriveJSON)

-- 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 -> Int
userLight_id       :: !Int
                           , UserLight -> Text
userLight_username :: !Text
                           , UserLight -> Text
userLight_email    :: !Text
                           , UserLight -> Text
userLight_password :: !Text
                           } deriving (Int -> UserLight -> ShowS
[UserLight] -> ShowS
UserLight -> String
(Int -> UserLight -> ShowS)
-> (UserLight -> String)
-> ([UserLight] -> ShowS)
-> Show UserLight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserLight] -> ShowS
$cshowList :: [UserLight] -> ShowS
show :: UserLight -> String
$cshow :: UserLight -> String
showsPrec :: Int -> UserLight -> ShowS
$cshowsPrec :: Int -> UserLight -> ShowS
Show, (forall x. UserLight -> Rep UserLight x)
-> (forall x. Rep UserLight x -> UserLight) -> Generic UserLight
forall x. Rep UserLight x -> UserLight
forall x. UserLight -> Rep UserLight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserLight x -> UserLight
$cfrom :: forall x. UserLight -> Rep UserLight x
Generic)

instance GQLType UserLight where
  typeOptions :: f UserLight -> GQLTypeOptions -> GQLTypeOptions
typeOptions f UserLight
_ = Text -> GQLTypeOptions -> GQLTypeOptions
GAGU.unPrefix Text
"userLight_"

toUserLight :: UserDB -> UserLight
toUserLight :: UserDB -> UserLight
toUserLight (UserDB Int
id Text
p Maybe UTCTime
_ Bool
_ Text
u Text
_ Text
_ Text
e Bool
_ Bool
_ UTCTime
_ ) = Int -> Text -> Text -> Text -> UserLight
UserLight Int
id Text
u Text
e Text
p


data UserPoly id pass llogin suser
              uname fname lname
              mail staff active djoined =
    UserDB { UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> id
user_id          :: !id
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> pass
user_password    :: !pass
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> llogin
user_lastLogin   :: !llogin
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> suser
user_isSuperUser :: !suser

           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> uname
user_username    :: !uname
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> fname
user_firstName   :: !fname
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> lname
user_lastName    :: !lname
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> mail
user_email       :: !mail

           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> staff
user_isStaff     :: !staff
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> active
user_isActive    :: !active
           , UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> djoined
user_dateJoined  :: !djoined
           } deriving (Int
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
-> ShowS
[UserPoly
   id pass llogin suser uname fname lname mail staff active djoined]
-> ShowS
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> String
(Int
 -> UserPoly
      id pass llogin suser uname fname lname mail staff active djoined
 -> ShowS)
-> (UserPoly
      id pass llogin suser uname fname lname mail staff active djoined
    -> String)
-> ([UserPoly
       id pass llogin suser uname fname lname mail staff active djoined]
    -> ShowS)
-> Show
     (UserPoly
        id pass llogin suser uname fname lname mail staff active djoined)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
Int
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
-> ShowS
forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
[UserPoly
   id pass llogin suser uname fname lname mail staff active djoined]
-> ShowS
forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> String
showList :: [UserPoly
   id pass llogin suser uname fname lname mail staff active djoined]
-> ShowS
$cshowList :: forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
[UserPoly
   id pass llogin suser uname fname lname mail staff active djoined]
-> ShowS
show :: UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> String
$cshow :: forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> String
showsPrec :: Int
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
-> ShowS
$cshowsPrec :: forall id pass llogin suser uname fname lname mail staff active
       djoined.
(Show id, Show pass, Show llogin, Show suser, Show uname,
 Show fname, Show lname, Show mail, Show staff, Show active,
 Show djoined) =>
Int
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
-> ShowS
Show, (forall x.
 UserPoly
   id pass llogin suser uname fname lname mail staff active djoined
 -> Rep
      (UserPoly
         id pass llogin suser uname fname lname mail staff active djoined)
      x)
-> (forall x.
    Rep
      (UserPoly
         id pass llogin suser uname fname lname mail staff active djoined)
      x
    -> UserPoly
         id pass llogin suser uname fname lname mail staff active djoined)
-> Generic
     (UserPoly
        id pass llogin suser uname fname lname mail staff active djoined)
forall x.
Rep
  (UserPoly
     id pass llogin suser uname fname lname mail staff active djoined)
  x
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
forall x.
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> Rep
     (UserPoly
        id pass llogin suser uname fname lname mail staff active djoined)
     x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall id pass llogin suser uname fname lname mail staff active
       djoined x.
Rep
  (UserPoly
     id pass llogin suser uname fname lname mail staff active djoined)
  x
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
forall id pass llogin suser uname fname lname mail staff active
       djoined x.
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> Rep
     (UserPoly
        id pass llogin suser uname fname lname mail staff active djoined)
     x
$cto :: forall id pass llogin suser uname fname lname mail staff active
       djoined x.
Rep
  (UserPoly
     id pass llogin suser uname fname lname mail staff active djoined)
  x
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
$cfrom :: forall id pass llogin suser uname fname lname mail staff active
       djoined x.
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> Rep
     (UserPoly
        id pass llogin suser uname fname lname mail staff active djoined)
     x
Generic)


type UserWrite = UserPoly (Maybe (Column PGInt4))        (Column PGText)
                          (Maybe (Column PGTimestamptz)) (Column PGBool)
                                 (Column PGText)         (Column PGText)
                                 (Column PGText)         (Column PGText)
                                 (Column PGBool)         (Column PGBool)
                                 (Maybe (Column PGTimestamptz))

type UserRead  = UserPoly        (Column PGInt4)         (Column PGText)
                                 (Column PGTimestamptz)  (Column PGBool)
                                 (Column PGText)         (Column PGText)
                                 (Column PGText)         (Column PGText)
                                 (Column PGBool)         (Column PGBool)
                                 (Column PGTimestamptz)

type UserReadNull = UserPoly     (Column (Nullable PGInt4))         (Column (Nullable PGText))
                                 (Column (Nullable PGTimestamptz))  (Column (Nullable PGBool))
                                 (Column (Nullable PGText))         (Column (Nullable PGText))
                                 (Column (Nullable PGText))         (Column (Nullable PGText))
                                 (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 UserWrite UserRead
userTable = String
-> TableFields UserWrite UserRead -> Table UserWrite UserRead
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Table String
"auth_user"
  (UserPoly
  (TableFields (Maybe (Column PGInt4)) (Column PGInt4))
  (TableFields (Column PGText) (Column PGText))
  (TableFields (Maybe (Column PGTimestamptz)) (Column PGTimestamptz))
  (TableFields (Column PGBool) (Column PGBool))
  (TableFields (Column PGText) (Column PGText))
  (TableFields (Column PGText) (Column PGText))
  (TableFields (Column PGText) (Column PGText))
  (TableFields (Column PGText) (Column PGText))
  (TableFields (Column PGBool) (Column PGBool))
  (TableFields (Column PGBool) (Column PGBool))
  (TableFields (Maybe (Column PGTimestamptz)) (Column PGTimestamptz))
-> TableFields UserWrite UserRead
forall (p :: * -> * -> *) a1_0 a2_0 a3_0 a4_0 a5_0 a6_0 a7_0 a8_0
       a9_0 a10_0 a11_0 a1_1 a2_1 a3_1 a4_1 a5_1 a6_1 a7_1 a8_1 a9_1 a10_1
       a11_1.
ProductProfunctor p =>
UserPoly
  (p a1_0 a1_1)
  (p a2_0 a2_1)
  (p a3_0 a3_1)
  (p a4_0 a4_1)
  (p a5_0 a5_1)
  (p a6_0 a6_1)
  (p a7_0 a7_1)
  (p a8_0 a8_1)
  (p a9_0 a9_1)
  (p a10_0 a10_1)
  (p a11_0 a11_1)
-> p (UserPoly
        a1_0 a2_0 a3_0 a4_0 a5_0 a6_0 a7_0 a8_0 a9_0 a10_0 a11_0)
     (UserPoly a1_1 a2_1 a3_1 a4_1 a5_1 a6_1 a7_1 a8_1 a9_1 a10_1 a11_1)
pUserDB UserDB :: forall id pass llogin suser uname fname lname mail staff active
       djoined.
id
-> pass
-> llogin
-> suser
-> uname
-> fname
-> lname
-> mail
-> staff
-> active
-> djoined
-> UserPoly
     id pass llogin suser uname fname lname mail staff active djoined
UserDB { user_id :: TableFields (Maybe (Column PGInt4)) (Column PGInt4)
user_id      = String -> TableFields (Maybe (Column PGInt4)) (Column PGInt4)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField String
"id"
                  , user_password :: TableFields (Column PGText) (Column PGText)
user_password    = String -> TableFields (Column PGText) (Column PGText)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"password"
                  , user_lastLogin :: TableFields (Maybe (Column PGTimestamptz)) (Column PGTimestamptz)
user_lastLogin   = String
-> TableFields
     (Maybe (Column PGTimestamptz)) (Column PGTimestamptz)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField String
"last_login"
                  , user_isSuperUser :: TableFields (Column PGBool) (Column PGBool)
user_isSuperUser = String -> TableFields (Column PGBool) (Column PGBool)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"is_superuser"
                  , user_username :: TableFields (Column PGText) (Column PGText)
user_username    = String -> TableFields (Column PGText) (Column PGText)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"username"
                  , user_firstName :: TableFields (Column PGText) (Column PGText)
user_firstName   = String -> TableFields (Column PGText) (Column PGText)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"first_name"
                  , user_lastName :: TableFields (Column PGText) (Column PGText)
user_lastName    = String -> TableFields (Column PGText) (Column PGText)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"last_name"
                  , user_email :: TableFields (Column PGText) (Column PGText)
user_email       = String -> TableFields (Column PGText) (Column PGText)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"email"
                  , user_isStaff :: TableFields (Column PGBool) (Column PGBool)
user_isStaff     = String -> TableFields (Column PGBool) (Column PGBool)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"is_staff"
                  , user_isActive :: TableFields (Column PGBool) (Column PGBool)
user_isActive    = String -> TableFields (Column PGBool) (Column PGBool)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField String
"is_active"
                  , user_dateJoined :: TableFields (Maybe (Column PGTimestamptz)) (Column PGTimestamptz)
user_dateJoined  = String
-> TableFields
     (Maybe (Column PGTimestamptz)) (Column PGTimestamptz)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField String
"date_joined"
                  }
      )

instance FromField UserLight where
  fromField :: FieldParser UserLight
fromField = FieldParser UserLight
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

instance FromField UserDB where
  fromField :: FieldParser UserDB
fromField = FieldParser UserDB
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

$(deriveJSON (unPrefix "userLight_") ''UserLight)
$(deriveJSON (unPrefix "user_") ''UserPoly)