[Graph api] Legend update endpoint

src/Gargantext/API/Routes/Named/Viz.hs

@@ -53,11 +53,12 @@ newtype PostPhylo mode = PostPhylo
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
 data GraphAPI mode = GraphAPI
-  { getGraphEp       :: mode :- Get '[JSON] HyperdataGraphAPI
-  , getGraphAsyncEp  :: mode :- "async" :> NamedRoutes GraphAsyncAPI
-  , cloneGraphEp     :: mode :- "clone" :> ReqBody '[JSON] HyperdataGraphAPI :> Post '[JSON] NodeId
-  , gexfEp           :: mode :- "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-  , graphVersionsAPI :: mode :- "versions" :> NamedRoutes GraphVersionsAPI
+  { getGraphEp          :: mode :- Get '[JSON] HyperdataGraphAPI
+  , getGraphAsyncEp     :: mode :- "async" :> NamedRoutes GraphAsyncAPI
+  , cloneGraphEp        :: mode :- "clone" :> ReqBody '[JSON] HyperdataGraphAPI :> Post '[JSON] NodeId
+  , gexfEp              :: mode :- "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+  , graphVersionsAPI    :: mode :- "versions" :> NamedRoutes GraphVersionsAPI
+  , updateGraphLegendEp :: mode :- "legend" :> ReqBody '[JSON] GraphLegendAPI :> Post '[JSON] NodeId
   } deriving Generic
 
 

src/Gargantext/API/Server/Named/Viz.hs

@@ -19,11 +19,12 @@ import Servant.Server.Generic (AsServerT)
 
 graphAPI :: AuthenticatedUser -> UserId -> NodeId -> Named.GraphAPI (AsServerT (GargM Env BackendInternalError))
 graphAPI authenticatedUser userId n = withNamedAccess authenticatedUser (PathNode n) $ Named.GraphAPI
-  { getGraphEp       = getGraph n
-  , getGraphAsyncEp  = graphAsync n
-  , cloneGraphEp     = graphClone userId n
-  , gexfEp           = getGraphGexf      n
-  , graphVersionsAPI = graphVersionsAPI  userId n
+  { getGraphEp          = getGraph n
+  , getGraphAsyncEp     = graphAsync n
+  , cloneGraphEp        = graphClone userId n
+  , gexfEp              = getGraphGexf      n
+  , graphVersionsAPI    = graphVersionsAPI  userId n
+  , updateGraphLegendEp = updateGraphLegend n
   }
 
 

src/Gargantext/Core/Viz/Graph/API.hs

@@ -297,3 +297,18 @@ getGraphGexf :: HasNodeStory env err m
 getGraphGexf nId = do
   HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph nId
   pure $ addHeader "attachment; filename=graph.gexf" graph
+
+------------------------------------------------------------
+updateGraphLegend :: HasNodeError err
+                  => NodeId
+                  -> GraphLegendAPI
+                  -> DBCmd err NodeId
+updateGraphLegend nId (GraphLegendAPI { _graphAPILegend = lg }) = do
+  nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
+  let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+  case graph of
+    Nothing -> pure nId
+    Just g -> do
+      let graph' = set (graph_metadata . _Just . gm_legend) lg g
+      _ <- updateHyperdata nId (HyperdataGraph (Just graph') (nodeGraph ^. node_hyperdata . hyperdataCamera))
+      pure nId

src/Gargantext/Core/Viz/Graph/Types.hs

@@ -241,6 +241,20 @@ instance FromField HyperdataGraphAPI
     fromField = fromField'
 
 
+-----------------------------------------------------------
+
+data GraphLegendAPI = GraphLegendAPI { _graphAPILegend :: [LegendField] }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_graphAPI") ''GraphLegendAPI)
+instance ToSchema GraphLegendAPI where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graphAPI")
+
+makeLenses ''GraphLegendAPI
+
+instance FromField GraphLegendAPI
+  where
+    fromField = fromField'
+
 
 
 ---------------------- defaults