Support transfering of notes

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

@@ -24,7 +24,9 @@ import Data.ByteString.Lazy qualified as BL
 import Data.Conduit.Combinators qualified as C
 import Data.Conduit.List qualified as CL
 import Data.Foldable (for_, foldlM)
+import Data.List qualified as List
 import Data.List.Split qualified as Split
+import Data.Monoid
 import Data.String (IsString(..))
 import Data.Text.Encoding  qualified as TE
 import Data.Text qualified as T
@@ -59,8 +61,8 @@ import Gargantext.Orphans ()
 import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
 import GHC.Generics (Generic)
 import Network.HTTP.Client qualified as HTTP
+import Network.HTTP.Types.Header qualified as HTTP
 import Prelude
-import qualified Network.HTTP.Types.Header as HTTP
 import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
 import Servant.Server.Generic (AsServerT)
 
@@ -270,7 +272,7 @@ importNote :: (MonadIO m, MonadLogger m, HasBackendInternalError err, IsDBCmd en
            -> m HyperdataFrame
 importNote mgr rawText cfg = do
   let _hf_base = cfg ^. gc_frames . f_write_url
-  case HTTP.parseRequest (T.unpack _hf_base) of
+  case HTTP.parseRequest (T.unpack _hf_base `appendPath` "/new") of
     Left err -> do
       let msg = "Couldn't extract a valid URL from " <> _hf_base <> ", " <> T.pack (show err)
       $(logLocM) ERROR msg
@@ -280,10 +282,14 @@ importNote mgr rawText cfg = do
                    , HTTP.requestHeaders = textMarkdown : (HTTP.requestHeaders rq0)
                    , HTTP.requestBody = HTTP.RequestBodyBS (TE.encodeUtf8 rawText)
                    }
-      -- The response will contain the new path to the notes, where the last fragment
+      -- The response will contain (in the redirects) the new path to the notes, where the last fragment
       -- is the frameId
-      res <- HTTP.responseBody <$> liftIO (HTTP.httpLbs rq mgr)
-      let _hf_frame_id = snd $ T.breakOnEnd "/" (TE.decodeUtf8 $ BL.toStrict res)
+      res <- liftIO $ HTTP.withResponseHistory rq mgr $ \redirects -> do
+        let allLocations = map (First . List.lookup HTTP.hLocation . HTTP.responseHeaders . snd) (HTTP.hrRedirects redirects)
+        case getFirst $ mconcat allLocations of
+          Nothing -> pure mempty
+          Just x  -> pure x
+      let _hf_frame_id = snd $ T.breakOnEnd "/" (TE.decodeUtf8 res)
       pure $ HyperdataFrame{..}
   where
    mk_err msg =
@@ -293,6 +299,13 @@ importNote mgr rawText cfg = do
    textMarkdown :: HTTP.Header
    textMarkdown = (HTTP.hContentType, fromString "text/markdown")
 
+-- | Append two URL paths together. The second argument must be given with an initial '/',
+-- and must be non-null.
+appendPath :: String -> String -> String
+appendPath t r = case List.last t of
+  '/' -> t <> List.tail r
+  _   -> t <> r
+
 checkNodesTypeAllowed :: (MonadError e m, HasNodeError e) => Tree (Node a) -> m ()
 checkNodesTypeAllowed (TreeN r xs) = do
   checkNodeTypeAllowed r