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