]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Node/User.hs
[ADM!] clean ini file. Breaking ini configuration.
[gargantext.git] / src / Gargantext / Database / Query / Table / Node / User.hs
1 {-|
2 Module : Gargantext.Database.Action.Query.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 FunctionalDependencies #-}
13 {-# LANGUAGE TemplateHaskell #-}
14
15 module Gargantext.Database.Query.Table.Node.User
16 where
17
18 import Control.Lens (makeLenses)
19 import Data.Aeson.TH (deriveJSON)
20 import Data.Maybe (fromMaybe)
21 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
22 import Data.Text (Text)
23 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
24 import GHC.Generics (Generic)
25 import Gargantext.Core (Lang(..))
26 import Gargantext.Core.Types (Name)
27 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
28 import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..), UserId, NodeType(..), pgNodeId)
29 import Gargantext.Database.Prelude -- (fromField', Cmd)
30 import Gargantext.Database.Query.Table.Node
31 import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact, fake_HyperdataContact)
32 import Gargantext.Database.Schema.Node -- (Node(..))
33 import Gargantext.Prelude
34 import Opaleye hiding (FromField)
35 import Test.QuickCheck (elements)
36 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
37
38 ------------------------------------------------------------------------
39 data HyperdataUser =
40 HyperdataUser { _hu_private :: !(Maybe HyperdataPrivate)
41 , _hu_shared :: !(Maybe HyperdataContact)
42 , _hu_public :: !(Maybe HyperdataPublic)
43 } deriving (Eq, Show, Generic)
44
45 data HyperdataPrivate =
46 HyperdataPrivate { _hpr_password :: !Text
47 , _hpr_lang :: !Lang
48 }
49 deriving (Eq, Show, Generic)
50
51 data HyperdataPublic =
52 HyperdataPublic { _hpu_pseudo :: !Text
53 , _hpu_publications :: ![DocumentId]
54 }
55 deriving (Eq, Show, Generic)
56
57 -- | Fake instances
58
59 fake_HyperdataUser :: HyperdataUser
60 fake_HyperdataUser = HyperdataUser (Just fake_HyperdataPrivate)
61 (Just fake_HyperdataContact)
62 (Just fake_HyperdataPublic)
63
64 fake_HyperdataPublic :: HyperdataPublic
65 fake_HyperdataPublic = HyperdataPublic "pseudo" [1..10]
66
67 fake_HyperdataPrivate :: HyperdataPrivate
68 fake_HyperdataPrivate = HyperdataPrivate "password" EN
69
70 -- | ToSchema instances
71 instance ToSchema HyperdataUser where
72 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hu_")
73
74 instance ToSchema HyperdataPrivate where
75 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpr_")
76
77 instance ToSchema HyperdataPublic where
78 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpu_")
79
80
81 -- | Arbitrary instances
82 instance Arbitrary HyperdataUser where
83 arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
84
85 instance Arbitrary HyperdataPrivate where
86 arbitrary = elements [HyperdataPrivate "" EN]
87
88 instance Arbitrary HyperdataPublic where
89 arbitrary = elements [HyperdataPublic "pseudo" [NodeId 2]]
90
91
92 -- | Specific Gargantext instance
93 instance Hyperdata HyperdataUser
94 instance Hyperdata HyperdataPrivate
95 instance Hyperdata HyperdataPublic
96
97 -- | Database (Posgresql-simple instance)
98 instance FromField HyperdataUser where
99 fromField = fromField'
100 instance FromField HyperdataPrivate where
101 fromField = fromField'
102 instance FromField HyperdataPublic where
103 fromField = fromField'
104
105 -- | Database (Opaleye instance)
106 instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
107 queryRunnerColumnDefault = fieldQueryRunnerColumn
108
109 instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate where
110 queryRunnerColumnDefault = fieldQueryRunnerColumn
111
112 instance QueryRunnerColumnDefault PGJsonb HyperdataPublic where
113 queryRunnerColumnDefault = fieldQueryRunnerColumn
114
115 -- | All lenses
116 makeLenses ''HyperdataUser
117 makeLenses ''HyperdataPrivate
118 makeLenses ''HyperdataPublic
119
120 -- | All Json instances
121 $(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
122 $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
123 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
124
125
126 -----------------------------------------------------------------
127 getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
128 getNodeUser nId = do
129 fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay
130 <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
131
132
133 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
134 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
135 where
136 name = maybe "User" identity maybeName
137 user = maybe fake_HyperdataUser identity maybeHyperdata