[upload zip] uploading zip works now (with base64 encoding)

spago.dhall

@@ -18,8 +18,8 @@ to generate this file without the comments in this block.
   , "argonaut"
   , "argonaut-codecs"
   , "argonaut-core"
+  , "arraybuffer-types"
   , "arrays"
-  , "b64"
   , "bifunctors"
   , "colors"
   , "console"

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -2,13 +2,12 @@ module Gargantext.Components.Forest.Tree.Node.Action.Upload where
 
 import Gargantext.Prelude
 
-import Data.Either (Either(..), fromRight')
+import Data.Either (Either, fromRight')
 import Data.Eq.Generic (genericEq)
 import Data.Foldable (intercalate)
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing)
 import Data.Newtype (class Newtype)
-import Data.String.Base64 as B64
 import Data.String.Regex as DSR
 import Data.String.Regex.Flags as DSRF
 import Data.Tuple (Tuple(..))
@@ -18,7 +17,7 @@ import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
 import Gargantext.Components.Forest.Tree.Node.Action (Props)
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
-import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsText)
+import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText)
 import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
 import Gargantext.Components.Lang (Lang(..))
 import Gargantext.Components.ListSelection as ListSelection
@@ -232,6 +231,11 @@ uploadButtonCpt = here.component "uploadButton" cpt
             case fileType' of
               Arbitrary ->
                 dispatch $ UploadArbitraryFile (Just name) blob selection'
+              ZIP -> do
+                liftEffect $ here.log "[uploadButton] reading base64"
+                contents <- readUFBAsBase64 blob
+                liftEffect $ here.log "[uploadButton] base64 read"
+                dispatch $ UploadFile nodeType fileType' (Just name) contents selection'
               _ -> do
                 contents <- readUFBAsText blob
                 dispatch $ UploadFile nodeType fileType' (Just name) contents selection'
@@ -368,12 +372,7 @@ uploadFile { contents, fileType, id, nodeType, mName, session } = do
   pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask
     --postMultipartFormData session p fileContents
   where
-    data' = case fileType of
-      ZIP -> case B64.btoa contents of
-                  Left _err -> Nothing
-                  Right dd -> Just dd
-      _   -> Just contents
-    bodyParams = [ Tuple "_wf_data"     data'
+    bodyParams = [ Tuple "_wf_data"     (Just contents)
                  , Tuple "_wf_filetype" (Just $ show fileType)
                  , Tuple "_wf_name"      mName
                  ]
@@ -398,14 +397,14 @@ uploadArbitraryFile :: Session
                     -> Aff (Either RESTError GT.AsyncTaskWithType)
 uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} selection = do
     contents <- readAsDataURL blob
-    uploadArbitraryDataURL session id mName contents
+    uploadArbitraryData session id mName contents
 
-uploadArbitraryDataURL :: Session
+uploadArbitraryData :: Session
                     -> ID
                     -> Maybe String
                     -> String
                     -> Aff (Either RESTError GT.AsyncTaskWithType)
-uploadArbitraryDataURL session id mName contents' = do
+uploadArbitraryData session id mName contents' = do
     let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
         contents = DSR.replace re "" contents'
     eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)

src/Gargantext/Components/Forest/Tree/Node/Action/Upload/Types.purs

 module Gargantext.Components.Forest.Tree.Node.Action.Upload.Types where
 
-import Data.Generic.Rep (class Generic)
+import Gargantext.Prelude
+
+import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Eq.Generic (genericEq)
-import Data.Show.Generic (genericShow)
+import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
+import Data.Show.Generic (genericShow)
 import Effect.Aff (Aff)
+import Gargantext.Utils.ArrayBuffer (arrayBufferToBase64)
 import Web.File.Blob (Blob, size)
-import Web.File.FileReader.Aff (readAsText)
-
-import Gargantext.Prelude
+import Web.File.FileReader.Aff (readAsArrayBuffer, readAsText)
 
 
 data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON | ZIP
@@ -33,5 +35,16 @@ derive instance Generic UploadFileBlob _
 instance Eq UploadFileBlob where
   eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2)
 
+readUFBAsArrayBuffer :: UploadFileBlob -> Aff ArrayBuffer
+readUFBAsArrayBuffer (UploadFileBlob b) = readAsArrayBuffer b
+
+readUFBAsBase64 :: UploadFileBlob -> Aff String
+readUFBAsBase64 (UploadFileBlob b) = do
+  ab <- readAsArrayBuffer b
+  pure $ arrayBufferToBase64 ab
+  --pure $ Base64.runBase64 $ Base64.encodeBase64 ab
+  --at <- readAsText b
+  --pure $ SBase64.encode at
+
 readUFBAsText :: UploadFileBlob -> Aff String
 readUFBAsText (UploadFileBlob b) = readAsText b

src/Gargantext/Components/Forest/Tree/Node/Tools/ProgressBar.purs

@@ -10,7 +10,7 @@ import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Timer (clearInterval, setInterval)
 import Gargantext.Config.REST (RESTError)
-import Gargantext.Config.Utils (handleRESTError)
+import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get)
 import Gargantext.Types (FrontendError)
@@ -60,6 +60,7 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
                 _ <- case R.readRef intervalIdRef of
                   Nothing -> pure unit
                   Just iid -> clearInterval iid
+                handleErrorInAsyncProgress errors asyncProgress
                 onFinish unit
               else
                 pure unit

src/Gargantext/Components/GraphExplorer/Button.purs

@@ -17,7 +17,7 @@ import Effect.Now as EN
 import Reactix as R
 import Reactix.DOM.HTML as H
 
-import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryDataURL)
+import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData)
 import Gargantext.Components.GraphExplorer.API (cloneGraph)
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Components.GraphExplorer.Utils as GEU
@@ -99,7 +99,7 @@ cameraButton { id
           case eClonedGraphId of
             Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
             Right clonedGraphId -> do
-              eRet <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
+              eRet <- uploadArbitraryData session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
               case eRet of
                 Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
                 Right _ret -> do

src/Gargantext/Config/Utils.purs

@@ -4,10 +4,12 @@ import Gargantext.Prelude
 
 import Data.Array as A
 import Data.Either (Either(..))
+import Data.Foldable (foldl)
+import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Gargantext.Config.REST (RESTError)
-import Gargantext.Types (FrontendError(..))
+import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..))
 import Gargantext.Utils.Reactix as R2
 import Toestand as T
 
@@ -22,3 +24,15 @@ handleRESTError errors (Left error) _ = liftEffect $ do
   T.modify_ (A.cons $ FRESTError { error }) errors
   here.log2 "[handleTaskError] RESTError" error
 handleRESTError _ (Right task) handler = handler task
+
+handleErrorInAsyncProgress :: T.Box (Array FrontendError)
+                           -> AsyncProgress
+                           -> Effect Unit
+handleErrorInAsyncProgress errors (AsyncProgress { status: IsFinished, log }) = do
+  T.modify_ (A.cons $ FStringError { error }) errors
+  where
+    error = foldl eventsErrorMessage "" log
+    eventsErrorMessage acc (AsyncTaskLog { events }) = (foldl eventErrorMessage "" events) <> "\n" <> acc
+    eventErrorMessage acc (AsyncEvent { level: "ERROR", message }) = message <> "\n" <> acc
+    eventErrorMessage acc _ = acc
+handleErrorInAsyncProgress _ _ = pure unit

src/Gargantext/Types.purs

@@ -14,16 +14,15 @@ import Data.Show.Generic (genericShow)
 import Data.String as S
 import Effect.Aff (Aff)
 import Foreign as F
+import Gargantext.Components.Lang (class Translate, Lang(..))
+import Gargantext.Config.REST (RESTError)
+import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
 import Prim.Row (class Union)
 import Reactix as R
 import Simple.JSON as JSON
 import Simple.JSON.Generics as JSONG
 import URI.Query (Query)
 
-import Gargantext.Components.Lang (class Translate, Lang(..))
-import Gargantext.Config.REST (RESTError)
-import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
-
 data Handed = LeftHanded | RightHanded
 
 switchHanded :: forall a. a -> a -> Handed -> a
@@ -721,18 +720,17 @@ derive instance Newtype AsyncTask _
 derive newtype instance JSON.ReadForeign AsyncTask
 instance Eq AsyncTask where eq = genericEq
 
-newtype AsyncTaskWithType = AsyncTaskWithType {
-    task :: AsyncTask
+newtype AsyncTaskWithType = AsyncTaskWithType
+  { task :: AsyncTask
   , typ  :: AsyncTaskType
   }
 derive instance Generic AsyncTaskWithType _
 derive instance Newtype AsyncTaskWithType _
 derive newtype instance JSON.ReadForeign AsyncTaskWithType
-instance Eq AsyncTaskWithType where
-  eq = genericEq
+instance Eq AsyncTaskWithType where eq = genericEq
 
-newtype AsyncProgress = AsyncProgress {
-    id :: AsyncTaskID
+newtype AsyncProgress = AsyncProgress
+  { id :: AsyncTaskID
   , log :: Array AsyncTaskLog
   , status :: AsyncTaskStatus
   }
@@ -740,8 +738,16 @@ derive instance Generic AsyncProgress _
 derive instance Newtype AsyncProgress _
 derive newtype instance JSON.ReadForeign AsyncProgress
 
-newtype AsyncTaskLog = AsyncTaskLog {
-    events :: Array String
+newtype AsyncEvent = AsyncEvent
+  { level :: String
+  , message :: String
+  }
+derive instance Generic AsyncEvent _
+derive instance Newtype AsyncEvent _
+derive newtype instance JSON.ReadForeign AsyncEvent
+
+newtype AsyncTaskLog = AsyncTaskLog
+  { events :: Array AsyncEvent
   , failed :: Int
   , remaining :: Int
   , succeeded :: Int
@@ -751,7 +757,7 @@ derive instance Newtype AsyncTaskLog _
 derive newtype instance JSON.ReadForeign AsyncTaskLog
 
 progressPercent :: AsyncProgress -> Number
-progressPercent (AsyncProgress {log}) = perc
+progressPercent (AsyncProgress { log }) = perc
   where
     perc = case A.head log of
       Nothing -> 0.0
@@ -781,10 +787,9 @@ toggleSidePanelState Opened        = Closed
 
 ---------------------------------------------------------------------------
 
-data FrontendError = FStringError
-  { error :: String
-  } | FRESTError
-  { error :: RESTError }
+data FrontendError =
+    FStringError { error :: String }
+  | FRESTError { error :: RESTError }
 
 derive instance Generic FrontendError _
 instance Eq FrontendError where eq = genericEq

src/Gargantext/Utils/ArrayBuffer.js

+exports.arrayBufferToBase64Impl = function(buffer) {
+    var binary = '';
+    var bytes = new Uint8Array( buffer );
+    var len = bytes.byteLength;
+    for (var i = 0; i < len; i++) {
+        binary += String.fromCharCode( bytes[ i ] );
+    }
+    return window.btoa( binary );
+}

src/Gargantext/Utils/ArrayBuffer.purs

+module Gargantext.Utils.ArrayBuffer where
+
+
+import Data.ArrayBuffer.Types (ArrayBuffer)
+import Data.Function.Uncurried (Fn1, runFn1)
+
+foreign import arrayBufferToBase64Impl :: Fn1 ArrayBuffer String
+
+arrayBufferToBase64 :: ArrayBuffer -> String
+arrayBufferToBase64 = runFn1 arrayBufferToBase64Impl
+