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, fake_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 type NodeUser  = Node HyperdataUser
  41
  42 data HyperdataUser =
  43      HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
  44                    , _hu_shared    :: !(Maybe HyperdataContact)
  45                    , _hu_public    :: !(Maybe HyperdataPublic)
  46                    } deriving (Eq, Show, Generic)
  47
  48 data HyperdataPrivate =
  49      HyperdataPrivate { _hpr_password :: !Text
  50                       , _hpr_lang     :: !Lang
  51                       }
  52      deriving (Eq, Show, Generic)
  53
  54 data HyperdataPublic =
  55      HyperdataPublic { _hpu_pseudo :: !Text
  56                      , _hpu_publications :: ![DocumentId]
  57                      }
  58      deriving (Eq, Show, Generic)
  59
  60 -- | Fake instances
  61
  62 fake_HyperdataUser :: HyperdataUser
  63 fake_HyperdataUser = HyperdataUser (Just fake_HyperdataPrivate)
  64                                    (Just fake_HyperdataContact)
  65                                    (Just fake_HyperdataPublic)
  66
  67 fake_HyperdataPublic :: HyperdataPublic
  68 fake_HyperdataPublic = HyperdataPublic "pseudo" [1..10]
  69
  70 fake_HyperdataPrivate :: HyperdataPrivate
  71 fake_HyperdataPrivate = HyperdataPrivate "password" EN
  72
  73 -- | ToSchema instances
  74 instance ToSchema HyperdataUser where
  75   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hu_")
  76
  77 instance ToSchema HyperdataPrivate where
  78   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpr_")
  79
  80 instance ToSchema HyperdataPublic where
  81   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpu_")
  82
  83
  84 -- | Arbitrary instances
  85 instance Arbitrary HyperdataUser where
  86   arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
  87
  88 instance Arbitrary HyperdataPrivate where
  89   arbitrary = elements [HyperdataPrivate "" EN]
  90
  91 instance Arbitrary HyperdataPublic where
  92   arbitrary = elements [HyperdataPublic "pseudo" [NodeId 2]]
  93
  94
  95 -- | Specific Gargantext instance
  96 instance Hyperdata HyperdataUser
  97 instance Hyperdata HyperdataPrivate
  98 instance Hyperdata HyperdataPublic
  99
 100 -- | Database (Posgresql-simple instance)
 101 instance FromField HyperdataUser where
 102   fromField = fromField'
 103 instance FromField HyperdataPrivate where
 104   fromField = fromField'
 105 instance FromField HyperdataPublic where
 106   fromField = fromField'
 107
 108 -- | Database (Opaleye instance)
 109 instance QueryRunnerColumnDefault PGJsonb HyperdataUser   where
 110   queryRunnerColumnDefault = fieldQueryRunnerColumn
 111
 112 instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate   where
 113   queryRunnerColumnDefault = fieldQueryRunnerColumn
 114
 115 instance QueryRunnerColumnDefault PGJsonb HyperdataPublic   where
 116   queryRunnerColumnDefault = fieldQueryRunnerColumn
 117
 118 -- | All lenses
 119 makeLenses ''HyperdataUser
 120 makeLenses ''HyperdataPrivate
 121 makeLenses ''HyperdataPublic
 122
 123 -- | All Json instances
 124 $(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
 125 $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
 126 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
 127
 128
 129
 130