Commit 41c736f6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[API/FACTO] Node.Corpus

parent 4bf375dd
...@@ -94,9 +94,9 @@ import Servant.Swagger.UI ...@@ -94,9 +94,9 @@ import Servant.Swagger.UI
import System.IO (FilePath) import System.IO (FilePath)
import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Gargantext.API.Corpus.Annuaire as Annuaire import qualified Gargantext.API.Node.Corpus.Annuaire as Annuaire
import qualified Gargantext.API.Corpus.Export as Export import qualified Gargantext.API.Node.Corpus.Export as Export
import qualified Gargantext.API.Corpus.New as New import qualified Gargantext.API.Node.Corpus.New as New
import qualified Gargantext.API.Ngrams.List as List import qualified Gargantext.API.Ngrams.List as List
import qualified Paths_gargantext as PG -- cabal magic build module import qualified Paths_gargantext as PG -- cabal magic build module
...@@ -109,11 +109,8 @@ fireWall req fw = do ...@@ -109,11 +109,8 @@ fireWall req fw = do
let origin = lookup "Origin" (requestHeaders req) let origin = lookup "Origin" (requestHeaders req)
let host = lookup "Host" (requestHeaders req) let host = lookup "Host" (requestHeaders req)
let hostOk = Just (encodeUtf8 "localhost:3000") if origin == Just (encodeUtf8 "http://localhost:8008")
let originOk = Just (encodeUtf8 "http://localhost:8008") && host == Just (encodeUtf8 "localhost:3000")
if origin == originOk
&& host == hostOk
|| (not $ unFireWall fw) || (not $ unFireWall fw)
then pure True then pure True
......
...@@ -30,8 +30,8 @@ import Data.Map (Map, toList, fromList) ...@@ -30,8 +30,8 @@ import Data.Map (Map, toList, fromList)
import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema) import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
import Data.Text (Text, concat, pack) import Data.Text (Text, concat, pack)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Corpus.New import Gargantext.API.Node.Corpus.New
import Gargantext.API.Corpus.New.File (FileType(..)) import Gargantext.API.Node.Corpus.New.File (FileType(..))
import Gargantext.API.Ngrams import Gargantext.API.Ngrams
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types (GargServer) import Gargantext.API.Admin.Types (GargServer)
......
...@@ -180,7 +180,14 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI ...@@ -180,7 +180,14 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy. -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI :: forall proxy a. (JSONB a, FromJSON a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a) nodeAPI :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a
-> UserId
-> NodeId
-> GargServer (NodeAPI a)
nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI' nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
where where
nodeAPI' :: GargServer (NodeAPI a) nodeAPI' :: GargServer (NodeAPI a)
......
{-| {-|
Module : Gargantext.API.Corpus.Annuaire Module : Gargantext.API.Node.Corpus.Annuaire
Description : New annuaire API Description : New annuaire API
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -17,7 +17,7 @@ Portability : POSIX ...@@ -17,7 +17,7 @@ Portability : POSIX
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
module Gargantext.API.Corpus.Annuaire module Gargantext.API.Node.Corpus.Annuaire
where where
import Control.Lens hiding (elements) import Control.Lens hiding (elements)
...@@ -37,7 +37,7 @@ import Servant.Job.Core ...@@ -37,7 +37,7 @@ import Servant.Job.Core
import Servant.Job.Types import Servant.Job.Types
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
import Web.FormUrlEncoded (FromForm) import Web.FormUrlEncoded (FromForm)
import qualified Gargantext.API.Corpus.New.File as NewFile import qualified Gargantext.API.Node.Corpus.New.File as NewFile
type Api = Summary "New Annuaire endpoint" type Api = Summary "New Annuaire endpoint"
......
{-| {-|
Module : Gargantext.API.Corpus.Export Module : Gargantext.API.Node.Corpus.Export
Description : Get Metrics from Storage (Database like) Description : Get Metrics from Storage (Database like)
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -22,7 +22,7 @@ Main exports of Gargantext: ...@@ -22,7 +22,7 @@ Main exports of Gargantext:
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Corpus.Export module Gargantext.API.Node.Corpus.Export
where where
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
......
{-| {-|
Module : Gargantext.API.Corpus.New Module : Gargantext.API.Node.Corpus.New
Description : New corpus API Description : New corpus API
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -22,7 +22,7 @@ New corpus means either: ...@@ -22,7 +22,7 @@ New corpus means either:
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Corpus.New module Gargantext.API.Node.Corpus.New
where where
import Control.Lens hiding (elements, Empty) import Control.Lens hiding (elements, Empty)
...@@ -35,7 +35,7 @@ import Data.Text (Text) ...@@ -35,7 +35,7 @@ import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..)) import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
import qualified Gargantext.API.Admin.Orchestrator.Types as T import qualified Gargantext.API.Admin.Orchestrator.Types as T
import Gargantext.API.Corpus.New.File import Gargantext.API.Node.Corpus.New.File
import Gargantext.Core (Lang(..){-, allLangs-}) import Gargantext.Core (Lang(..){-, allLangs-})
import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Core.Types.Individu (UserId, User(..))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
......
{-| {-|
Module : Gargantext.API.Corpus.New.File Module : Gargantext.API.Node.Corpus.New.File
Description : Server API Description : Server API
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
...@@ -22,7 +22,7 @@ Portability : POSIX ...@@ -22,7 +22,7 @@ Portability : POSIX
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.API.Corpus.New.File module Gargantext.API.Node.Corpus.New.File
where where
import Control.Lens ((.~), (?~)) import Control.Lens ((.~), (?~))
......
...@@ -85,7 +85,6 @@ instance ToSchema hyperdata => ...@@ -85,7 +85,6 @@ instance ToSchema hyperdata =>
) where ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
instance ToSchema hyperdata => instance ToSchema hyperdata =>
ToSchema (NodePolySearch NodeId NodeTypeId ToSchema (NodePolySearch NodeId NodeTypeId
(Maybe UserId) (Maybe UserId)
...@@ -102,7 +101,6 @@ instance ToSchema hyperdata => ...@@ -102,7 +101,6 @@ instance ToSchema hyperdata =>
) where ) where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ns_")
instance (Arbitrary hyperdata instance (Arbitrary hyperdata
,Arbitrary nodeId ,Arbitrary nodeId
,Arbitrary nodeTypeId ,Arbitrary nodeTypeId
...@@ -127,8 +125,6 @@ instance (Arbitrary hyperdata ...@@ -127,8 +125,6 @@ instance (Arbitrary hyperdata
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
------------------------------------------------------------------------ ------------------------------------------------------------------------
pgNodeId :: NodeId -> O.Column O.PGInt4 pgNodeId :: NodeId -> O.Column O.PGInt4
pgNodeId = O.pgInt4 . id2int pgNodeId = O.pgInt4 . id2int
...@@ -158,7 +154,6 @@ type TSVector = Text ...@@ -158,7 +154,6 @@ type TSVector = Text
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance FromHttpApiData NodeId where instance FromHttpApiData NodeId where
parseUrlPiece n = pure $ NodeId $ (read . cs) n parseUrlPiece n = pure $ NodeId $ (read . cs) n
...@@ -306,7 +301,6 @@ instance ToSchema EventLevel where ...@@ -306,7 +301,6 @@ instance ToSchema EventLevel where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Event = Event { event_level :: !EventLevel data Event = Event { event_level :: !EventLevel
, event_message :: !Text , event_message :: !Text
, event_date :: !UTCTime , event_date :: !UTCTime
...@@ -320,7 +314,6 @@ instance ToSchema Event where ...@@ -320,7 +314,6 @@ instance ToSchema Event where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "event_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "event_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Resource = Resource { resource_path :: !(Maybe Text) data Resource = Resource { resource_path :: !(Maybe Text)
, resource_scraper :: !(Maybe Text) , resource_scraper :: !(Maybe Text)
, resource_query :: !(Maybe Text) , resource_query :: !(Maybe Text)
...@@ -428,7 +421,6 @@ instance Arbitrary HyperdataCorpus where ...@@ -428,7 +421,6 @@ instance Arbitrary HyperdataCorpus where
arbitrary = pure hyperdataCorpus -- TODO arbitrary = pure hyperdataCorpus -- TODO
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataList = data HyperdataList =
HyperdataList { hd_list :: !(Maybe Text) HyperdataList { hd_list :: !(Maybe Text)
} deriving (Show, Generic) } deriving (Show, Generic)
...@@ -564,7 +556,6 @@ instance FromHttpApiData NodeType ...@@ -564,7 +556,6 @@ instance FromHttpApiData NodeType
instance ToParamSchema NodeType instance ToParamSchema NodeType
instance ToSchema NodeType instance ToSchema NodeType
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
hyperdataDocument :: HyperdataDocument hyperdataDocument :: HyperdataDocument
...@@ -606,11 +597,10 @@ instance ToSchema HyperdataAny where ...@@ -606,11 +597,10 @@ instance ToSchema HyperdataAny where
& schema.description ?~ "a node" & schema.description ?~ "a node"
& schema.example ?~ emptyObject -- TODO & schema.example ?~ emptyObject -- TODO
instance ToSchema Status where instance ToSchema Status where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_")
------------------------------------------------------------------------
instance FromField HyperdataAny where instance FromField HyperdataAny where
fromField = fromField' fromField = fromField'
...@@ -663,7 +653,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperData ...@@ -663,7 +653,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperData
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGJsonb HyperdataDocument instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
where where
queryRunnerColumnDefault = fieldQueryRunnerColumn queryRunnerColumnDefault = fieldQueryRunnerColumn
......
...@@ -31,7 +31,6 @@ module Gargantext.Database.Query.Table.Node ...@@ -31,7 +31,6 @@ module Gargantext.Database.Query.Table.Node
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens (set, view) import Control.Lens (set, view)
import Data.Aeson import Data.Aeson
import Data.Proxy (Proxy(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Text (Text) import Data.Text (Text)
import GHC.Int (Int64) import GHC.Int (Int64)
...@@ -244,7 +243,6 @@ instance HasDefault NodeType where ...@@ -244,7 +243,6 @@ instance HasDefault NodeType where
_ -> undefined _ -> undefined
------------------------------------------------------------------------ ------------------------------------------------------------------------
nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
nodeDefault nt parent = node nt name hyper (Just parent) nodeDefault nt parent = node nt name hyper (Just parent)
where where
......
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