[FEAT] framing: back + front

bin/gargantext-import/Main.hs

@@ -27,7 +27,7 @@ import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire,
 import Gargantext.Database.Query.Table.User (insertUsersDemo)
 import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
-import Gargantext.Database.Prelude (Cmd, )
+import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
 import Gargantext.Text.Corpus.Parsers (FileFormat(..))
 import Prelude (read)

gargantext.ini_toModify

@@ -2,7 +2,10 @@
 MASTER_USER = gargantua
 
 # SECURITY WARNING: keep the secret key used in production secret!
-SECRET_KEY = PASSWORD_TO_CHANGE
+SECRET_KEY      = PASSWORD_TO_CHANGE
+
+FRAME_WRITE_URL = URL_TO_CHANGE
+FRAME_CALC_URL  = URL_TO_CHANGE
 
 [database]
 # PostgreSQL access

src/Gargantext/API/Admin/Auth.hs

@@ -41,7 +41,7 @@ import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
 import Gargantext.Database.Schema.Node (NodePoly(_node_id)) 
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
-import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool)
+import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 import Gargantext.Prelude hiding (reverse)
 import Gargantext.Database.Query.Table.User
 import Servant
@@ -90,7 +90,7 @@ makeTokenForUser uid = do
   either joseError (pure . toStrict . decodeUtf8) e
   -- TODO not sure about the encoding...
 
-checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err)
+checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
                  => Username
                  -> GargPassword
                  -> Cmd' env err CheckAuth
@@ -109,7 +109,7 @@ checkAuthRequest u (GargPassword p) = do
               token <- makeTokenForUser uid
               pure $ Valid token uid
 
-auth :: (HasSettings env, HasConnectionPool env, HasJoseError err)
+auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env)
      => AuthRequest -> Cmd' env err AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p

src/Gargantext/API/Admin/Settings.hs

@@ -35,8 +35,9 @@ import GHC.Enum
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo, renv_var, renv_lock)
-import Gargantext.Database.Prelude (databaseParameters, HasConnectionPool(..), Cmd', runCmd)
+import Gargantext.Database.Prelude (databaseParameters, HasConnectionPool(..), Cmd', runCmd, HasConfig(..))
 import Gargantext.Prelude
+
 import Network.HTTP.Client (Manager)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Prelude (Bounded(), fail)
@@ -53,7 +54,7 @@ import System.Log.FastLogger
 import Web.HttpApiData (parseUrlPiece)
 import qualified Data.ByteString.Lazy as L
 import qualified Servant.Job.Core
-
+import Gargantext.Config (GargConfig(), readConfig, defaultConfig)
 
 type PortNumber = Int
 
@@ -75,6 +76,7 @@ data Settings = Settings
     , _sendLoginEmails :: SendEmailType
     , _scrapydUrl      :: BaseUrl
     , _fileFolder      :: FilePath
+    , _config          :: GargConfig
     }
 
 makeLenses ''Settings
@@ -86,7 +88,7 @@ devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
-  jwk <- readKey jwkFile
+  jwk       <- readKey jwkFile
   pure $ Settings
     { _allowedOrigin = "http://localhost:8008"
     , _allowedHost = "localhost:3000"
@@ -98,6 +100,7 @@ devSettings jwkFile = do
     , _fileFolder = "data"
     , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
     , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
+    , _config      = defaultConfig
     }
   where
     xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
@@ -136,11 +139,15 @@ data Env = Env
   , _env_manager  :: !Manager
   , _env_self_url :: !BaseUrl
   , _env_scrapers :: !ScrapersEnv
+  , _env_gargConfig :: !GargConfig
   }
   deriving (Generic)
 
 makeLenses ''Env
 
+instance HasConfig Env where
+  hasConfig = env_gargConfig
+
 instance HasConnectionPool Env where
   connPool = env_pool
 
@@ -191,7 +198,7 @@ mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
 mkRepoSaver repo_var = mkDebounce settings
   where
     settings = defaultDebounceSettings
-                 { debounceFreq   = 1000000 -- 1 second
+                 { debounceFreq   = let n = 6 :: Int in 10^n  -- 1 second
                  , debounceAction = withMVar repo_var repoSaverAction
                    -- Here this not only `readMVar` but `takeMVar`.
                    -- Namely while repoSaverAction is saving no other change
@@ -238,17 +245,18 @@ devJwkFile = "dev.jwk"
 
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
-  manager <- newTlsManager
-  settings <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
+  manager     <- newTlsManager
+  settings    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
   when (port /= settings ^. appPort) $
     panic "TODO: conflicting settings of port"
 
-  self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
-  param    <- databaseParameters file
-  pool     <- newPool param
-  repo     <- readRepoEnv
+  self_url     <- parseBaseUrl $ "http://0.0.0.0:" <> show port
+  param        <- databaseParameters file
+  pool         <- newPool param
+  repo         <- readRepoEnv
   scrapers_env <- newJobEnv defaultSettings manager
-  logger <- newStderrLoggerSet defaultBufSize
+  logger       <- newStderrLoggerSet defaultBufSize
+  config       <- readConfig file
 
   pure $ Env
     { _env_settings   = settings
@@ -258,19 +266,24 @@ newEnv port file = do
     , _env_manager    = manager
     , _env_scrapers   = scrapers_env
     , _env_self_url   = self_url
+    , _env_gargConfig = config
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)
 newPool param = createPool (connect param) close 1 (60*60) 8
 
 data DevEnv = DevEnv
-  { _dev_env_pool :: !(Pool Connection)
-  , _dev_env_repo :: !RepoEnv
+  { _dev_env_pool     :: !(Pool Connection)
+  , _dev_env_repo     :: !RepoEnv
   , _dev_env_settings :: !Settings
+  , _dev_env_config   :: !GargConfig
   }
 
 makeLenses ''DevEnv
 
+instance HasConfig DevEnv where
+  hasConfig = dev_env_config
+
 instance HasConnectionPool DevEnv where
   connPool = dev_env_pool
 
@@ -303,10 +316,12 @@ withDevEnv iniPath k = do
       pool  <- newPool param
       repo  <- readRepoEnv
       setts <- devSettings devJwkFile
+      config <- readConfig iniPath
       pure $ DevEnv
         { _dev_env_pool = pool
         , _dev_env_repo = repo
         , _dev_env_settings = setts
+        , _dev_env_config   = config
         }
 
 -- | Run Cmd Sugar for the Repl (GHCI)

src/Gargantext/API/Ngrams.hs

@@ -123,7 +123,7 @@ import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ng
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Database.Prelude (fromField', HasConnectionPool)
+import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error)
 import Servant hiding (Patch)
@@ -1030,7 +1030,7 @@ getTime' = liftBase $ getTime ProcessCPUTime
 
 
 getTableNgrams :: forall env err m.
-                  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env)
+                  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeType -> NodeId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -1132,7 +1132,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
   pure tableMap3
 
 
-scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env) => NodeId -> TabType -> ListId -> m Int
+scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) => NodeId -> TabType -> ListId -> m Int
 scoresRecomputeTableNgrams nId tabType listId = do
   tableMap <- getNgramsTableMap listId ngramsType
   _ <- tableMap & v_data %%~ setScores
@@ -1221,7 +1221,7 @@ type TableNgramsApi =  TableNgramsApiGet
                   :<|> TableNgramsApiPost
                   :<|> RecomputeScoresNgramsApiGet
 
-getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env)
+getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -1235,7 +1235,7 @@ getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize o
       searchQuery = maybe (const True) isInfixOf mt
 
 -- | Text search is deactivated for now for ngrams by doc only
-getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env)
+getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => DocId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
@@ -1256,6 +1256,7 @@ apiNgramsTableCorpus :: ( RepoCmdM env err m
                         , HasNodeError err
                         , HasInvalidError err
                         , HasConnectionPool env
+                        , HasConfig         env
                         )
                      => NodeId -> ServerT TableNgramsApi m
 apiNgramsTableCorpus cId =  getTableNgramsCorpus cId
@@ -1267,6 +1268,7 @@ apiNgramsTableDoc :: ( RepoCmdM env err m
                      , HasNodeError err
                      , HasInvalidError err
                      , HasConnectionPool env
+                     , HasConfig         env
                      )
                   => DocId -> ServerT TableNgramsApi m
 apiNgramsTableDoc dId =  getTableNgramsDoc dId

src/Gargantext/API/Node.hs

@@ -35,39 +35,37 @@ import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
 import Gargantext.API.Admin.Auth (withAccess, PathId(..))
-import Gargantext.API.Prelude
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Node.New
-import qualified Gargantext.API.Node.Share  as Share
-import qualified Gargantext.API.Node.Update as Update
-
+import Gargantext.API.Prelude
 import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
 import Gargantext.API.Table
 import Gargantext.Core.Types (NodeTableResult)
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
-import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Query.Tree (tree, TreeMode(..))
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Table.NodeNode
+import Gargantext.Database.Query.Tree (tree, TreeMode(..))
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
-import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Gargantext.API.Node.Share  as Share
+import qualified Gargantext.API.Node.Update as Update
 import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
+import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
 
 {-
 import qualified Gargantext.Text.List.Learn as Learn
@@ -313,5 +311,5 @@ moveNode :: User
          -> ParentId
          -> Cmd err [Int]
 moveNode _u n p = update (Move n p)
-
+-------------------------------------------------------------
 -------------------------------------------------------------

src/Gargantext/API/Node/Get.hs

+{-|
+Module      : Gargantext.API.Node.Get
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Polymorphic Get Node API
+
+-}
+
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Gargantext.API.Node.Get
+      where
+
+-- import Gargantext.API.Admin.Settings (HasSettings)
+-- import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+-- import Test.QuickCheck (elements)
+-- import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Data.Aeson
+import Data.Swagger
+import GHC.Generics (Generic)
+import Gargantext.API.Prelude
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Node (JSONB{-, getNodeWith-})
+import Gargantext.Prelude
+import Servant
+import Test.QuickCheck.Arbitrary
+
+------------------------------------------------------------------------
+type API a = Summary "Polymorphic Get Node Endpoint"
+         :> ReqBody '[JSON] GetNodeParams
+         :> Get '[JSON] (Node a)
+
+------------------------------------------------------------------------
+data GetNodeParams = GetNodeParams { node_id  :: NodeId 
+                                   , nodetype :: NodeType
+                                   }
+    deriving (Generic)
+
+----------------------------------------------------------------------
+api :: forall proxy a.
+    ( JSONB a
+    , FromJSON a
+    , ToJSON   a
+    ) => proxy a -> UserId -> NodeId -> GargServer (API a)
+api _p _uId _nId (GetNodeParams _nId' _nt) = undefined
+
+------------------------------------------------------------------------
+instance FromJSON  GetNodeParams where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON    GetNodeParams where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+  
+instance ToSchema  GetNodeParams
+instance Arbitrary GetNodeParams where
+  arbitrary = GetNodeParams <$> arbitrary <*> arbitrary
+
+------------------------------------------------------------------------

src/Gargantext/API/Prelude.hs

@@ -83,6 +83,7 @@ type GargServerC env err m =
     , HasRepo      env
     , HasSettings  env
     , HasJobEnv    env JobLog JobLog
+    , HasConfig    env
     )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m
@@ -96,9 +97,10 @@ type GargServerM env err = ReaderT env (ExceptT err IO)
 
 type EnvC env =
   ( HasConnectionPool env
-  , HasRepo env
-  , HasSettings env
-  , HasJobEnv env JobLog JobLog
+  , HasRepo           env
+  , HasSettings       env
+  , HasJobEnv         env JobLog JobLog
+  , HasConfig         env
   )
 
 -------------------------------------------------------------------

src/Gargantext/Config.hs

+{-|
+Module      : Gargantext.Config
+Description : Textmining Collaborative Platform
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Gargantext.Config where
+
+import System.IO (FilePath)
+import Data.Ini (readIniFile, lookupValue)
+import Data.Either.Extra (Either(Left, Right))
+import Gargantext.Prelude
+import Data.Text (Text, pack)
+import GHC.Generics (Generic)
+import Control.Lens (makeLenses)
+
+
+data GargConfig = GargConfig { _gc_masteruser :: Text
+                             , _gc_secretkey  :: Text
+                             , _gc_frame_write_url :: Text
+                             , _gc_frame_calc_url  :: Text
+                             }
+  deriving (Generic)
+
+makeLenses ''GargConfig
+
+
+readConfig :: FilePath -> IO GargConfig
+readConfig fp = do
+  ini         <- readIniFile fp
+  let ini'' = case ini of
+        Left e     -> panic (pack $ "No ini file error" <> show e)
+        Right ini' -> ini'
+
+  let val x = case (lookupValue (pack "gargantext") (pack x) ini'') of
+        Left _   -> panic (pack $ "no" <> x)
+        Right p' -> p'
+
+  pure $ GargConfig (val "MASTER_USER")
+                    (val "SECRET_KEY")
+                    (val "FRAME_WRITE_URL")
+                    (val "FRAME_CALC_URL")
+
+defaultConfig :: GargConfig
+defaultConfig = GargConfig "gargantua" "secret" "https://frame_write.url" "https://frame_calc.url"

src/Gargantext/Database/Action/Node.hs

@@ -20,19 +20,22 @@ Portability : POSIX
 module Gargantext.Database.Action.Node
   where
 
-import Protolude
-
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Query.Table.Node.Error
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.Node.User
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils (sha)
+import Gargantext.Database.Prelude
+import Control.Lens (view)
+import Gargantext.Config (GargConfig(..))
 
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
-mkNodeWithParent :: HasNodeError err
+mkNodeWithParent :: (HasNodeError err)
                  => NodeType
                  -> Maybe ParentId
                  -> UserId
@@ -91,5 +94,22 @@ mkNodeWithParent NodeGraph (Just i) uId _name =
     where
       hd = arbitraryGraph
 
+mkNodeWithParent NodeFrameWrite (Just i) uId name = do
+  config <- view hasConfig
+  let
+    u = _gc_frame_write_url config
+    s = _gc_secretkey config
+    hd = HyperdataFrame u (sha $ s <> (cs $ show i))
+  insertNodesWithParentR (Just i) [node NodeFrameWrite name hd Nothing uId]
+
+mkNodeWithParent NodeFrameCalc (Just i) uId name = do
+  config <- view hasConfig
+  let
+    u = _gc_frame_calc_url config
+    s = _gc_secretkey config
+    hd = HyperdataFrame u (sha $ s <> (cs $ show i))
+
+  insertNodesWithParentR (Just i) [node NodeFrameCalc name hd Nothing uId]
+
 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 

src/Gargantext/Database/Admin/Config.hs

@@ -66,6 +66,9 @@ nodeTypeId n =
     NodeDashboard   -> 71
     NodeNoteBook    -> 88
 
+    NodeFrameWrite  -> 991
+    NodeFrameCalc   -> 992
+
 --  Cooccurrences -> 9
 --
 --  Specclusion  -> 11

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

@@ -195,6 +195,16 @@ $(makeLenses ''HyperdataCorpus)
 instance Hyperdata HyperdataCorpus
 
 ------------------------------------------------------------------------
+data HyperdataFrame =
+  HyperdataFrame { base :: !Text 
+                 , frame_id :: !Text
+                 }
+    deriving (Generic)
+$(deriveJSON (unPrefix "") ''HyperdataFrame)
+$(makeLenses ''HyperdataFrame)
+
+instance Hyperdata HyperdataFrame
+
 ------------------------------------------------------------------------
 docExample :: ByteString
 docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"

src/Gargantext/Database/Admin/Types/Node.hs

@@ -250,8 +250,6 @@ data NodeType = NodeUser
               | NodeDashboard  | NodeChart    | NodeNoteBook
               | NodeList       | NodeListModel
               | NodeListCooc
-  deriving (Show, Read, Eq, Generic, Bounded, Enum)
-
 
 {-
               -- | Metrics
@@ -259,6 +257,12 @@ data NodeType = NodeUser
               -- | Classification
 -}
 
+              -- Optional Nodes
+              | NodeFrameWrite | NodeFrameCalc
+
+  deriving (Show, Read, Eq, Generic, Bounded, Enum)
+
+
 allNodeTypes :: [NodeType]
 allNodeTypes = [minBound ..]
 
@@ -272,6 +276,8 @@ instance FromHttpApiData NodeType
 instance ToParamSchema NodeType
 instance ToSchema      NodeType
 
+instance Arbitrary NodeType where
+  arbitrary = elements allNodeTypes
 
 ------------------------------------------------------------------------
 -- Instances

src/Gargantext/Database/Prelude.hs

@@ -13,7 +13,6 @@ Portability : POSIX
 
 module Gargantext.Database.Prelude where
 
-
 import Control.Exception
 import Control.Lens (Getter, view)
 import Control.Monad.Error.Class -- (MonadError(..), Error)
@@ -35,6 +34,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Gargantext.Prelude
+import Gargantext.Config (GargConfig())
 import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
 import Opaleye.Aggregate (countRows)
 import System.IO (FilePath)
@@ -52,6 +52,13 @@ class HasConnectionPool env where
 instance HasConnectionPool (Pool Connection) where
   connPool = identity
 
+class HasConfig env where
+  hasConfig :: Getter env GargConfig
+
+instance HasConfig GargConfig where
+  hasConfig = identity
+
+-------------------------------------------------------
 type CmdM' env err m =
   ( MonadReader env m
   , MonadError err m
@@ -61,6 +68,7 @@ type CmdM' env err m =
 type CmdM env err m =
   ( CmdM' env err m
   , HasConnectionPool env
+  , HasConfig         env
   )
 
 type Cmd' env err a = forall m. CmdM' env err m => m a
@@ -99,7 +107,7 @@ runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
 runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
 runPGSQuery :: (MonadError err m, MonadReader env m, MonadBaseControl IO m,
-                PGS.FromRow r, PGS.ToRow q, HasConnectionPool env)
+                PGS.FromRow r, PGS.ToRow q, HasConnectionPool env, HasConfig env)
                 => PGS.Query -> q -> m [r]
 runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
   where

src/Gargantext/Database/Query/Table/Node.hs

@@ -167,6 +167,8 @@ nodeContactW maybeName maybeContact aId =
 defaultFolder :: HyperdataCorpus
 defaultFolder = defaultCorpus
 
+
+
 nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite
 nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
   where