Merge branch 'dev-public' into dev

src/Gargantext/API.hs

@@ -76,6 +76,7 @@ import System.IO (FilePath)
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.Text.IO               as T
 import qualified Paths_gargantext           as PG -- cabal magic build module
+import qualified Gargantext.API.Public      as Public
 
 
 data Mode = Dev | Mock | Prod 
@@ -219,7 +220,7 @@ server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  schemaUiServer swaggerDoc
-     :<|> hoistServerWithContext 
+     :<|> hoistServerWithContext
             (Proxy :: Proxy GargAPI)
             (Proxy :: Proxy AuthContext)
             transform
@@ -240,6 +241,8 @@ serverGargAPI -- orchestrator
        =  auth
      :<|> gargVersion
      :<|> serverPrivateGargAPI
+     :<|> Public.api
+
   --   :<|> orchestrator
   where
 

src/Gargantext/API/Admin/Auth.hs

@@ -201,8 +201,7 @@ withAccessM uId (PathNodeNode cId docId) m = do
 
 withAccess :: forall env err m api.
               (GargServerC env err m, HasServer api '[]) =>
-              Proxy api -> Proxy m ->
-              UserId -> PathId ->
+              Proxy api -> Proxy m -> UserId -> PathId ->
               ServerT api m -> ServerT api m
 withAccess p _ uId id = hoistServer p f
   where

src/Gargantext/API/Node.hs

@@ -46,7 +46,6 @@ 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.Action.Share (unPublish)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
@@ -145,7 +144,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "phylo"     :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
              :<|> "move"      :> MoveAPI
-             :<|> "unpublish" :> Put '[JSON] Int
+             :<|> "unpublish" :> Share.Unpublish
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -221,7 +220,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> moveNode   (RootId $ NodeId uId) id'
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
-           :<|> unPublish (RootId $ NodeId uId) id'
+           :<|> Share.unPublish id'
 
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Share.hs

@@ -20,8 +20,10 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Gargantext.API.Prelude
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Share (shareNodeWith)
+import Gargantext.Database.Action.Share (ShareNodeWith(..))
+import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
@@ -31,37 +33,40 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
-data ShareNode = ShareTeam   { username :: Text }
-               | SharePublic { rights   :: Text}
+data ShareNodeParams = ShareTeamParams   { username :: Text  }
+                     | SharePublicParams { node_id  :: NodeId}
   deriving (Generic)
 ------------------------------------------------------------------------
 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
-instance FromJSON  ShareNode where
+instance FromJSON  ShareNodeParams where
   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
-instance ToJSON    ShareNode where
+instance ToJSON    ShareNodeParams where
   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
-instance ToSchema  ShareNode
-instance Arbitrary ShareNode where
-  arbitrary = elements [ ShareTeam "user1"
-                       , SharePublic "public"
+instance ToSchema  ShareNodeParams
+instance Arbitrary ShareNodeParams where
+  arbitrary = elements [ ShareTeamParams "user1"
+                       , SharePublicParams (NodeId 1)
                        ]
 ------------------------------------------------------------------------
 -- TODO permission
 api :: HasNodeError err
     => NodeId
-    -> ShareNode
+    -> ShareNodeParams
     -> Cmd err Int
-api nId (ShareTeam user) =
-  fromIntegral <$> shareNodeWith nId NodeFolderShared (UserName user)
-api nId (SharePublic _rights) =
-  fromIntegral <$> shareNodeWith nId NodeFolderPublic UserPublic
+api nId (ShareTeamParams user) =
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId 
+api nId2 (SharePublicParams nId1) =
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
 
 ------------------------------------------------------------------------
 type API = Summary " Share Node with username"
-         :> ReqBody '[JSON] ShareNode
+         :> ReqBody '[JSON] ShareNodeParams
          :> Post    '[JSON] Int
 
+------------------------------------------------------------------------
+type Unpublish = Summary " Unpublish Node"
+               :> Capture "node_id" NodeId
+               :> Put '[JSON] Int
 
-
-
-
+unPublish :: NodeId -> GargServer Unpublish
+unPublish n = DB.unPublish n

src/Gargantext/API/Public.hs

+{-|
+Module      : Gargantext.API.Public
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Gargantext.API.Public
+      where
+
+import Control.Lens ((^?), (^.), _Just)
+import Data.Maybe (maybe, catMaybes)
+import Data.Tuple (snd)
+import Data.Text (Text)
+import Data.List (replicate, null)
+import Data.Aeson
+import Data.Swagger
+import GHC.Generics (Generic)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Prelude
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
+import Gargantext.Core.Utils.DateUtils (utc2year)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Schema.Node -- (NodePoly(..))
+import Gargantext.Prelude
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Data.Map as Map
+
+------------------------------------------------------------------------
+type API = Summary " Public API"
+         :> Get '[JSON] [PublicData]
+
+api :: HasNodeError err
+    => Cmd err [PublicData]
+api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
+
+
+selectPublic :: HasNodeError err
+             => Cmd err [( Node HyperdataFolder, Maybe Int)] 
+selectPublic = selectPublicNodes
+
+  -- | For tests only
+  -- pure $ replicate 6 defaultPublicData
+
+filterPublicDatas :: [( Node HyperdataFolder, Maybe Int)] -> [(Node HyperdataFolder, [NodeId])]
+filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
+                                              ( _node_id n, (n, maybe [] (:[]) mi' ))
+                              ) datas
+                        & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))
+                        & Map.filter (not . null . snd)
+                        & Map.elems
+
+
+toPublicData :: (Node HyperdataFolder, [NodeId]) -> Maybe PublicData
+toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
+                                   <*> (hd ^? (_Just . hf_data . cf_desc))
+                                   <*> Just "images/Gargantextuel-212x300.jpg"
+                                   <*> Just "https://.."
+                                   <*> Just (cs $ show $ utc2year (n^.node_date))
+                                   <*> (hd ^? (_Just . hf_data . cf_query))
+                                   <*> (hd ^? (_Just . hf_data . cf_authors))
+  where
+    hd = head
+       $ filter (\(HyperdataField cd _ _) -> cd == JSON)
+       $ n^. (node_hyperdata . hc_fields)
+
+
+data PublicData = PublicData
+  { title    :: Text
+  , abstract :: Text
+  , img      :: Text
+  , url      :: Text
+  , date     :: Text
+  , database :: Text
+  , author   :: Text
+  } | NoData { nodata:: Text}
+  deriving (Generic)
+
+
+instance FromJSON  PublicData where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON    PublicData where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToSchema  PublicData
+instance Arbitrary PublicData where
+  arbitrary = elements
+            $ replicate 6 defaultPublicData 
+
+defaultPublicData :: PublicData
+defaultPublicData =
+  PublicData "Title"
+             (foldl (<>) "" $ replicate 100 "abstract ")
+             "images/Gargantextuel-212x300.jpg"
+             "https://.."
+             "YY/MM/DD"
+             "database"
+             "Author"
+
+
+
+

src/Gargantext/API/Routes.hs

@@ -24,34 +24,34 @@ Portability : POSIX
 module Gargantext.API.Routes
       where
 ---------------------------------------------------------------------
+
 import Control.Concurrent (threadDelay)
 import Data.Text (Text)
 import Data.Validity
-import Servant
-import Servant.Auth as SA
-import Servant.Auth.Swagger ()
-import Servant.Job.Async
-import Servant.Swagger.UI
-
 import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
-import Gargantext.API.Prelude
 import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
 import Gargantext.API.Node
+import Gargantext.API.Prelude
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
+import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Swagger ()
+import Servant.Job.Async
+import Servant.Swagger.UI
+import qualified Gargantext.API.Ngrams.List           as List
 import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
 import qualified Gargantext.API.Node.Corpus.Export    as Export
 import qualified Gargantext.API.Node.Corpus.New       as New
-import qualified Gargantext.API.Ngrams.List           as List
-
+import qualified Gargantext.API.Public                as Public
 
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
@@ -75,6 +75,7 @@ type GargAPI' =
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.
           :<|> GargPrivateAPI
+          :<|> "public" :> Public.API
 
 
 type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser

src/Gargantext/Database/Action/Node.hs

@@ -101,7 +101,10 @@ mkNodeWithParent NodeFrameWrite i u n =
 mkNodeWithParent NodeFrameCalc i u n =
   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
 
-mkNodeWithParent _ _ _ _       = nodeError NotImplYet
+mkNodeWithParent n (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeDashboard name (hasDefaultData n) Nothing uId]
+
+-- mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 
 
 -- | Sugar to create a node, get his NodeId and update his Hyperdata after

src/Gargantext/Database/Action/Share.hs

@@ -9,72 +9,87 @@ Portability : POSIX
 
 -}
 
+
 module Gargantext.Database.Action.Share
   where
 
 import Control.Lens (view)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Utils (getUserId)
-import Gargantext.Database.Admin.Config (hasNodeType)
+import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, msg)
 import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Prelude
 
+-- | TODO move in Config of Gargantext
+publicNodeTypes :: [NodeType]
+publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo]
+
+------------------------------------------------------------------------
+
+data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
+                                        , snwu_user    :: User }
+                   | ShareNodeWith_Node { snwn_nodetype :: NodeType
+                                        , snwn_node_id :: NodeId
+                                        }
+
 ------------------------------------------------------------------------
 shareNodeWith :: HasNodeError err
-              => NodeId
-              -> NodeType
-              -> User
+              => ShareNodeWith
+              -> NodeId
               -> Cmd err Int64
-shareNodeWith n nt u = do
+shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
   nodeToCheck <- getNode   n
-  case nt of
-    NodeFolderShared -> do
-      userIdCheck <- getUserId u
-      if not (hasNodeType nodeToCheck NodeTeam)
-        then panic "Can share node Team only"
-        else
-          if (view node_userId nodeToCheck == userIdCheck)
-            then panic "Can share to others only"
-            else do 
-              folderSharedId  <- getFolderId u NodeFolderShared
-              insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
-
-    NodeFolderPublic -> if not (hasNodeType nodeToCheck NodeGraph)
-                          then panic "Can share node graph only"
-                          else do
-                            folderId  <- getFolderId (UserDBId $ view node_userId nodeToCheck) NodeFolderPublic
-                            insertNodeNode [NodeNode folderId n Nothing Nothing]
-
-    _ -> panic "shareNodeWith not implemented with this NodeType"
+  userIdCheck <- getUserId u
+  if not (hasNodeType nodeToCheck NodeTeam)
+    then msg "Can share node Team only"
+    else
+      if (view node_userId nodeToCheck == userIdCheck)
+        then msg "Can share to others only"
+        else do
+          folderSharedId  <- getFolderId u NodeFolderShared
+          insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
+
+shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
+  nodeToCheck <- getNode n
+  if not (isInNodeTypes nodeToCheck publicNodeTypes)
+    then msg $ "Can share this nodesTypes only: " <> (cs $ show publicNodeTypes)
+    else do
+      folderToCheck <- getNode nId
+      if hasNodeType folderToCheck NodeFolderPublic
+         then insertNodeNode [NodeNode nId n Nothing Nothing]
+         else msg "Can share NodeWith NodeFolderPublic only"
+
+shareNodeWith _ _ = msg "shareNodeWith not implemented for this NodeType"
 
 ------------------------------------------------------------------------
-getFolderId :: User -> NodeType -> Cmd err NodeId
+getFolderId :: HasNodeError err => User -> NodeType -> Cmd err NodeId
 getFolderId u nt = do
   rootId <- getRootId u
   s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
   case head s of
-    Nothing -> panic "No folder shared found"
+    Nothing -> msg "No folder shared found"
     Just  f -> pure (_node_id f)
 
 ------------------------------------------------------------------------
 type TeamId = NodeId
 
-delFolderTeam :: User -> TeamId -> Cmd err Int
+delFolderTeam :: HasNodeError err => User -> TeamId -> Cmd err Int
 delFolderTeam u nId = do
   folderSharedId <- getFolderId u NodeFolderShared
   deleteNodeNode folderSharedId nId
 
-unPublish :: User -> NodeId -> Cmd err Int
-unPublish  u nId = do
-  folderId <- getFolderId u NodeFolderPublic
-  deleteNodeNode folderId nId
+
+unPublish :: HasNodeError err
+          => ParentId -> NodeId
+          -> Cmd err Int
+unPublish p n = deleteNodeNode p n
 

src/Gargantext/Database/Admin/Config.hs

@@ -87,6 +87,8 @@ nodeTypeId n =
 hasNodeType :: forall a. Node a -> NodeType -> Bool
 hasNodeType n nt = (view node_typename n) == (nodeTypeId nt)
 
+isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool
+isInNodeTypes n ts = elem (view node_typename n) (map nodeTypeId ts)
 
 -- | Nodes are typed in the database according to a specific ID
 --

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

@@ -35,7 +35,7 @@ import Gargantext.Viz.Types (Histo(..))
 
 
 data CodeType = JSON | Markdown | Haskell
-  deriving (Generic)
+  deriving (Generic, Eq)
 instance ToJSON CodeType
 instance FromJSON CodeType
 instance ToSchema CodeType
@@ -57,6 +57,12 @@ data CorpusField = MarkdownField { _cf_text :: !Text }
                   | HaskellField { _cf_haskell :: !Text }
                   deriving (Generic)
 
+isField :: CodeType -> CorpusField -> Bool
+isField Markdown (MarkdownField   _) = True
+isField JSON     (JsonField _ _ _ _) = True
+isField Haskell  (HaskellField    _) = True
+isField _ _                          = False
+
 $(deriveJSON (unPrefix "_cf_") ''CorpusField)
 $(makeLenses ''CorpusField)
 
@@ -194,6 +200,7 @@ $(makeLenses ''HyperdataCorpus)
 
 instance Hyperdata HyperdataCorpus
 
+type HyperdataFolder = HyperdataCorpus
 ------------------------------------------------------------------------
 data HyperdataFrame =
   HyperdataFrame { base :: !Text 
@@ -296,38 +303,25 @@ $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 instance Hyperdata HyperdataResource
 
 ------------------------------------------------------------------------
-data HyperdataDashboard = HyperdataDashboard { hyperdataDashboard_preferences   :: !(Maybe Text)
-                                             , hyperdataDashboard_charts        :: ![Chart]
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
-
-instance Hyperdata HyperdataDashboard
-
 ------------------------------------------------------------------------
 -- TODO add the Graph Structure here
-data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: !(Maybe Text)
-                                     , hyperdataPhylo_data          :: !(Maybe Phylo)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
-
-instance Hyperdata HyperdataPhylo
 
 ------------------------------------------------------------------------
--- | TODO FEATURE: Notebook saved in the node
-data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: !(Maybe Text)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
-
-instance Hyperdata HyperdataNotebook
-
-
 -- | TODO CLEAN
+-- | TODO FEATURE: Notebook saved in the node
 data HyperData = HyperdataTexts { hd_preferences :: !(Maybe Text)}
                | HyperdataList' { hd_preferences :: !(Maybe Text)}
+               | HyperdataDashboard { hd_preferences :: !(Maybe Text)
+                                    , hd_charts      :: ![Chart]
+                                    }
+               | HyperdataNotebook { hd_preferences :: !(Maybe Text)}
+               | HyperdataPhylo    { hd_preferences :: !(Maybe Text)
+                                   , hd_data        :: !(Maybe Phylo)
+                                   }
+
   deriving (Show, Generic)
 
 $(deriveJSON (unPrefix "hd_") ''HyperData)
-
 instance Hyperdata HyperData
 
 ------------------------------------------------------------------------
@@ -395,10 +389,6 @@ instance FromField HyperdataListModel
   where
     fromField = fromField'
 
-instance FromField HyperdataPhylo
-  where
-    fromField = fromField'
-
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
@@ -437,10 +427,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

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

@@ -233,10 +233,6 @@ instance Arbitrary Resource where
 instance ToSchema Resource where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
 
-------------------------------------------------------------------------
-
-
-
 ------------------------------------------------------------------------
 -- | Then a Node can be either a Folder or a Corpus or a Document
 data NodeType = NodeUser
@@ -280,6 +276,8 @@ instance ToSchema      NodeType
 instance Arbitrary NodeType where
   arbitrary = elements allNodeTypes
 
+
+
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------
@@ -311,5 +309,3 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
-
-

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

@@ -228,17 +228,20 @@ class HasDefault a where
 
 instance HasDefault NodeType where
   hasDefaultData nt = case nt of
-      NodeTexts    -> HyperdataTexts (Just "Preferences")
-      NodeList     -> HyperdataList' (Just "Preferences")
-      NodeListCooc -> HyperdataList' (Just "Preferences")
-      _         -> undefined
+      NodeTexts     -> HyperdataTexts (Just "Preferences")
+      NodeList      -> HyperdataList' (Just "Preferences")
+      NodeListCooc  -> HyperdataList' (Just "Preferences")
+      -- NodeFolder    -> defaultFolder
+      NodeDashboard -> arbitraryDashboard
+      _             -> panic "HasDefaultData undefined"
       --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
 
   hasDefaultName nt = case nt of
       NodeTexts -> "Texts"
       NodeList  -> "Lists"
       NodeListCooc -> "Cooc"
-      _         -> undefined
+      NodePhylo    -> "Phylo"
+      _         -> panic "HasDefaultName undefined"
 
 ------------------------------------------------------------------------
 nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
@@ -277,17 +280,7 @@ insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
 insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
 
 ------------------------------------------------------------------------
-arbitraryPhylo :: HyperdataPhylo
-arbitraryPhylo = HyperdataPhylo Nothing Nothing
-
-nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite
-nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
-  where
-    name = maybe "Phylo" identity maybeName
-    graph = maybe arbitraryPhylo identity maybePhylo
-
-------------------------------------------------------------------------
-arbitraryDashboard :: HyperdataDashboard
+arbitraryDashboard :: HyperData 
 arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
 ------------------------------------------------------------------------
 
@@ -446,16 +439,12 @@ mkNode nt p u = insertNodesR [nodeDefault nt p u]
 mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
   where
-    nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
+    nodeDashboardW :: Maybe Name -> Maybe HyperData -> ParentId -> UserId -> NodeWrite
     nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
       where
         name = maybe "Board" identity maybeName
         dashboard = maybe arbitraryDashboard identity maybeDashboard
 
-
-mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
-mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
-
 getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 

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

@@ -19,6 +19,7 @@ Portability : POSIX
 
 module Gargantext.Database.Query.Table.Node.Error where
 
+import Data.Text (Text)
 import Gargantext.Database.Admin.Types.Node (NodeId)
 import Control.Lens (Prism', (#), (^?))
 import Control.Monad.Error.Class (MonadError(..))
@@ -39,6 +40,7 @@ data NodeError = NoListFound
                | ManyNodeUsers
                | DoesNotExist NodeId
                | NeedsConfiguration
+               | NodeError Text
 
 instance Show NodeError
   where
@@ -56,10 +58,16 @@ instance Show NodeError
     show ManyNodeUsers = "Many userNode/user"
     show (DoesNotExist n)   = "Node does not exist" <> show n
     show NeedsConfiguration = "Needs configuration"
+    show (NodeError e)   = "NodeError: " <> cs e
 
 class HasNodeError e where
   _NodeError :: Prism' e NodeError
 
+msg :: ( MonadError e m
+              , HasNodeError e)
+          => Text -> m a
+msg x = nodeError (NodeError x)
+
 nodeError :: ( MonadError e m
              , HasNodeError e)
           => NodeError -> m a

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

@@ -28,6 +28,7 @@ module Gargantext.Database.Query.Table.NodeNode
   , getNodeNode
   , insertNodeNode
   , deleteNodeNode
+  , selectPublicNodes
   )
   where
 
@@ -153,3 +154,21 @@ joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
+joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
+joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond (n, nn) = nn^.nn_node1_id .== n^.node_id
+
+
+------------------------------------------------------------------------
+selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
+                  => Cmd err [(Node a, Maybe Int)]
+selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
+
+queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
+queryWithType nt = proc () -> do
+  (n, nn) <- joinOn1 -< ()
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
+  returnA  -<  (n, nn^.nn_node2_id)
+

src/Gargantext/Database/Query/Tree.hs

@@ -40,7 +40,7 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId)
+import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
 import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
@@ -89,28 +89,48 @@ tree_advanced :: HasTreeError err
        -> Cmd err (Tree NodeTree)
 tree_advanced r nodeTypes = do
   mainRoot    <- dbTree     r nodeTypes
-  sharedRoots <- findShared r NodeFolderShared nodeTypes
-  publicRoots <- findShared r NodeFolderPublic nodeTypes
+  sharedRoots <- findShared r NodeFolderShared nodeTypes sharedTreeUpdate
+  publicRoots <- findShared r NodeFolderPublic nodeTypes publicTreeUpdate
   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
 
 ------------------------------------------------------------------------
 -- | Collaborative Nodes in the Tree
-findShared :: RootId -> NodeType -> [NodeType] -> Cmd err [DbTreeNode]
-findShared r nt nts = do
-  folderSharedId <- maybe (panic "no folder found") identity
-                <$> head
-                <$> findNodesId r [nt]
-  folders       <- getNodeNode folderSharedId
-  nodesSharedId <- mapM (\child -> sharedTree folderSharedId child nts)
+findShared :: HasTreeError err
+           => RootId -> NodeType -> [NodeType] -> UpdateTree err
+           -> Cmd err [DbTreeNode]
+findShared r nt nts fun = do
+  foldersSharedId <- findNodesId r [nt]
+  trees       <- mapM (updateTree nts fun) foldersSharedId
+  pure $ concat trees
+
+
+updateTree :: HasTreeError err
+           => [NodeType] -> UpdateTree err -> RootId
+           -> Cmd err [DbTreeNode]
+updateTree nts fun r = do
+  folders       <- getNodeNode r
+  nodesSharedId <- mapM (fun r nts)
                  $ map _nn_node2_id folders
   pure $ concat nodesSharedId
 
-sharedTree :: ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
-sharedTree p n nt = dbTree n nt
-               <&> map (\n' -> if _dt_nodeId n' == n 
+
+type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
+ 
+sharedTreeUpdate :: HasTreeError err => UpdateTree err
+sharedTreeUpdate p nt n = dbTree n nt
+               <&> map (\n' -> if _dt_nodeId n' == n
+                                  then set dt_parentId (Just p) n'
+                                  else n')
+
+publicTreeUpdate :: HasTreeError err => UpdateTree err
+publicTreeUpdate p nt n = dbTree n nt
+               <&> map (\n' -> if _dt_nodeId n' == n
+                                -- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
                                   then set dt_parentId (Just p) n'
                                   else n')
 
+
+
 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
 findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
 findNodesId r nt = tail

src/Gargantext/Viz/Phylo/API.hs

@@ -32,7 +32,7 @@ import Web.HttpApiData (parseUrlPiece, readTextData)
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
-import Gargantext.Database.Query.Table.Node (insertNodes, nodePhyloW, getNodeWith)
+import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
 import Gargantext.Database.Schema.Node (_node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
@@ -95,15 +95,16 @@ type GetPhylo =  QueryParam "listId"      ListId
 -- Add real text processing
 -- Fix Filter parameters
 getPhylo :: PhyloId -> GargServer GetPhylo
---getPhylo phId _lId l msb _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
 getPhylo phId _lId l msb  = do
-  phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
+  phNode     <- getNodeWith phId (Proxy :: Proxy HyperData)
   let
     level = maybe 2 identity l
     branc = maybe 2 identity msb
-    maybePhylo = hyperdataPhylo_data $ _node_hyperdata phNode
+    maybePhylo = hd_data $ _node_hyperdata phNode
 
-  p <- liftBase $ viewPhylo2Svg $ viewPhylo level branc  $ maybe phyloFromQuery identity maybePhylo
+  p <- liftBase $ viewPhylo2Svg
+                $ viewPhylo level branc
+                $ maybe phyloFromQuery identity maybePhylo
   pure (SVG p)
 ------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
@@ -119,7 +120,7 @@ postPhylo n userId _lId = do
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
   phy  <- flowPhylo n
-  pId <- insertNodes [nodePhyloW (Just "Phylo") (Just $ HyperdataPhylo Nothing (Just phy)) n userId]
+  pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
   pure $ NodeId (fromIntegral pId)
 
 ------------------------------------------------------------------------