Commit 0f22711d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graphql] more user work

parent 4565f557
Pipeline #1995 failed with stage
module Gargantext.Components.GraphQL where module Gargantext.Components.GraphQL where
--import Data.Argonaut.Decode (class DecodeJson) import Data.Argonaut.Decode (JsonDecodeError)
import Data.Bifunctor (lmap)
import Data.List.Types (NonEmptyList)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.GraphQL.AffjaxSimpleJSONClient (AffjaxClient(..)) import Foreign (unsafeToForeign, ForeignError)
import Gargantext.Components.GraphQL.User import Gargantext.Components.GraphQL.User (User)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import GraphQL.Client.Args (type (==>)) import GraphQL.Client.Args (type (==>))
--import GraphQL.Client.BaseClients.Urql import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
import GraphQL.Client.Query (query) import GraphQL.Client.Query (queryWithDecoder)
import GraphQL.Client.Types (class GqlQuery, Client(..)) import GraphQL.Client.Types (class GqlQuery, Client, class QueryClient)
import Simple.JSON as JSON import Simple.JSON as JSON
import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL" here = R2.here "Gargantext.Components.GraphQL"
client :: Client AffjaxClient Schema Void Void --client :: Client AffjaxClient Schema Void Void
client = Client $ AffjaxClient "http://localhost:8008/gql" [] --client = Client $ AffjaxClient "http://localhost:8008/gql" []
-- | Run a graphQL query with a custom decoder and custom options
gqlQuery ::
forall client schema query returns a b queryOpts mutationOpts.
QueryClient client queryOpts mutationOpts =>
GqlQuery schema query returns =>
JSON.ReadForeign returns =>
--(queryOpts -> queryOpts) ->
(Client client schema a b) ->
String ->
query ->
Aff returns
gqlQuery = queryWithDecoder (unsafeToForeign >>> JSON.read >>> lmap toJsonError)
toJsonError :: NonEmptyList ForeignError -> JsonDecodeError
toJsonError = unsafeCoerce -- map ForeignErrors to JsonDecodeError as you wish
queryGql :: queryGql ::
forall query returns. forall query returns.
...@@ -26,9 +45,10 @@ queryGql :: ...@@ -26,9 +45,10 @@ queryGql ::
JSON.ReadForeign returns => JSON.ReadForeign returns =>
String -> query -> Aff returns String -> query -> Aff returns
queryGql name q = do queryGql name q = do
--query client name q
client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
gqlQuery (client :: Client UrqlClient Schema Void Void) name q
--client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
query client name q
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema) --query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
-- Schema -- Schema
......
...@@ -21,48 +21,49 @@ import Simple.JSON as JSON ...@@ -21,48 +21,49 @@ import Simple.JSON as JSON
data AffjaxClient data AffjaxClient
= AffjaxClient URL (Array RequestHeader) = AffjaxClient URL (Array RequestHeader)
--
instance queryClient :: QueryClient AffjaxClient Unit Unit where -- instance queryClient :: QueryClient AffjaxClient Unit Unit where
clientQuery _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "query" url headers name q vars -- clientQuery _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "query" url headers name q vars
clientMutation _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "mutation" url headers name q vars -- clientMutation _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "mutation" url headers name q vars
defQueryOpts = const unit -- defQueryOpts = const unit
defMutationOpts = const unit -- defMutationOpts = const unit
--
throwLeft :: forall r body. Either Error { body :: body | r } -> Aff body -- throwLeft :: forall r body. Either Error { body :: body | r } -> Aff body
throwLeft = case _ of -- throwLeft = case _ of
Left err -> throwError $ error $ printError err -- Left err -> throwError $ error $ printError err
Right { body } -> pure body -- Right { body } -> pure body
--
queryPostForeign :: -- queryPostForeign ::
forall d. -- forall d.
JSON.WriteForeign d => -- JSON.WriteForeign d =>
String -> URL -> Array RequestHeader -> String -> String -> d -> Aff (Either Error (Response String)) -- String -> URL -> Array RequestHeader -> String -> String -> d -> Aff (Either Error (Response String))
queryPostForeign opStr url headers queryName q vars = do -- queryPostForeign opStr url headers queryName q vars = do
request -- request
defaultRequest -- defaultRequest
{ withCredentials = true -- { withCredentials = true
, url = url -- , url = url
, method = Left Method.POST -- , method = Left Method.POST
--, responseFormat = ResponseFormat.json -- --, responseFormat = ResponseFormat.json
, responseFormat = ResponseFormat.string -- , responseFormat = ResponseFormat.string
, content = -- , content =
Just -- Just
-- $ RequestBody.Json -- -- $ RequestBody.Json
-- $ encodeJson -- -- $ encodeJson
$ RequestBody.String -- $ RequestBody.String
$ JSON.writeJSON -- $ JSON.writeJSON
{ query: opStr <> " " <> queryName <> " " <> q -- { query: opStr <> " " <> queryName <> " " <> q
, variables: vars -- , variables: vars
, operationName: queryName -- , operationName: queryName
} -- }
, headers = headers <> [ ContentType applicationJSON ] -- , headers = headers <> [ ContentType applicationJSON ]
} -- }
--
convertJsonResponse :: Either Error (Response String) -> Aff (Either Error (Response Json)) -- convertJsonResponse :: Either Error (Response String) -> Aff (Either Error (Response Json))
convertJsonResponse (Left err) = pure $ Left err -- convertJsonResponse (Left err) = pure $ Left err
convertJsonResponse (Right res@{ body }) = pure $ case JSON.readJSON body of -- convertJsonResponse (Right res@{ body }) = pure $ case JSON.readJSON body of
Left err -> Left $ ResponseBodyError (DLN.head err) (res { body = unsafeToForeign body }) -- Left err -> Left $ ResponseBodyError (DLN.head err) (res { body = unsafeToForeign body })
Right body' -> Right $ res { body = toJSON body' } -- Right body' -> Right $ res { body = toJSON body' }
--
foreign import toJSON :: forall d. JSON.ReadForeign d => d -> Json -- foreign import toJSON :: forall d. JSON.ReadForeign d => d -> Json
--
--
module Gargantext.Components.GraphQL.User where module Gargantext.Components.GraphQL.User where
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (HyperdataUser)
import Gargantext.Prelude import Gargantext.Prelude
import Type.Proxy (Proxy(..)) import Type.Proxy (Proxy(..))
type User type User
= { u_id :: Int = { u_id :: Int
, u_hyperdata :: HyperdataUser , u_hyperdata ::
{ _hu_shared :: Maybe
{ _hc_title :: Maybe String
, _hc_source :: Maybe String
, _hc_who :: Maybe
{ _cw_firstName :: Maybe String
, _cw_lastName :: Maybe String
}
, _hc_where :: Array
{ _cw_organization :: Array String }
}
}
, u_username :: String , u_username :: String
, u_email :: String , u_email :: String
} }
...@@ -26,3 +36,20 @@ u_username :: Proxy "u_username" ...@@ -26,3 +36,20 @@ u_username :: Proxy "u_username"
u_username = Proxy u_username = Proxy
u_email :: Proxy "u_email" u_email :: Proxy "u_email"
u_email = Proxy u_email = Proxy
_hu_shared :: Proxy "shared"
_hu_shared = Proxy
_hc_source :: Proxy "_hc_source"
_hc_source = Proxy
_hc_title :: Proxy "_hc_title"
_hc_title = Proxy
_hc_who :: Proxy "_hc_who"
_hc_who = Proxy
_hc_where :: Proxy "_cw_where"
_hc_where = Proxy
_cw_firstName :: Proxy "_cw_firstName"
_cw_firstName = Proxy
_cw_lastName :: Proxy "_cw_lastName"
_cw_lastName = Proxy
_cw_organization :: Proxy "_cw_organization"
_cw_organization = Proxy
...@@ -4,6 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User ...@@ -4,6 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User
) )
where where
import Gargantext.Components.GraphQL.User
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as A import Data.Array as A
...@@ -15,7 +16,6 @@ import Effect.Aff (Aff, launchAff_) ...@@ -15,7 +16,6 @@ import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphQL (queryGql) import Gargantext.Components.GraphQL (queryGql)
import Gargantext.Components.GraphQL.User
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
...@@ -245,16 +245,53 @@ getUser session id = do ...@@ -245,16 +245,53 @@ getUser session id = do
{ users } <- queryGql "get user" { users } <- queryGql "get user"
{ users: { user_id: id } =>> { users: { user_id: id } =>>
{ u_id { u_id
, u_hyperdata , u_hyperdata:
{ _hu_shared:
{ _hc_title
, _hc_source
, _hc_who:
{ _cw_firstName
, _cw_lastName }
, _hc_where:
{ _cw_organization }
}
}
, u_username , u_username
, u_email } } , u_email } }
liftEffect $ here.log2 "[getUser] users" users liftEffect $ here.log2 "[getUser] users" users
pure $ case A.head users of pure $ case A.head users of
Nothing -> Left (CustomError $ "user with id " <> show id <> " not found") Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
-- NOTE Contact is at G.C.N.A.U.C.Types
Just u -> Right $ { contactNode: Contact Just u -> Right $ { contactNode: Contact
{ id: u.u_id { id: u.u_id
, date: Nothing , date: Nothing
, hyperdata: u.u_hyperdata , hyperdata: HyperdataUser
{ shared: (\shared -> HyperdataContact
{ bdd: Nothing
, who: (\who -> ContactWho
{ idWho: Nothing
, firstName: who._cw_firstName
, lastName: who._cw_lastName
, keywords: []
, freetags: []
}) <$> shared._hc_who
, ou: (\ou -> ContactWhere
{ organization: ou._cw_organization
, labTeamDepts: []
, role: Nothing
, office: Nothing
, country: Nothing
, city: Nothing
, touch: Nothing
, entry: Nothing
, exit: Nothing }) <$> shared._hc_where
, source: shared._hc_source
, title: shared._hc_title
, lastValidation: Nothing
, uniqId: Nothing
, uniqIdBdd: Nothing
}) <$> u.u_hyperdata._hu_shared
}
, name: Just u.u_username , name: Just u.u_username
, parentId: Nothing , parentId: Nothing
, typename: Nothing , typename: Nothing
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment