Commit b454c023 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[upload] base64-encoded upload works now

parent 4b0bed4d
......@@ -18,6 +18,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, u
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
......@@ -75,6 +76,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
......
......@@ -338,21 +338,21 @@ performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
performAction RefreshTree p
-------
performAction (UploadFile nodeType fileType mName contents) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
performAction (UploadFile nodeType fileType mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadFile session nodeType id fileType {mName, contents}
task <- uploadFile session nodeType id fileType {mName, blob}
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
performAction (UploadArbitraryFile nodeType mName contents) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
performAction (UploadArbitraryFile nodeType mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadArbitraryFile session nodeType id { contents, mName }
task <- uploadArbitraryFile session nodeType id { blob, mName }
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
......
......@@ -13,7 +13,7 @@ import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
......@@ -150,11 +150,11 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session, handed} = R.createEle
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
liftEffect $ setDroppedFile
$ const
$ Just
$ DroppedFile { contents: (UploadFileContents contents)
$ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV
, lang : EN
}
......
......@@ -7,7 +7,7 @@ import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileBlob)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
......@@ -24,8 +24,8 @@ data Action = AddNode String GT.NodeType
| RenameNode String
| UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| UploadArbitraryFile GT.NodeType (Maybe String) UploadFileContents
| UploadFile GT.NodeType FileType (Maybe String) UploadFileBlob
| UploadArbitraryFile GT.NodeType (Maybe String) UploadFileBlob
| DownloadNode
| RefreshTree
......
module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
......@@ -14,12 +17,13 @@ import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Routes as GR
......@@ -27,6 +31,7 @@ import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.String as GUS
-- UploadFile Action
......@@ -49,7 +54,7 @@ actionUpload _ _ _ _ =
-- file upload types
data DroppedFile =
DroppedFile { contents :: UploadFileContents
DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType
, lang :: Lang
}
......@@ -58,7 +63,7 @@ type FileHash = String
type UploadFile =
{ contents :: UploadFileContents
{ blob :: UploadFileBlob
, name :: String
}
......@@ -117,9 +122,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
--contents <- readAsDataURL blob
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
setMFile $ const $ Just $ {blob: UploadFileBlob blob, name}
type UploadButtonProps =
......@@ -156,14 +162,14 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
Just _ -> ""
onClick e = do
let { contents, name } = unsafePartial $ fromJust mFile
let { blob, name } = unsafePartial $ fromJust mFile
log2 "[uploadButton] fileType" fileType
void $ launchAff do
case fileType of
Arbitrary ->
dispatch $ UploadArbitraryFile nodeType (Just name) contents
dispatch $ UploadArbitraryFile nodeType (Just name) blob
_ ->
dispatch $ UploadFile nodeType fileType (Just name) contents
dispatch $ UploadFile nodeType fileType (Just name) blob
liftEffect $ do
setMFile $ const $ Nothing
setFileType $ const $ CSV
......@@ -185,7 +191,7 @@ fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
where
cpt { dispatch
, droppedFile: Just (DroppedFile {contents, fileType}) /\ setDroppedFile
, droppedFile: Just (DroppedFile {blob, fileType}) /\ setDroppedFile
, isDragOver: (_ /\ setIsDragOver)
, nodeType
} _ = pure
......@@ -228,7 +234,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
]
where
onChange e l =
setDroppedFile $ const $ Just $ DroppedFile $ { contents
setDroppedFile $ const $ Just $ DroppedFile $ { blob
, fileType: read $ R2.unsafeEventValue e
, lang : fromMaybe EN $ read $ R2.unsafeEventValue l
}
......@@ -243,7 +249,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
, type: "button"
, on: {click: \_ -> do
setDroppedFile $ const Nothing
launchAff $ dispatch $ UploadFile nodeType ft Nothing contents
launchAff $ dispatch $ UploadFile nodeType ft Nothing blob
}
} [H.text "Upload"]
Nothing ->
......@@ -271,11 +277,12 @@ uploadFile :: Session
-> GT.NodeType
-> ID
-> FileType
-> {contents :: UploadFileContents, mName :: Maybe String}
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadFile session nodeType id fileType {mName, contents: UploadFileContents contents} = do
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
contents <- readAsText blob
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents
where
p = case nodeType of
......@@ -283,31 +290,34 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
_ -> GR.NodeAPI nodeType (Just id) ""
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
bodyParams c = [ Tuple "_wf_data" (Just c)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
uploadArbitraryFile :: Session
-> GT.NodeType
-> ID
-> {contents :: UploadFileContents, mName :: Maybe String}
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadArbitraryFile session nodeType id {mName, contents: UploadFileContents contents} = do
uploadArbitraryFile session nodeType id {mName, blob: UploadFileBlob blob} = do
if nodeType == Corpus then
pure unit
else
throwError $ error $ "[uploadArbitraryFile] NodeType " <> (show nodeType) <> " not supported"
task <- postWwwUrlencoded session p bodyParams
contents' <- readAsDataURL blob
let re = unsafePartial $ fromRight $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
where
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams = [ Tuple "_wfi_data" (Just contents)
, Tuple "_wfi_name" mName
]
bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_name" mName
]
------------------------------------------------------------------------
......@@ -343,9 +353,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
liftEffect $ do
setMFile $ const $ Just $ { contents: UploadFileContents contents
setMFile $ const $ Just $ { blob: UploadFileBlob blob
, name
}
......@@ -371,9 +381,9 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
Just _ -> ""
onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile
let {name, blob} = unsafePartial $ fromJust mFile
void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) contents
_ <- dispatch $ UploadFile nodeType CSV (Just name) blob
liftEffect $ do
setMFile $ const $ Nothing
......
......@@ -4,6 +4,8 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Web.File.Blob (Blob)
import Gargantext.Prelude (class Read, class Show, class Eq)
......@@ -27,6 +29,4 @@ instance readFileType :: Read FileType where
read _ = Nothing
newtype UploadFileContents = UploadFileContents String
newtype UploadFileBlob = UploadFileBlob Blob
module Gargantext.Components.Nodes.File where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as T
newtype HyperdataFile = HyperdataFile {
mime :: String
, name :: String
, path :: String
}
instance decodeHyperdataFile :: DecodeJson HyperdataFile where
decodeJson json = do
obj <- decodeJson json
mime <- obj .: "mime"
name <- obj .: "name"
path <- obj .: "path"
pure $ HyperdataFile {
mime
, name
, path
}
newtype File = File {
id :: Int
, date :: String
, hyperdata :: HyperdataFile
, name :: String
}
instance decodeFile :: DecodeJson File where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
date <- obj .: "date"
hyperdata' <- obj .: "hyperdata"
hyperdata <- decodeJson hyperdata'
name <- obj .: "name"
pure $ File {
id
, date
, hyperdata
, name
}
type FileLayoutProps = (
nodeId :: Int
, session :: Session
)
fileLayout :: Record FileLayoutProps -> R.Element
fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = R.hooksComponent "G.C.N.F.fileLayout" cpt
where
cpt { nodeId, session } _ = do
useLoader { nodeId } (loadFile session) $ \loaded ->
fileLayoutLoaded { loaded, nodeId, session }
type LoadFileProps = (
nodeId :: Int
)
loadFile :: Session -> Record LoadFileProps -> Aff File
loadFile session { nodeId } = get session $ NodeAPI T.Node (Just nodeId) ""
type FileLayoutLoadedProps = (
loaded :: File
| FileLayoutProps
)
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = R.hooksComponent "G.C.N.F.fileLayoutLoaded" cpt
where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
R.useEffect' $ do
log2 "[fileLayoutLoaded] hyperdata" hyperdata
pure $ H.div { className: "col-md-12" } [
H.div { className: "row" } [
H.h2 {} [ H.text hyperdata.name ]
]
, H.div { className: "row" } [
H.div { className: "btn btn-default" } [
H.a { href: "/api/v1.0/node/" <> show nodeId <> "/file/download"
, target: "_blank"
} [ H.text "Download" ]
]
]
]
......@@ -33,6 +33,7 @@ router = oneOf
, RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int
, RouteFile <$> (route "file" *> sid) <*> int
, Home <$ lit ""
]
where
......
......@@ -27,6 +27,7 @@ data AppRoute
| ContactPage SessionId Int Int
| RouteFrameWrite SessionId Int
| RouteFrameCalc SessionId Int
| RouteFile SessionId Int
derive instance eqAppRoute :: Eq AppRoute
......@@ -74,6 +75,7 @@ instance showAppRoute :: Show AppRoute where
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
show (RouteFile s i) = "file" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
......@@ -94,8 +96,9 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFile s i) = "file/" <> show s <> "/" <> show i
nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute
nodeTypeAppRoute GT.Annuaire s i = Just $ Annuaire s i
......
exports._btoa = function(s) {
return btoa(unescape(encodeURIComponent(s)));
}
module Gargantext.Utils.String where
import Data.Function.Uncurried (Fn1, runFn1)
foreign import _btoa :: Fn1 String String
btoa :: String -> String
btoa = runFn1 _btoa
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment