[upload] base64-encoded file upload works now

package.yaml

@@ -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

@@ -43,6 +43,7 @@ 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
@@ -148,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"
@@ -223,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,12 +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.IO as TIO
+import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant
 import Servant.Job.Core
@@ -178,7 +180,7 @@ instance ToSchema NewWithForm where
 
 -------------------------------------------------------
 data NewWithFile = NewWithFile
-  { _wfi_data     :: !Text
+  { _wfi_b64_data :: !Text
   , _wfi_lang     :: !(Maybe Lang)
   , _wfi_name     :: !Text
   } deriving (Eq, Show, Generic)
@@ -191,7 +193,12 @@ instance ToSchema NewWithFile where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
 
 instance GPU.SaveFile NewWithFile where
-  saveFile' fp (NewWithFile d _ _) = TIO.writeFile fp d
+  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

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/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/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
 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