Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
120
Issues
120
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
f6821a40
Commit
f6821a40
authored
Jul 06, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Who is Who Challenge?] ZuriHack 2023 hint (egg inside).
parent
c0957869
Changes
4
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
312 additions
and
4 deletions
+312
-4
server
server
+2
-4
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+4
-0
Contact.sh
src/Gargantext/API/GraphQL/Contact.sh
+197
-0
Telegram.hs
src/Gargantext/Core/Text/Corpus/Parsers/Telegram.hs
+109
-0
No files found.
server
View file @
f6821a40
...
@@ -4,10 +4,8 @@ FOLDER="logs"
...
@@ -4,10 +4,8 @@ FOLDER="logs"
FILE
=
$(
date
+%Y%m%d%H%M.log
)
FILE
=
$(
date
+%Y%m%d%H%M.log
)
LOGFILE
=
$FOLDER
"/"
$FILE
LOGFILE
=
$FOLDER
"/"
$FILE
#BIN="/home/anoe/projets/gargantext-hs/.stack-work/docker/_home/.local/bin/gargantext-server"
#BIN="~/.local/bin/gargantext-server"
mkdir
-p
$FOLDER
mkdir
-p
$FOLDER
env
LANG
=
en_US.UTF-8 ~/.cabal/bin/gargantext-server
--ini
gargantext.ini
--run
Dev +RTS
>
$LOGFILE
2>&1 &
tail
-F
$LOGFILE
# -p
# In nix-shell run:
#env LANG=en_US.UTF-8 stack --docker exec gargantext-server -- --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p
cabal
exec
--
gargantext-server
--ini
gargantext.ini
--run
Dev +RTS
>
$LOGFILE
2>&1 &
tail
-F
$LOGFILE
src/Gargantext/API/Admin/Auth.hs
View file @
f6821a40
...
@@ -18,6 +18,10 @@ Main authorization of Gargantext are managed in this module
...
@@ -18,6 +18,10 @@ Main authorization of Gargantext are managed in this module
TODO-ACCESS Critical
TODO-ACCESS Critical
To see the authors:
- gource src
And you have the main viz
-}
-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MonoLocalBinds #-}
...
...
src/Gargantext/API/GraphQL/Contact.sh
0 → 100644
View file @
f6821a40
{
-# LANGUAGE DeriveAnyClass
#-}
{
-# LANGUAGE DuplicateRecordFields
#-}
module Gargantext.API.GraphQL.Contact where
import Control.Lens
import Data.Morpheus.Types
(
GQLType
, Resolver
, ResolverM
, QUERY
, lift
)
import Data.Text
(
Text
)
import qualified Data.Text as T
import Gargantext.API.Prelude
(
GargM, GargError
)
import Gargantext.Core.Mail.Types
(
HasMail
)
import Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
)
, hc_source
, hc_title
, hu_shared
)
import Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
, ContactWho
, ContactWhere
, cw_city
, cw_country
, cw_firstName
, cw_lastName
, cw_labTeamDepts
, cw_office
, cw_organization
, cw_role
, cw_touch
, ct_mail
, ct_phone
, hc_who
, hc_where
)
import Gargantext.Database.Prelude
(
HasConnectionPool, HasConfig
)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import Gargantext.Database.Query.Table.User
(
getUsersWithHyperdata, getUsersWithNodeHyperdata
)
import Gargantext.Database.Schema.User
(
UserLight
(
..
))
import Gargantext.Database.Schema.Node
(
node_id, node_hyperdata
)
import Gargantext.Prelude
import GHC.Generics
(
Generic
)
data UserInfo
=
UserInfo
{
ui_id :: Int
, ui_username :: Text
, ui_email :: Text
, ui_title :: Maybe Text
, ui_source :: Maybe Text
, ui_cwFirstName :: Maybe Text
, ui_cwLastName :: Maybe Text
, ui_cwCity :: Maybe Text
, ui_cwCountry :: Maybe Text
, ui_cwOrganization ::
[
Text]
, ui_cwLabTeamDepts ::
[
Text]
, ui_cwOffice :: Maybe Text
, ui_cwRole :: Maybe Text
, ui_cwTouchPhone :: Maybe Text
, ui_cwTouchMail :: Maybe Text
}
deriving
(
Generic, GQLType, Show
)
--
| Arguments to the
"user info"
query.
data UserInfoArgs
=
UserInfoArgs
{
user_id :: Int
}
deriving
(
Generic, GQLType
)
--
| Arguments to the
"user info"
mutation,
data UserInfoMArgs
=
UserInfoMArgs
{
ui_id :: Int
, ui_username :: Maybe Text
, ui_email :: Maybe Text
, ui_title :: Maybe Text
, ui_source :: Maybe Text
, ui_cwFirstName :: Maybe Text
, ui_cwLastName :: Maybe Text
, ui_cwCity :: Maybe Text
, ui_cwCountry :: Maybe Text
, ui_cwOrganization :: Maybe
[
Text]
, ui_cwLabTeamDepts :: Maybe
[
Text]
, ui_cwOffice :: Maybe Text
, ui_cwRole :: Maybe Text
, ui_cwTouchPhone :: Maybe Text
, ui_cwTouchMail :: Maybe Text
}
deriving
(
Generic, GQLType
)
type
GqlM e
env
=
Resolver QUERY e
(
GargM
env
GargError
)
--
| Function to resolve user from a query.
resolveUserInfos
::
(
HasConnectionPool
env
, HasConfig
env
, HasMail
env
)
=>
UserInfoArgs -> GqlM e
env
[
UserInfo]
resolveUserInfos UserInfoArgs
{
user_id
}
=
do
lift
$
printDebug
"[resolveUserInfo] ui_id"
user_id
dbUsers user_id
--
| Mutation
for
user info
updateUserInfo
::
(
HasConnectionPool
env
, HasConfig
env
, HasMail
env
)
=>
UserInfoMArgs -> ResolverM e
(
GargM
env
GargError
)
Int
updateUserInfo
(
UserInfoMArgs
{
ui_id, ..
})
=
do
lift
$
printDebug
"[updateUserInfo] ui_id"
ui_id
users
<- lift
(
getUsersWithNodeHyperdata ui_id
)
case
users
of
[]
-> panic
$
"[updateUserInfo] User with id "
<
>
(
T.pack
$
show ui_id
)
<
>
" doesn't exist."
((
_u, node_u
)
:_
)
->
do
let
u_hyperdata
=
node_u ^. node_hyperdata
--
lift
$
printDebug
"[updateUserInfo] u"
u
let
u_hyperdata
' = uh ui_titleL ui_title $
uh ui_sourceL ui_source $
uh ui_cwFirstNameL ui_cwFirstName $
uh ui_cwLastNameL ui_cwLastName $
uh ui_cwCityL ui_cwCity $
uh ui_cwCountryL ui_cwCountry $
uh'
ui_cwLabTeamDeptsL ui_cwLabTeamDepts
$
uh
' ui_cwOrganizationL ui_cwOrganization $
uh ui_cwOfficeL ui_cwOffice $
uh ui_cwRoleL ui_cwRole $
uh ui_cwTouchMailL ui_cwTouchMail $
uh ui_cwTouchPhoneL ui_cwTouchPhone $
u_hyperdata
-- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
_ <- lift
$
updateHyperdata
(
node_u ^. node_id
)
u_hyperdata
'
--let _newUser = toUser (u, u_hyperdata'
)
pure 1
where
uh _ Nothing u_hyperdata
=
u_hyperdata
uh lens
' (Just val) u_hyperdata = u_hyperdata & lens'
.~ Just val
uh
' _ Nothing u_hyperdata = u_hyperdata
uh'
lens
' (Just val) u_hyperdata = u_hyperdata & lens'
.~ val
--
| Inner
function
to fetch the user from DB.
dbUsers
::
(
HasConnectionPool
env
, HasConfig
env
, HasMail
env
)
=>
Int -> GqlM e
env
[
UserInfo]
dbUsers user_id
=
do
--
lift
$
printDebug
"[dbUsers]"
user_id
--
user <- getUsersWithId user_id
--
hyperdata <- getUserHyperdata user_id
--
lift
(
map toUser <
$>
zip user hyperdata
)
lift
(
map toUser <
$>
(
getUsersWithHyperdata user_id
))
toUser ::
(
UserLight, HyperdataUser
)
-> UserInfo
toUser
(
UserLight
{
..
}
, u_hyperdata
)
=
UserInfo
{
ui_id
=
userLight_id
, ui_username
=
userLight_username
, ui_email
=
userLight_email
, ui_title
=
u_hyperdata ^. ui_titleL
, ui_source
=
u_hyperdata ^. ui_sourceL
, ui_cwFirstName
=
u_hyperdata ^. ui_cwFirstNameL
, ui_cwLastName
=
u_hyperdata ^. ui_cwLastNameL
, ui_cwCity
=
u_hyperdata ^. ui_cwCityL
, ui_cwCountry
=
u_hyperdata ^. ui_cwCountryL
, ui_cwLabTeamDepts
=
u_hyperdata ^. ui_cwLabTeamDeptsL
, ui_cwOrganization
=
u_hyperdata ^. ui_cwOrganizationL
, ui_cwOffice
=
u_hyperdata ^. ui_cwOfficeL
, ui_cwRole
=
u_hyperdata ^. ui_cwRoleL
, ui_cwTouchMail
=
u_hyperdata ^. ui_cwTouchMailL
, ui_cwTouchPhone
=
u_hyperdata ^. ui_cwTouchPhoneL
}
sharedL :: Traversal
' HyperdataUser HyperdataContact
sharedL = hu_shared . _Just
ui_titleL :: Traversal'
HyperdataUser
(
Maybe Text
)
ui_titleL
=
sharedL
.
hc_title
ui_sourceL :: Traversal
' HyperdataUser (Maybe Text)
ui_sourceL = sharedL . hc_source
contactWhoL :: Traversal'
HyperdataUser ContactWho
contactWhoL
=
sharedL
.
hc_who
.
_Just
ui_cwFirstNameL :: Traversal
' HyperdataUser (Maybe Text)
ui_cwFirstNameL = contactWhoL . cw_firstName
ui_cwLastNameL :: Traversal'
HyperdataUser
(
Maybe Text
)
ui_cwLastNameL
=
contactWhoL
.
cw_lastName
contactWhereL :: Traversal
' HyperdataUser ContactWhere
contactWhereL = sharedL . hc_where . (ix 0)
ui_cwCityL :: Traversal'
HyperdataUser
(
Maybe Text
)
ui_cwCityL
=
contactWhereL
.
cw_city
ui_cwCountryL :: Traversal
' HyperdataUser (Maybe Text)
ui_cwCountryL = contactWhereL . cw_country
ui_cwLabTeamDeptsL :: Traversal'
HyperdataUser
[
Text]
ui_cwLabTeamDeptsL
=
hu_shared
.
_Just
.
(
hc_where
.
(
ix 0
)
.
cw_labTeamDepts
)
ui_cwOrganizationL :: Traversal
' HyperdataUser [Text]
ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
ui_cwOfficeL :: Traversal'
HyperdataUser
(
Maybe Text
)
ui_cwOfficeL
=
contactWhereL
.
cw_office
ui_cwRoleL :: Traversal
' HyperdataUser (Maybe Text)
ui_cwRoleL = contactWhereL . cw_role
ui_cwTouchMailL :: Traversal'
HyperdataUser
(
Maybe Text
)
ui_cwTouchMailL
=
hu_shared
.
_Just
.
(
hc_where
.
(
ix 0
)
.
cw_touch
.
_Just
.
ct_mail
)
--ui_cwTouchMailL
=
contactWhereL
.
cw_touch
.
_Just
.
ct_mail
ui_cwTouchPhoneL :: Traversal
' HyperdataUser (Maybe Text)
ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
--ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
src/Gargantext/Core/Text/Corpus/Parsers/Telegram.hs
0 → 100644
View file @
f6821a40
module
Gargantext.Core.Text.Corpus.Parsers.Telegram
where
import
Data.Aeson
import
Data.Text
(
Text
)
--import Data.Time
import
GHC.Generics
(
Generic
)
--import Gargantext.Core (Lang(..))
--import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import
Gargantext.Prelude
import
System.FilePath
(
FilePath
)
import
qualified
Data.ByteString.Lazy
as
DBL
readFile_Telegram
::
FilePath
->
IO
[
TelegramMsg
]
readFile_Telegram
fp
=
do
raw
<-
DBL
.
readFile
fp
let
mayIssues
=
decode
raw
case
mayIssues
of
Just
is
->
pure
is
Nothing
->
pure
[]
data
TelegramMsg
=
TelegramMsg
{
_action_entities
::
!
Text
,
_broadcastg
::
!
Text
,
_buttonsg
::
!
Text
,
_buttons_countg
::
!
Text
,
_buttons_flatg
::
!
Text
,
_chatg
::
!
Text
,
_chat_peerg
::
!
Text
,
_fileg
::
!
Text
,
_forwardg
::
!
Text
,
_input_chatg
::
!
Text
,
_input_senderg
::
!
Text
,
_linked_chatg
::
!
Text
,
_reply_messageg
::
!
Text
,
_senderg
::
!
Text
,
_sender_idg
::
!
Text
,
_textg
::
!
Text
,
_via_botg
::
!
Text
,
_via_input_botg
::
!
Text
,
actiong
::
!
Text
,
dateg
::
!
Text
,
edit_dateg
::
!
Text
,
edit_hideg
::
!
Text
,
entitiesg
::
!
Text
,
forwardsg
::
!
Text
,
from_idg
::
!
Text
,
from_scheduledg
::
!
Text
,
fwd_fromg
::
!
Text
,
grouped_idg
::
!
Text
,
idg
::
!
Text
,
legacyg
::
!
Text
,
mediag
::
!
Text
,
media_unreadg
::
!
Text
,
mentionedg
::
!
Text
,
messageg
::
!
Text
,
noforwardsg
::
!
Text
,
outg
::
!
Text
,
peer_idg
::
!
Text
,
pinnedg
::
!
Text
,
postg
::
!
Text
,
post_authorg
::
!
Text
,
reactionsg
::
!
Text
,
repliesg
::
!
Text
,
reply_markupg
::
!
Text
,
reply_tog
::
!
Text
,
restriction_reasong
::
!
Text
,
silentg
::
!
Text
,
ttl_periodg
::
!
Text
,
via_bot_idg
::
!
Text
,
views
::
!
Text
}
deriving
(
Show
,
Generic
)
instance
FromJSON
TelegramMsg
{-
gitlabIssue2hyperdataDocument :: Issue -> HyperdataDocument
gitlabIssue2hyperdataDocument issue = HyperdataDocument
{ _hd_bdd = Nothing
, _hd_doi = Nothing
, _hd_url = Nothing
, _hd_uniqId = Nothing
, _hd_uniqIdBdd = Nothing
, _hd_page = Nothing
, _hd_title = Just (_issue_title issue)
, _hd_authors = Nothing
, _hd_institutes = Nothing
, _hd_source = Nothing
, _hd_abstract = Just (_issue_content issue)
, _hd_publication_date = Just $ DT.pack $ show date
, _hd_publication_year = Just $ fromIntegral year
, _hd_publication_month = Just month
, _hd_publication_day = Just day
, _hd_publication_hour = Just (todHour tod)
, _hd_publication_minute = Just (todMin tod)
, _hd_publication_second = Just (round $ todSec tod)
, _hd_language_iso2 = Just $ (DT.pack . show) lang
}
where lang = EN
date = _issue_created issue
(year, month, day) = toGregorian $ localDay date
tod = localTimeOfDay date
-}
{-
readFile_IssuesAsDocs :: FilePath -> IO [HyperdataDocument]
readFile_IssuesAsDocs = fmap (fmap gitlabIssue2hyperdataDocument) . readFile_Issues
-}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment