src/Gargantext/Database/Node/User.hs

   1 {-|
   2 Module      : Gargantext.Database.Node.User
   3 Description : User Node in Gargantext
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE DeriveGeneric          #-}
  13 {-# LANGUAGE NoImplicitPrelude      #-}
  14 {-# LANGUAGE FunctionalDependencies #-}
  15 {-# LANGUAGE OverloadedStrings      #-}
  16 {-# LANGUAGE FlexibleInstances      #-}
  17 {-# LANGUAGE MultiParamTypeClasses  #-}
  18 {-# LANGUAGE TemplateHaskell        #-}
  19
  20 module Gargantext.Database.Node.User
  21   where
  22
  23 import Control.Lens (makeLenses)
  24 import Data.Aeson.TH (deriveJSON)
  25 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
  26 import Data.Text (Text)
  27 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  28 import GHC.Generics (Generic)
  29 import Gargantext.Core (Lang(..))
  30 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  31 import Gargantext.Database.Node.Contact (HyperdataContact)
  32 import Gargantext.Database.Types.Node (Node,Hyperdata, DocumentId, NodeId(..))
  33 import Gargantext.Database.Utils (fromField')
  34 import Gargantext.Prelude
  35 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
  36 import Test.QuickCheck (elements)
  37 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  38
  39 ------------------------------------------------------------------------
  40
  41 type NodeUser  = Node HyperdataUser
  42
  43 data HyperdataUser =
  44      HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
  45                    , _hu_shared    :: !(Maybe HyperdataContact)
  46                    , _hu_public    :: !(Maybe HyperdataPublic)
  47                    } deriving (Eq, Show, Generic)
  48
  49 data HyperdataPrivate =
  50      HyperdataPrivate { _hpr_password :: !Text
  51                       , _hpr_lang     :: !Lang
  52                       }
  53      deriving (Eq, Show, Generic)
  54
  55 data HyperdataPublic =
  56      HyperdataPublic { _hpu_pseudo :: !Text
  57                      , _hpu_publications :: ![DocumentId]
  58                      }
  59      deriving (Eq, Show, Generic)
  60
  61 -- | ToSchema instances
  62 instance ToSchema HyperdataUser where
  63   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hu_")
  64
  65 instance ToSchema HyperdataPrivate where
  66   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpr_")
  67
  68 instance ToSchema HyperdataPublic where
  69   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpu_")
  70
  71
  72 -- | Arbitrary instances
  73 instance Arbitrary HyperdataUser where
  74   arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
  75
  76 instance Arbitrary HyperdataPrivate where
  77   arbitrary = elements [HyperdataPrivate "" EN]
  78
  79 instance Arbitrary HyperdataPublic where
  80   arbitrary = elements [HyperdataPublic "pseudo" [NodeId 2]]
  81
  82
  83 -- | Specific Gargantext instance
  84 instance Hyperdata HyperdataUser
  85 instance Hyperdata HyperdataPrivate
  86 instance Hyperdata HyperdataPublic
  87
  88 -- | Database (Posgresql-simple instance)
  89 instance FromField HyperdataUser where
  90   fromField = fromField'
  91 instance FromField HyperdataPrivate where
  92   fromField = fromField'
  93 instance FromField HyperdataPublic where
  94   fromField = fromField'
  95
  96 -- | Database (Opaleye instance)
  97 instance QueryRunnerColumnDefault PGJsonb HyperdataUser   where
  98   queryRunnerColumnDefault = fieldQueryRunnerColumn
  99
 100 instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate   where
 101   queryRunnerColumnDefault = fieldQueryRunnerColumn
 102
 103 instance QueryRunnerColumnDefault PGJsonb HyperdataPublic   where
 104   queryRunnerColumnDefault = fieldQueryRunnerColumn
 105
 106 -- | All lenses
 107 makeLenses ''HyperdataUser
 108 makeLenses ''HyperdataPrivate
 109 makeLenses ''HyperdataPublic
 110
 111 -- | All Json instances
 112 $(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
 113 $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
 114 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)