src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

   1 {-|
   2 Module      : Gargantext.Database.Admin.Types.Hyperdata.User
   3 Description :
   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 DeriveGeneric              #-}
  14 {-# LANGUAGE DeriveAnyClass             #-}
  15 {-# LANGUAGE FlexibleContexts           #-}
  16 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  17 {-# LANGUAGE MultiParamTypeClasses      #-}
  18 {-# LANGUAGE NoImplicitPrelude          #-}
  19 {-# LANGUAGE OverloadedStrings          #-}
  20 {-# LANGUAGE RankNTypes                 #-}
  21 {-# LANGUAGE TemplateHaskell            #-}
  22
  23
  24 module Gargantext.Database.Admin.Types.Hyperdata.User
  25   where
  26
  27 import Data.Morpheus.Types (GQLType(..), typeDirective)
  28 import qualified Gargantext.API.GraphQL.Utils as GAGU
  29 import Gargantext.Core (Lang(..))
  30 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
  31 import Gargantext.Database.Admin.Types.Hyperdata.Contact
  32 import Gargantext.Database.Admin.Types.Node (DocumentId)
  33 import Gargantext.Prelude
  34 import qualified PUBMED.Types as PUBMED
  35
  36 -- import Gargantext.Database.Schema.Node -- (Node(..))
  37
  38 data HyperdataUser =
  39      HyperdataUser { _hu_private        :: !(Maybe HyperdataPrivate)
  40                    , _hu_shared         :: !(Maybe HyperdataContact)
  41                    , _hu_public         :: !(Maybe HyperdataPublic)
  42                    , _hu_pubmed_api_key :: !(Maybe PUBMED.APIKey)
  43                    } deriving (Eq, Show, Generic)
  44
  45 instance GQLType HyperdataUser where
  46   directives _ = typeDirective (GAGU.RemovePrefix "_hu_")
  47
  48 data HyperdataPrivate =
  49      HyperdataPrivate { _hpr_password :: !Text
  50                       , _hpr_lang     :: !Lang
  51                       }
  52      deriving (Eq, Show, Generic)
  53
  54 instance GQLType HyperdataPrivate where
  55   directives _ = typeDirective (GAGU.RemovePrefix "_hpr_")
  56
  57
  58 data HyperdataPublic =
  59      HyperdataPublic { _hpu_pseudo       :: !Text
  60                      , _hpu_publications :: ![DocumentId]
  61                      }
  62      deriving (Eq, Show, Generic)
  63
  64 instance GQLType HyperdataPublic where
  65   directives _ = typeDirective (GAGU.RemovePrefix "_hpu_")
  66
  67 -- | Default
  68 defaultHyperdataUser :: HyperdataUser
  69 defaultHyperdataUser =
  70   HyperdataUser
  71     { _hu_private        = Just defaultHyperdataPrivate
  72     , _hu_shared         = Just defaultHyperdataContact
  73     , _hu_public         = Just defaultHyperdataPublic
  74     , _hu_pubmed_api_key = Nothing }
  75
  76 defaultHyperdataPublic :: HyperdataPublic
  77 defaultHyperdataPublic = HyperdataPublic "pseudo" [1..10]
  78
  79 defaultHyperdataPrivate :: HyperdataPrivate
  80 defaultHyperdataPrivate = HyperdataPrivate "password" EN
  81
  82
  83 ------------------------------------------------------------------------
  84 -- Instances
  85 ------------------------------------------------------------------------
  86 -- | Specific Gargantext instance
  87 instance Hyperdata HyperdataUser
  88 instance Hyperdata HyperdataPrivate
  89 instance Hyperdata HyperdataPublic
  90
  91 -- | All lenses
  92 makeLenses ''HyperdataUser
  93 makeLenses ''HyperdataPrivate
  94 makeLenses ''HyperdataPublic
  95
  96 -- | All Json instances
  97 $(deriveJSON (unPrefix "_hu_")  ''HyperdataUser)
  98 $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
  99 $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
 100
 101 -- | Arbitrary instances
 102 instance Arbitrary HyperdataUser where
 103   arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 104
 105 instance Arbitrary HyperdataPrivate where
 106   arbitrary = pure defaultHyperdataPrivate
 107
 108 instance Arbitrary HyperdataPublic where
 109   arbitrary = pure defaultHyperdataPublic
 110
 111 -- | ToSchema instances
 112 instance ToSchema HyperdataUser where
 113   declareNamedSchema proxy =
 114     genericDeclareNamedSchema (unPrefixSwagger "_hu_") proxy
 115     & mapped.schema.description ?~ "User Hyperdata"
 116     & mapped.schema.example ?~ toJSON defaultHyperdataUser
 117
 118 instance ToSchema HyperdataPrivate where
 119   declareNamedSchema proxy =
 120     genericDeclareNamedSchema (unPrefixSwagger "_hpr_") proxy
 121     & mapped.schema.description ?~ "User Private Hyperdata"
 122     & mapped.schema.example ?~ toJSON defaultHyperdataPrivate
 123
 124
 125 instance ToSchema HyperdataPublic where
 126   declareNamedSchema proxy =
 127     genericDeclareNamedSchema (unPrefixSwagger "_hpu_") proxy
 128     & mapped.schema.description ?~ "User Public Hyperdata"
 129     & mapped.schema.example ?~ toJSON defaultHyperdataPublic
 130
 131
 132 -- | Database (Posgresql-simple instance)
 133 instance FromField HyperdataUser where
 134   fromField = fromField'
 135 instance FromField HyperdataPrivate where
 136   fromField = fromField'
 137 instance FromField HyperdataPublic where
 138   fromField = fromField'
 139
 140 -- | Database (Opaleye instance)
 141 instance DefaultFromField SqlJsonb HyperdataUser   where
 142   defaultFromField = fromPGSFromField
 143
 144 instance DefaultFromField SqlJsonb HyperdataPrivate   where
 145   defaultFromField = fromPGSFromField
 146
 147 instance DefaultFromField SqlJsonb HyperdataPublic   where
 148   defaultFromField = fromPGSFromField