Merge branch 'dev' into dev-doc-annotation-issue

README.md

@@ -13,9 +13,8 @@ Institute of Paris Île-de-France (ISC-PIF) and its partners.
 
 ## Installation
 
-Disclaimer: this project is still on development, this is work in
-progress. Please report and improve this documentation if you encounter
-issues.
+Disclaimer: this project is still in development, this is work in
+progress. Please report and improve this documentation if you encounter issues.
 
 ### Build Core Code
 
@@ -33,8 +32,7 @@ curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devo
 
 ### Add dependencies
 
-1. CoreNLP is needed (EN and FR); This dependency will not be needed
-   soon.
+1. CoreNLP is needed (EN and FR); This dependency will not be needed soon.
 
 ``` sh
 ./devops/install-corenlp
@@ -69,9 +67,10 @@ Initialization schema should be loaded automatically (from `devops/postgres/sche
 
 Change the passwords in gargantext.ini_toModify then move it:
 
+``` sh
 mv gargantext.ini_toModify gargantext.ini
-
-(.gitignore avoids adding this file to the repository by mistake)
+```
+(`.gitignore` avoids adding this file to the repository by mistake)
 
 
 ##### Run Gargantext
@@ -104,6 +103,15 @@ docker run --rm -it -p 9000:9000 cgenie/corenlp-garg
 stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 10000 ./1000.csv
 ```
 
+### Nix
+
+It is also possible to build everything with [Nix](https://nixos.org/) instead of Docker:
+``` sh
+stack --nix build
+stack --nix exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 10000 ./1000.csv
+stack --nix exec gargantext-server -- --ini gargantext.ini --run Prod
+```
+
 ## Use Cases
 
 ### Multi-User with Graphical User Interface (Server Mode)
@@ -112,12 +120,14 @@ stack exec gargantext-import -- "corpusCsvHal" "user1" "IMT3" gargantext.ini 100
 ~/.local/bin/stack --docker exec gargantext-server -- --ini "gargantext.ini" --run Prod
 ```
 
-Then you can log in with `user1:1resu`.
+Then you can log in with `user1` / `1resu`.
 
 
 ### Command Line Mode tools
 
 #### Simple cooccurrences computation and indexation from a list of Ngrams
 
+``` sh
 stack --docker exec gargantext-cli -- CorpusFromGarg.csv ListFromGarg.csv Ouput.json
+```
 

gargantext.ini_toModify

@@ -10,7 +10,7 @@ SECRET_KEY      = PASSWORD_TO_CHANGE
 DATA_FILEPATH = FILEPATH_TO_CHANGE
 
 # [external]
-# FRAMES
+# FRAMES (i.e. iframe sources used in various places on the frontend)
 FRAME_WRITE_URL = URL_TO_CHANGE
 FRAME_CALC_URL  = URL_TO_CHANGE
 

package.yaml

 name: gargantext
-version: '0.0.1.7.3'
+version: '0.0.1.7.4'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -40,6 +40,7 @@ library:
   - Gargantext.API
   - Gargantext.API.HashedResponse
   - Gargantext.API.Node
+  - Gargantext.API.Node.File
   - Gargantext.API.Admin.Settings
   - Gargantext.API.Prelude
   - Gargantext.Core
@@ -161,6 +162,7 @@ library:
   - located-base
   - logging-effect
   - matrix
+  - MissingH
   - monad-control
   - monad-logger
   - mtl
@@ -208,6 +210,7 @@ library:
   - servant-xml
   - simple-reflect
   - singletons # (IGraph)
+  - wai-app-static
 
     # for mail
   - smtp-mail

src/Gargantext/API/HashedResponse.hs

@@ -14,10 +14,10 @@ module Gargantext.API.HashedResponse where
 import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
+import GHC.Generics (Generic)
 
 import Gargantext.Prelude
 import qualified Gargantext.Core.Crypto.Hash as Crypto (hash)
-import GHC.Generics (Generic)
 
 data HashedResponse a = HashedResponse { hash :: Text, value :: a }
   deriving (Generic)

src/Gargantext/API/Node.hs

@@ -36,9 +36,14 @@ 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.Metrics
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Node.File
 import Gargantext.API.Node.New
 import Gargantext.API.Prelude
 import Gargantext.API.Table
@@ -60,9 +65,6 @@ import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
-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.API.Search as Search
@@ -147,6 +149,8 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "move"      :> MoveAPI
              :<|> "unpublish" :> Share.Unpublish
 
+             :<|> "file"      :> FileApi
+
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 type RenameApi = Summary " Rename Node"
@@ -222,6 +226,8 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            -- :<|> postUpload id'
            :<|> Share.unPublish id'
 
+           :<|> fileApi uId id'
+
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }

src/Gargantext/API/Node/Corpus/New.hs

@@ -22,10 +22,14 @@ module Gargantext.API.Node.Corpus.New
 import Control.Lens hiding (elements, Empty)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as BSB64
 import Data.Either
 import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant
 import Servant.Job.Core
@@ -36,16 +40,24 @@ import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded          (FromForm)
 
+import Gargantext.Prelude
+
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
+import Gargantext.API.Admin.Settings (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
+import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node (CorpusId, UserId)
-import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
+import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import qualified Gargantext.Prelude.Utils as GPU
 import qualified Gargantext.Text.Corpus.API as API
 import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
 
@@ -166,6 +178,31 @@ instance FromJSON NewWithForm where
 instance ToSchema NewWithForm where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
+-------------------------------------------------------
+data NewWithFile = NewWithFile
+  { _wfi_b64_data :: !Text
+  , _wfi_lang     :: !(Maybe Lang)
+  , _wfi_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewWithFile
+instance FromForm NewWithFile
+instance FromJSON NewWithFile where
+  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
+instance ToSchema NewWithFile where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
+
+instance GPU.SaveFile NewWithFile where
+  saveFile' fp (NewWithFile b64d _ _) = do
+    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
+    case eDecoded of
+      Left err -> panic $ T.pack $ "Error decoding: " <> err
+      Right decoded -> BS.writeFile fp decoded
+    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
+
+--instance GPU.ReadFile NewWithFile where
+--  readFile' = TIO.readFile
+
 ------------------------------------------------------------------------
 type AsyncJobs event ctI input output =
   AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
@@ -189,14 +226,6 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
      :> AsyncJobs JobLog '[JSON] () JobLog
 -}
 
-type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
-   :> "corpus"
-     :> Capture "corpus_id" CorpusId
-   :> "add"
-   :> "form"
-   :> "async"
-     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
-
 
 ------------------------------------------------------------------------
 -- TODO WithQuery also has a corpus id
@@ -209,10 +238,10 @@ addToCorpusWithQuery :: FlowCmdM env err m
 addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   -- TODO ...
   logStatus JobLog { _scst_succeeded = Just 0
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 5
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 5
+                   , _scst_events    = Just []
+                   }
   printDebug "addToCorpusWithQuery" (cid, dbs)
   -- TODO add cid
   -- TODO if cid is folder -> create Corpus
@@ -221,19 +250,28 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   txts <- mapM (\db  -> getDataText db     (Multi l) q Nothing) [database2origin dbs]
 
   logStatus JobLog { _scst_succeeded = Just 2
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 1
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
 
   cids <- mapM (\txt -> flowDataText u txt (Multi l) cid) txts
   printDebug "corpus id" cids
   -- TODO ...
   pure      JobLog { _scst_succeeded = Just 3
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 0
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 0
+                   , _scst_events    = Just []
+                   }
+
+
+type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
+   :> "corpus"
+     :> Capture "corpus_id" CorpusId
+   :> "add"
+   :> "form"
+   :> "async"
+     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
 
 addToCorpusWithForm :: FlowCmdM env err m
                     => User
@@ -243,12 +281,13 @@ addToCorpusWithForm :: FlowCmdM env err m
                     -> m JobLog
 addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
 
-  printDebug "Parsing corpus: " cid
+  printDebug "[addToCorpusWithForm] Parsing corpus: " cid
+  printDebug "[addToCorpusWithForm] fileType" ft
   logStatus JobLog { _scst_succeeded = Just 0
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 2
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 2
+                   , _scst_events    = Just []
+                   }
   let
     parse = case ft of
       CSV_HAL   -> Parser.parseFormat Parser.CsvHal
@@ -263,10 +302,10 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
 
   printDebug "Parsing corpus finished : " cid
   logStatus JobLog { _scst_succeeded = Just 1
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 1
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
 
 
   printDebug "Starting extraction     : " cid
@@ -278,10 +317,10 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
 
   printDebug "Extraction finished   : " cid
   pure      JobLog { _scst_succeeded = Just 2
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 0
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 0
+                   , _scst_events    = Just []
+                   }
 
 {-
 addToCorpusWithFile :: FlowCmdM env err m
@@ -307,3 +346,49 @@ addToCorpusWithFile cid input filetype logStatus = do
 -}
 
 
+
+type AddWithFile = Summary "Add with FileUrlEncoded to corpus endpoint"
+   :> "corpus"
+     :> Capture "corpus_id" CorpusId
+   :> "add"
+   :> "file"
+   :> "async"
+     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
+
+addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m)
+                    => User
+                    -> CorpusId
+                    -> NewWithFile
+                    -> (JobLog -> m ())
+                    -> m JobLog
+addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) logStatus = do
+
+  printDebug "[addToCorpusWithFile] Uploading file to corpus: " cid
+  logStatus JobLog { _scst_succeeded = Just 0
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+
+  fPath <- GPU.writeFile nwf
+  printDebug "[addToCorpusWithFile] File saved as: " fPath
+
+  uId <- getUserId user
+  nIds <- mkNodeWithParent NodeFile (Just cid) uId fName
+
+  _ <- case nIds of
+    [nId] -> do
+        node <- getNodeWith nId (Proxy :: Proxy HyperdataFile)
+        let hl = node ^. node_hyperdata
+        _ <- updateHyperdata nId $ hl { _hff_name = fName
+                                      , _hff_path = T.pack fPath }
+
+        printDebug "[addToCorpusWithFile] Created node with id: " nId
+    _     -> pure ()
+
+  printDebug "[addToCorpusWithFile] File upload to corpus finished: " cid
+  pure $ JobLog { _scst_succeeded = Just 1
+                , _scst_failed    = Just 0
+                , _scst_remaining = Just 0
+                , _scst_events    = Just []
+                }

src/Gargantext/API/Node/File.hs

+{-# LANGUAGE AllowAmbiguousTypes     #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches -fno-warn-unused-imports #-}
+
+module Gargantext.API.Node.File where
+
+import Control.Lens ((^.))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.MIME.Types as DMT
+import Data.Monoid (mempty)
+import Data.Swagger
+import Data.Text
+import Data.Text.Encoding
+import qualified Data.Text.IO as TIO
+import GHC.Generics (Generic)
+import qualified Network.HTTP.Media as M
+import Network.Wai.Application.Static
+import Servant
+import Servant.API.Raw (Raw)
+import Servant.Server.Internal
+
+import Gargantext.Prelude
+import qualified Gargantext.Prelude.Utils as GPU
+
+import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Prelude
+import Gargantext.Database.Action.Flow.Types
+import Gargantext.Database.Admin.Types.Hyperdata.File
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+
+data RESPONSE deriving Typeable
+
+instance Accept RESPONSE where
+  contentType _ = "text" M.// "*"
+
+instance MimeRender RESPONSE BSResponse where
+  mimeRender _ (BSResponse val) = BSL.fromStrict $ val
+
+type FileApi = Summary "File download"
+            :> "download"
+            :> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
+
+fileApi :: UserId -> NodeId -> GargServer FileApi
+fileApi uId nId = fileDownload uId nId
+
+newtype Contents = Contents BS.ByteString
+
+instance GPU.ReadFile Contents where
+  readFile' fp = do
+    c <- BS.readFile fp
+    pure $ Contents c
+
+newtype BSResponse = BSResponse BS.ByteString
+  deriving (Generic)
+
+instance ToSchema BSResponse  where
+  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy BSResponse)
+
+fileDownload :: (HasSettings env, FlowCmdM env err m)
+             => UserId
+             -> NodeId
+             -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
+fileDownload uId nId = do
+  printDebug "[fileDownload] uId" uId
+  printDebug "[fileDownload] nId" nId
+
+  node <- getNodeWith nId (Proxy :: Proxy HyperdataFile)
+  let (HyperdataFile { _hff_name = name'
+                     , _hff_path = path }) = node ^. node_hyperdata
+
+  Contents c <- GPU.readFile $ unpack path
+
+  let (mMime, _) = DMT.guessType DMT.defaultmtd False $ unpack name'
+      mime = case mMime of
+        Just m  -> m
+        Nothing -> "text/plain"
+
+  pure $ addHeader (pack mime) $ BSResponse c
+ 
+  --pure c
+
+  -- let settings = embeddedSettings [("", encodeUtf8 c)]
+
+  -- Tagged $ staticApp settings
+
+  -- let settings = embeddedSettings [("", "hello")]
+  -- Tagged $ staticApp settings
+

src/Gargantext/API/Node/New.hs

@@ -24,6 +24,12 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Servant
+import Servant.Job.Async
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import Web.FormUrlEncoded          (FromForm)
+
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude
@@ -35,11 +41,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
-import Servant
-import Servant.Job.Async
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
 
 ------------------------------------------------------------------------
 data PostNode = PostNode { pn_name     :: Text
@@ -87,25 +88,25 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
 
   printDebug "postNodeAsync" nId
   logStatus JobLog { _scst_succeeded = Just 1
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 2
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 2
+                   , _scst_events    = Just []
+                   }
 
   nodeUser <- getNodeUser (NodeId uId)
 
   -- _ <- threadDelay 1000
   logStatus JobLog { _scst_succeeded = Just 1
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 2
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 2
+                   , _scst_events    = Just []
+                   }
 
   let uId' = nodeUser ^. node_userId
   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 
   pure      JobLog { _scst_succeeded = Just 3
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 0
-                          , _scst_events    = Just []
-                          }
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 0
+                   , _scst_events    = Just []
+                   }

src/Gargantext/API/Routes.hs

@@ -144,7 +144,8 @@ type GargPrivateAPI' =
                           :> TreeAPI
 
            -- :<|> New.Upload
-           :<|> New.AddWithForm 
+           :<|> New.AddWithForm
+           :<|> New.AddWithFile
            :<|> New.AddWithQuery
 
            -- :<|> "annuaire" :> Annuaire.AddWithForm
@@ -222,6 +223,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
           <$> PathNode <*> treeAPI
      -- TODO access
      :<|> addCorpusWithForm  (RootId (NodeId uid))
+     :<|> addCorpusWithFile  (RootId (NodeId uid))
      :<|> addCorpusWithQuery (RootId (NodeId uid))
 
      -- :<|> addAnnuaireWithForm
@@ -271,6 +273,16 @@ addCorpusWithForm user cid =
           liftBase $ log x
       in New.addToCorpusWithForm user cid i log')
 
+addCorpusWithFile :: User -> GargServer New.AddWithFile
+addCorpusWithFile user cid =
+  serveJobsAPI $
+    JobFunction (\i log ->
+      let
+        log' x = do
+          printDebug "addToCorpusWithFile" x
+          liftBase $ log x
+      in New.addToCorpusWithFile user cid i log')
+
 addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
 addAnnuaireWithForm cid =
   serveJobsAPI $

src/Gargantext/Config.hs

@@ -58,7 +58,7 @@ readConfig fp = do
 defaultConfig :: GargConfig
 defaultConfig = GargConfig "gargantua"
                            "secret"
-                           "data/"
+                           "data"
                            "https://frame_write.url"
                            "https://frame_calc.url"
                            "https://frame_searx.url"

src/Gargantext/Database/Action/Delete.hs

@@ -17,34 +17,53 @@ TODO: NodeError
 module Gargantext.Database.Action.Delete
   where
 
+import Control.Lens     (view, (^.))
+import Data.Text
+import Servant
+
+import Gargantext.API.Admin.Settings
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Utils (getUserId)
-import Gargantext.Database.Admin.Config (hasNodeType)
-import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Action.Share (delFolderTeam)
+import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
+import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
+import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
-import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
-import Gargantext.Database.Action.Share (delFolderTeam)
+import qualified Gargantext.Prelude.Utils as GPU
 
 ------------------------------------------------------------------------
-deleteNode :: HasNodeError err
+
+deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err, HasSettings env)
            => User
            -> NodeId
-           -> Cmd err Int
+           -> Cmd' env err Int
 deleteNode u nodeId = do
   node' <- N.getNode nodeId
-  if hasNodeType node' NodeUser
-     then panic "Not allowed to delete NodeUser (yet)"
-     else if hasNodeType node' NodeTeam
-             then do
-                uId   <- getUserId u
-                if _node_userId node' == uId
-                   then N.deleteNode    nodeId
-                   else delFolderTeam u nodeId
-             else N.deleteNode nodeId
-
-
-
+  case (view node_typename node') of
+    nt | nt == nodeTypeId NodeUser -> panic "Not allowed to delete NodeUser (yet)"
+    nt | nt == nodeTypeId NodeTeam -> do
+      uId   <- getUserId u
+      if _node_userId node' == uId
+        then N.deleteNode    nodeId
+        else delFolderTeam u nodeId
+    nt | nt == nodeTypeId NodeFile -> do
+      node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
+      let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
+      GPU.removeFile $ unpack path
+      N.deleteNode nodeId
+    _                             -> N.deleteNode nodeId
+   
+  -- if hasNodeType node' NodeUser
+  --    then panic "Not allowed to delete NodeUser (yet)"
+  --    else if hasNodeType node' NodeTeam
+  --            then do
+  --               uId   <- getUserId u
+  --               if _node_userId node' == uId
+  --                  then N.deleteNode    nodeId
+  --                  else delFolderTeam u nodeId
+  --            else N.deleteNode nodeId

src/Gargantext/Database/Admin/Config.hs

@@ -66,6 +66,8 @@ nodeTypeId n =
     NodeDashboard   -> 71
 --    NodeNoteBook    -> 88
 
+    NodeFile        -> 101
+
     NodeFrameWrite  -> 991
     NodeFrameCalc   -> 992
 

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

@@ -17,6 +17,7 @@ module Gargantext.Database.Admin.Types.Hyperdata
   , module Gargantext.Database.Admin.Types.Hyperdata.Corpus
   , module Gargantext.Database.Admin.Types.Hyperdata.Dashboard
   , module Gargantext.Database.Admin.Types.Hyperdata.Document
+  , module Gargantext.Database.Admin.Types.Hyperdata.File
   , module Gargantext.Database.Admin.Types.Hyperdata.Folder
   , module Gargantext.Database.Admin.Types.Hyperdata.Frame
   , module Gargantext.Database.Admin.Types.Hyperdata.List
@@ -34,6 +35,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Hyperdata.Dashboard
 import Gargantext.Database.Admin.Types.Hyperdata.Document
+import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Hyperdata.Folder
 import Gargantext.Database.Admin.Types.Hyperdata.Frame
 import Gargantext.Database.Admin.Types.Hyperdata.List

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

@@ -53,6 +53,8 @@ data DefaultHyperdata =
   | DefaultFrameWrite    HyperdataFrame
   | DefaultFrameCalc     HyperdataFrame
 
+  | DefaultFile          HyperdataFile
+
 instance Hyperdata DefaultHyperdata
 
 instance ToJSON DefaultHyperdata where
@@ -82,6 +84,8 @@ instance ToJSON DefaultHyperdata where
   toJSON (DefaultFrameWrite x) = toJSON x
   toJSON (DefaultFrameCalc  x) = toJSON x
 
+  toJSON (DefaultFile x) = toJSON x
+
 
 defaultHyperdata :: NodeType -> DefaultHyperdata
 defaultHyperdata NodeUser           = DefaultUser    defaultHyperdataUser
@@ -109,3 +113,5 @@ defaultHyperdata NodeDashboard      = DefaultDashboard defaultHyperdataDashboard
 
 defaultHyperdata NodeFrameWrite     = DefaultFrameWrite defaultHyperdataFrame
 defaultHyperdata NodeFrameCalc      = DefaultFrameCalc  defaultHyperdataFrame
+
+defaultHyperdata NodeFile           = DefaultFile defaultHyperdataFile

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

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.File
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Gargantext.Database.Admin.Types.Hyperdata.File
+  where
+
+import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+
+------------------------------------------------------------------------
+data HyperdataFile =
+  HyperdataFile { _hff_name     :: !Text
+                , _hff_path     :: !Text
+                , _hff_mime     :: !Text
+                }
+    deriving (Generic)
+
+
+defaultHyperdataFile :: HyperdataFile
+defaultHyperdataFile = HyperdataFile "" "" ""
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+-- | Specific Gargantext instance
+instance Hyperdata HyperdataFile
+makeLenses ''HyperdataFile
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_hff_") ''HyperdataFile)
+
+-- | Arbitrary instances for tests
+instance Arbitrary HyperdataFile where
+  arbitrary = pure defaultHyperdataFile
+
+instance FromField HyperdataFile
+  where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataFile
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance ToSchema HyperdataFile where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "_hff_") proxy
+    & mapped.schema.description ?~ "File Hyperdata"
+    & mapped.schema.example ?~ toJSON defaultHyperdataFile

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

@@ -259,6 +259,7 @@ data NodeType = NodeUser
 
               -- Optional Nodes
               | NodeFrameWrite | NodeFrameCalc
+              | NodeFile
 
   deriving (Show, Read, Eq, Generic, Bounded, Enum)
 
@@ -293,6 +294,8 @@ defaultName NodeDashboard     = "Dashboard"
 defaultName NodeFrameWrite    = "Frame Write"
 defaultName NodeFrameCalc     = "Frame Calc"
 
+defaultName NodeFile          = "File"
+
 
 instance FromJSON NodeType
 instance ToJSON NodeType

src/Gargantext/Prelude/Utils.hs

@@ -14,22 +14,25 @@ Portability : POSIX
 module Gargantext.Prelude.Utils
   where
 
+import Control.Exception
 import Control.Lens (view)
+import Control.Monad.Reader (ask, MonadReader)
 import Control.Monad.Random.Class (MonadRandom)
-import Control.Monad.Reader (MonadReader)
-import Control.Monad.Reader (ask)
 import Data.Text (Text)
+import qualified Data.Text             as Text
 import GHC.IO (FilePath)
-import Gargantext.Config
-import Gargantext.API.Admin.Settings
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Prelude
-import Gargantext.Core.Crypto.Hash
 import System.Directory (createDirectoryIfMissing)
+import qualified System.Directory as SD
+import System.IO.Error
 import System.Random (newStdGen)
-import qualified Data.Text             as Text
 import qualified System.Random.Shuffle as SRS
 
+import Gargantext.API.Admin.Settings
+import Gargantext.Config
+import Gargantext.Core.Crypto.Hash
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
+import Gargantext.Prelude
+
 --------------------------------------------------------------------------
 shuffle :: MonadRandom m => [a] -> m [a]
 shuffle ns = SRS.shuffleM ns 
@@ -50,7 +53,7 @@ type FileName   = FilePath
 -- ("gar/gan","texthello")
 
 
-toPath :: Int -> Text -> (FolderPath,FileName)
+toPath :: Int -> Text -> (FolderPath, FileName)
 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
   where
     (x1,x') = Text.splitAt n x
@@ -63,17 +66,26 @@ class ReadFile a where
   readFile' :: FilePath -> IO a
 
 
+folderFilePath :: (MonadReader env m, MonadBase IO m) => m (FolderPath, FileName)
+folderFilePath = do
+  (foldPath, fileName)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
+
+  pure (foldPath, fileName)
+
+
 writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a)
-         => a -> m FilePath
+          => a -> m FilePath
 writeFile a = do
   dataPath <- view (settings . config . gc_datafilepath) <$> ask
-  (fp,fn)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
 
-  let foldPath = dataPath <> "/" <> fp
-      filePath = foldPath <> "/" <> fn
+  (foldPath, fileName) <- folderFilePath
+
+  let filePath = foldPath <> "/" <> fileName
+      dataFoldPath = dataPath <> "/" <> foldPath
+      dataFileName = dataPath <> "/" <> filePath
 
-  _ <- liftBase $ createDirectoryIfMissing True foldPath
-  _ <- liftBase $ saveFile' filePath a
+  _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
+  _ <- liftBase $ saveFile' dataFileName a
 
   pure filePath
 
@@ -83,3 +95,13 @@ readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a)
 readFile fp = do
   dataPath <- view (settings . config . gc_datafilepath) <$> ask
   liftBase $ readFile' $ dataPath <> "/" <> fp
+
+removeFile :: (MonadReader env m, MonadBase IO m, HasSettings env)
+           => FilePath -> m ()
+removeFile fp = do
+  dataPath <- view (settings . config . gc_datafilepath) <$> ask
+  liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e

src/Gargantext/Viz/Graph/API.hs

@@ -20,11 +20,16 @@ module Gargantext.Viz.Graph.API
 
 import Control.Lens (set, (^.), _Just, (^?))
 import Data.Aeson
+import qualified Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Swagger
 import Data.Text
 import Debug.Trace (trace)
 import GHC.Generics (Generic)
+import Servant
+import Servant.Job.Async
+import Servant.XML
+
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (NgramsRepo, r_version)
 import Gargantext.API.Ngrams.Tools
@@ -45,10 +50,6 @@ import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.GEXF ()
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
 import Gargantext.Viz.Graph.Distances (Distance(..), GraphMetric(..))
-import Servant
-import Servant.Job.Async
-import Servant.XML
-import qualified Data.Map as Map
 
 ------------------------------------------------------------------------
 -- | There is no Delete specific API for Graph since it can be deleted